module Language.PureScript.AST.Exported
( exportedDeclarations
, isExported
) where
import Prelude
import Protolude (sortOn)
import Control.Category ((>>>))
import Control.Applicative ((<|>))
import Data.Maybe (mapMaybe)
import Data.Map qualified as M
import Language.PureScript.AST.Declarations (DataConstructorDeclaration(..), Declaration(..), DeclarationRef(..), Module(..), declName, declRefName, flattenDecls)
import Language.PureScript.Types (Constraint(..), Type(..), everythingOnTypes)
import Language.PureScript.Names (ModuleName, Name(..), ProperName, ProperNameType(..), Qualified, coerceProperName, disqualify, isQualified, isQualifiedWith)
exportedDeclarations :: Module -> [Declaration]
exportedDeclarations :: Module -> [Declaration]
exportedDeclarations (Module SourceSpan
_ [Comment]
_ ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
exps) = [Declaration] -> [Declaration]
go [Declaration]
decls
where
go :: [Declaration] -> [Declaration]
go = [Declaration] -> [Declaration]
flattenDecls
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe [DeclarationRef] -> Declaration -> Bool
isExported Maybe [DeclarationRef]
exps)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (Maybe [DeclarationRef] -> Declaration -> Declaration
filterDataConstructors Maybe [DeclarationRef]
exps)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ModuleName
-> Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
filterInstances ModuleName
mn Maybe [DeclarationRef]
exps
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id [DeclarationRef] -> [Declaration] -> [Declaration]
reorder Maybe [DeclarationRef]
exps
filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
filterDataConstructors Maybe [DeclarationRef]
exps (DataDeclaration SourceAnn
sa DataDeclType
dType ProperName 'TypeName
tyName [(Text, Maybe SourceType)]
tyArgs [DataConstructorDeclaration]
dctors) =
SourceAnn
-> DataDeclType
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> [DataConstructorDeclaration]
-> Declaration
DataDeclaration SourceAnn
sa DataDeclType
dType ProperName 'TypeName
tyName [(Text, Maybe SourceType)]
tyArgs forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (ProperName 'TypeName
-> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
isDctorExported ProperName 'TypeName
tyName Maybe [DeclarationRef]
exps forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorName) [DataConstructorDeclaration]
dctors
filterDataConstructors Maybe [DeclarationRef]
_ Declaration
other = Declaration
other
filterInstances
:: ModuleName
-> Maybe [DeclarationRef]
-> [Declaration]
-> [Declaration]
filterInstances :: ModuleName
-> Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
filterInstances ModuleName
_ Maybe [DeclarationRef]
Nothing = forall a. a -> a
id
filterInstances ModuleName
mn (Just [DeclarationRef]
exps) =
let refs :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs = forall a b. a -> Either a b
Left forall a b. (a -> b) -> [a] -> [b]
`map` forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe (ProperName 'ClassName)
typeClassName [DeclarationRef]
exps
forall a. [a] -> [a] -> [a]
++ forall a b. b -> Either a b
Right forall a b. (a -> b) -> [a] -> [b]
`map` forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe (ProperName 'TypeName)
typeName [DeclarationRef]
exps
in forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Either (ProperName 'ClassName) (ProperName 'TypeName)]
-> Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))
-> Bool
visibleOutside [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
typeInstanceConstituents)
where
visibleOutside
:: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
-> Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))
-> Bool
visibleOutside :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
-> Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))
-> Bool
visibleOutside [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))
q
| forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Qualified a -> Bool
checkQual forall a. Qualified a -> Bool
checkQual Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))
q = Bool
True
| Bool
otherwise = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Qualified a -> a
disqualify) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Qualified a -> a
disqualify) Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))
q forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs
checkQual :: Qualified a -> Bool
checkQual :: forall a. Qualified a -> Bool
checkQual Qualified a
q = forall a. Qualified a -> Bool
isQualified Qualified a
q Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn Qualified a
q)
typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)
typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)
typeName (TypeRef SourceSpan
_ ProperName 'TypeName
n Maybe [ProperName 'ConstructorName]
_) = forall a. a -> Maybe a
Just ProperName 'TypeName
n
typeName DeclarationRef
_ = forall a. Maybe a
Nothing
typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)
typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)
typeClassName (TypeClassRef SourceSpan
_ ProperName 'ClassName
n) = forall a. a -> Maybe a
Just ProperName 'ClassName
n
typeClassName DeclarationRef
_ = forall a. Maybe a
Nothing
typeInstanceConstituents :: Declaration -> [Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))]
typeInstanceConstituents :: Declaration
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
typeInstanceConstituents (TypeInstanceDeclaration SourceAnn
_ SourceAnn
_ ChainId
_ Integer
_ Either Text Ident
_ [SourceConstraint]
constraints Qualified (ProperName 'ClassName)
className [SourceType]
tys TypeInstanceBody
_) =
forall a b. a -> Either a b
Left Qualified (ProperName 'ClassName)
className forall a. a -> [a] -> [a]
: (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}.
Constraint a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
fromConstraint [SourceConstraint]
constraints forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}.
Type a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
fromType [SourceType]
tys)
where
fromConstraint :: Constraint a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
fromConstraint Constraint a
c = forall a b. a -> Either a b
Left (forall a. Constraint a -> Qualified (ProperName 'ClassName)
constraintClass Constraint a
c) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
fromType (forall a. Constraint a -> [Type a]
constraintArgs Constraint a
c)
fromType :: Type a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
fromType = forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r
everythingOnTypes forall a. [a] -> [a] -> [a]
(++) Type a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
go
go :: Type a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
go (TypeConstructor a
_ Qualified (ProperName 'TypeName)
n) = [forall a b. b -> Either a b
Right Qualified (ProperName 'TypeName)
n]
go (ConstrainedType a
_ Constraint a
c Type a
_) = Constraint a
-> [Either
(Qualified (ProperName 'ClassName))
(Qualified (ProperName 'TypeName))]
fromConstraint Constraint a
c
go Type a
_ = []
typeInstanceConstituents Declaration
_ = []
isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
isExported Maybe [DeclarationRef]
Nothing Declaration
_ = Bool
True
isExported Maybe [DeclarationRef]
_ TypeInstanceDeclaration{} = Bool
True
isExported (Just [DeclarationRef]
exps) (KindDeclaration SourceAnn
_ KindSignatureFor
_ ProperName 'TypeName
n SourceType
_) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DeclarationRef -> Bool
matches [DeclarationRef]
exps
where
matches :: DeclarationRef -> Bool
matches DeclarationRef
declRef = do
let refName :: Name
refName = DeclarationRef -> Name
declRefName DeclarationRef
declRef
ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n forall a. Eq a => a -> a -> Bool
== Name
refName Bool -> Bool -> Bool
|| ProperName 'ClassName -> Name
TyClassName (ProperName 'TypeName -> ProperName 'ClassName
tyToClassName ProperName 'TypeName
n) forall a. Eq a => a -> a -> Bool
== Name
refName
isExported (Just [DeclarationRef]
exps) Declaration
decl = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DeclarationRef -> Bool
matches [DeclarationRef]
exps
where
matches :: DeclarationRef -> Bool
matches DeclarationRef
declRef = Declaration -> Maybe Name
declName Declaration
decl forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (DeclarationRef -> Name
declRefName DeclarationRef
declRef)
isDctorExported :: ProperName 'TypeName -> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
isDctorExported :: ProperName 'TypeName
-> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
isDctorExported ProperName 'TypeName
_ Maybe [DeclarationRef]
Nothing ProperName 'ConstructorName
_ = Bool
True
isDctorExported ProperName 'TypeName
ident (Just [DeclarationRef]
exps) ProperName 'ConstructorName
ctor = DeclarationRef -> Bool
test forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` [DeclarationRef]
exps
where
test :: DeclarationRef -> Bool
test (TypeRef SourceSpan
_ ProperName 'TypeName
ident' Maybe [ProperName 'ConstructorName]
Nothing) = ProperName 'TypeName
ident forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
ident'
test (TypeRef SourceSpan
_ ProperName 'TypeName
ident' (Just [ProperName 'ConstructorName]
ctors)) = ProperName 'TypeName
ident forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
ident' Bool -> Bool -> Bool
&& ProperName 'ConstructorName
ctor forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ProperName 'ConstructorName]
ctors
test DeclarationRef
_ = Bool
False
reorder :: [DeclarationRef] -> [Declaration] -> [Declaration]
reorder :: [DeclarationRef] -> [Declaration] -> [Declaration]
reorder [DeclarationRef]
refs =
forall o a. Ord o => (a -> o) -> [a] -> [a]
sortOn Declaration -> Maybe Int
refIndex
where
refIndices :: Map Name Int
refIndices =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map DeclarationRef -> Name
declRefName [DeclarationRef]
refs) [(Int
0::Int)..]
refIndex :: Declaration -> Maybe Int
refIndex = \case
KindDeclaration SourceAnn
_ KindSignatureFor
_ ProperName 'TypeName
n SourceType
_ ->
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n) Map Name Int
refIndices forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ProperName 'ClassName -> Name
TyClassName (ProperName 'TypeName -> ProperName 'ClassName
tyToClassName ProperName 'TypeName
n)) Map Name Int
refIndices
Declaration
decl -> Declaration -> Maybe Name
declName Declaration
decl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Name Int
refIndices
tyToClassName :: ProperName 'TypeName -> ProperName 'ClassName
tyToClassName :: ProperName 'TypeName -> ProperName 'ClassName
tyToClassName = forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName