{-# LANGUAGE TemplateHaskell #-}

-- |
-- Data types for names
--
module Language.PureScript.Names where

import Prelude.Compat

import Codec.Serialise (Serialise)
import Control.Monad.Supply.Class
import Control.DeepSeq (NFData)
import Data.Functor.Contravariant (contramap)
import qualified Data.Vector as V

import GHC.Generics (Generic)
import Data.Aeson
import Data.Aeson.TH
import Data.Text (Text)
import qualified Data.Text as T

-- | A sum of the possible name types, useful for error and lint messages.
data Name
  = IdentName Ident
  | ValOpName (OpName 'ValueOpName)
  | TyName (ProperName 'TypeName)
  | TyOpName (OpName 'TypeOpName)
  | DctorName (ProperName 'ConstructorName)
  | TyClassName (ProperName 'ClassName)
  | ModName ModuleName
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, (forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Name x -> Name
$cfrom :: forall x. Name -> Rep Name x
Generic)

instance NFData Name
instance Serialise Name

getIdentName :: Name -> Maybe Ident
getIdentName :: Name -> Maybe Ident
getIdentName (IdentName Ident
name) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
name
getIdentName Name
_ = Maybe Ident
forall a. Maybe a
Nothing

getValOpName :: Name -> Maybe (OpName 'ValueOpName)
getValOpName :: Name -> Maybe (OpName 'ValueOpName)
getValOpName (ValOpName OpName 'ValueOpName
name) = OpName 'ValueOpName -> Maybe (OpName 'ValueOpName)
forall a. a -> Maybe a
Just OpName 'ValueOpName
name
getValOpName Name
_ = Maybe (OpName 'ValueOpName)
forall a. Maybe a
Nothing

getTypeName :: Name -> Maybe (ProperName 'TypeName)
getTypeName :: Name -> Maybe (ProperName 'TypeName)
getTypeName (TyName ProperName 'TypeName
name) = ProperName 'TypeName -> Maybe (ProperName 'TypeName)
forall a. a -> Maybe a
Just ProperName 'TypeName
name
getTypeName Name
_ = Maybe (ProperName 'TypeName)
forall a. Maybe a
Nothing

getTypeOpName :: Name -> Maybe (OpName 'TypeOpName)
getTypeOpName :: Name -> Maybe (OpName 'TypeOpName)
getTypeOpName (TyOpName OpName 'TypeOpName
name) = OpName 'TypeOpName -> Maybe (OpName 'TypeOpName)
forall a. a -> Maybe a
Just OpName 'TypeOpName
name
getTypeOpName Name
_ = Maybe (OpName 'TypeOpName)
forall a. Maybe a
Nothing

getDctorName :: Name -> Maybe (ProperName 'ConstructorName)
getDctorName :: Name -> Maybe (ProperName 'ConstructorName)
getDctorName (DctorName ProperName 'ConstructorName
name) = ProperName 'ConstructorName -> Maybe (ProperName 'ConstructorName)
forall a. a -> Maybe a
Just ProperName 'ConstructorName
name
getDctorName Name
_ = Maybe (ProperName 'ConstructorName)
forall a. Maybe a
Nothing

getClassName :: Name -> Maybe (ProperName 'ClassName)
getClassName :: Name -> Maybe (ProperName 'ClassName)
getClassName (TyClassName ProperName 'ClassName
name) = ProperName 'ClassName -> Maybe (ProperName 'ClassName)
forall a. a -> Maybe a
Just ProperName 'ClassName
name
getClassName Name
_ = Maybe (ProperName 'ClassName)
forall a. Maybe a
Nothing

getModName :: Name -> Maybe ModuleName
getModName :: Name -> Maybe ModuleName
getModName (ModName ModuleName
name) = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
name
getModName Name
_ = Maybe ModuleName
forall a. Maybe a
Nothing

-- |
-- Names for value identifiers
--
data Ident
  -- |
  -- An alphanumeric identifier
  --
  = Ident Text
  -- |
  -- A generated name for an identifier
  --
  | GenIdent (Maybe Text) Integer
  -- |
  -- A generated name used only for type-checking
  --
  | UnusedIdent
  deriving (Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show, Ident -> Ident -> Bool
(Ident -> Ident -> Bool) -> (Ident -> Ident -> Bool) -> Eq Ident
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c== :: Ident -> Ident -> Bool
Eq, Eq Ident
Eq Ident
-> (Ident -> Ident -> Ordering)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Ident)
-> (Ident -> Ident -> Ident)
-> Ord Ident
Ident -> Ident -> Bool
Ident -> Ident -> Ordering
Ident -> Ident -> Ident
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 :: Ident -> Ident -> Ident
$cmin :: Ident -> Ident -> Ident
max :: Ident -> Ident -> Ident
$cmax :: Ident -> Ident -> Ident
>= :: Ident -> Ident -> Bool
$c>= :: Ident -> Ident -> Bool
> :: Ident -> Ident -> Bool
$c> :: Ident -> Ident -> Bool
<= :: Ident -> Ident -> Bool
$c<= :: Ident -> Ident -> Bool
< :: Ident -> Ident -> Bool
$c< :: Ident -> Ident -> Bool
compare :: Ident -> Ident -> Ordering
$ccompare :: Ident -> Ident -> Ordering
$cp1Ord :: Eq Ident
Ord, (forall x. Ident -> Rep Ident x)
-> (forall x. Rep Ident x -> Ident) -> Generic Ident
forall x. Rep Ident x -> Ident
forall x. Ident -> Rep Ident x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ident x -> Ident
$cfrom :: forall x. Ident -> Rep Ident x
Generic)

instance NFData Ident
instance Serialise Ident

runIdent :: Ident -> Text
runIdent :: Ident -> Text
runIdent (Ident Text
i) = Text
i
runIdent (GenIdent Maybe Text
Nothing Integer
n) = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n)
runIdent (GenIdent (Just Text
name) Integer
n) = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n)
runIdent Ident
UnusedIdent = Text
"$__unused"

showIdent :: Ident -> Text
showIdent :: Ident -> Text
showIdent = Ident -> Text
runIdent

freshIdent :: MonadSupply m => Text -> m Ident
freshIdent :: Text -> m Ident
freshIdent Text
name = Maybe Text -> Integer -> Ident
GenIdent (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) (Integer -> Ident) -> m Integer -> m Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Integer
forall (m :: * -> *). MonadSupply m => m Integer
fresh

freshIdent' :: MonadSupply m => m Ident
freshIdent' :: m Ident
freshIdent' = Maybe Text -> Integer -> Ident
GenIdent Maybe Text
forall a. Maybe a
Nothing (Integer -> Ident) -> m Integer -> m Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Integer
forall (m :: * -> *). MonadSupply m => m Integer
fresh

-- |
-- Operator alias names.
--
newtype OpName (a :: OpNameType) = OpName { OpName a -> Text
runOpName :: Text }
  deriving (Int -> OpName a -> ShowS
[OpName a] -> ShowS
OpName a -> String
(Int -> OpName a -> ShowS)
-> (OpName a -> String) -> ([OpName a] -> ShowS) -> Show (OpName a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: OpNameType). Int -> OpName a -> ShowS
forall (a :: OpNameType). [OpName a] -> ShowS
forall (a :: OpNameType). OpName a -> String
showList :: [OpName a] -> ShowS
$cshowList :: forall (a :: OpNameType). [OpName a] -> ShowS
show :: OpName a -> String
$cshow :: forall (a :: OpNameType). OpName a -> String
showsPrec :: Int -> OpName a -> ShowS
$cshowsPrec :: forall (a :: OpNameType). Int -> OpName a -> ShowS
Show, OpName a -> OpName a -> Bool
(OpName a -> OpName a -> Bool)
-> (OpName a -> OpName a -> Bool) -> Eq (OpName a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: OpNameType). OpName a -> OpName a -> Bool
/= :: OpName a -> OpName a -> Bool
$c/= :: forall (a :: OpNameType). OpName a -> OpName a -> Bool
== :: OpName a -> OpName a -> Bool
$c== :: forall (a :: OpNameType). OpName a -> OpName a -> Bool
Eq, Eq (OpName a)
Eq (OpName a)
-> (OpName a -> OpName a -> Ordering)
-> (OpName a -> OpName a -> Bool)
-> (OpName a -> OpName a -> Bool)
-> (OpName a -> OpName a -> Bool)
-> (OpName a -> OpName a -> Bool)
-> (OpName a -> OpName a -> OpName a)
-> (OpName a -> OpName a -> OpName a)
-> Ord (OpName a)
OpName a -> OpName a -> Bool
OpName a -> OpName a -> Ordering
OpName a -> OpName a -> OpName a
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
forall (a :: OpNameType). Eq (OpName a)
forall (a :: OpNameType). OpName a -> OpName a -> Bool
forall (a :: OpNameType). OpName a -> OpName a -> Ordering
forall (a :: OpNameType). OpName a -> OpName a -> OpName a
min :: OpName a -> OpName a -> OpName a
$cmin :: forall (a :: OpNameType). OpName a -> OpName a -> OpName a
max :: OpName a -> OpName a -> OpName a
$cmax :: forall (a :: OpNameType). OpName a -> OpName a -> OpName a
>= :: OpName a -> OpName a -> Bool
$c>= :: forall (a :: OpNameType). OpName a -> OpName a -> Bool
> :: OpName a -> OpName a -> Bool
$c> :: forall (a :: OpNameType). OpName a -> OpName a -> Bool
<= :: OpName a -> OpName a -> Bool
$c<= :: forall (a :: OpNameType). OpName a -> OpName a -> Bool
< :: OpName a -> OpName a -> Bool
$c< :: forall (a :: OpNameType). OpName a -> OpName a -> Bool
compare :: OpName a -> OpName a -> Ordering
$ccompare :: forall (a :: OpNameType). OpName a -> OpName a -> Ordering
$cp1Ord :: forall (a :: OpNameType). Eq (OpName a)
Ord, (forall x. OpName a -> Rep (OpName a) x)
-> (forall x. Rep (OpName a) x -> OpName a) -> Generic (OpName a)
forall x. Rep (OpName a) x -> OpName a
forall x. OpName a -> Rep (OpName a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: OpNameType) x. Rep (OpName a) x -> OpName a
forall (a :: OpNameType) x. OpName a -> Rep (OpName a) x
$cto :: forall (a :: OpNameType) x. Rep (OpName a) x -> OpName a
$cfrom :: forall (a :: OpNameType) x. OpName a -> Rep (OpName a) x
Generic)

instance NFData (OpName a)
instance Serialise (OpName a)

instance ToJSON (OpName a) where
  toJSON :: OpName a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (OpName a -> Text) -> OpName a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpName a -> Text
forall (a :: OpNameType). OpName a -> Text
runOpName

instance FromJSON (OpName a) where
  parseJSON :: Value -> Parser (OpName a)
parseJSON = (Text -> OpName a) -> Parser Text -> Parser (OpName a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> OpName a
forall (a :: OpNameType). Text -> OpName a
OpName (Parser Text -> Parser (OpName a))
-> (Value -> Parser Text) -> Value -> Parser (OpName a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON

showOp :: OpName a -> Text
showOp :: OpName a -> Text
showOp OpName a
op = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OpName a -> Text
forall (a :: OpNameType). OpName a -> Text
runOpName OpName a
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- |
-- The closed set of operator alias types.
--
data OpNameType = ValueOpName | TypeOpName | AnyOpName

eraseOpName :: OpName a -> OpName 'AnyOpName
eraseOpName :: OpName a -> OpName 'AnyOpName
eraseOpName = Text -> OpName 'AnyOpName
forall (a :: OpNameType). Text -> OpName a
OpName (Text -> OpName 'AnyOpName)
-> (OpName a -> Text) -> OpName a -> OpName 'AnyOpName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpName a -> Text
forall (a :: OpNameType). OpName a -> Text
runOpName

coerceOpName :: OpName a -> OpName b
coerceOpName :: OpName a -> OpName b
coerceOpName = Text -> OpName b
forall (a :: OpNameType). Text -> OpName a
OpName (Text -> OpName b) -> (OpName a -> Text) -> OpName a -> OpName b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpName a -> Text
forall (a :: OpNameType). OpName a -> Text
runOpName

-- |
-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.
--
newtype ProperName (a :: ProperNameType) = ProperName { ProperName a -> Text
runProperName :: Text }
  deriving (Int -> ProperName a -> ShowS
[ProperName a] -> ShowS
ProperName a -> String
(Int -> ProperName a -> ShowS)
-> (ProperName a -> String)
-> ([ProperName a] -> ShowS)
-> Show (ProperName a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: ProperNameType). Int -> ProperName a -> ShowS
forall (a :: ProperNameType). [ProperName a] -> ShowS
forall (a :: ProperNameType). ProperName a -> String
showList :: [ProperName a] -> ShowS
$cshowList :: forall (a :: ProperNameType). [ProperName a] -> ShowS
show :: ProperName a -> String
$cshow :: forall (a :: ProperNameType). ProperName a -> String
showsPrec :: Int -> ProperName a -> ShowS
$cshowsPrec :: forall (a :: ProperNameType). Int -> ProperName a -> ShowS
Show, ProperName a -> ProperName a -> Bool
(ProperName a -> ProperName a -> Bool)
-> (ProperName a -> ProperName a -> Bool) -> Eq (ProperName a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
/= :: ProperName a -> ProperName a -> Bool
$c/= :: forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
== :: ProperName a -> ProperName a -> Bool
$c== :: forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
Eq, Eq (ProperName a)
Eq (ProperName a)
-> (ProperName a -> ProperName a -> Ordering)
-> (ProperName a -> ProperName a -> Bool)
-> (ProperName a -> ProperName a -> Bool)
-> (ProperName a -> ProperName a -> Bool)
-> (ProperName a -> ProperName a -> Bool)
-> (ProperName a -> ProperName a -> ProperName a)
-> (ProperName a -> ProperName a -> ProperName a)
-> Ord (ProperName a)
ProperName a -> ProperName a -> Bool
ProperName a -> ProperName a -> Ordering
ProperName a -> ProperName a -> ProperName a
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
forall (a :: ProperNameType). Eq (ProperName a)
forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
forall (a :: ProperNameType).
ProperName a -> ProperName a -> Ordering
forall (a :: ProperNameType).
ProperName a -> ProperName a -> ProperName a
min :: ProperName a -> ProperName a -> ProperName a
$cmin :: forall (a :: ProperNameType).
ProperName a -> ProperName a -> ProperName a
max :: ProperName a -> ProperName a -> ProperName a
$cmax :: forall (a :: ProperNameType).
ProperName a -> ProperName a -> ProperName a
>= :: ProperName a -> ProperName a -> Bool
$c>= :: forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
> :: ProperName a -> ProperName a -> Bool
$c> :: forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
<= :: ProperName a -> ProperName a -> Bool
$c<= :: forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
< :: ProperName a -> ProperName a -> Bool
$c< :: forall (a :: ProperNameType). ProperName a -> ProperName a -> Bool
compare :: ProperName a -> ProperName a -> Ordering
$ccompare :: forall (a :: ProperNameType).
ProperName a -> ProperName a -> Ordering
$cp1Ord :: forall (a :: ProperNameType). Eq (ProperName a)
Ord, (forall x. ProperName a -> Rep (ProperName a) x)
-> (forall x. Rep (ProperName a) x -> ProperName a)
-> Generic (ProperName a)
forall x. Rep (ProperName a) x -> ProperName a
forall x. ProperName a -> Rep (ProperName a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: ProperNameType) x.
Rep (ProperName a) x -> ProperName a
forall (a :: ProperNameType) x.
ProperName a -> Rep (ProperName a) x
$cto :: forall (a :: ProperNameType) x.
Rep (ProperName a) x -> ProperName a
$cfrom :: forall (a :: ProperNameType) x.
ProperName a -> Rep (ProperName a) x
Generic)

instance NFData (ProperName a)
instance Serialise (ProperName a)

instance ToJSON (ProperName a) where
  toJSON :: ProperName a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ProperName a -> Text) -> ProperName a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName a -> Text
forall (a :: ProperNameType). ProperName a -> Text
runProperName

instance FromJSON (ProperName a) where
  parseJSON :: Value -> Parser (ProperName a)
parseJSON = (Text -> ProperName a) -> Parser Text -> Parser (ProperName a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ProperName a
forall (a :: ProperNameType). Text -> ProperName a
ProperName (Parser Text -> Parser (ProperName a))
-> (Value -> Parser Text) -> Value -> Parser (ProperName a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON

-- |
-- The closed set of proper name types.
--
data ProperNameType
  = TypeName
  | ConstructorName
  | ClassName
  | Namespace

-- |
-- Coerces a ProperName from one ProperNameType to another. This should be used
-- with care, and is primarily used to convert ClassNames into TypeNames after
-- classes have been desugared.
--
coerceProperName :: ProperName a -> ProperName b
coerceProperName :: ProperName a -> ProperName b
coerceProperName = Text -> ProperName b
forall (a :: ProperNameType). Text -> ProperName a
ProperName (Text -> ProperName b)
-> (ProperName a -> Text) -> ProperName a -> ProperName b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName a -> Text
forall (a :: ProperNameType). ProperName a -> Text
runProperName

-- |
-- Module names
--
newtype ModuleName = ModuleName Text
  deriving (Int -> ModuleName -> ShowS
[ModuleName] -> ShowS
ModuleName -> String
(Int -> ModuleName -> ShowS)
-> (ModuleName -> String)
-> ([ModuleName] -> ShowS)
-> Show ModuleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleName] -> ShowS
$cshowList :: [ModuleName] -> ShowS
show :: ModuleName -> String
$cshow :: ModuleName -> String
showsPrec :: Int -> ModuleName -> ShowS
$cshowsPrec :: Int -> ModuleName -> ShowS
Show, ModuleName -> ModuleName -> Bool
(ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool) -> Eq ModuleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, Eq ModuleName
Eq ModuleName
-> (ModuleName -> ModuleName -> Ordering)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> ModuleName)
-> (ModuleName -> ModuleName -> ModuleName)
-> Ord ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
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 :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmax :: ModuleName -> ModuleName -> ModuleName
>= :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c< :: ModuleName -> ModuleName -> Bool
compare :: ModuleName -> ModuleName -> Ordering
$ccompare :: ModuleName -> ModuleName -> Ordering
$cp1Ord :: Eq ModuleName
Ord, (forall x. ModuleName -> Rep ModuleName x)
-> (forall x. Rep ModuleName x -> ModuleName) -> Generic ModuleName
forall x. Rep ModuleName x -> ModuleName
forall x. ModuleName -> Rep ModuleName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleName x -> ModuleName
$cfrom :: forall x. ModuleName -> Rep ModuleName x
Generic)
  deriving newtype Decoder s ModuleName
Decoder s [ModuleName]
[ModuleName] -> Encoding
ModuleName -> Encoding
(ModuleName -> Encoding)
-> (forall s. Decoder s ModuleName)
-> ([ModuleName] -> Encoding)
-> (forall s. Decoder s [ModuleName])
-> Serialise ModuleName
forall s. Decoder s [ModuleName]
forall s. Decoder s ModuleName
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [ModuleName]
$cdecodeList :: forall s. Decoder s [ModuleName]
encodeList :: [ModuleName] -> Encoding
$cencodeList :: [ModuleName] -> Encoding
decode :: Decoder s ModuleName
$cdecode :: forall s. Decoder s ModuleName
encode :: ModuleName -> Encoding
$cencode :: ModuleName -> Encoding
Serialise

instance NFData ModuleName

runModuleName :: ModuleName -> Text
runModuleName :: ModuleName -> Text
runModuleName (ModuleName Text
name) = Text
name

moduleNameFromString :: Text -> ModuleName
moduleNameFromString :: Text -> ModuleName
moduleNameFromString = Text -> ModuleName
ModuleName

isBuiltinModuleName :: ModuleName -> Bool
isBuiltinModuleName :: ModuleName -> Bool
isBuiltinModuleName (ModuleName Text
mn) = Text
mn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Prim" Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"Prim." Text
mn

-- |
-- A qualified name, i.e. a name with an optional module name
--
data Qualified a = Qualified (Maybe ModuleName) a
  deriving (Int -> Qualified a -> ShowS
[Qualified a] -> ShowS
Qualified a -> String
(Int -> Qualified a -> ShowS)
-> (Qualified a -> String)
-> ([Qualified a] -> ShowS)
-> Show (Qualified a)
forall a. Show a => Int -> Qualified a -> ShowS
forall a. Show a => [Qualified a] -> ShowS
forall a. Show a => Qualified a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Qualified a] -> ShowS
$cshowList :: forall a. Show a => [Qualified a] -> ShowS
show :: Qualified a -> String
$cshow :: forall a. Show a => Qualified a -> String
showsPrec :: Int -> Qualified a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Qualified a -> ShowS
Show, Qualified a -> Qualified a -> Bool
(Qualified a -> Qualified a -> Bool)
-> (Qualified a -> Qualified a -> Bool) -> Eq (Qualified a)
forall a. Eq a => Qualified a -> Qualified a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Qualified a -> Qualified a -> Bool
$c/= :: forall a. Eq a => Qualified a -> Qualified a -> Bool
== :: Qualified a -> Qualified a -> Bool
$c== :: forall a. Eq a => Qualified a -> Qualified a -> Bool
Eq, Eq (Qualified a)
Eq (Qualified a)
-> (Qualified a -> Qualified a -> Ordering)
-> (Qualified a -> Qualified a -> Bool)
-> (Qualified a -> Qualified a -> Bool)
-> (Qualified a -> Qualified a -> Bool)
-> (Qualified a -> Qualified a -> Bool)
-> (Qualified a -> Qualified a -> Qualified a)
-> (Qualified a -> Qualified a -> Qualified a)
-> Ord (Qualified a)
Qualified a -> Qualified a -> Bool
Qualified a -> Qualified a -> Ordering
Qualified a -> Qualified a -> Qualified a
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
forall a. Ord a => Eq (Qualified a)
forall a. Ord a => Qualified a -> Qualified a -> Bool
forall a. Ord a => Qualified a -> Qualified a -> Ordering
forall a. Ord a => Qualified a -> Qualified a -> Qualified a
min :: Qualified a -> Qualified a -> Qualified a
$cmin :: forall a. Ord a => Qualified a -> Qualified a -> Qualified a
max :: Qualified a -> Qualified a -> Qualified a
$cmax :: forall a. Ord a => Qualified a -> Qualified a -> Qualified a
>= :: Qualified a -> Qualified a -> Bool
$c>= :: forall a. Ord a => Qualified a -> Qualified a -> Bool
> :: Qualified a -> Qualified a -> Bool
$c> :: forall a. Ord a => Qualified a -> Qualified a -> Bool
<= :: Qualified a -> Qualified a -> Bool
$c<= :: forall a. Ord a => Qualified a -> Qualified a -> Bool
< :: Qualified a -> Qualified a -> Bool
$c< :: forall a. Ord a => Qualified a -> Qualified a -> Bool
compare :: Qualified a -> Qualified a -> Ordering
$ccompare :: forall a. Ord a => Qualified a -> Qualified a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Qualified a)
Ord, a -> Qualified b -> Qualified a
(a -> b) -> Qualified a -> Qualified b
(forall a b. (a -> b) -> Qualified a -> Qualified b)
-> (forall a b. a -> Qualified b -> Qualified a)
-> Functor Qualified
forall a b. a -> Qualified b -> Qualified a
forall a b. (a -> b) -> Qualified a -> Qualified b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Qualified b -> Qualified a
$c<$ :: forall a b. a -> Qualified b -> Qualified a
fmap :: (a -> b) -> Qualified a -> Qualified b
$cfmap :: forall a b. (a -> b) -> Qualified a -> Qualified b
Functor, Qualified a -> Bool
(a -> m) -> Qualified a -> m
(a -> b -> b) -> b -> Qualified a -> b
(forall m. Monoid m => Qualified m -> m)
-> (forall m a. Monoid m => (a -> m) -> Qualified a -> m)
-> (forall m a. Monoid m => (a -> m) -> Qualified a -> m)
-> (forall a b. (a -> b -> b) -> b -> Qualified a -> b)
-> (forall a b. (a -> b -> b) -> b -> Qualified a -> b)
-> (forall b a. (b -> a -> b) -> b -> Qualified a -> b)
-> (forall b a. (b -> a -> b) -> b -> Qualified a -> b)
-> (forall a. (a -> a -> a) -> Qualified a -> a)
-> (forall a. (a -> a -> a) -> Qualified a -> a)
-> (forall a. Qualified a -> [a])
-> (forall a. Qualified a -> Bool)
-> (forall a. Qualified a -> Int)
-> (forall a. Eq a => a -> Qualified a -> Bool)
-> (forall a. Ord a => Qualified a -> a)
-> (forall a. Ord a => Qualified a -> a)
-> (forall a. Num a => Qualified a -> a)
-> (forall a. Num a => Qualified a -> a)
-> Foldable Qualified
forall a. Eq a => a -> Qualified a -> Bool
forall a. Num a => Qualified a -> a
forall a. Ord a => Qualified a -> a
forall m. Monoid m => Qualified m -> m
forall a. Qualified a -> Bool
forall a. Qualified a -> Int
forall a. Qualified a -> [a]
forall a. (a -> a -> a) -> Qualified a -> a
forall m a. Monoid m => (a -> m) -> Qualified a -> m
forall b a. (b -> a -> b) -> b -> Qualified a -> b
forall a b. (a -> b -> b) -> b -> Qualified a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Qualified a -> a
$cproduct :: forall a. Num a => Qualified a -> a
sum :: Qualified a -> a
$csum :: forall a. Num a => Qualified a -> a
minimum :: Qualified a -> a
$cminimum :: forall a. Ord a => Qualified a -> a
maximum :: Qualified a -> a
$cmaximum :: forall a. Ord a => Qualified a -> a
elem :: a -> Qualified a -> Bool
$celem :: forall a. Eq a => a -> Qualified a -> Bool
length :: Qualified a -> Int
$clength :: forall a. Qualified a -> Int
null :: Qualified a -> Bool
$cnull :: forall a. Qualified a -> Bool
toList :: Qualified a -> [a]
$ctoList :: forall a. Qualified a -> [a]
foldl1 :: (a -> a -> a) -> Qualified a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Qualified a -> a
foldr1 :: (a -> a -> a) -> Qualified a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Qualified a -> a
foldl' :: (b -> a -> b) -> b -> Qualified a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Qualified a -> b
foldl :: (b -> a -> b) -> b -> Qualified a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Qualified a -> b
foldr' :: (a -> b -> b) -> b -> Qualified a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Qualified a -> b
foldr :: (a -> b -> b) -> b -> Qualified a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Qualified a -> b
foldMap' :: (a -> m) -> Qualified a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Qualified a -> m
foldMap :: (a -> m) -> Qualified a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Qualified a -> m
fold :: Qualified m -> m
$cfold :: forall m. Monoid m => Qualified m -> m
Foldable, Functor Qualified
Foldable Qualified
Functor Qualified
-> Foldable Qualified
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Qualified a -> f (Qualified b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Qualified (f a) -> f (Qualified a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Qualified a -> m (Qualified b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Qualified (m a) -> m (Qualified a))
-> Traversable Qualified
(a -> f b) -> Qualified a -> f (Qualified b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Qualified (m a) -> m (Qualified a)
forall (f :: * -> *) a.
Applicative f =>
Qualified (f a) -> f (Qualified a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Qualified a -> m (Qualified b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Qualified a -> f (Qualified b)
sequence :: Qualified (m a) -> m (Qualified a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Qualified (m a) -> m (Qualified a)
mapM :: (a -> m b) -> Qualified a -> m (Qualified b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Qualified a -> m (Qualified b)
sequenceA :: Qualified (f a) -> f (Qualified a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Qualified (f a) -> f (Qualified a)
traverse :: (a -> f b) -> Qualified a -> f (Qualified b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Qualified a -> f (Qualified b)
$cp2Traversable :: Foldable Qualified
$cp1Traversable :: Functor Qualified
Traversable, (forall x. Qualified a -> Rep (Qualified a) x)
-> (forall x. Rep (Qualified a) x -> Qualified a)
-> Generic (Qualified a)
forall x. Rep (Qualified a) x -> Qualified a
forall x. Qualified a -> Rep (Qualified a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Qualified a) x -> Qualified a
forall a x. Qualified a -> Rep (Qualified a) x
$cto :: forall a x. Rep (Qualified a) x -> Qualified a
$cfrom :: forall a x. Qualified a -> Rep (Qualified a) x
Generic)

instance NFData a => NFData (Qualified a)
instance Serialise a => Serialise (Qualified a)

showQualified :: (a -> Text) -> Qualified a -> Text
showQualified :: (a -> Text) -> Qualified a -> Text
showQualified a -> Text
f (Qualified Maybe ModuleName
Nothing a
a) = a -> Text
f a
a
showQualified a -> Text
f (Qualified (Just ModuleName
name) a
a) = ModuleName -> Text
runModuleName ModuleName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
f a
a

getQual :: Qualified a -> Maybe ModuleName
getQual :: Qualified a -> Maybe ModuleName
getQual (Qualified Maybe ModuleName
mn a
_) = Maybe ModuleName
mn

-- |
-- Provide a default module name, if a name is unqualified
--
qualify :: ModuleName -> Qualified a -> (ModuleName, a)
qualify :: ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
m (Qualified Maybe ModuleName
Nothing a
a) = (ModuleName
m, a
a)
qualify ModuleName
_ (Qualified (Just ModuleName
m) a
a) = (ModuleName
m, a
a)

-- |
-- Makes a qualified value from a name and module name.
--
mkQualified :: a -> ModuleName -> Qualified a
mkQualified :: a -> ModuleName -> Qualified a
mkQualified a
name ModuleName
mn = Maybe ModuleName -> a -> Qualified a
forall a. Maybe ModuleName -> a -> Qualified a
Qualified (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
mn) a
name

-- | Remove the module name from a qualified name
disqualify :: Qualified a -> a
disqualify :: Qualified a -> a
disqualify (Qualified Maybe ModuleName
_ a
a) = a
a

-- |
-- Remove the qualification from a value when it is qualified with a particular
-- module name.
--
disqualifyFor :: Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor :: Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
mn (Qualified Maybe ModuleName
mn' a
a) | Maybe ModuleName
mn Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ModuleName
mn' = a -> Maybe a
forall a. a -> Maybe a
Just a
a
disqualifyFor Maybe ModuleName
_ Qualified a
_ = Maybe a
forall a. Maybe a
Nothing

-- |
-- Checks whether a qualified value is actually qualified with a module reference
--
isQualified :: Qualified a -> Bool
isQualified :: Qualified a -> Bool
isQualified (Qualified Maybe ModuleName
Nothing a
_) = Bool
False
isQualified Qualified a
_ = Bool
True

-- |
-- Checks whether a qualified value is not actually qualified with a module reference
--
isUnqualified :: Qualified a -> Bool
isUnqualified :: Qualified a -> Bool
isUnqualified = Bool -> Bool
not (Bool -> Bool) -> (Qualified a -> Bool) -> Qualified a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified a -> Bool
forall a. Qualified a -> Bool
isQualified

-- |
-- Checks whether a qualified value is qualified with a particular module
--
isQualifiedWith :: ModuleName -> Qualified a -> Bool
isQualifiedWith :: ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn (Qualified (Just ModuleName
mn') a
_) = ModuleName
mn ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
mn'
isQualifiedWith ModuleName
_ Qualified a
_ = Bool
False

$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Qualified)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Ident)

instance ToJSON ModuleName where
  toJSON :: ModuleName -> Value
toJSON (ModuleName Text
name) = [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Text -> [Text]
T.splitOn Text
"." Text
name)

instance FromJSON ModuleName where
  parseJSON :: Value -> Parser ModuleName
parseJSON = String
-> (Array -> Parser ModuleName) -> Value -> Parser ModuleName
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"ModuleName" ((Array -> Parser ModuleName) -> Value -> Parser ModuleName)
-> (Array -> Parser ModuleName) -> Value -> Parser ModuleName
forall a b. (a -> b) -> a -> b
$ \Array
names -> do
    Vector Text
names' <- (Value -> Parser Text) -> Array -> Parser (Vector Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Array
names
    ModuleName -> Parser ModuleName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ModuleName
ModuleName (Text -> [Text] -> Text
T.intercalate Text
"." (Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList Vector Text
names')))

instance ToJSONKey ModuleName where
  toJSONKey :: ToJSONKeyFunction ModuleName
toJSONKey = (ModuleName -> Text)
-> ToJSONKeyFunction Text -> ToJSONKeyFunction ModuleName
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ModuleName -> Text
runModuleName ToJSONKeyFunction Text
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey

instance FromJSONKey ModuleName where
  fromJSONKey :: FromJSONKeyFunction ModuleName
fromJSONKey = (Text -> ModuleName)
-> FromJSONKeyFunction Text -> FromJSONKeyFunction ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ModuleName
moduleNameFromString FromJSONKeyFunction Text
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey