module Language.PureScript.Externs
( ExternsFile(..)
, ExternsImport(..)
, ExternsFixity(..)
, ExternsTypeFixity(..)
, ExternsDeclaration(..)
, externsIsCurrentVersion
, moduleToExternsFile
, applyExternsFileToEnvironment
, externsFileName
) where
import Prelude
import Codec.Serialise (Serialise)
import Control.Monad (join)
import GHC.Generics (Generic)
import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
import Data.List (foldl', find)
import Data.Foldable (fold)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Version (showVersion)
import Data.Map qualified as M
import Data.List.NonEmpty qualified as NEL
import Language.PureScript.AST (Associativity, Declaration(..), DeclarationRef(..), Fixity(..), ImportDeclarationType, Module(..), NameSource(..), Precedence, SourceSpan, pattern TypeFixityDeclaration, pattern ValueFixityDeclaration, getTypeOpRef, getValueOpRef)
import Language.PureScript.AST.Declarations.ChainId (ChainId)
import Language.PureScript.Crash (internalError)
import Language.PureScript.Environment (DataDeclType, Environment(..), FunctionalDependency, NameKind(..), NameVisibility(..), TypeClassData(..), TypeKind(..), dictTypeName, makeTypeClassData)
import Language.PureScript.Names (Ident, ModuleName, OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, isPlainIdent)
import Language.PureScript.TypeClassDictionaries (NamedDict, TypeClassDictionaryInScope(..))
import Language.PureScript.Types (SourceConstraint, SourceType, srcInstanceType)
import Paths_purescript as Paths
data ExternsFile = ExternsFile
{ ExternsFile -> Text
efVersion :: Text
, ExternsFile -> ModuleName
efModuleName :: ModuleName
, ExternsFile -> [DeclarationRef]
efExports :: [DeclarationRef]
, ExternsFile -> [ExternsImport]
efImports :: [ExternsImport]
, ExternsFile -> [ExternsFixity]
efFixities :: [ExternsFixity]
, ExternsFile -> [ExternsTypeFixity]
efTypeFixities :: [ExternsTypeFixity]
, ExternsFile -> [ExternsDeclaration]
efDeclarations :: [ExternsDeclaration]
, ExternsFile -> SourceSpan
efSourceSpan :: SourceSpan
} deriving (Int -> ExternsFile -> ShowS
[ExternsFile] -> ShowS
ExternsFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternsFile] -> ShowS
$cshowList :: [ExternsFile] -> ShowS
show :: ExternsFile -> String
$cshow :: ExternsFile -> String
showsPrec :: Int -> ExternsFile -> ShowS
$cshowsPrec :: Int -> ExternsFile -> ShowS
Show, forall x. Rep ExternsFile x -> ExternsFile
forall x. ExternsFile -> Rep ExternsFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternsFile x -> ExternsFile
$cfrom :: forall x. ExternsFile -> Rep ExternsFile x
Generic)
instance Serialise ExternsFile
data ExternsImport = ExternsImport
{
ExternsImport -> ModuleName
eiModule :: ModuleName
, ExternsImport -> ImportDeclarationType
eiImportType :: ImportDeclarationType
, ExternsImport -> Maybe ModuleName
eiImportedAs :: Maybe ModuleName
} deriving (Int -> ExternsImport -> ShowS
[ExternsImport] -> ShowS
ExternsImport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternsImport] -> ShowS
$cshowList :: [ExternsImport] -> ShowS
show :: ExternsImport -> String
$cshow :: ExternsImport -> String
showsPrec :: Int -> ExternsImport -> ShowS
$cshowsPrec :: Int -> ExternsImport -> ShowS
Show, forall x. Rep ExternsImport x -> ExternsImport
forall x. ExternsImport -> Rep ExternsImport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternsImport x -> ExternsImport
$cfrom :: forall x. ExternsImport -> Rep ExternsImport x
Generic)
instance Serialise ExternsImport
data ExternsFixity = ExternsFixity
{
ExternsFixity -> Associativity
efAssociativity :: Associativity
, ExternsFixity -> Integer
efPrecedence :: Precedence
, ExternsFixity -> OpName 'ValueOpName
efOperator :: OpName 'ValueOpName
, ExternsFixity
-> Qualified (Either Ident (ProperName 'ConstructorName))
efAlias :: Qualified (Either Ident (ProperName 'ConstructorName))
} deriving (Int -> ExternsFixity -> ShowS
[ExternsFixity] -> ShowS
ExternsFixity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternsFixity] -> ShowS
$cshowList :: [ExternsFixity] -> ShowS
show :: ExternsFixity -> String
$cshow :: ExternsFixity -> String
showsPrec :: Int -> ExternsFixity -> ShowS
$cshowsPrec :: Int -> ExternsFixity -> ShowS
Show, forall x. Rep ExternsFixity x -> ExternsFixity
forall x. ExternsFixity -> Rep ExternsFixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternsFixity x -> ExternsFixity
$cfrom :: forall x. ExternsFixity -> Rep ExternsFixity x
Generic)
instance Serialise ExternsFixity
data ExternsTypeFixity = ExternsTypeFixity
{
ExternsTypeFixity -> Associativity
efTypeAssociativity :: Associativity
, ExternsTypeFixity -> Integer
efTypePrecedence :: Precedence
, ExternsTypeFixity -> OpName 'TypeOpName
efTypeOperator :: OpName 'TypeOpName
, ExternsTypeFixity -> Qualified (ProperName 'TypeName)
efTypeAlias :: Qualified (ProperName 'TypeName)
} deriving (Int -> ExternsTypeFixity -> ShowS
[ExternsTypeFixity] -> ShowS
ExternsTypeFixity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternsTypeFixity] -> ShowS
$cshowList :: [ExternsTypeFixity] -> ShowS
show :: ExternsTypeFixity -> String
$cshow :: ExternsTypeFixity -> String
showsPrec :: Int -> ExternsTypeFixity -> ShowS
$cshowsPrec :: Int -> ExternsTypeFixity -> ShowS
Show, forall x. Rep ExternsTypeFixity x -> ExternsTypeFixity
forall x. ExternsTypeFixity -> Rep ExternsTypeFixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternsTypeFixity x -> ExternsTypeFixity
$cfrom :: forall x. ExternsTypeFixity -> Rep ExternsTypeFixity x
Generic)
instance Serialise ExternsTypeFixity
data ExternsDeclaration =
EDType
{ ExternsDeclaration -> ProperName 'TypeName
edTypeName :: ProperName 'TypeName
, ExternsDeclaration -> SourceType
edTypeKind :: SourceType
, ExternsDeclaration -> TypeKind
edTypeDeclarationKind :: TypeKind
}
| EDTypeSynonym
{ ExternsDeclaration -> ProperName 'TypeName
edTypeSynonymName :: ProperName 'TypeName
, ExternsDeclaration -> [(Text, Maybe SourceType)]
edTypeSynonymArguments :: [(Text, Maybe SourceType)]
, ExternsDeclaration -> SourceType
edTypeSynonymType :: SourceType
}
| EDDataConstructor
{ ExternsDeclaration -> ProperName 'ConstructorName
edDataCtorName :: ProperName 'ConstructorName
, ExternsDeclaration -> DataDeclType
edDataCtorOrigin :: DataDeclType
, ExternsDeclaration -> ProperName 'TypeName
edDataCtorTypeCtor :: ProperName 'TypeName
, ExternsDeclaration -> SourceType
edDataCtorType :: SourceType
, ExternsDeclaration -> [Ident]
edDataCtorFields :: [Ident]
}
| EDValue
{ ExternsDeclaration -> Ident
edValueName :: Ident
, ExternsDeclaration -> SourceType
edValueType :: SourceType
}
| EDClass
{ ExternsDeclaration -> ProperName 'ClassName
edClassName :: ProperName 'ClassName
, ExternsDeclaration -> [(Text, Maybe SourceType)]
edClassTypeArguments :: [(Text, Maybe SourceType)]
, ExternsDeclaration -> [(Ident, SourceType)]
edClassMembers :: [(Ident, SourceType)]
, ExternsDeclaration -> [SourceConstraint]
edClassConstraints :: [SourceConstraint]
, ExternsDeclaration -> [FunctionalDependency]
edFunctionalDependencies :: [FunctionalDependency]
, ExternsDeclaration -> Bool
edIsEmpty :: Bool
}
| EDInstance
{ ExternsDeclaration -> Qualified (ProperName 'ClassName)
edInstanceClassName :: Qualified (ProperName 'ClassName)
, ExternsDeclaration -> Ident
edInstanceName :: Ident
, ExternsDeclaration -> [(Text, SourceType)]
edInstanceForAll :: [(Text, SourceType)]
, ExternsDeclaration -> [SourceType]
edInstanceKinds :: [SourceType]
, ExternsDeclaration -> [SourceType]
edInstanceTypes :: [SourceType]
, ExternsDeclaration -> Maybe [SourceConstraint]
edInstanceConstraints :: Maybe [SourceConstraint]
, ExternsDeclaration -> Maybe ChainId
edInstanceChain :: Maybe ChainId
, ExternsDeclaration -> Integer
edInstanceChainIndex :: Integer
, ExternsDeclaration -> NameSource
edInstanceNameSource :: NameSource
, ExternsDeclaration -> SourceSpan
edInstanceSourceSpan :: SourceSpan
}
deriving (Int -> ExternsDeclaration -> ShowS
[ExternsDeclaration] -> ShowS
ExternsDeclaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternsDeclaration] -> ShowS
$cshowList :: [ExternsDeclaration] -> ShowS
show :: ExternsDeclaration -> String
$cshow :: ExternsDeclaration -> String
showsPrec :: Int -> ExternsDeclaration -> ShowS
$cshowsPrec :: Int -> ExternsDeclaration -> ShowS
Show, forall x. Rep ExternsDeclaration x -> ExternsDeclaration
forall x. ExternsDeclaration -> Rep ExternsDeclaration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternsDeclaration x -> ExternsDeclaration
$cfrom :: forall x. ExternsDeclaration -> Rep ExternsDeclaration x
Generic)
instance Serialise ExternsDeclaration
externsIsCurrentVersion :: ExternsFile -> Bool
externsIsCurrentVersion :: ExternsFile -> Bool
externsIsCurrentVersion ExternsFile
ef =
Text -> String
T.unpack (ExternsFile -> Text
efVersion ExternsFile
ef) forall a. Eq a => a -> a -> Bool
== Version -> String
showVersion Version
Paths.version
applyExternsFileToEnvironment :: ExternsFile -> Environment -> Environment
applyExternsFileToEnvironment :: ExternsFile -> Environment -> Environment
applyExternsFileToEnvironment ExternsFile{[DeclarationRef]
[ExternsDeclaration]
[ExternsTypeFixity]
[ExternsFixity]
[ExternsImport]
Text
SourceSpan
ModuleName
efSourceSpan :: SourceSpan
efDeclarations :: [ExternsDeclaration]
efTypeFixities :: [ExternsTypeFixity]
efFixities :: [ExternsFixity]
efImports :: [ExternsImport]
efExports :: [DeclarationRef]
efModuleName :: ModuleName
efVersion :: Text
efSourceSpan :: ExternsFile -> SourceSpan
efDeclarations :: ExternsFile -> [ExternsDeclaration]
efTypeFixities :: ExternsFile -> [ExternsTypeFixity]
efFixities :: ExternsFile -> [ExternsFixity]
efImports :: ExternsFile -> [ExternsImport]
efExports :: ExternsFile -> [DeclarationRef]
efModuleName :: ExternsFile -> ModuleName
efVersion :: ExternsFile -> Text
..} = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Environment -> ExternsDeclaration -> Environment
applyDecl) [ExternsDeclaration]
efDeclarations
where
applyDecl :: Environment -> ExternsDeclaration -> Environment
applyDecl :: Environment -> ExternsDeclaration -> Environment
applyDecl Environment
env (EDType ProperName 'TypeName
pn SourceType
kind TypeKind
tyKind) = Environment
env { types :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
types = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. a -> Qualified a
qual ProperName 'TypeName
pn) (SourceType
kind, TypeKind
tyKind) (Environment
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
types Environment
env) }
applyDecl Environment
env (EDTypeSynonym ProperName 'TypeName
pn [(Text, Maybe SourceType)]
args SourceType
ty) = Environment
env { typeSynonyms :: Map
(Qualified (ProperName 'TypeName))
([(Text, Maybe SourceType)], SourceType)
typeSynonyms = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. a -> Qualified a
qual ProperName 'TypeName
pn) ([(Text, Maybe SourceType)]
args, SourceType
ty) (Environment
-> Map
(Qualified (ProperName 'TypeName))
([(Text, Maybe SourceType)], SourceType)
typeSynonyms Environment
env) }
applyDecl Environment
env (EDDataConstructor ProperName 'ConstructorName
pn DataDeclType
dTy ProperName 'TypeName
tNm SourceType
ty [Ident]
nms) = Environment
env { dataConstructors :: Map
(Qualified (ProperName 'ConstructorName))
(DataDeclType, ProperName 'TypeName, SourceType, [Ident])
dataConstructors = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. a -> Qualified a
qual ProperName 'ConstructorName
pn) (DataDeclType
dTy, ProperName 'TypeName
tNm, SourceType
ty, [Ident]
nms) (Environment
-> Map
(Qualified (ProperName 'ConstructorName))
(DataDeclType, ProperName 'TypeName, SourceType, [Ident])
dataConstructors Environment
env) }
applyDecl Environment
env (EDValue Ident
ident SourceType
ty) = Environment
env { names :: Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
names = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
efModuleName) Ident
ident) (SourceType
ty, NameKind
External, NameVisibility
Defined) (Environment
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
names Environment
env) }
applyDecl Environment
env (EDClass ProperName 'ClassName
pn [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
members [SourceConstraint]
cs [FunctionalDependency]
deps Bool
tcIsEmpty) = Environment
env { typeClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
typeClasses = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. a -> Qualified a
qual ProperName 'ClassName
pn) ([(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
members [SourceConstraint]
cs [FunctionalDependency]
deps Bool
tcIsEmpty) (Environment
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
typeClasses Environment
env) }
applyDecl Environment
env (EDInstance Qualified (ProperName 'ClassName)
className Ident
ident [(Text, SourceType)]
vars [SourceType]
kinds [SourceType]
tys Maybe [SourceConstraint]
cs Maybe ChainId
ch Integer
idx NameSource
ns SourceSpan
ss) =
Environment
env { typeClassDictionaries :: Map
QualifiedBy
(Map
(Qualified (ProperName 'ClassName))
(Map (Qualified Ident) (NonEmpty NamedDict)))
typeClassDictionaries =
forall k a.
(Ord k, Monoid a) =>
(a -> a) -> k -> Map k a -> Map k a
updateMap
(forall k a.
(Ord k, Monoid a) =>
(a -> a) -> k -> Map k a -> Map k a
updateMap (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Semigroup a => a -> a -> a
(<>) (forall a. a -> Qualified a
qual Ident
ident) (forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedDict
dict)) Qualified (ProperName 'ClassName)
className)
(ModuleName -> QualifiedBy
ByModuleName ModuleName
efModuleName) (Environment
-> Map
QualifiedBy
(Map
(Qualified (ProperName 'ClassName))
(Map (Qualified Ident) (NonEmpty NamedDict)))
typeClassDictionaries Environment
env) }
where
dict :: NamedDict
dict :: NamedDict
dict = forall v.
Maybe ChainId
-> Integer
-> v
-> [(Qualified (ProperName 'ClassName), Integer)]
-> Qualified (ProperName 'ClassName)
-> [(Text, SourceType)]
-> [SourceType]
-> [SourceType]
-> Maybe [SourceConstraint]
-> Maybe SourceType
-> TypeClassDictionaryInScope v
TypeClassDictionaryInScope Maybe ChainId
ch Integer
idx (forall a. a -> Qualified a
qual Ident
ident) [] Qualified (ProperName 'ClassName)
className [(Text, SourceType)]
vars [SourceType]
kinds [SourceType]
tys Maybe [SourceConstraint]
cs Maybe SourceType
instTy
updateMap :: (Ord k, Monoid a) => (a -> a) -> k -> M.Map k a -> M.Map k a
updateMap :: forall k a.
(Ord k, Monoid a) =>
(a -> a) -> k -> Map k a -> Map k a
updateMap a -> a
f = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold)
instTy :: Maybe SourceType
instTy :: Maybe SourceType
instTy = case NameSource
ns of
NameSource
CompilerNamed -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SourceSpan
-> [(Text, SourceType)]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> SourceType
srcInstanceType SourceSpan
ss [(Text, SourceType)]
vars Qualified (ProperName 'ClassName)
className [SourceType]
tys
NameSource
UserNamed -> forall a. Maybe a
Nothing
qual :: a -> Qualified a
qual :: forall a. a -> Qualified a
qual = forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
efModuleName)
moduleToExternsFile :: Module -> Environment -> M.Map Ident Ident -> ExternsFile
moduleToExternsFile :: Module -> Environment -> Map Ident Ident -> ExternsFile
moduleToExternsFile (Module SourceSpan
_ [Comment]
_ ModuleName
_ [Declaration]
_ Maybe [DeclarationRef]
Nothing) Environment
_ Map Ident Ident
_ = forall a. HasCallStack => String -> a
internalError String
"moduleToExternsFile: module exports were not elaborated"
moduleToExternsFile (Module SourceSpan
ss [Comment]
_ ModuleName
mn [Declaration]
ds (Just [DeclarationRef]
exps)) Environment
env Map Ident Ident
renamedIdents = ExternsFile{[DeclarationRef]
[ExternsDeclaration]
[ExternsTypeFixity]
[ExternsFixity]
[ExternsImport]
Text
SourceSpan
ModuleName
efSourceSpan :: SourceSpan
efDeclarations :: [ExternsDeclaration]
efTypeFixities :: [ExternsTypeFixity]
efFixities :: [ExternsFixity]
efImports :: [ExternsImport]
efExports :: [DeclarationRef]
efModuleName :: ModuleName
efVersion :: Text
efSourceSpan :: SourceSpan
efDeclarations :: [ExternsDeclaration]
efTypeFixities :: [ExternsTypeFixity]
efFixities :: [ExternsFixity]
efImports :: [ExternsImport]
efExports :: [DeclarationRef]
efModuleName :: ModuleName
efVersion :: Text
..}
where
efVersion :: Text
efVersion = String -> Text
T.pack (Version -> String
showVersion Version
Paths.version)
efModuleName :: ModuleName
efModuleName = ModuleName
mn
efExports :: [DeclarationRef]
efExports = forall a b. (a -> b) -> [a] -> [b]
map DeclarationRef -> DeclarationRef
renameRef [DeclarationRef]
exps
efImports :: [ExternsImport]
efImports = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe ExternsImport
importDecl [Declaration]
ds
efFixities :: [ExternsFixity]
efFixities = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe ExternsFixity
fixityDecl [Declaration]
ds
efTypeFixities :: [ExternsTypeFixity]
efTypeFixities = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe ExternsTypeFixity
typeFixityDecl [Declaration]
ds
efDeclarations :: [ExternsDeclaration]
efDeclarations = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DeclarationRef -> [ExternsDeclaration]
toExternsDeclaration [DeclarationRef]
exps
efSourceSpan :: SourceSpan
efSourceSpan = SourceSpan
ss
fixityDecl :: Declaration -> Maybe ExternsFixity
fixityDecl :: Declaration -> Maybe ExternsFixity
fixityDecl (ValueFixityDeclaration (SourceSpan, [Comment])
_ (Fixity Associativity
assoc Integer
prec) Qualified (Either Ident (ProperName 'ConstructorName))
name OpName 'ValueOpName
op) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (Associativity
-> Integer
-> OpName 'ValueOpName
-> Qualified (Either Ident (ProperName 'ConstructorName))
-> ExternsFixity
ExternsFixity Associativity
assoc Integer
prec OpName 'ValueOpName
op Qualified (Either Ident (ProperName 'ConstructorName))
name)) (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just OpName 'ValueOpName
op) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeclarationRef -> Maybe (OpName 'ValueOpName)
getValueOpRef) [DeclarationRef]
exps)
fixityDecl Declaration
_ = forall a. Maybe a
Nothing
typeFixityDecl :: Declaration -> Maybe ExternsTypeFixity
typeFixityDecl :: Declaration -> Maybe ExternsTypeFixity
typeFixityDecl (TypeFixityDeclaration (SourceSpan, [Comment])
_ (Fixity Associativity
assoc Integer
prec) Qualified (ProperName 'TypeName)
name OpName 'TypeOpName
op) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (Associativity
-> Integer
-> OpName 'TypeOpName
-> Qualified (ProperName 'TypeName)
-> ExternsTypeFixity
ExternsTypeFixity Associativity
assoc Integer
prec OpName 'TypeOpName
op Qualified (ProperName 'TypeName)
name)) (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just OpName 'TypeOpName
op) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeclarationRef -> Maybe (OpName 'TypeOpName)
getTypeOpRef) [DeclarationRef]
exps)
typeFixityDecl Declaration
_ = forall a. Maybe a
Nothing
importDecl :: Declaration -> Maybe ExternsImport
importDecl :: Declaration -> Maybe ExternsImport
importDecl (ImportDeclaration (SourceSpan, [Comment])
_ ModuleName
m ImportDeclarationType
mt Maybe ModuleName
qmn) = forall a. a -> Maybe a
Just (ModuleName
-> ImportDeclarationType -> Maybe ModuleName -> ExternsImport
ExternsImport ModuleName
m ImportDeclarationType
mt Maybe ModuleName
qmn)
importDecl Declaration
_ = forall a. Maybe a
Nothing
toExternsDeclaration :: DeclarationRef -> [ExternsDeclaration]
toExternsDeclaration :: DeclarationRef -> [ExternsDeclaration]
toExternsDeclaration (TypeRef SourceSpan
_ ProperName 'TypeName
pn Maybe [ProperName 'ConstructorName]
dctors) =
case forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'TypeName
pn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
types Environment
env of
Maybe (SourceType, TypeKind)
Nothing -> forall a. HasCallStack => String -> a
internalError String
"toExternsDeclaration: no kind in toExternsDeclaration"
Just (SourceType
kind, TypeKind
TypeSynonym)
| Just ([(Text, Maybe SourceType)]
args, SourceType
synTy) <- forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'TypeName
pn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map
(Qualified (ProperName 'TypeName))
([(Text, Maybe SourceType)], SourceType)
typeSynonyms Environment
env -> [ ProperName 'TypeName
-> SourceType -> TypeKind -> ExternsDeclaration
EDType ProperName 'TypeName
pn SourceType
kind TypeKind
TypeSynonym, ProperName 'TypeName
-> [(Text, Maybe SourceType)] -> SourceType -> ExternsDeclaration
EDTypeSynonym ProperName 'TypeName
pn [(Text, Maybe SourceType)]
args SourceType
synTy ]
Just (SourceType
kind, ExternData [Role]
rs) -> [ ProperName 'TypeName
-> SourceType -> TypeKind -> ExternsDeclaration
EDType ProperName 'TypeName
pn SourceType
kind ([Role] -> TypeKind
ExternData [Role]
rs) ]
Just (SourceType
kind, tk :: TypeKind
tk@(DataType DataDeclType
_ [(Text, Maybe SourceType, Role)]
_ [(ProperName 'ConstructorName, [SourceType])]
tys)) ->
ProperName 'TypeName
-> SourceType -> TypeKind -> ExternsDeclaration
EDType ProperName 'TypeName
pn SourceType
kind TypeKind
tk forall a. a -> [a] -> [a]
: [ ProperName 'ConstructorName
-> DataDeclType
-> ProperName 'TypeName
-> SourceType
-> [Ident]
-> ExternsDeclaration
EDDataConstructor ProperName 'ConstructorName
dctor DataDeclType
dty ProperName 'TypeName
pn SourceType
ty [Ident]
args
| ProperName 'ConstructorName
dctor <- forall a. a -> Maybe a -> a
fromMaybe (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(ProperName 'ConstructorName, [SourceType])]
tys) Maybe [ProperName 'ConstructorName]
dctors
, (DataDeclType
dty, ProperName 'TypeName
_, SourceType
ty, [Ident]
args) <- forall a. Maybe a -> [a]
maybeToList (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'ConstructorName
dctor 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)
]
Maybe (SourceType, TypeKind)
_ -> forall a. HasCallStack => String -> a
internalError String
"toExternsDeclaration: Invalid input"
toExternsDeclaration (ValueRef SourceSpan
_ Ident
ident)
| Just (SourceType
ty, NameKind
_, NameVisibility
_) <- forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) 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
= [ Ident -> SourceType -> ExternsDeclaration
EDValue (Ident -> Ident
lookupRenamedIdent Ident
ident) SourceType
ty ]
toExternsDeclaration (TypeClassRef SourceSpan
_ ProperName 'ClassName
className)
| let dictName :: ProperName 'TypeName
dictName = 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 a b. (a -> b) -> a -> b
$ ProperName 'ClassName
className
, Just TypeClassData{Bool
[(Text, Maybe SourceType)]
[(Ident, SourceType)]
[SourceConstraint]
[FunctionalDependency]
Set Int
Set (Set Int)
typeClassIsEmpty :: TypeClassData -> Bool
typeClassCoveringSets :: TypeClassData -> Set (Set Int)
typeClassDeterminedArguments :: TypeClassData -> Set Int
typeClassDependencies :: TypeClassData -> [FunctionalDependency]
typeClassSuperclasses :: TypeClassData -> [SourceConstraint]
typeClassMembers :: TypeClassData -> [(Ident, SourceType)]
typeClassArguments :: TypeClassData -> [(Text, Maybe SourceType)]
typeClassIsEmpty :: Bool
typeClassCoveringSets :: Set (Set Int)
typeClassDeterminedArguments :: Set Int
typeClassDependencies :: [FunctionalDependency]
typeClassSuperclasses :: [SourceConstraint]
typeClassMembers :: [(Ident, SourceType)]
typeClassArguments :: [(Text, Maybe SourceType)]
..} <- forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'ClassName
className forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
typeClasses Environment
env
, Just (SourceType
kind, TypeKind
tk) <- forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
className) forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
types Environment
env
, Just (SourceType
dictKind, dictData :: TypeKind
dictData@(DataType DataDeclType
_ [(Text, Maybe SourceType, Role)]
_ [(ProperName 'ConstructorName
dctor, [SourceType]
_)])) <- forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'TypeName
dictName forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
types Environment
env
, Just (DataDeclType
dty, ProperName 'TypeName
_, SourceType
ty, [Ident]
args) <- forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'ConstructorName
dctor 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
= [ ProperName 'TypeName
-> SourceType -> TypeKind -> ExternsDeclaration
EDType (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
className) SourceType
kind TypeKind
tk
, ProperName 'TypeName
-> SourceType -> TypeKind -> ExternsDeclaration
EDType ProperName 'TypeName
dictName SourceType
dictKind TypeKind
dictData
, ProperName 'ConstructorName
-> DataDeclType
-> ProperName 'TypeName
-> SourceType
-> [Ident]
-> ExternsDeclaration
EDDataConstructor ProperName 'ConstructorName
dctor DataDeclType
dty ProperName 'TypeName
dictName SourceType
ty [Ident]
args
, ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> ExternsDeclaration
EDClass ProperName 'ClassName
className [(Text, Maybe SourceType)]
typeClassArguments [(Ident, SourceType)]
typeClassMembers [SourceConstraint]
typeClassSuperclasses [FunctionalDependency]
typeClassDependencies Bool
typeClassIsEmpty
]
toExternsDeclaration (TypeInstanceRef SourceSpan
ss' Ident
ident NameSource
ns)
= [ Qualified (ProperName 'ClassName)
-> Ident
-> [(Text, SourceType)]
-> [SourceType]
-> [SourceType]
-> Maybe [SourceConstraint]
-> Maybe ChainId
-> Integer
-> NameSource
-> SourceSpan
-> ExternsDeclaration
EDInstance Qualified (ProperName 'ClassName)
tcdClassName (Ident -> Ident
lookupRenamedIdent Ident
ident) [(Text, SourceType)]
tcdForAll [SourceType]
tcdInstanceKinds [SourceType]
tcdInstanceTypes Maybe [SourceConstraint]
tcdDependencies Maybe ChainId
tcdChain Integer
tcdIndex NameSource
ns SourceSpan
ss'
| Map
(Qualified (ProperName 'ClassName))
(Map (Qualified Ident) (NonEmpty NamedDict))
m1 <- forall a. Maybe a -> [a]
maybeToList (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) (Environment
-> Map
QualifiedBy
(Map
(Qualified (ProperName 'ClassName))
(Map (Qualified Ident) (NonEmpty NamedDict)))
typeClassDictionaries Environment
env))
, Map (Qualified Ident) (NonEmpty NamedDict)
m2 <- forall k a. Map k a -> [a]
M.elems Map
(Qualified (ProperName 'ClassName))
(Map (Qualified Ident) (NonEmpty NamedDict))
m1
, NonEmpty NamedDict
nel <- forall a. Maybe a -> [a]
maybeToList (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) Ident
ident) Map (Qualified Ident) (NonEmpty NamedDict)
m2)
, TypeClassDictionaryInScope{Integer
[(Text, SourceType)]
[(Qualified (ProperName 'ClassName), Integer)]
[SourceType]
Maybe [SourceConstraint]
Maybe ChainId
Maybe SourceType
Qualified (ProperName 'ClassName)
Qualified Ident
tcdDescription :: forall v. TypeClassDictionaryInScope v -> Maybe SourceType
tcdDependencies :: forall v. TypeClassDictionaryInScope v -> Maybe [SourceConstraint]
tcdInstanceTypes :: forall v. TypeClassDictionaryInScope v -> [SourceType]
tcdInstanceKinds :: forall v. TypeClassDictionaryInScope v -> [SourceType]
tcdForAll :: forall v. TypeClassDictionaryInScope v -> [(Text, SourceType)]
tcdClassName :: forall v.
TypeClassDictionaryInScope v -> Qualified (ProperName 'ClassName)
tcdPath :: forall v.
TypeClassDictionaryInScope v
-> [(Qualified (ProperName 'ClassName), Integer)]
tcdValue :: forall v. TypeClassDictionaryInScope v -> v
tcdIndex :: forall v. TypeClassDictionaryInScope v -> Integer
tcdChain :: forall v. TypeClassDictionaryInScope v -> Maybe ChainId
tcdDescription :: Maybe SourceType
tcdPath :: [(Qualified (ProperName 'ClassName), Integer)]
tcdValue :: Qualified Ident
tcdIndex :: Integer
tcdChain :: Maybe ChainId
tcdDependencies :: Maybe [SourceConstraint]
tcdInstanceTypes :: [SourceType]
tcdInstanceKinds :: [SourceType]
tcdForAll :: [(Text, SourceType)]
tcdClassName :: Qualified (ProperName 'ClassName)
..} <- forall a. NonEmpty a -> [a]
NEL.toList NonEmpty NamedDict
nel
]
toExternsDeclaration DeclarationRef
_ = []
renameRef :: DeclarationRef -> DeclarationRef
renameRef :: DeclarationRef -> DeclarationRef
renameRef = \case
ValueRef SourceSpan
ss' Ident
ident -> SourceSpan -> Ident -> DeclarationRef
ValueRef SourceSpan
ss' forall a b. (a -> b) -> a -> b
$ Ident -> Ident
lookupRenamedIdent Ident
ident
TypeInstanceRef SourceSpan
ss' Ident
ident NameSource
_ | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Ident -> Bool
isPlainIdent Ident
ident -> SourceSpan -> Ident -> NameSource -> DeclarationRef
TypeInstanceRef SourceSpan
ss' (Ident -> Ident
lookupRenamedIdent Ident
ident) NameSource
CompilerNamed
DeclarationRef
other -> DeclarationRef
other
lookupRenamedIdent :: Ident -> Ident
lookupRenamedIdent :: Ident -> Ident
lookupRenamedIdent = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault) Map Ident Ident
renamedIdents
externsFileName :: FilePath
externsFileName :: String
externsFileName = String
"externs.cbor"