module Language.PureScript.AST.Declarations where
import qualified Data.Data as D
import Language.PureScript.AST.Binders
import Language.PureScript.AST.Operators
import Language.PureScript.AST.SourcePos
import Language.PureScript.Types
import Language.PureScript.Names
import Language.PureScript.Kinds
import Language.PureScript.TypeClassDictionaries
import Language.PureScript.Comments
import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.Environment
data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
getModuleName :: Module -> ModuleName
getModuleName (Module name _ _) = name
isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
isExported Nothing _ = True
isExported _ TypeInstanceDeclaration{} = True
isExported exps (PositionedDeclaration _ _ d) = isExported exps d
isExported (Just exps) decl = any (matches decl) exps
where
matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'
matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
matches (PositionedDeclaration _ _ d) r = d `matches` r
matches d (PositionedDeclarationRef _ _ r) = d `matches` r
matches _ _ = False
exportedDeclarations :: Module -> [Declaration]
exportedDeclarations (Module _ decls exps) = filter (isExported exps) (flattenDecls decls)
isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
isDctorExported _ Nothing _ = True
isDctorExported ident (Just exps) ctor = test `any` exps
where
test (PositionedDeclarationRef _ _ d) = test d
test (TypeRef ident' Nothing) = ident == ident'
test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
test _ = False
exportedDctors :: Module -> ProperName -> [ProperName]
exportedDctors (Module _ decls exps) ident =
filter (isDctorExported ident exps) dctors
where
dctors = concatMap getDctors (flattenDecls decls)
getDctors (DataDeclaration _ _ _ ctors) = map fst ctors
getDctors (PositionedDeclaration _ _ d) = getDctors d
getDctors _ = []
data DeclarationRef
= TypeRef ProperName (Maybe [ProperName])
| ValueRef Ident
| TypeClassRef ProperName
| TypeInstanceRef Ident
| PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
deriving (Show, D.Data, D.Typeable)
instance Eq DeclarationRef where
(TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
(ValueRef name) == (ValueRef name') = name == name'
(TypeClassRef name) == (TypeClassRef name') = name == name'
(TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
(PositionedDeclarationRef _ _ r) == r' = r == r'
r == (PositionedDeclarationRef _ _ r') = r == r'
_ == _ = False
data ImportDeclarationType
= Unqualified
| Qualifying [DeclarationRef]
| Hiding [DeclarationRef]
deriving (Show, D.Data, D.Typeable)
data Declaration
= DataDeclaration DataDeclType ProperName [(String, Maybe Kind)] [(ProperName, [Type])]
| DataBindingGroupDeclaration [Declaration]
| TypeSynonymDeclaration ProperName [(String, Maybe Kind)] Type
| TypeDeclaration Ident Type
| ValueDeclaration Ident NameKind [Binder] (Either [(Guard, Expr)] Expr)
| BindingGroupDeclaration [(Ident, NameKind, Expr)]
| ExternDeclaration ForeignImportType Ident (Maybe JS) Type
| ExternDataDeclaration ProperName Kind
| ExternInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type]
| FixityDeclaration Fixity String
| ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
| TypeClassDeclaration ProperName [(String, Maybe Kind)] [Constraint] [Declaration]
| TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] [Declaration]
| PositionedDeclaration SourceSpan [Comment] Declaration
deriving (Show, D.Data, D.Typeable)
isValueDecl :: Declaration -> Bool
isValueDecl ValueDeclaration{} = True
isValueDecl (PositionedDeclaration _ _ d) = isValueDecl d
isValueDecl _ = False
isDataDecl :: Declaration -> Bool
isDataDecl DataDeclaration{} = True
isDataDecl TypeSynonymDeclaration{} = True
isDataDecl (PositionedDeclaration _ _ d) = isDataDecl d
isDataDecl _ = False
isImportDecl :: Declaration -> Bool
isImportDecl ImportDeclaration{} = True
isImportDecl (PositionedDeclaration _ _ d) = isImportDecl d
isImportDecl _ = False
isExternDataDecl :: Declaration -> Bool
isExternDataDecl ExternDataDeclaration{} = True
isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
isExternDataDecl _ = False
isExternInstanceDecl :: Declaration -> Bool
isExternInstanceDecl ExternInstanceDeclaration{} = True
isExternInstanceDecl (PositionedDeclaration _ _ d) = isExternInstanceDecl d
isExternInstanceDecl _ = False
isFixityDecl :: Declaration -> Bool
isFixityDecl FixityDeclaration{} = True
isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
isFixityDecl _ = False
isExternDecl :: Declaration -> Bool
isExternDecl ExternDeclaration{} = True
isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
isExternDecl _ = False
isTypeClassDeclaration :: Declaration -> Bool
isTypeClassDeclaration TypeClassDeclaration{} = True
isTypeClassDeclaration TypeInstanceDeclaration{} = True
isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d
isTypeClassDeclaration _ = False
flattenDecls :: [Declaration] -> [Declaration]
flattenDecls = concatMap flattenOne
where flattenOne :: Declaration -> [Declaration]
flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls
flattenOne d = [d]
type Guard = Expr
data Expr
= NumericLiteral (Either Integer Double)
| StringLiteral String
| BooleanLiteral Bool
| UnaryMinus Expr
| BinaryNoParens (Qualified Ident) Expr Expr
| Parens Expr
| ArrayLiteral [Expr]
| ObjectLiteral [(String, Expr)]
| Accessor String Expr
| ObjectUpdate Expr [(String, Expr)]
| Abs (Either Ident Binder) Expr
| App Expr Expr
| Var (Qualified Ident)
| IfThenElse Expr Expr Expr
| Constructor (Qualified ProperName)
| Case [Expr] [CaseAlternative]
| TypedValue Bool Expr Type
| Let [Declaration] Expr
| Do [DoNotationElement]
| TypeClassDictionaryConstructorApp (Qualified ProperName) Expr
| TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
| SuperClassDictionary (Qualified ProperName) [Type]
| PositionedValue SourceSpan [Comment] Expr deriving (Show, D.Data, D.Typeable)
data CaseAlternative = CaseAlternative
{
caseAlternativeBinders :: [Binder]
, caseAlternativeResult :: Either [(Guard, Expr)] Expr
} deriving (Show, D.Data, D.Typeable)
data DoNotationElement
= DoNotationValue Expr
| DoNotationBind Binder Expr
| DoNotationLet [Declaration]
| PositionedDoNotationElement SourceSpan [Comment] DoNotationElement deriving (Show, D.Data, D.Typeable)