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 (Int -> OccNameStr -> ShowS
[OccNameStr] -> ShowS
OccNameStr -> String
(Int -> OccNameStr -> ShowS)
-> (OccNameStr -> String)
-> ([OccNameStr] -> ShowS)
-> Show OccNameStr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OccNameStr] -> ShowS
$cshowList :: [OccNameStr] -> ShowS
show :: OccNameStr -> String
$cshow :: OccNameStr -> String
showsPrec :: Int -> OccNameStr -> ShowS
$cshowsPrec :: Int -> OccNameStr -> ShowS
Show, OccNameStr -> OccNameStr -> Bool
(OccNameStr -> OccNameStr -> Bool)
-> (OccNameStr -> OccNameStr -> Bool) -> Eq OccNameStr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OccNameStr -> OccNameStr -> Bool
$c/= :: OccNameStr -> OccNameStr -> Bool
== :: OccNameStr -> OccNameStr -> Bool
$c== :: OccNameStr -> OccNameStr -> Bool
Eq, Eq OccNameStr
Eq OccNameStr
-> (OccNameStr -> OccNameStr -> Ordering)
-> (OccNameStr -> OccNameStr -> Bool)
-> (OccNameStr -> OccNameStr -> Bool)
-> (OccNameStr -> OccNameStr -> Bool)
-> (OccNameStr -> OccNameStr -> Bool)
-> (OccNameStr -> OccNameStr -> OccNameStr)
-> (OccNameStr -> OccNameStr -> OccNameStr)
-> Ord OccNameStr
OccNameStr -> OccNameStr -> Bool
OccNameStr -> OccNameStr -> Ordering
OccNameStr -> OccNameStr -> OccNameStr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OccNameStr -> OccNameStr -> OccNameStr
$cmin :: OccNameStr -> OccNameStr -> OccNameStr
max :: OccNameStr -> OccNameStr -> OccNameStr
$cmax :: OccNameStr -> OccNameStr -> OccNameStr
>= :: OccNameStr -> OccNameStr -> Bool
$c>= :: OccNameStr -> OccNameStr -> Bool
> :: OccNameStr -> OccNameStr -> Bool
$c> :: OccNameStr -> OccNameStr -> Bool
<= :: OccNameStr -> OccNameStr -> Bool
$c<= :: OccNameStr -> OccNameStr -> Bool
< :: OccNameStr -> OccNameStr -> Bool
$c< :: OccNameStr -> OccNameStr -> Bool
compare :: OccNameStr -> OccNameStr -> Ordering
$ccompare :: OccNameStr -> OccNameStr -> Ordering
$cp1Ord :: Eq OccNameStr
Ord)
data RawNameSpace = Constructor | Value
deriving (Int -> RawNameSpace -> ShowS
[RawNameSpace] -> ShowS
RawNameSpace -> String
(Int -> RawNameSpace -> ShowS)
-> (RawNameSpace -> String)
-> ([RawNameSpace] -> ShowS)
-> Show RawNameSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawNameSpace] -> ShowS
$cshowList :: [RawNameSpace] -> ShowS
show :: RawNameSpace -> String
$cshow :: RawNameSpace -> String
showsPrec :: Int -> RawNameSpace -> ShowS
$cshowsPrec :: Int -> RawNameSpace -> ShowS
Show, RawNameSpace -> RawNameSpace -> Bool
(RawNameSpace -> RawNameSpace -> Bool)
-> (RawNameSpace -> RawNameSpace -> Bool) -> Eq RawNameSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawNameSpace -> RawNameSpace -> Bool
$c/= :: RawNameSpace -> RawNameSpace -> Bool
== :: RawNameSpace -> RawNameSpace -> Bool
$c== :: RawNameSpace -> RawNameSpace -> Bool
Eq, Eq RawNameSpace
Eq RawNameSpace
-> (RawNameSpace -> RawNameSpace -> Ordering)
-> (RawNameSpace -> RawNameSpace -> Bool)
-> (RawNameSpace -> RawNameSpace -> Bool)
-> (RawNameSpace -> RawNameSpace -> Bool)
-> (RawNameSpace -> RawNameSpace -> Bool)
-> (RawNameSpace -> RawNameSpace -> RawNameSpace)
-> (RawNameSpace -> RawNameSpace -> RawNameSpace)
-> Ord RawNameSpace
RawNameSpace -> RawNameSpace -> Bool
RawNameSpace -> RawNameSpace -> Ordering
RawNameSpace -> RawNameSpace -> RawNameSpace
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawNameSpace -> RawNameSpace -> RawNameSpace
$cmin :: RawNameSpace -> RawNameSpace -> RawNameSpace
max :: RawNameSpace -> RawNameSpace -> RawNameSpace
$cmax :: RawNameSpace -> RawNameSpace -> RawNameSpace
>= :: RawNameSpace -> RawNameSpace -> Bool
$c>= :: RawNameSpace -> RawNameSpace -> Bool
> :: RawNameSpace -> RawNameSpace -> Bool
$c> :: RawNameSpace -> RawNameSpace -> Bool
<= :: RawNameSpace -> RawNameSpace -> Bool
$c<= :: RawNameSpace -> RawNameSpace -> Bool
< :: RawNameSpace -> RawNameSpace -> Bool
$c< :: RawNameSpace -> RawNameSpace -> Bool
compare :: RawNameSpace -> RawNameSpace -> Ordering
$ccompare :: RawNameSpace -> RawNameSpace -> Ordering
$cp1Ord :: Eq RawNameSpace
Ord)
rawNameSpace :: String -> RawNameSpace
rawNameSpace :: String -> RawNameSpace
rawNameSpace (Char
c:String
_)
| Char -> Bool
isUpper Char
c = RawNameSpace
Constructor
rawNameSpace String
_ = RawNameSpace
Value
instance IsString OccNameStr where
fromString :: String -> OccNameStr
fromString String
s = RawNameSpace -> FastString -> OccNameStr
OccNameStr (String -> RawNameSpace
rawNameSpace String
s) (String -> FastString
fsLit String
s)
valueOccName, typeOccName :: OccNameStr -> OccName
valueOccName :: OccNameStr -> OccName
valueOccName (OccNameStr RawNameSpace
Constructor FastString
s) = FastString -> OccName
mkDataOccFS FastString
s
valueOccName (OccNameStr RawNameSpace
Value FastString
s) = FastString -> OccName
mkVarOccFS FastString
s
typeOccName :: OccNameStr -> OccName
typeOccName (OccNameStr RawNameSpace
Constructor FastString
s) = FastString -> OccName
mkTcOccFS FastString
s
typeOccName (OccNameStr RawNameSpace
Value FastString
s) = FastString -> OccName
mkTyVarOccFS FastString
s
newtype ModuleNameStr = ModuleNameStr { ModuleNameStr -> ModuleName
unModuleNameStr :: ModuleName }
deriving (ModuleNameStr -> ModuleNameStr -> Bool
(ModuleNameStr -> ModuleNameStr -> Bool)
-> (ModuleNameStr -> ModuleNameStr -> Bool) -> Eq ModuleNameStr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleNameStr -> ModuleNameStr -> Bool
$c/= :: ModuleNameStr -> ModuleNameStr -> Bool
== :: ModuleNameStr -> ModuleNameStr -> Bool
$c== :: ModuleNameStr -> ModuleNameStr -> Bool
Eq, Eq ModuleNameStr
Eq ModuleNameStr
-> (ModuleNameStr -> ModuleNameStr -> Ordering)
-> (ModuleNameStr -> ModuleNameStr -> Bool)
-> (ModuleNameStr -> ModuleNameStr -> Bool)
-> (ModuleNameStr -> ModuleNameStr -> Bool)
-> (ModuleNameStr -> ModuleNameStr -> Bool)
-> (ModuleNameStr -> ModuleNameStr -> ModuleNameStr)
-> (ModuleNameStr -> ModuleNameStr -> ModuleNameStr)
-> Ord ModuleNameStr
ModuleNameStr -> ModuleNameStr -> Bool
ModuleNameStr -> ModuleNameStr -> Ordering
ModuleNameStr -> ModuleNameStr -> ModuleNameStr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleNameStr -> ModuleNameStr -> ModuleNameStr
$cmin :: ModuleNameStr -> ModuleNameStr -> ModuleNameStr
max :: ModuleNameStr -> ModuleNameStr -> ModuleNameStr
$cmax :: ModuleNameStr -> ModuleNameStr -> ModuleNameStr
>= :: ModuleNameStr -> ModuleNameStr -> Bool
$c>= :: ModuleNameStr -> ModuleNameStr -> Bool
> :: ModuleNameStr -> ModuleNameStr -> Bool
$c> :: ModuleNameStr -> ModuleNameStr -> Bool
<= :: ModuleNameStr -> ModuleNameStr -> Bool
$c<= :: ModuleNameStr -> ModuleNameStr -> Bool
< :: ModuleNameStr -> ModuleNameStr -> Bool
$c< :: ModuleNameStr -> ModuleNameStr -> Bool
compare :: ModuleNameStr -> ModuleNameStr -> Ordering
$ccompare :: ModuleNameStr -> ModuleNameStr -> Ordering
$cp1Ord :: Eq ModuleNameStr
Ord)
instance Show ModuleNameStr where
show :: ModuleNameStr -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (ModuleNameStr -> String) -> ModuleNameStr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String)
-> (ModuleNameStr -> ModuleName) -> ModuleNameStr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleNameStr -> ModuleName
unModuleNameStr
instance IsString ModuleNameStr where
fromString :: String -> ModuleNameStr
fromString = ModuleName -> ModuleNameStr
ModuleNameStr (ModuleName -> ModuleNameStr)
-> (String -> ModuleName) -> String -> ModuleNameStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ModuleName
mkModuleNameFS (FastString -> ModuleName)
-> (String -> FastString) -> String -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
fsLit
data RdrNameStr = UnqualStr OccNameStr | QualStr ModuleNameStr OccNameStr
deriving (Int -> RdrNameStr -> ShowS
[RdrNameStr] -> ShowS
RdrNameStr -> String
(Int -> RdrNameStr -> ShowS)
-> (RdrNameStr -> String)
-> ([RdrNameStr] -> ShowS)
-> Show RdrNameStr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RdrNameStr] -> ShowS
$cshowList :: [RdrNameStr] -> ShowS
show :: RdrNameStr -> String
$cshow :: RdrNameStr -> String
showsPrec :: Int -> RdrNameStr -> ShowS
$cshowsPrec :: Int -> RdrNameStr -> ShowS
Show, RdrNameStr -> RdrNameStr -> Bool
(RdrNameStr -> RdrNameStr -> Bool)
-> (RdrNameStr -> RdrNameStr -> Bool) -> Eq RdrNameStr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RdrNameStr -> RdrNameStr -> Bool
$c/= :: RdrNameStr -> RdrNameStr -> Bool
== :: RdrNameStr -> RdrNameStr -> Bool
$c== :: RdrNameStr -> RdrNameStr -> Bool
Eq, Eq RdrNameStr
Eq RdrNameStr
-> (RdrNameStr -> RdrNameStr -> Ordering)
-> (RdrNameStr -> RdrNameStr -> Bool)
-> (RdrNameStr -> RdrNameStr -> Bool)
-> (RdrNameStr -> RdrNameStr -> Bool)
-> (RdrNameStr -> RdrNameStr -> Bool)
-> (RdrNameStr -> RdrNameStr -> RdrNameStr)
-> (RdrNameStr -> RdrNameStr -> RdrNameStr)
-> Ord RdrNameStr
RdrNameStr -> RdrNameStr -> Bool
RdrNameStr -> RdrNameStr -> Ordering
RdrNameStr -> RdrNameStr -> RdrNameStr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RdrNameStr -> RdrNameStr -> RdrNameStr
$cmin :: RdrNameStr -> RdrNameStr -> RdrNameStr
max :: RdrNameStr -> RdrNameStr -> RdrNameStr
$cmax :: RdrNameStr -> RdrNameStr -> RdrNameStr
>= :: RdrNameStr -> RdrNameStr -> Bool
$c>= :: RdrNameStr -> RdrNameStr -> Bool
> :: RdrNameStr -> RdrNameStr -> Bool
$c> :: RdrNameStr -> RdrNameStr -> Bool
<= :: RdrNameStr -> RdrNameStr -> Bool
$c<= :: RdrNameStr -> RdrNameStr -> Bool
< :: RdrNameStr -> RdrNameStr -> Bool
$c< :: RdrNameStr -> RdrNameStr -> Bool
compare :: RdrNameStr -> RdrNameStr -> Ordering
$ccompare :: RdrNameStr -> RdrNameStr -> Ordering
$cp1Ord :: Eq RdrNameStr
Ord)
valueRdrName, typeRdrName :: RdrNameStr -> Located RdrName
valueRdrName :: RdrNameStr -> Located RdrName
valueRdrName (UnqualStr OccNameStr
r) = RdrName -> Located RdrName
forall e. e -> Located e
builtLoc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
Unqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ OccNameStr -> OccName
valueOccName OccNameStr
r
valueRdrName (QualStr (ModuleNameStr ModuleName
m) OccNameStr
r) = RdrName -> Located RdrName
forall e. e -> Located e
builtLoc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
Qual ModuleName
m (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ OccNameStr -> OccName
valueOccName OccNameStr
r
typeRdrName :: RdrNameStr -> Located RdrName
typeRdrName (UnqualStr OccNameStr
r) = RdrName -> Located RdrName
forall e. e -> Located e
builtLoc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
Unqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ OccNameStr -> OccName
typeOccName OccNameStr
r
typeRdrName (QualStr (ModuleNameStr ModuleName
m) OccNameStr
r) = RdrName -> Located RdrName
forall e. e -> Located e
builtLoc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
Qual ModuleName
m (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ OccNameStr -> OccName
typeOccName OccNameStr
r
instance IsString RdrNameStr where
fromString :: String -> RdrNameStr
fromString String
s = case String -> ([String], String)
collectModuleName String
s of
([String]
m, String
n)
| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
m -> OccNameStr -> RdrNameStr
UnqualStr (String -> OccNameStr
forall a. IsString a => String -> a
fromString String
n)
| Bool
otherwise -> ModuleNameStr -> OccNameStr -> RdrNameStr
QualStr (String -> ModuleNameStr
forall a. IsString a => String -> a
fromString (String -> ModuleNameStr) -> String -> ModuleNameStr
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
m) (String -> OccNameStr
forall a. IsString a => String -> a
fromString String
n)
collectModuleName :: String -> ([String],String)
collectModuleName :: String -> ([String], String)
collectModuleName String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isVarChar String
s of
(String
"", String
n) -> ([], String
n)
(String
n, String
"") -> ([], String
n)
(String
m, Char
'.' : String
s') -> case String -> ([String], String)
collectModuleName String
s' of
([String]
m', String
s'') -> (String
m String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
m', String
s'')
(String, String)
_ -> String -> ([String], String)
forall a. HasCallStack => String -> a
error (String -> ([String], String)) -> String -> ([String], String)
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse RdrNameStr: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
where
isVarChar :: Char -> Bool
isVarChar Char
'\'' = Bool
True
isVarChar Char
'_' = Bool
True
isVarChar Char
c = Char -> Bool
isAlphaNum Char
c
exportRdrName :: RdrNameStr -> Located RdrName
exportRdrName :: RdrNameStr -> Located RdrName
exportRdrName (UnqualStr OccNameStr
r) = RdrName -> Located RdrName
forall e. e -> Located e
builtLoc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
Unqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ OccNameStr -> OccName
exportOccName OccNameStr
r
exportRdrName (QualStr (ModuleNameStr ModuleName
m) OccNameStr
r) = RdrName -> Located RdrName
forall e. e -> Located e
builtLoc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
Qual ModuleName
m (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ OccNameStr -> OccName
exportOccName OccNameStr
r
exportOccName :: OccNameStr -> OccName
exportOccName :: OccNameStr -> OccName
exportOccName (OccNameStr RawNameSpace
Value FastString
s) = FastString -> OccName
mkVarOccFS FastString
s
exportOccName (OccNameStr RawNameSpace
Constructor FastString
s) = FastString -> OccName
mkTcOccFS FastString
s