module Language.PureScript.Environment where

import Prelude.Compat
import Protolude (ordNub)

import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Codec.Serialise (Serialise)
import Data.Aeson ((.=), (.:))
import qualified Data.Aeson as A
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tree (Tree, rootLabel)
import qualified Data.Graph as G
import Data.Foldable (toList)
import qualified Data.List.NonEmpty as NEL

import Language.PureScript.AST.SourcePos
import Language.PureScript.Crash
import Language.PureScript.Names
import Language.PureScript.Roles
import Language.PureScript.TypeClassDictionaries
import Language.PureScript.Types
import qualified Language.PureScript.Constants.Prim as C

-- | The @Environment@ defines all values and types which are currently in scope:
data Environment = Environment
  { Environment
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
names :: M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
  -- ^ Values currently in scope
  , Environment
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
types :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
  -- ^ Type names currently in scope
  , Environment
-> Map
     (Qualified (ProperName 'ConstructorName))
     (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
  -- ^ Data constructors currently in scope, along with their associated type
  -- constructor name, argument types and return type.
  , Environment -> Map (Qualified (ProperName 'TypeName)) [Role]
roleDeclarations :: M.Map (Qualified (ProperName 'TypeName)) [Role]
  -- ^ Explicit role declarations currently in scope. Note that this field is
  -- only used to store declared roles temporarily until they can be checked;
  -- to find a type's real checked and/or inferred roles, refer to the TypeKind
  -- in the `types` field.
  , Environment
-> Map
     (Qualified (ProperName 'TypeName))
     ([(Text, Maybe SourceType)], SourceType)
typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceType)], SourceType)
  -- ^ Type synonyms currently in scope
  , Environment
-> Map
     (Maybe ModuleName)
     (Map
        (Qualified (ProperName 'ClassName))
        (Map (Qualified Ident) (NonEmpty NamedDict)))
typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict)))
  -- ^ Available type class dictionaries. When looking up 'Nothing' in the
  -- outer map, this returns the map of type class dictionaries in local
  -- scope (ie dictionaries brought in by a constrained type).
  , Environment
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
  -- ^ Type classes
  } deriving (Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show, (forall x. Environment -> Rep Environment x)
-> (forall x. Rep Environment x -> Environment)
-> Generic Environment
forall x. Rep Environment x -> Environment
forall x. Environment -> Rep Environment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Environment x -> Environment
$cfrom :: forall x. Environment -> Rep Environment x
Generic)

instance NFData Environment

-- | Information about a type class
data TypeClassData = TypeClassData
  { TypeClassData -> [(Text, Maybe SourceType)]
typeClassArguments :: [(Text, Maybe SourceType)]
  -- ^ A list of type argument names, and their kinds, where kind annotations
  -- were provided.
  , TypeClassData -> [(Ident, SourceType)]
typeClassMembers :: [(Ident, SourceType)]
  -- ^ A list of type class members and their types. Type arguments listed above
  -- are considered bound in these types.
  , TypeClassData -> [SourceConstraint]
typeClassSuperclasses :: [SourceConstraint]
  -- ^ A list of superclasses of this type class. Type arguments listed above
  -- are considered bound in the types appearing in these constraints.
  , TypeClassData -> [FunctionalDependency]
typeClassDependencies :: [FunctionalDependency]
  -- ^ A list of functional dependencies for the type arguments of this class.
  , TypeClassData -> Set Int
typeClassDeterminedArguments :: S.Set Int
  -- ^ A set of indexes of type argument that are fully determined by other
  -- arguments via functional dependencies. This can be computed from both
  -- typeClassArguments and typeClassDependencies.
  , TypeClassData -> Set (Set Int)
typeClassCoveringSets :: S.Set (S.Set Int)
  -- ^ A sets of arguments that can be used to infer all other arguments.
  , TypeClassData -> Bool
typeClassIsEmpty :: Bool
  -- ^ Whether or not dictionaries for this type class are necessarily empty.
  } deriving (Int -> TypeClassData -> ShowS
[TypeClassData] -> ShowS
TypeClassData -> String
(Int -> TypeClassData -> ShowS)
-> (TypeClassData -> String)
-> ([TypeClassData] -> ShowS)
-> Show TypeClassData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeClassData] -> ShowS
$cshowList :: [TypeClassData] -> ShowS
show :: TypeClassData -> String
$cshow :: TypeClassData -> String
showsPrec :: Int -> TypeClassData -> ShowS
$cshowsPrec :: Int -> TypeClassData -> ShowS
Show, (forall x. TypeClassData -> Rep TypeClassData x)
-> (forall x. Rep TypeClassData x -> TypeClassData)
-> Generic TypeClassData
forall x. Rep TypeClassData x -> TypeClassData
forall x. TypeClassData -> Rep TypeClassData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeClassData x -> TypeClassData
$cfrom :: forall x. TypeClassData -> Rep TypeClassData x
Generic)

instance NFData TypeClassData

-- | A functional dependency indicates a relationship between two sets of
-- type arguments in a class declaration.
data FunctionalDependency = FunctionalDependency
  { FunctionalDependency -> [Int]
fdDeterminers :: [Int]
  -- ^ the type arguments which determine the determined type arguments
  , FunctionalDependency -> [Int]
fdDetermined  :: [Int]
  -- ^ the determined type arguments
  } deriving (Int -> FunctionalDependency -> ShowS
[FunctionalDependency] -> ShowS
FunctionalDependency -> String
(Int -> FunctionalDependency -> ShowS)
-> (FunctionalDependency -> String)
-> ([FunctionalDependency] -> ShowS)
-> Show FunctionalDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionalDependency] -> ShowS
$cshowList :: [FunctionalDependency] -> ShowS
show :: FunctionalDependency -> String
$cshow :: FunctionalDependency -> String
showsPrec :: Int -> FunctionalDependency -> ShowS
$cshowsPrec :: Int -> FunctionalDependency -> ShowS
Show, (forall x. FunctionalDependency -> Rep FunctionalDependency x)
-> (forall x. Rep FunctionalDependency x -> FunctionalDependency)
-> Generic FunctionalDependency
forall x. Rep FunctionalDependency x -> FunctionalDependency
forall x. FunctionalDependency -> Rep FunctionalDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionalDependency x -> FunctionalDependency
$cfrom :: forall x. FunctionalDependency -> Rep FunctionalDependency x
Generic)

instance NFData FunctionalDependency
instance Serialise FunctionalDependency

instance A.FromJSON FunctionalDependency where
  parseJSON :: Value -> Parser FunctionalDependency
parseJSON = String
-> (Object -> Parser FunctionalDependency)
-> Value
-> Parser FunctionalDependency
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FunctionalDependency" ((Object -> Parser FunctionalDependency)
 -> Value -> Parser FunctionalDependency)
-> (Object -> Parser FunctionalDependency)
-> Value
-> Parser FunctionalDependency
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Int] -> [Int] -> FunctionalDependency
FunctionalDependency
      ([Int] -> [Int] -> FunctionalDependency)
-> Parser [Int] -> Parser ([Int] -> FunctionalDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"determiners"
      Parser ([Int] -> FunctionalDependency)
-> Parser [Int] -> Parser FunctionalDependency
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"determined"

instance A.ToJSON FunctionalDependency where
  toJSON :: FunctionalDependency -> Value
toJSON FunctionalDependency{[Int]
fdDetermined :: [Int]
fdDeterminers :: [Int]
fdDetermined :: FunctionalDependency -> [Int]
fdDeterminers :: FunctionalDependency -> [Int]
..} =
    [Pair] -> Value
A.object [ Text
"determiners" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Int]
fdDeterminers
             , Text
"determined" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Int]
fdDetermined
             ]

-- | The initial environment with no values and only the default javascript types defined
initEnvironment :: Environment
initEnvironment :: Environment
initEnvironment = Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
-> Map
     (Qualified (ProperName 'ConstructorName))
     (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
-> Map (Qualified (ProperName 'TypeName)) [Role]
-> Map
     (Qualified (ProperName 'TypeName))
     ([(Text, Maybe SourceType)], SourceType)
-> Map
     (Maybe ModuleName)
     (Map
        (Qualified (ProperName 'ClassName))
        (Map (Qualified Ident) (NonEmpty NamedDict)))
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
-> Environment
Environment Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
forall k a. Map k a
M.empty Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
allPrimTypes Map
  (Qualified (ProperName 'ConstructorName))
  (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
forall k a. Map k a
M.empty Map (Qualified (ProperName 'TypeName)) [Role]
forall k a. Map k a
M.empty Map
  (Qualified (ProperName 'TypeName))
  ([(Text, Maybe SourceType)], SourceType)
forall k a. Map k a
M.empty Map
  (Maybe ModuleName)
  (Map
     (Qualified (ProperName 'ClassName))
     (Map (Qualified Ident) (NonEmpty NamedDict)))
forall k a. Map k a
M.empty Map (Qualified (ProperName 'ClassName)) TypeClassData
allPrimClasses

-- | A constructor for TypeClassData that computes which type class arguments are fully determined
-- and argument covering sets.
-- Fully determined means that this argument cannot be used when selecting a type class instance.
-- A covering set is a minimal collection of arguments that can be used to find an instance and
-- therefore determine all other type arguments.
--
-- An example of the difference between determined and fully determined would be with the class:
-- ```class C a b c | a -> b, b -> a, b -> c```
-- In this case, `a` must differ when `b` differs, and vice versa - each is determined by the other.
-- Both `a` and `b` can be used in selecting a type class instance. However, `c` cannot - it is
-- fully determined by `a` and `b`.
--
-- Define a graph of type class arguments with edges being fundep determiners to determined. Each
-- argument also has a self looping edge.
-- An argument is fully determined if doesn't appear at the start of a path of strongly connected components.
-- An argument is not fully determined otherwise.
--
-- The way we compute this is by saying: an argument X is fully determined if there are arguments that
-- determine X that X does not determine. This is the same thing: everything X determines includes everything
-- in its SCC, and everything determining X is either before it in an SCC path, or in the same SCC.
makeTypeClassData
  :: [(Text, Maybe SourceType)]
  -> [(Ident, SourceType)]
  -> [SourceConstraint]
  -> [FunctionalDependency]
  -> Bool
  -> TypeClassData
makeTypeClassData :: [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
m [SourceConstraint]
s [FunctionalDependency]
deps Bool
tcIsEmpty = [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Set Int
-> Set (Set Int)
-> Bool
-> TypeClassData
TypeClassData [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
m [SourceConstraint]
s [FunctionalDependency]
deps Set Int
determinedArgs Set (Set Int)
coveringSets Bool
tcIsEmpty
  where
    argumentIndices :: [Int]
argumentIndices = [Int
0 .. [(Text, Maybe SourceType)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Maybe SourceType)]
args Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

    -- each argument determines themselves
    identities :: [(Int, [Int])]
identities = (\Int
i -> (Int
i, [Int
i])) (Int -> (Int, [Int])) -> [Int] -> [(Int, [Int])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
argumentIndices

    -- list all the edges in the graph: for each fundep an edge exists for each determiner to each determined
    contributingDeps :: Map Int [Int]
contributingDeps = ([Int] -> [Int] -> [Int]) -> [(Int, [Int])] -> Map Int [Int]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [Int])] -> Map Int [Int])
-> [(Int, [Int])] -> Map Int [Int]
forall a b. (a -> b) -> a -> b
$ [(Int, [Int])]
identities [(Int, [Int])] -> [(Int, [Int])] -> [(Int, [Int])]
forall a. [a] -> [a] -> [a]
++ do
      FunctionalDependency
fd <- [FunctionalDependency]
deps
      Int
src <- FunctionalDependency -> [Int]
fdDeterminers FunctionalDependency
fd
      (Int
src, FunctionalDependency -> [Int]
fdDetermined FunctionalDependency
fd) (Int, [Int]) -> [(Int, [Int])] -> [(Int, [Int])]
forall a. a -> [a] -> [a]
: (Int -> (Int, [Int])) -> [Int] -> [(Int, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (, []) (FunctionalDependency -> [Int]
fdDetermined FunctionalDependency
fd)

    -- build a graph of which arguments determine other arguments
    (Graph
depGraph, Int -> (Int, Int, [Int])
fromVertex, Int -> Maybe Int
fromKey) = [(Int, Int, [Int])]
-> (Graph, Int -> (Int, Int, [Int]), Int -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
G.graphFromEdges ((\(Int
n, [Int]
v) -> (Int
n, Int
n, [Int] -> [Int]
forall a. Ord a => [a] -> [a]
ordNub [Int]
v)) ((Int, [Int]) -> (Int, Int, [Int]))
-> [(Int, [Int])] -> [(Int, Int, [Int])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int [Int] -> [(Int, [Int])]
forall k a. Map k a -> [(k, a)]
M.toList Map Int [Int]
contributingDeps)

    -- do there exist any arguments that contribute to `arg` that `arg` doesn't contribute to
    isFunDepDetermined :: Int -> Bool
    isFunDepDetermined :: Int -> Bool
isFunDepDetermined Int
arg = case Int -> Maybe Int
fromKey Int
arg of
      Maybe Int
Nothing -> String -> Bool
forall a. HasCallStack => String -> a
internalError String
"Unknown argument index in makeTypeClassData"
      Just Int
v -> let contributesToVar :: [Int]
contributesToVar = Graph -> Int -> [Int]
G.reachable (Graph -> Graph
G.transposeG Graph
depGraph) Int
v
                    varContributesTo :: [Int]
varContributesTo = Graph -> Int -> [Int]
G.reachable Graph
depGraph Int
v
                in (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Int
r -> Bool -> Bool
not (Int
r Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
varContributesTo)) [Int]
contributesToVar

    -- find all the arguments that are determined
    determinedArgs :: S.Set Int
    determinedArgs :: Set Int
determinedArgs = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter Int -> Bool
isFunDepDetermined [Int]
argumentIndices

    argFromVertex :: G.Vertex -> Int
    argFromVertex :: Int -> Int
argFromVertex Int
index = let (Int
_, Int
arg, [Int]
_) = Int -> (Int, Int, [Int])
fromVertex Int
index in Int
arg

    isVertexDetermined :: G.Vertex -> Bool
    isVertexDetermined :: Int -> Bool
isVertexDetermined = Int -> Bool
isFunDepDetermined (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
argFromVertex

    -- from an scc find the non-determined args
    sccNonDetermined :: Tree G.Vertex -> Maybe [Int]
    sccNonDetermined :: Tree Int -> Maybe [Int]
sccNonDetermined Tree Int
tree
      -- if any arg in an scc is determined then all of them are
      | Int -> Bool
isVertexDetermined (Tree Int -> Int
forall a. Tree a -> a
rootLabel Tree Int
tree) = Maybe [Int]
forall a. Maybe a
Nothing
      | Bool
otherwise = [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (Int -> Int
argFromVertex (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree Int -> [Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Tree Int
tree)

    -- find the covering sets
    coveringSets :: S.Set (S.Set Int)
    coveringSets :: Set (Set Int)
coveringSets = let funDepSets :: [[Int]]
funDepSets = [[Int]] -> [[Int]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Tree Int -> Maybe [Int]) -> [Tree Int] -> [[Int]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tree Int -> Maybe [Int]
sccNonDetermined (Graph -> [Tree Int]
G.scc Graph
depGraph))
                   in [Set Int] -> Set (Set Int)
forall a. Ord a => [a] -> Set a
S.fromList ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList ([Int] -> Set Int) -> [[Int]] -> [Set Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Int]]
funDepSets)

-- | The visibility of a name in scope
data NameVisibility
  = Undefined
  -- ^ The name is defined in the current binding group, but is not visible
  | Defined
  -- ^ The name is defined in the another binding group, or has been made visible by a function binder
  deriving (Int -> NameVisibility -> ShowS
[NameVisibility] -> ShowS
NameVisibility -> String
(Int -> NameVisibility -> ShowS)
-> (NameVisibility -> String)
-> ([NameVisibility] -> ShowS)
-> Show NameVisibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameVisibility] -> ShowS
$cshowList :: [NameVisibility] -> ShowS
show :: NameVisibility -> String
$cshow :: NameVisibility -> String
showsPrec :: Int -> NameVisibility -> ShowS
$cshowsPrec :: Int -> NameVisibility -> ShowS
Show, NameVisibility -> NameVisibility -> Bool
(NameVisibility -> NameVisibility -> Bool)
-> (NameVisibility -> NameVisibility -> Bool) -> Eq NameVisibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameVisibility -> NameVisibility -> Bool
$c/= :: NameVisibility -> NameVisibility -> Bool
== :: NameVisibility -> NameVisibility -> Bool
$c== :: NameVisibility -> NameVisibility -> Bool
Eq, (forall x. NameVisibility -> Rep NameVisibility x)
-> (forall x. Rep NameVisibility x -> NameVisibility)
-> Generic NameVisibility
forall x. Rep NameVisibility x -> NameVisibility
forall x. NameVisibility -> Rep NameVisibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameVisibility x -> NameVisibility
$cfrom :: forall x. NameVisibility -> Rep NameVisibility x
Generic)

instance NFData NameVisibility
instance Serialise NameVisibility

-- | A flag for whether a name is for an private or public value - only public values will be
-- included in a generated externs file.
data NameKind
  = Private
  -- ^ A private value introduced as an artifact of code generation (class instances, class member
  -- accessors, etc.)
  | Public
  -- ^ A public value for a module member or foreign import declaration
  | External
  -- ^ A name for member introduced by foreign import
  deriving (Int -> NameKind -> ShowS
[NameKind] -> ShowS
NameKind -> String
(Int -> NameKind -> ShowS)
-> (NameKind -> String) -> ([NameKind] -> ShowS) -> Show NameKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameKind] -> ShowS
$cshowList :: [NameKind] -> ShowS
show :: NameKind -> String
$cshow :: NameKind -> String
showsPrec :: Int -> NameKind -> ShowS
$cshowsPrec :: Int -> NameKind -> ShowS
Show, NameKind -> NameKind -> Bool
(NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool) -> Eq NameKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameKind -> NameKind -> Bool
$c/= :: NameKind -> NameKind -> Bool
== :: NameKind -> NameKind -> Bool
$c== :: NameKind -> NameKind -> Bool
Eq, (forall x. NameKind -> Rep NameKind x)
-> (forall x. Rep NameKind x -> NameKind) -> Generic NameKind
forall x. Rep NameKind x -> NameKind
forall x. NameKind -> Rep NameKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameKind x -> NameKind
$cfrom :: forall x. NameKind -> Rep NameKind x
Generic)

instance NFData NameKind
instance Serialise NameKind

-- | The kinds of a type
data TypeKind
  = DataType DataDeclType [(Text, Maybe SourceType, Role)] [(ProperName 'ConstructorName, [SourceType])]
  -- ^ Data type
  | TypeSynonym
  -- ^ Type synonym
  | ExternData [Role]
  -- ^ Foreign data
  | LocalTypeVariable
  -- ^ A local type variable
  | ScopedTypeVar
  -- ^ A scoped type variable
  deriving (Int -> TypeKind -> ShowS
[TypeKind] -> ShowS
TypeKind -> String
(Int -> TypeKind -> ShowS)
-> (TypeKind -> String) -> ([TypeKind] -> ShowS) -> Show TypeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeKind] -> ShowS
$cshowList :: [TypeKind] -> ShowS
show :: TypeKind -> String
$cshow :: TypeKind -> String
showsPrec :: Int -> TypeKind -> ShowS
$cshowsPrec :: Int -> TypeKind -> ShowS
Show, TypeKind -> TypeKind -> Bool
(TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> Bool) -> Eq TypeKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeKind -> TypeKind -> Bool
$c/= :: TypeKind -> TypeKind -> Bool
== :: TypeKind -> TypeKind -> Bool
$c== :: TypeKind -> TypeKind -> Bool
Eq, (forall x. TypeKind -> Rep TypeKind x)
-> (forall x. Rep TypeKind x -> TypeKind) -> Generic TypeKind
forall x. Rep TypeKind x -> TypeKind
forall x. TypeKind -> Rep TypeKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeKind x -> TypeKind
$cfrom :: forall x. TypeKind -> Rep TypeKind x
Generic)

instance NFData TypeKind
instance Serialise TypeKind

-- | The type ('data' or 'newtype') of a data type declaration
data DataDeclType
  = Data
  -- ^ A standard data constructor
  | Newtype
  -- ^ A newtype constructor
  deriving (Int -> DataDeclType -> ShowS
[DataDeclType] -> ShowS
DataDeclType -> String
(Int -> DataDeclType -> ShowS)
-> (DataDeclType -> String)
-> ([DataDeclType] -> ShowS)
-> Show DataDeclType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataDeclType] -> ShowS
$cshowList :: [DataDeclType] -> ShowS
show :: DataDeclType -> String
$cshow :: DataDeclType -> String
showsPrec :: Int -> DataDeclType -> ShowS
$cshowsPrec :: Int -> DataDeclType -> ShowS
Show, DataDeclType -> DataDeclType -> Bool
(DataDeclType -> DataDeclType -> Bool)
-> (DataDeclType -> DataDeclType -> Bool) -> Eq DataDeclType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataDeclType -> DataDeclType -> Bool
$c/= :: DataDeclType -> DataDeclType -> Bool
== :: DataDeclType -> DataDeclType -> Bool
$c== :: DataDeclType -> DataDeclType -> Bool
Eq, Eq DataDeclType
Eq DataDeclType
-> (DataDeclType -> DataDeclType -> Ordering)
-> (DataDeclType -> DataDeclType -> Bool)
-> (DataDeclType -> DataDeclType -> Bool)
-> (DataDeclType -> DataDeclType -> Bool)
-> (DataDeclType -> DataDeclType -> Bool)
-> (DataDeclType -> DataDeclType -> DataDeclType)
-> (DataDeclType -> DataDeclType -> DataDeclType)
-> Ord DataDeclType
DataDeclType -> DataDeclType -> Bool
DataDeclType -> DataDeclType -> Ordering
DataDeclType -> DataDeclType -> DataDeclType
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 :: DataDeclType -> DataDeclType -> DataDeclType
$cmin :: DataDeclType -> DataDeclType -> DataDeclType
max :: DataDeclType -> DataDeclType -> DataDeclType
$cmax :: DataDeclType -> DataDeclType -> DataDeclType
>= :: DataDeclType -> DataDeclType -> Bool
$c>= :: DataDeclType -> DataDeclType -> Bool
> :: DataDeclType -> DataDeclType -> Bool
$c> :: DataDeclType -> DataDeclType -> Bool
<= :: DataDeclType -> DataDeclType -> Bool
$c<= :: DataDeclType -> DataDeclType -> Bool
< :: DataDeclType -> DataDeclType -> Bool
$c< :: DataDeclType -> DataDeclType -> Bool
compare :: DataDeclType -> DataDeclType -> Ordering
$ccompare :: DataDeclType -> DataDeclType -> Ordering
$cp1Ord :: Eq DataDeclType
Ord, (forall x. DataDeclType -> Rep DataDeclType x)
-> (forall x. Rep DataDeclType x -> DataDeclType)
-> Generic DataDeclType
forall x. Rep DataDeclType x -> DataDeclType
forall x. DataDeclType -> Rep DataDeclType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataDeclType x -> DataDeclType
$cfrom :: forall x. DataDeclType -> Rep DataDeclType x
Generic)

instance NFData DataDeclType
instance Serialise DataDeclType

showDataDeclType :: DataDeclType -> Text
showDataDeclType :: DataDeclType -> Text
showDataDeclType DataDeclType
Data = Text
"data"
showDataDeclType DataDeclType
Newtype = Text
"newtype"

instance A.ToJSON DataDeclType where
  toJSON :: DataDeclType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (DataDeclType -> Text) -> DataDeclType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclType -> Text
showDataDeclType

instance A.FromJSON DataDeclType where
  parseJSON :: Value -> Parser DataDeclType
parseJSON = String
-> (Text -> Parser DataDeclType) -> Value -> Parser DataDeclType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"DataDeclType" ((Text -> Parser DataDeclType) -> Value -> Parser DataDeclType)
-> (Text -> Parser DataDeclType) -> Value -> Parser DataDeclType
forall a b. (a -> b) -> a -> b
$ \Text
str ->
    case Text
str of
      Text
"data" -> DataDeclType -> Parser DataDeclType
forall (m :: * -> *) a. Monad m => a -> m a
return DataDeclType
Data
      Text
"newtype" -> DataDeclType -> Parser DataDeclType
forall (m :: * -> *) a. Monad m => a -> m a
return DataDeclType
Newtype
      Text
other -> String -> Parser DataDeclType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser DataDeclType) -> String -> Parser DataDeclType
forall a b. (a -> b) -> a -> b
$ String
"invalid type: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
other String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"

-- | Construct a ProperName in the Prim module
primName :: Text -> Qualified (ProperName a)
primName :: Text -> Qualified (ProperName a)
primName = Maybe ModuleName -> ProperName a -> Qualified (ProperName a)
forall a. Maybe ModuleName -> a -> Qualified a
Qualified (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
C.Prim) (ProperName a -> Qualified (ProperName a))
-> (Text -> ProperName a) -> Text -> Qualified (ProperName a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ProperName a
forall (a :: ProperNameType). Text -> ProperName a
ProperName

-- | Construct a 'ProperName' in the @Prim.NAME@ module.
primSubName :: Text -> Text -> Qualified (ProperName a)
primSubName :: Text -> Text -> Qualified (ProperName a)
primSubName Text
sub =
  Maybe ModuleName -> ProperName a -> Qualified (ProperName a)
forall a. Maybe ModuleName -> a -> Qualified a
Qualified (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Text -> ModuleName
ModuleName (Text -> ModuleName) -> Text -> ModuleName
forall a b. (a -> b) -> a -> b
$ Text
forall a. IsString a => a
C.prim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sub) (ProperName a -> Qualified (ProperName a))
-> (Text -> ProperName a) -> Text -> Qualified (ProperName a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ProperName a
forall (a :: ProperNameType). Text -> ProperName a
ProperName

primKind :: Text -> SourceType
primKind :: Text -> SourceType
primKind = Text -> SourceType
primTy

primSubKind :: Text -> Text -> SourceType
primSubKind :: Text -> Text -> SourceType
primSubKind Text
sub = SourceAnn -> Qualified (ProperName 'TypeName) -> SourceType
forall a. a -> Qualified (ProperName 'TypeName) -> Type a
TypeConstructor SourceAnn
nullSourceAnn (Qualified (ProperName 'TypeName) -> SourceType)
-> (Text -> Qualified (ProperName 'TypeName)) -> Text -> SourceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
sub

-- | Kind of ground types
kindType :: SourceType
kindType :: SourceType
kindType = Text -> SourceType
primKind Text
forall a. IsString a => a
C.typ

kindConstraint :: SourceType
kindConstraint :: SourceType
kindConstraint = Text -> SourceType
primKind Text
forall a. IsString a => a
C.constraint

isKindType :: Type a -> Bool
isKindType :: Type a -> Bool
isKindType (TypeConstructor a
_ Qualified (ProperName 'TypeName)
n) = Qualified (ProperName 'TypeName)
n Qualified (ProperName 'TypeName)
-> Qualified (ProperName 'TypeName) -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
forall a. IsString a => a
C.typ
isKindType Type a
_ = Bool
False

kindSymbol :: SourceType
kindSymbol :: SourceType
kindSymbol = Text -> SourceType
primKind Text
forall a. IsString a => a
C.symbol

kindDoc :: SourceType
kindDoc :: SourceType
kindDoc = Text -> Text -> SourceType
primSubKind Text
forall a. IsString a => a
C.typeError Text
forall a. IsString a => a
C.doc

kindBoolean :: SourceType
kindBoolean :: SourceType
kindBoolean = Text -> Text -> SourceType
primSubKind Text
forall a. IsString a => a
C.moduleBoolean Text
forall a. IsString a => a
C.kindBoolean

kindOrdering :: SourceType
kindOrdering :: SourceType
kindOrdering = Text -> Text -> SourceType
primSubKind Text
forall a. IsString a => a
C.moduleOrdering Text
forall a. IsString a => a
C.kindOrdering

kindRowList :: SourceType -> SourceType
kindRowList :: SourceType -> SourceType
kindRowList = SourceAnn -> SourceType -> SourceType -> SourceType
forall a. a -> Type a -> Type a -> Type a
TypeApp SourceAnn
nullSourceAnn (Text -> Text -> SourceType
primSubKind Text
forall a. IsString a => a
C.moduleRowList Text
forall a. IsString a => a
C.kindRowList)

kindRow :: SourceType -> SourceType
kindRow :: SourceType -> SourceType
kindRow = SourceAnn -> SourceType -> SourceType -> SourceType
forall a. a -> Type a -> Type a -> Type a
TypeApp SourceAnn
nullSourceAnn (Text -> SourceType
primKind Text
forall a. IsString a => a
C.row)

kindOfREmpty :: SourceType
kindOfREmpty :: SourceType
kindOfREmpty = Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k"))

-- | Construct a type in the Prim module
primTy :: Text -> SourceType
primTy :: Text -> SourceType
primTy = SourceAnn -> Qualified (ProperName 'TypeName) -> SourceType
forall a. a -> Qualified (ProperName 'TypeName) -> Type a
TypeConstructor SourceAnn
nullSourceAnn (Qualified (ProperName 'TypeName) -> SourceType)
-> (Text -> Qualified (ProperName 'TypeName)) -> Text -> SourceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName

-- | Type constructor for functions
tyFunction :: SourceType
tyFunction :: SourceType
tyFunction = Text -> SourceType
primTy Text
"Function"

-- | Type constructor for strings
tyString :: SourceType
tyString :: SourceType
tyString = Text -> SourceType
primTy Text
"String"

-- | Type constructor for strings
tyChar :: SourceType
tyChar :: SourceType
tyChar = Text -> SourceType
primTy Text
"Char"

-- | Type constructor for numbers
tyNumber :: SourceType
tyNumber :: SourceType
tyNumber = Text -> SourceType
primTy Text
"Number"

-- | Type constructor for integers
tyInt :: SourceType
tyInt :: SourceType
tyInt = Text -> SourceType
primTy Text
"Int"

-- | Type constructor for booleans
tyBoolean :: SourceType
tyBoolean :: SourceType
tyBoolean = Text -> SourceType
primTy Text
"Boolean"

-- | Type constructor for arrays
tyArray :: SourceType
tyArray :: SourceType
tyArray = Text -> SourceType
primTy Text
"Array"

-- | Type constructor for records
tyRecord :: SourceType
tyRecord :: SourceType
tyRecord = Text -> SourceType
primTy Text
"Record"

tyVar :: Text -> SourceType
tyVar :: Text -> SourceType
tyVar = SourceAnn -> Text -> SourceType
forall a. a -> Text -> Type a
TypeVar SourceAnn
nullSourceAnn

tyForall :: Text -> SourceType -> SourceType -> SourceType
tyForall :: Text -> SourceType -> SourceType -> SourceType
tyForall Text
var SourceType
k SourceType
ty = SourceAnn
-> Text
-> Maybe SourceType
-> SourceType
-> Maybe SkolemScope
-> SourceType
forall a.
a
-> Text -> Maybe (Type a) -> Type a -> Maybe SkolemScope -> Type a
ForAll SourceAnn
nullSourceAnn Text
var (SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
k) SourceType
ty Maybe SkolemScope
forall a. Maybe a
Nothing

-- | Check whether a type is a record
isObject :: Type a -> Bool
isObject :: Type a -> Bool
isObject = SourceType -> Type a -> Bool
forall a b. Type a -> Type b -> Bool
isTypeOrApplied SourceType
tyRecord

-- | Check whether a type is a function
isFunction :: Type a -> Bool
isFunction :: Type a -> Bool
isFunction = SourceType -> Type a -> Bool
forall a b. Type a -> Type b -> Bool
isTypeOrApplied SourceType
tyFunction

isTypeOrApplied :: Type a -> Type b -> Bool
isTypeOrApplied :: Type a -> Type b -> Bool
isTypeOrApplied Type a
t1 (TypeApp b
_ Type b
t2 Type b
_) = Type a -> Type b -> Bool
forall a b. Type a -> Type b -> Bool
eqType Type a
t1 Type b
t2
isTypeOrApplied Type a
t1 Type b
t2 = Type a -> Type b -> Bool
forall a b. Type a -> Type b -> Bool
eqType Type a
t1 Type b
t2

-- | Smart constructor for function types
function :: SourceType -> SourceType -> SourceType
function :: SourceType -> SourceType -> SourceType
function SourceType
t1 SourceType
t2 = SourceAnn -> SourceType -> SourceType -> SourceType
forall a. a -> Type a -> Type a -> Type a
TypeApp SourceAnn
nullSourceAnn (SourceAnn -> SourceType -> SourceType -> SourceType
forall a. a -> Type a -> Type a -> Type a
TypeApp SourceAnn
nullSourceAnn SourceType
tyFunction SourceType
t1) SourceType
t2

-- To make reading the kind signatures below easier
(-:>) :: SourceType -> SourceType -> SourceType
-:> :: SourceType -> SourceType -> SourceType
(-:>) = SourceType -> SourceType -> SourceType
function
infixr 4 -:>

primClass :: Qualified (ProperName 'TypeName) -> (SourceType -> SourceType) -> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass :: Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'TypeName)
name SourceType -> SourceType
mkKind =
  [ let k :: SourceType
k = SourceType -> SourceType
mkKind SourceType
kindConstraint
    in (Qualified (ProperName 'TypeName)
name, (SourceType
k, [Role] -> TypeKind
ExternData (SourceType -> [Role]
forall a. Type a -> [Role]
nominalRolesForKind SourceType
k)))
  , let k :: SourceType
k = SourceType -> SourceType
mkKind SourceType
kindType
    in (ProperName 'TypeName -> ProperName 'TypeName
forall (a :: ProperNameType). ProperName a -> ProperName a
dictSynonymName (ProperName 'TypeName -> ProperName 'TypeName)
-> Qualified (ProperName 'TypeName)
-> Qualified (ProperName 'TypeName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'TypeName)
name, (SourceType
k, TypeKind
TypeSynonym))
  ]

-- | The primitive types in the external environment with their
-- associated kinds. There are also pseudo `Fail`, `Warn`, and `Partial` types
-- that correspond to the classes with the same names.
primTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Type",             (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Constraint",       (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Symbol",           (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Row",              (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Function",         (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational, Role
Representational]))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Array",            (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational]))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Record",           (SourceType -> SourceType
kindRow SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational]))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"String",           (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Char",             (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Number",           (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Int",              (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Boolean",          (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Partial",          (SourceType
kindConstraint, [Role] -> TypeKind
ExternData []))
    ]

-- | This 'Map' contains all of the prim types from all Prim modules.
allPrimTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
allPrimTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
allPrimTypes = [Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
  [ Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primBooleanTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primOrderingTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowListTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primSymbolTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes
  ]

primBooleanTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primBooleanTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primBooleanTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleBoolean Text
"True", (SourceType
tyBoolean, [Role] -> TypeKind
ExternData []))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleBoolean Text
"False", (SourceType
tyBoolean, [Role] -> TypeKind
ExternData []))
    ]

primCoerceTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
 -> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind))
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall a b. (a -> b) -> a -> b
$ [[(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleCoerce Text
"Coercible") (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    ]

primOrderingTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primOrderingTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primOrderingTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleOrdering Text
"Ordering", (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleOrdering Text
"LT", (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleOrdering Text
"EQ", (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleOrdering Text
"GT", (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    ]

primRowTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
 -> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind))
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall a b. (a -> b) -> a -> b
$ [[(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Union") (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Nub")   (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Lacks") (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Cons")  (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    ]

primRowListTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowListTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowListTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
 -> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind))
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall a b. (a -> b) -> a -> b
$
    [ (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRowList Text
"RowList", (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRowList Text
"Cons", (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k"), [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom, Role
Phantom]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRowList Text
"Nil", (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k"), [Role] -> TypeKind
ExternData []))
    ] [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
forall a. Semigroup a => a -> a -> a
<> [[(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRowList Text
"RowToList")  (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType) -> SourceType -> SourceType
forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    ]

primSymbolTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primSymbolTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primSymbolTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
 -> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind))
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall a b. (a -> b) -> a -> b
$ [[(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleSymbol Text
"Append")  (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleSymbol Text
"Compare") (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindOrdering SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleSymbol Text
"Cons")    (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    ]

primTypeErrorTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes =
  [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
 -> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind))
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
forall a b. (a -> b) -> a -> b
$
    [ (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Doc", (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Fail", (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Warn", (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Text", (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Quote", (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"QuoteLabel", (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Beside", (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom]))
    , (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Above", (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom]))
    ] [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
forall a. Semigroup a => a -> a -> a
<> [[(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]]
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Fail") (\SourceType
kind -> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (Text -> Text -> Qualified (ProperName 'TypeName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Warn") (\SourceType
kind -> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    ]

-- | The primitive class map. This just contains the `Partial` class.
-- `Partial` is used as a kind of magic constraint for partial functions.
primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses =
  [(Qualified (ProperName 'ClassName), TypeClassData)]
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Partial", ([(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData [] [] [] [] Bool
True))
    ]

-- | This contains all of the type classes from all Prim modules.
allPrimClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
allPrimClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
allPrimClasses = [Map (Qualified (ProperName 'ClassName)) TypeClassData]
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
  [ Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses
  , Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses
  , Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses
  , Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses
  , Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses
  , Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses
  ]

primCoerceClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses =
  [(Qualified (ProperName 'ClassName), TypeClassData)]
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class Coercible (a :: k) (b :: k)
    [ (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleCoerce Text
"Coercible", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"a", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
        , (Text
"b", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
        ] [] [] [] Bool
True)
    ]

primRowClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses =
  [(Qualified (ProperName 'ClassName), TypeClassData)]
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class Union (left :: Row k) (right :: Row k) (union :: Row k) | left right -> union, right union -> left, union left -> right
    [ (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Union", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"right", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"union", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
1, Int
2] [Int
0]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
2, Int
0] [Int
1]
        ] Bool
True)

    -- class Nub (original :: Row k) (nubbed :: Row k) | original -> nubbed
    , (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Nub", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"original", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"nubbed", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0] [Int
1]
        ] Bool
True)

    -- class Lacks (label :: Symbol) (row :: Row k)
    , (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Lacks", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"label", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"row", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        ] [] [] [] Bool
True)

    -- class RowCons (label :: Symbol) (a :: k) (tail :: Row k) (row :: Row k) | label tail a -> row, label row -> tail a
    , (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRow Text
"Cons", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"label", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"a", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
        , (Text
"tail", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"row", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1, Int
2] [Int
3]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
3] [Int
1, Int
2]
        ] Bool
True)
    ]

primRowListClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses =
  [(Qualified (ProperName 'ClassName), TypeClassData)]
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class RowToList (row :: Row k) (list :: RowList k) | row -> list
    [ (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleRowList Text
"RowToList", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"row", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"list", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k")))
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0] [Int
1]
        ] Bool
True)
    ]

primSymbolClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses =
  [(Qualified (ProperName 'ClassName), TypeClassData)]
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class Append (left :: Symbol) (right :: Symbol) (appended :: Symbol) | left right -> appended, right appended -> left, appended left -> right
    [ (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleSymbol Text
"Append", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"right", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"appended", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
1, Int
2] [Int
0]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
2, Int
0] [Int
1]
        ] Bool
True)

    -- class Compare (left :: Symbol) (right :: Symbol) (ordering :: Ordering) | left right -> ordering
    , (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleSymbol Text
"Compare", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"right", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"ordering", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindOrdering)
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
        ] Bool
True)

    -- class Cons (head :: Symbol) (tail :: Symbol) (symbol :: Symbol) | head tail -> symbol, symbol -> head tail
    , (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.moduleSymbol Text
"Cons", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"head", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"tail", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"symbol", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindSymbol)
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
2] [Int
0, Int
1]
        ] Bool
True)
    ]

primTypeErrorClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses =
  [(Qualified (ProperName 'ClassName), TypeClassData)]
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class Fail (message :: Symbol)
    [ (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Fail", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [(Text
"message", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindDoc)] [] [] [] Bool
True)

    -- class Warn (message :: Symbol)
    , (Text -> Text -> Qualified (ProperName 'ClassName)
forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
forall a. IsString a => a
C.typeError Text
"Warn", [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [(Text
"message", SourceType -> Maybe SourceType
forall a. a -> Maybe a
Just SourceType
kindDoc)] [] [] [] Bool
True)
    ]

-- | Finds information about data constructors from the current environment.
lookupConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
lookupConstructor :: Environment
-> Qualified (ProperName 'ConstructorName)
-> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
lookupConstructor Environment
env Qualified (ProperName 'ConstructorName)
ctor =
  (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
-> Maybe (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
-> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
forall a. a -> Maybe a -> a
fromMaybe (String -> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
forall a. HasCallStack => String -> a
internalError String
"Data constructor not found") (Maybe (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
 -> (DataDeclType, ProperName 'TypeName, SourceType, [Ident]))
-> Maybe (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
-> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
forall a b. (a -> b) -> a -> b
$ Qualified (ProperName 'ConstructorName)
ctor Qualified (ProperName 'ConstructorName)
-> Map
     (Qualified (ProperName 'ConstructorName))
     (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
-> Maybe (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map
     (Qualified (ProperName 'ConstructorName))
     (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
dataConstructors Environment
env

-- | Checks whether a data constructor is for a newtype.
isNewtypeConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> Bool
isNewtypeConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> Bool
isNewtypeConstructor Environment
e Qualified (ProperName 'ConstructorName)
ctor = case Environment
-> Qualified (ProperName 'ConstructorName)
-> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
lookupConstructor Environment
e Qualified (ProperName 'ConstructorName)
ctor of
  (DataDeclType
Newtype, ProperName 'TypeName
_, SourceType
_, [Ident]
_) -> Bool
True
  (DataDeclType
Data, ProperName 'TypeName
_, SourceType
_, [Ident]
_) -> Bool
False

-- | Finds information about values from the current environment.
lookupValue :: Environment -> Qualified Ident -> Maybe (SourceType, NameKind, NameVisibility)
lookupValue :: Environment
-> Qualified Ident -> Maybe (SourceType, NameKind, NameVisibility)
lookupValue Environment
env Qualified Ident
ident = Qualified Ident
ident Qualified Ident
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
-> Maybe (SourceType, NameKind, NameVisibility)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
names Environment
env

dictSynonymName' :: Text -> Text
dictSynonymName' :: Text -> Text
dictSynonymName' = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$Dict")

dictSynonymName :: ProperName a -> ProperName a
dictSynonymName :: ProperName a -> ProperName a
dictSynonymName = Text -> ProperName a
forall (a :: ProperNameType). Text -> ProperName a
ProperName (Text -> ProperName a)
-> (ProperName a -> Text) -> ProperName a -> ProperName a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dictSynonymName' (Text -> Text) -> (ProperName a -> Text) -> ProperName a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName a -> Text
forall (a :: ProperNameType). ProperName a -> Text
runProperName

isDictSynonym :: ProperName a -> Bool
isDictSynonym :: ProperName a -> Bool
isDictSynonym = Text -> Text -> Bool
T.isSuffixOf Text
"$Dict" (Text -> Bool) -> (ProperName a -> Text) -> ProperName a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName a -> Text
forall (a :: ProperNameType). ProperName a -> Text
runProperName

-- |
-- Given the kind of a type, generate a list @Nominal@ roles. This is used for
-- opaque foreign types as well as type classes.
nominalRolesForKind :: Type a -> [Role]
nominalRolesForKind :: Type a -> [Role]
nominalRolesForKind Type a
k = Int -> Role -> [Role]
forall a. Int -> a -> [a]
replicate (Type a -> Int
forall a. Type a -> Int
kindArity Type a
k) Role
Nominal

kindArity :: Type a -> Int
kindArity :: Type a -> Int
kindArity = [Type a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Type a] -> Int) -> (Type a -> [Type a]) -> Type a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Type a], Type a) -> [Type a]
forall a b. (a, b) -> a
fst (([Type a], Type a) -> [Type a])
-> (Type a -> ([Type a], Type a)) -> Type a -> [Type a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type a -> ([Type a], Type a)
forall a. Type a -> ([Type a], Type a)
unapplyKinds

unapplyKinds :: Type a -> ([Type a], Type a)
unapplyKinds :: Type a -> ([Type a], Type a)
unapplyKinds = [Type a] -> Type a -> ([Type a], Type a)
forall a. [Type a] -> Type a -> ([Type a], Type a)
go [] where
  go :: [Type a] -> Type a -> ([Type a], Type a)
go [Type a]
kinds (TypeApp a
_ (TypeApp a
_ Type a
fn Type a
k1) Type a
k2)
    | Type a -> SourceType -> Bool
forall a b. Type a -> Type b -> Bool
eqType Type a
fn SourceType
tyFunction = [Type a] -> Type a -> ([Type a], Type a)
go (Type a
k1 Type a -> [Type a] -> [Type a]
forall a. a -> [a] -> [a]
: [Type a]
kinds) Type a
k2
  go [Type a]
kinds (ForAll a
_ Text
_ Maybe (Type a)
_ Type a
k Maybe SkolemScope
_) = [Type a] -> Type a -> ([Type a], Type a)
go [Type a]
kinds Type a
k
  go [Type a]
kinds Type a
k = ([Type a] -> [Type a]
forall a. [a] -> [a]
reverse [Type a]
kinds, Type a
k)