-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

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)

-- | A string identifier referring to a name.
--
-- 'OccNameStr' keeps track of whether it is a "constructor" or "variable"
-- (e.g.: @\"Foo\"@ vs @\"foo\"@, respectively).
--
-- 'OccNameStr' is simililar in purpose to GHC's 'OccName'.  However, unlike
-- 'OccName', 'OccNameStr' does not differentiate between the namespace
-- of types and of values.
-- Functions in this package that take an 'OccNameStr' as input
-- will internally convert it to the proper namespace.  (This approach
-- makes it easier to implement an 'IsString' instance without the context
-- where a name would be used.)
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)

-- TODO: symbols
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

-- | A newtype wrapper around 'ModuleName' which is an instance of 'IsString'.
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

-- | A string identifier which may be qualified to a particular module.
--
-- 'RdrNameStr' wraps an 'OccNameStr' and thus keeps track of whether it is a
-- "constructor" or "variable" (e.g.: @\"Foo.Bar\"@ vs @\"Foo.bar\"@,
-- respectively).
--
-- 'RdrNameStr' is simililar in purpose to GHC's 'RdrName'.  However, unlike
-- 'RdrName', 'RdrNameStr' does not differentiate between the namespace of types
-- and of values.
-- Functions in this package that take a 'RdrNameStr' as input
-- will internally convert it to the proper namespace.  (This approach
-- makes it easier to implement an 'IsString' instance without the context
-- where a name would be used.)
--
-- For example:
--
-- > fromString "A.B.c" == QualStr (fromString "A.B") (fromString "c")
-- > fromString "c" == UnqualStr (fromString "c")
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)

-- GHC always wraps RdrName in a Located.  (Usually: 'Located (IdP pass)')
-- So for convenience, these functions return a Located-wrapped value.
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

-- TODO: operators
instance IsString RdrNameStr where
    -- Split "Foo.Bar.baz" into ("Foo.Bar", "baz")
    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)  -- Symbol
    (String
n, String
"") -> ([], String
n)  -- Identifier
    (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

-- | A RdrName suitable for an import or export list.
-- E.g.: `import F(a, B)`
-- The 'a' should be a value, but the 'B' should be a type/class.
-- (Currently, GHC doesn't distinguish the class and type namespaces.)
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