-- |
-- This module generates code for \"externs\" files, i.e. files containing only
-- foreign import declarations.
--
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

-- | The data which will be serialized to an externs file
data ExternsFile = ExternsFile
  -- NOTE: Make sure to keep `efVersion` as the first field in this
  -- record, so the derived Serialise instance produces CBOR that can
  -- be checked for its version independent of the remaining format
  { ExternsFile -> Text
efVersion :: Text
  -- ^ The externs version
  , ExternsFile -> ModuleName
efModuleName :: ModuleName
  -- ^ Module name
  , ExternsFile -> [DeclarationRef]
efExports :: [DeclarationRef]
  -- ^ List of module exports
  , ExternsFile -> [ExternsImport]
efImports :: [ExternsImport]
  -- ^ List of module imports
  , ExternsFile -> [ExternsFixity]
efFixities :: [ExternsFixity]
  -- ^ List of operators and their fixities
  , ExternsFile -> [ExternsTypeFixity]
efTypeFixities :: [ExternsTypeFixity]
  -- ^ List of type operators and their fixities
  , ExternsFile -> [ExternsDeclaration]
efDeclarations :: [ExternsDeclaration]
  -- ^ List of type and value declaration
  , ExternsFile -> SourceSpan
efSourceSpan :: SourceSpan
  -- ^ Source span for error reporting
  } 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

-- | A module import in an externs file
data ExternsImport = ExternsImport
  {
  -- | The imported module
    ExternsImport -> ModuleName
eiModule :: ModuleName
  -- | The import type: regular, qualified or hiding
  , ExternsImport -> ImportDeclarationType
eiImportType :: ImportDeclarationType
  -- | The imported-as name, for qualified imports
  , 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

-- | A fixity declaration in an externs file
data ExternsFixity = ExternsFixity
  {
  -- | The associativity of the operator
    ExternsFixity -> Associativity
efAssociativity :: Associativity
  -- | The precedence level of the operator
  , ExternsFixity -> Integer
efPrecedence :: Precedence
  -- | The operator symbol
  , ExternsFixity -> OpName 'ValueOpName
efOperator :: OpName 'ValueOpName
  -- | The value the operator is an alias for
  , 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

-- | A type fixity declaration in an externs file
data ExternsTypeFixity = ExternsTypeFixity
  {
  -- | The associativity of the operator
    ExternsTypeFixity -> Associativity
efTypeAssociativity :: Associativity
  -- | The precedence level of the operator
  , ExternsTypeFixity -> Integer
efTypePrecedence :: Precedence
  -- | The operator symbol
  , ExternsTypeFixity -> OpName 'TypeOpName
efTypeOperator :: OpName 'TypeOpName
  -- | The value the operator is an alias for
  , 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

-- | A type or value declaration appearing in an externs file
data ExternsDeclaration =
  -- | A type declaration
    EDType
      { ExternsDeclaration -> ProperName 'TypeName
edTypeName                :: ProperName 'TypeName
      , ExternsDeclaration -> SourceType
edTypeKind                :: SourceType
      , ExternsDeclaration -> TypeKind
edTypeDeclarationKind     :: TypeKind
      }
  -- | A type synonym
  | EDTypeSynonym
      { ExternsDeclaration -> ProperName 'TypeName
edTypeSynonymName         :: ProperName 'TypeName
      , ExternsDeclaration -> [(Text, Maybe SourceType)]
edTypeSynonymArguments    :: [(Text, Maybe SourceType)]
      , ExternsDeclaration -> SourceType
edTypeSynonymType         :: SourceType
      }
  -- | A data constructor
  | 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]
      }
  -- | A value declaration
  | EDValue
      { ExternsDeclaration -> Ident
edValueName               :: Ident
      , ExternsDeclaration -> SourceType
edValueType               :: SourceType
      }
  -- | A type class declaration
  | 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
      }
  -- | An instance declaration
  | 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

-- | Check whether the version in an externs file matches the currently running
-- version.
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

-- | Convert an externs file back into a module
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)

-- | Generate an externs file for all declarations in a module.
--
-- The `Map Ident Ident` argument should contain any top-level `GenIdent`s that
-- were rewritten to `Ident`s when the module was compiled; this rewrite only
-- happens in the CoreFn, not the original module AST, so it needs to be
-- applied to the exported names here also. (The appropriate map is returned by
-- `L.P.Renamer.renameInModule`.)
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"