module Language.PureScript.Environment where

import Prelude

import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Control.Monad (unless)
import Codec.Serialise (Serialise)
import Data.Aeson ((.=), (.:))
import Data.Aeson qualified as A
import Data.Foldable (find, fold)
import Data.Functor ((<&>))
import Data.IntMap qualified as IM
import Data.IntSet qualified as IS
import Data.Map qualified as M
import Data.Set qualified as S
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Semigroup (First(..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.List.NonEmpty qualified as NEL

import Language.PureScript.AST.SourcePos (nullSourceAnn)
import Language.PureScript.Crash (internalError)
import Language.PureScript.Names (Ident, ProperName(..), ProperNameType(..), Qualified, QualifiedBy, coerceProperName)
import Language.PureScript.Roles (Role(..))
import Language.PureScript.TypeClassDictionaries (NamedDict)
import Language.PureScript.Types (SourceConstraint, SourceType, Type(..), TypeVarVisibility(..), eqType, srcTypeConstructor, freeTypeVariables)
import Language.PureScript.Constants.Prim qualified 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))
     ([(Text, Maybe SourceType)], SourceType)
typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceType)], SourceType)
  -- ^ Type synonyms currently in scope
  , Environment
-> Map
     QualifiedBy
     (Map
        (Qualified (ProperName 'ClassName))
        (Map (Qualified Ident) (NonEmpty NamedDict)))
typeClassDictionaries :: M.Map QualifiedBy (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
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. 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, Maybe (Set (NonEmpty Int)))]
typeClassMembers :: [(Ident, SourceType, Maybe (S.Set (NEL.NonEmpty Int)))]
  -- ^ A list of type class members and their types and whether or not
  -- they have type variables that must be defined using Visible Type Applications.
  -- 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
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. 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
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. 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FunctionalDependency" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Int] -> [Int] -> FunctionalDependency
FunctionalDependency
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"determiners"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 [ Key
"determiners" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Int]
fdDeterminers
             , Key
"determined" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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))
     ([(Text, Maybe SourceType)], SourceType)
-> Map
     QualifiedBy
     (Map
        (Qualified (ProperName 'ClassName))
        (Map (Qualified Ident) (NonEmpty NamedDict)))
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
-> Environment
Environment forall k a. Map k a
M.empty Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
allPrimTypes forall k a. Map k a
M.empty forall k a. Map k a
M.empty 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 = [(Text, Maybe SourceType)]
-> [(Ident, SourceType, Maybe (Set (NonEmpty Int)))]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Set Int
-> Set (Set Int)
-> Bool
-> TypeClassData
TypeClassData [(Text, Maybe SourceType)]
args [(Ident, SourceType, Maybe (Set (NonEmpty Int)))]
m' [SourceConstraint]
s [FunctionalDependency]
deps Set Int
determinedArgs Set (Set Int)
coveringSets
  where
    ( Set Int
determinedArgs, Set (Set Int)
coveringSets ) = Int -> [FunctionalDependency] -> (Set Int, Set (Set Int))
computeCoveringSets (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Maybe SourceType)]
args) [FunctionalDependency]
deps

    coveringSets' :: [Set Int]
coveringSets' = forall a. Set a -> [a]
S.toList Set (Set Int)
coveringSets

    m' :: [(Ident, SourceType, Maybe (Set (NonEmpty Int)))]
m' = forall a b. (a -> b) -> [a] -> [b]
map (\(Ident
a, SourceType
b) -> (Ident
a, SourceType
b, SourceType -> Maybe (Set (NonEmpty Int))
addVtaInfo SourceType
b)) [(Ident, SourceType)]
m
    
    addVtaInfo :: SourceType -> Maybe (S.Set (NEL.NonEmpty Int))
    addVtaInfo :: SourceType -> Maybe (Set (NonEmpty Int))
addVtaInfo SourceType
memberTy = do
      let mentionedArgIndexes :: Set Int
mentionedArgIndexes = forall a. Ord a => [a] -> Set a
S.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Int
argToIndex forall a b. (a -> b) -> a -> b
$ forall a. Type a -> [Text]
freeTypeVariables SourceType
memberTy)
      let leftovers :: [Set Int]
leftovers = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Int
mentionedArgIndexes) [Set Int]
coveringSets'
      forall a. Ord a => [a] -> Set a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList) [Set Int]
leftovers

    argToIndex :: Text -> Maybe Int
    argToIndex :: Text -> Maybe Int
argToIndex = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Maybe SourceType)]
args [Int
0..])

-- A moving frontier of sets to consider, along with the fundeps that can be
-- applied in each case. At each stage, all sets in the frontier will be the
-- same size, decreasing by 1 each time.
type Frontier = M.Map IS.IntSet (First (IM.IntMap (NEL.NonEmpty IS.IntSet)))
--                         ^                 ^          ^          ^
--         when *these* parameters           |          |          |
--         are still needed,                 |          |          |
--                              *these* parameters      |          |
--                              can be determined       |          |
--                                         from a non-zero         |
--                                         number of fundeps,      |
--                                                      which accept *these*
--                                                      parameters as inputs.

computeCoveringSets :: Int -> [FunctionalDependency] -> (S.Set Int, S.Set (S.Set Int))
computeCoveringSets :: Int -> [FunctionalDependency] -> (Set Int, Set (Set Int))
computeCoveringSets Int
nargs [FunctionalDependency]
deps = ( Set Int
determinedArgs, Set (Set Int)
coveringSets )
  where
    argumentIndices :: Set Int
argumentIndices = forall a. Ord a => [a] -> Set a
S.fromList [Int
0 .. Int
nargs forall a. Num a => a -> a -> a
- Int
1]

    -- Compute all sets of arguments that determine the remaining arguments via
    -- functional dependencies. This is done in stages, where each stage
    -- considers sets of the same size to share work.
    allCoveringSets :: S.Set (S.Set Int)
    allCoveringSets :: Set (Set Int)
allCoveringSets = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall a. [a] -> Set a
S.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toAscList) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Frontier -> (Set IntSet, ())
search forall a b. (a -> b) -> a -> b
$
      -- The initial frontier consists of just the set of all parameters and all
      -- fundeps organized into the map structure.
      forall k a. k -> a -> Map k a
M.singleton
        ([Int] -> IntSet
IS.fromList [Int
0 .. Int
nargs forall a. Num a => a -> a -> a
- Int
1]) forall a b. (a -> b) -> a -> b
$
          forall a. a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ do
            FunctionalDependency
fd <- [FunctionalDependency]
deps
            let srcs :: NonEmpty IntSet
srcs = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> IntSet
IS.fromList (FunctionalDependency -> [Int]
fdDeterminers FunctionalDependency
fd))
            Int
tgt <- FunctionalDependency -> [Int]
fdDetermined FunctionalDependency
fd
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
tgt, NonEmpty IntSet
srcs)

      where

      -- Recursively advance the frontier until all frontiers are exhausted
      -- and coverings sets found. The covering sets found during the process
      -- are locally-minimal, in that none can be reduced by a fundep, but
      -- there may be subsets found from other frontiers.
      search :: Frontier -> (S.Set IS.IntSet, ())
      search :: Frontier -> (Set IntSet, ())
search Frontier
frontier = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Frontier
frontier) forall a b. (a -> b) -> a -> b
$ forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey IntSet
-> First (IntMap (NonEmpty IntSet)) -> (Set IntSet, Frontier)
step Frontier
frontier forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Frontier -> (Set IntSet, ())
search

      -- The input set from the frontier is known to cover all parameters, but
      -- it may be able to be reduced by more fundeps.
      step :: IS.IntSet -> First (IM.IntMap (NEL.NonEmpty IS.IntSet)) -> (S.Set IS.IntSet, Frontier)
      step :: IntSet
-> First (IntMap (NonEmpty IntSet)) -> (Set IntSet, Frontier)
step IntSet
needed (First IntMap (NonEmpty IntSet)
inEdges)
        -- If there are no applicable fundeps, record it as a locally minimal
        -- covering set. This has already been reduced to only applicable fundeps
        | forall a. IntMap a -> Bool
IM.null IntMap (NonEmpty IntSet)
inEdges = (forall a. a -> Set a
S.singleton IntSet
needed, forall k a. Map k a
M.empty)
        | Bool
otherwise       = (forall a. Set a
S.empty, forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int -> Frontier
removeParameter [Int]
paramsToTry)

          where

          determined :: [Int]
determined = forall a. IntMap a -> [Int]
IM.keys IntMap (NonEmpty IntSet)
inEdges
          -- If there is an acyclically determined functional dependency, prefer
          -- it to reduce the number of cases to check. That is a dependency
          -- that does not help determine other parameters.
          acycDetermined :: Maybe Int
acycDetermined = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> IntSet -> Bool
`IS.notMember` (forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. NonEmpty a -> [a]
NEL.toList forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IM.elems IntMap (NonEmpty IntSet)
inEdges)) [Int]
determined
          paramsToTry :: [Int]
paramsToTry = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Int]
determined forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
acycDetermined

          -- For each parameter to be removed to build the next frontier,
          -- delete the fundeps that determine it and filter out the fundeps
          -- that make use of it. Of course, if it an acyclic fundep we already
          -- found that there are none that use it.
          removeParameter :: Int -> Frontier
          removeParameter :: Int -> Frontier
removeParameter Int
y =
            forall k a. k -> a -> Map k a
M.singleton
              (Int -> IntSet -> IntSet
IS.delete Int
y IntSet
needed) forall a b. (a -> b) -> a -> b
$
                case Maybe Int
acycDetermined of
                  Just Int
_ -> forall a. a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> IntMap a
IM.delete Int
y IntMap (NonEmpty IntSet)
inEdges
                  Maybe Int
Nothing ->
                    forall a. a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IM.mapMaybe (forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> NonEmpty a -> [a]
NEL.filter (Int
y Int -> IntSet -> Bool
`IS.notMember`)) forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> IntMap a
IM.delete Int
y IntMap (NonEmpty IntSet)
inEdges

    -- Reduce to the inclusion-minimal sets
    coveringSets :: Set (Set Int)
coveringSets = forall a. (a -> Bool) -> Set a -> Set a
S.filter (\Set Int
v -> Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Set Int
c -> Set Int
c forall a. Ord a => Set a -> Set a -> Bool
`S.isProperSubsetOf` Set Int
v) Set (Set Int)
allCoveringSets)) Set (Set Int)
allCoveringSets

    -- An argument is determined if it is in no covering set
    determinedArgs :: Set Int
determinedArgs = Set Int
argumentIndices forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Set (Set Int)
coveringSets

-- | 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
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
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. 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
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
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. 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
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
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. 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
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
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
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
Ord, 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 = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclType -> Text
showDataDeclType

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

-- | Kind of ground types
kindType :: SourceType
kindType :: SourceType
kindType = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Type

kindConstraint :: SourceType
kindConstraint :: SourceType
kindConstraint = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Constraint

kindSymbol :: SourceType
kindSymbol :: SourceType
kindSymbol = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Symbol

kindDoc :: SourceType
kindDoc :: SourceType
kindDoc = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Doc

kindOrdering :: SourceType
kindOrdering :: SourceType
kindOrdering = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.TypeOrdering

kindRowList :: SourceType -> SourceType
kindRowList :: SourceType -> SourceType
kindRowList = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn (Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.RowList)

kindRow :: SourceType -> SourceType
kindRow :: SourceType -> SourceType
kindRow = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn (Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Row)

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

-- | Type constructor for functions
tyFunction :: SourceType
tyFunction :: SourceType
tyFunction = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Function

-- | Type constructor for strings
tyString :: SourceType
tyString :: SourceType
tyString = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.String

-- | Type constructor for strings
tyChar :: SourceType
tyChar :: SourceType
tyChar = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Char

-- | Type constructor for numbers
tyNumber :: SourceType
tyNumber :: SourceType
tyNumber = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Number

-- | Type constructor for integers
tyInt :: SourceType
tyInt :: SourceType
tyInt = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Int

-- | Type constructor for booleans
tyBoolean :: SourceType
tyBoolean :: SourceType
tyBoolean = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Boolean

-- | Type constructor for arrays
tyArray :: SourceType
tyArray :: SourceType
tyArray = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Array

-- | Type constructor for records
tyRecord :: SourceType
tyRecord :: SourceType
tyRecord = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Record

tyVar :: Text -> SourceType
tyVar :: Text -> SourceType
tyVar = forall a. a -> Text -> Type a
TypeVar (SourceSpan, [Comment])
nullSourceAnn

tyForall :: Text -> SourceType -> SourceType -> SourceType
tyForall :: Text -> SourceType -> SourceType -> SourceType
tyForall Text
var SourceType
k SourceType
ty = forall a.
a
-> TypeVarVisibility
-> Text
-> Maybe (Type a)
-> Type a
-> Maybe SkolemScope
-> Type a
ForAll (SourceSpan, [Comment])
nullSourceAnn TypeVarVisibility
TypeVarInvisible Text
var (forall a. a -> Maybe a
Just SourceType
k) SourceType
ty forall a. Maybe a
Nothing

-- | Smart constructor for function types
function :: SourceType -> SourceType -> SourceType
function :: SourceType -> SourceType -> SourceType
function = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn SourceType
tyFunction

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

primClass :: Qualified (ProperName 'ClassName) -> (SourceType -> SourceType) -> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass :: Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
name SourceType -> SourceType
mkKind =
  [ let k :: SourceType
k = SourceType -> SourceType
mkKind SourceType
kindConstraint
    in (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ClassName)
name, (SourceType
k, [Role] -> TypeKind
ExternData (forall a. Type a -> [Role]
nominalRolesForKind SourceType
k)))
  , let k :: SourceType
k = SourceType -> SourceType
mkKind SourceType
kindType
    in (forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ClassName)
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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Qualified (ProperName 'TypeName)
C.Type,                         (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.Constraint,                   (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.Symbol,                       (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.Row,                          (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Qualified (ProperName 'TypeName)
C.Function,                     (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational, Role
Representational]))
    , (Qualified (ProperName 'TypeName)
C.Array,                        (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational]))
    , (Qualified (ProperName 'TypeName)
C.Record,                       (SourceType -> SourceType
kindRow SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational]))
    , (Qualified (ProperName 'TypeName)
C.String,                       (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.Char,                         (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.Number,                       (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.Int,                          (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.Boolean,                      (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'ClassName)
C.Partial forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName, (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 = 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)
primIntTypes
  , Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes
  ]

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

primCoerceTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.Coercible (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType 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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Qualified (ProperName 'TypeName)
C.TypeOrdering, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.LT, (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.EQ, (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'TypeName)
C.GT, (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    ]

primRowTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowUnion (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType 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 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowNub   (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType 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 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowLacks (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType 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 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowCons  (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType 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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
    [ (Qualified (ProperName 'TypeName)
C.RowList, (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Qualified (ProperName 'TypeName)
C.RowListCons, (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType 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]))
    , (Qualified (ProperName 'TypeName)
C.RowListNil, (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k"), [Role] -> TypeKind
ExternData []))
    ] forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowToList  (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType 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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.SymbolAppend  (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.SymbolCompare (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindOrdering SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.SymbolCons    (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    ]

primIntTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primIntTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primIntTypes =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntAdd      (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntCompare  (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kindOrdering SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntMul      (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntToString (\SourceType
kind -> SourceType
tyInt 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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
    [ (Qualified (ProperName 'TypeName)
C.Doc, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (Qualified (ProperName 'ClassName)
C.Fail forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
    , (Qualified (ProperName 'ClassName)
C.Warn forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
    , (Qualified (ProperName 'TypeName)
C.Text, (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Qualified (ProperName 'TypeName)
C.Quote, (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Qualified (ProperName 'TypeName)
C.QuoteLabel, (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (Qualified (ProperName 'TypeName)
C.Beside, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom]))
    , (Qualified (ProperName 'TypeName)
C.Above, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom]))
    ] forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.Fail (\SourceType
kind -> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Qualified (ProperName 'ClassName)
C.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 = 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
primIntClasses
  , Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses
  ]

primCoerceClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class Coercible (a :: k) (b :: k)
    [ (Qualified (ProperName 'ClassName)
C.Coercible, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"a", forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
        , (Text
"b", 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 =
  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
    [ (Qualified (ProperName 'ClassName)
C.RowUnion, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"right", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"union", 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
    , (Qualified (ProperName 'ClassName)
C.RowNub, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"original", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"nubbed", 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)
    , (Qualified (ProperName 'ClassName)
C.RowLacks, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"label", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"row", 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
    , (Qualified (ProperName 'ClassName)
C.RowCons, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"label", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"a", forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
        , (Text
"tail", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"row", 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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class RowToList (row :: Row k) (list :: RowList k) | row -> list
    [ (Qualified (ProperName 'ClassName)
C.RowToList, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"row", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
        , (Text
"list", 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 =
  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
    [ (Qualified (ProperName 'ClassName)
C.SymbolAppend, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"right", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"appended", 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
    , (Qualified (ProperName 'ClassName)
C.SymbolCompare, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"right", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"ordering", 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
    , (Qualified (ProperName 'ClassName)
C.SymbolCons, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"head", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"tail", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        , (Text
"symbol", 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)
    ]

primIntClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primIntClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primIntClasses =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    -- class Add (left :: Int) (right :: Int) (sum :: Int) | left right -> sum, left sum -> right, right sum -> left
    [ (Qualified (ProperName 'ClassName)
C.IntAdd, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", forall a. a -> Maybe a
Just SourceType
tyInt)
        , (Text
"right", forall a. a -> Maybe a
Just SourceType
tyInt)
        , (Text
"sum", forall a. a -> Maybe a
Just SourceType
tyInt)
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
2] [Int
1]
        , [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
1, Int
2] [Int
0]
        ] Bool
True)

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

    -- class Mul (left :: Int) (right :: Int) (product :: Int) | left right -> product
    , (Qualified (ProperName 'ClassName)
C.IntMul, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"left", forall a. a -> Maybe a
Just SourceType
tyInt)
        , (Text
"right", forall a. a -> Maybe a
Just SourceType
tyInt)
        , (Text
"product", forall a. a -> Maybe a
Just SourceType
tyInt)
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
        ] Bool
True)

    -- class ToString (int :: Int) (string :: Symbol) | int -> string
    , (Qualified (ProperName 'ClassName)
C.IntToString, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [ (Text
"int", forall a. a -> Maybe a
Just SourceType
tyInt)
        , (Text
"string", forall a. a -> Maybe a
Just SourceType
kindSymbol)
        ] [] []
        [ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0] [Int
1]
        ] Bool
True)
    ]

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

    -- class Warn (message :: Symbol)
    , (Qualified (ProperName 'ClassName)
C.Warn, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
        [(Text
"message", 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 =
  forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Data constructor not found") forall a b. (a -> b) -> a -> b
$ Qualified (ProperName 'ConstructorName)
ctor 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

-- | 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 forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
names Environment
env

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

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

isDictTypeName :: ProperName a -> Bool
isDictTypeName :: forall (a :: ProperNameType). ProperName a -> Bool
isDictTypeName = Text -> Text -> Bool
T.isSuffixOf Text
"$Dict" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Type a -> [Role]
nominalRolesForKind Type a
k = forall a. Int -> a -> [a]
replicate (forall a. Type a -> Int
kindArity Type a
k) Role
Nominal

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

unapplyKinds :: Type a -> ([Type a], Type a)
unapplyKinds :: forall a. Type a -> ([Type a], Type a)
unapplyKinds = 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)
    | 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 forall a. a -> [a] -> [a]
: [Type a]
kinds) Type a
k2
  go [Type a]
kinds (ForAll a
_ TypeVarVisibility
_ 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 = (forall a. [a] -> [a]
reverse [Type a]
kinds, Type a
k)