module GHC.SourceGen.Name.Internal where
import Data.Char (isAlphaNum, isUpper)
import Data.List (intercalate)
import Data.String (IsString(..))
import FastString (FastString, fsLit)
import Module (mkModuleNameFS, ModuleName, moduleNameString)
import RdrName
import OccName
import SrcLoc (Located)
import GHC.SourceGen.Syntax.Internal (builtLoc)
data OccNameStr = OccNameStr !RawNameSpace !FastString
deriving (Show, Eq, Ord)
data RawNameSpace = Constructor | Value
deriving (Show, Eq, Ord)
rawNameSpace :: String -> RawNameSpace
rawNameSpace (c:_)
| isUpper c = Constructor
rawNameSpace _ = Value
instance IsString OccNameStr where
fromString s = OccNameStr (rawNameSpace s) (fsLit s)
valueOccName, typeOccName :: OccNameStr -> OccName
valueOccName (OccNameStr Constructor s) = mkDataOccFS s
valueOccName (OccNameStr Value s) = mkVarOccFS s
typeOccName (OccNameStr Constructor s) = mkTcOccFS s
typeOccName (OccNameStr Value s) = mkTyVarOccFS s
newtype ModuleNameStr = ModuleNameStr { unModuleNameStr :: ModuleName }
deriving (Eq, Ord)
instance Show ModuleNameStr where
show = show . moduleNameString . unModuleNameStr
instance IsString ModuleNameStr where
fromString = ModuleNameStr . mkModuleNameFS . fsLit
data RdrNameStr = UnqualStr OccNameStr | QualStr ModuleNameStr OccNameStr
deriving (Show, Eq, Ord)
valueRdrName, typeRdrName :: RdrNameStr -> Located RdrName
valueRdrName (UnqualStr r) = builtLoc $ Unqual $ valueOccName r
valueRdrName (QualStr (ModuleNameStr m) r) = builtLoc $ Qual m $ valueOccName r
typeRdrName (UnqualStr r) = builtLoc $ Unqual $ typeOccName r
typeRdrName (QualStr (ModuleNameStr m) r) = builtLoc $ Qual m $ typeOccName r
instance IsString RdrNameStr where
fromString s = case collectModuleName s of
(m, n)
| null m -> UnqualStr (fromString n)
| otherwise -> QualStr (fromString $ intercalate "." m) (fromString n)
collectModuleName :: String -> ([String],String)
collectModuleName s = case span isVarChar s of
("", n) -> ([], n)
(n, "") -> ([], n)
(m, '.' : s') -> case collectModuleName s' of
(m', s'') -> (m : m', s'')
_ -> error $ "Unable to parse RdrNameStr: " ++ show s
where
isVarChar '\'' = True
isVarChar '_' = True
isVarChar c = isAlphaNum c
exportRdrName :: RdrNameStr -> Located RdrName
exportRdrName (UnqualStr r) = builtLoc $ Unqual $ exportOccName r
exportRdrName (QualStr (ModuleNameStr m) r) = builtLoc $ Qual m $ exportOccName r
exportOccName :: OccNameStr -> OccName
exportOccName (OccNameStr Value s) = mkVarOccFS s
exportOccName (OccNameStr Constructor s) = mkTcOccFS s