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 qualified Data.Aeson as A
import Data.Foldable (find, fold)
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe (fromMaybe)
import Data.Semigroup (First(..))
import Data.Text (Text)
import qualified Data.Text as T
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))
     ([(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)]
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
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)]
-> [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
  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

-- 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
"'"

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

-- | Construct a 'ProperName' in the @Prim.NAME@ module.
primSubName :: Text -> Text -> Qualified (ProperName a)
primSubName :: forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
sub =
  forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName forall a b. (a -> b) -> a -> b
$ Text -> ModuleName
ModuleName forall a b. (a -> b) -> a -> b
$ forall a. IsString a => a
C.prim forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
sub) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> Qualified (ProperName 'TypeName) -> Type a
TypeConstructor (SourceSpan, [Comment])
nullSourceAnn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName Text
sub

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

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

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

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

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

kindRowList :: SourceType -> SourceType
kindRowList :: SourceType -> SourceType
kindRowList = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn (Text -> Text -> SourceType
primSubKind forall a. IsString a => a
C.moduleRowList forall a. IsString a => a
C.kindRowList)

kindRow :: SourceType -> SourceType
kindRow :: SourceType -> SourceType
kindRow = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn (Text -> SourceType
primKind 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 = forall a. a -> Qualified (ProperName 'TypeName) -> Type a
TypeConstructor (SourceSpan, [Comment])
nullSourceAnn forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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
-> Text -> Maybe (Type a) -> Type a -> Maybe SkolemScope -> Type a
ForAll (SourceSpan, [Comment])
nullSourceAnn 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 '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 (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 (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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Type",             (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Constraint",       (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Symbol",           (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Row",              (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (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]))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Array",            (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational]))
    , (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]))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"String",           (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Char",             (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Number",           (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Int",              (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
primName Text
"Boolean",          (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (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 = 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
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleBoolean Text
"True", (SourceType
tyBoolean, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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 =
  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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleCoerce Text
"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
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleOrdering Text
"Ordering", (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleOrdering Text
"LT", (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleOrdering Text
"EQ", (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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 =
  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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Union") (\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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Nub")   (\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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Lacks") (\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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Cons")  (\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
$
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRowList Text
"RowList", (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRowList Text
"Cons", (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]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRowList Text
"Nil", (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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRowList Text
"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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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 (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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 (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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)
    ]

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 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"Add")     (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"Compare") (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kindOrdering SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"Mul")     (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kind)
    , Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"ToString") (\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
$
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"Doc", (SourceType
kindType, [Role] -> TypeKind
ExternData []))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"Fail", (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"Warn", (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"Text", (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"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]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"QuoteLabel", (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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]))
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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]))
    ] forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
    [ Qualified (ProperName 'TypeName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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 (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName 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 =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (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 = 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)
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleCoerce Text
"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
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Union", [(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
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Nub", [(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)
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Lacks", [(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
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRow Text
"Cons", [(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
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleRowList Text
"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
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleSymbol Text
"Append", [(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
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleSymbol Text
"Compare", [(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
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleSymbol Text
"Cons", [(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
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"Add", [(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
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"Compare", [(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
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"Mul", [(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
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.moduleInt Text
"ToString", [(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)
    [ (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"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)
    , (forall (a :: ProperNameType).
Text -> Text -> Qualified (ProperName a)
primSubName forall a. IsString a => a
C.typeError Text
"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
_ 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)