module Language.PureScript.AST.Exported
  ( exportedDeclarations
  , isExported
  ) where

import Prelude
import Protolude (sortOn)

import Control.Category ((>>>))
import Control.Applicative ((<|>))

import Data.Maybe (mapMaybe)
import qualified Data.Map as M

import Language.PureScript.AST.Declarations
import Language.PureScript.Types
import Language.PureScript.Names

-- |
-- Return a list of all declarations which are exported from a module.
-- This function descends into data declarations to filter out unexported
-- data constructors, and also filters out type instance declarations if
-- they refer to classes or types which are not themselves exported.
--
-- Note that this function assumes that the module has already had its imports
-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
-- produce incorrect results if this is not the case - for example, type class
-- instances will be incorrectly removed in some cases.
--
-- The returned declarations are in the same order as they appear in the export
-- list, unless there is no export list, in which case they appear in the same
-- order as they do in the source file.
--
-- Kind signatures declarations are also exported if their associated
-- declaration is exported.
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

-- |
-- Filter out all data constructors from a declaration which are not exported.
-- If the supplied declaration is not a data declaration, this function returns
-- it unchanged.
--
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

-- |
-- Filter out all the type instances from a list of declarations which
-- reference a type or type class which is both local and not exported.
--
-- Note that this function assumes that the module has already had its imports
-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
-- produce incorrect results if this is not the case - for example, type class
-- instances will be incorrectly removed in some cases.
--
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
  -- Given a Qualified ProperName, and a list of all exported types and type
  -- classes, returns whether the supplied Qualified ProperName is visible
  -- outside this module. This is true if one of the following hold:
  --
  --  * the name is defined in the same module and is exported,
  --  * the name is defined in a different module (and must be exported from
  --    that module; the code would fail to compile otherwise).
  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

  -- Check that a qualified name is qualified for a different module
  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

-- |
-- Get all type and type class names referenced by a type instance declaration.
--
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

  -- Note that type synonyms are disallowed in instance declarations, so
  -- we don't need to handle them here.
  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
_ = []


-- |
-- Test if a declaration is exported, given a module's export list. Note that
-- this function does not account for type instance declarations of
-- non-exported types, or non-exported data constructors. Therefore, you should
-- prefer 'exportedDeclarations' to this function, where possible.
--
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)

-- |
-- Test if a data constructor for a given type is exported, given a module's
-- export list. Prefer 'exportedDeclarations' to this function, where possible.
--
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 declarations based on the order they appear in the given export
-- list.
--
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

-- |
-- Workaround to the fact that a `KindDeclaration`'s name's `ProperNameType`
-- isn't the same as the corresponding `TypeClassDeclaration`'s `ProperNameType`
tyToClassName :: ProperName 'TypeName -> ProperName 'ClassName
tyToClassName :: ProperName 'TypeName -> ProperName 'ClassName
tyToClassName = forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName