module Language.PureScript.AST.Declarations where
import Prelude.Compat
import Control.Monad.Identity
import Data.Aeson.TH
import qualified Data.Map as M
import Language.PureScript.AST.Binders
import Language.PureScript.AST.Literals
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.Environment
import qualified Language.PureScript.Bundle as Bundle
import qualified Text.Parsec as P
type Context = [(Ident, Type)]
data SimpleErrorMessage
= ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)
| ErrorParsingModule P.ParseError
| MissingFFIModule ModuleName
| MultipleFFIModules ModuleName [FilePath]
| UnnecessaryFFIModule ModuleName FilePath
| MissingFFIImplementations ModuleName [Ident]
| UnusedFFIImplementations ModuleName [Ident]
| InvalidFFIIdentifier ModuleName String
| CannotGetFileInfo FilePath
| CannotReadFile FilePath
| CannotWriteFile FilePath
| InfiniteType Type
| InfiniteKind Kind
| MultipleValueOpFixities (OpName 'ValueOpName)
| MultipleTypeOpFixities (OpName 'TypeOpName)
| OrphanTypeDeclaration Ident
| RedefinedModule ModuleName [SourceSpan]
| RedefinedIdent Ident
| OverlappingNamesInLet
| UnknownName (Qualified Name)
| UnknownImport ModuleName Name
| UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)
| UnknownExport Name
| UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)
| ScopeConflict Name [ModuleName]
| ScopeShadowing Name (Maybe ModuleName) [ModuleName]
| DeclConflict Name Name
| ExportConflict (Qualified Name) (Qualified Name)
| DuplicateModuleName ModuleName
| DuplicateTypeArgument String
| InvalidDoBind
| InvalidDoLet
| CycleInDeclaration Ident
| CycleInTypeSynonym (Maybe (ProperName 'TypeName))
| CycleInModules [ModuleName]
| NameIsUndefined Ident
| UndefinedTypeVariable (ProperName 'TypeName)
| PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))
| EscapedSkolem (Maybe Expr)
| TypesDoNotUnify Type Type
| KindsDoNotUnify Kind Kind
| ConstrainedTypeUnified Type Type
| OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]
| NoInstanceFound Constraint
| PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]
| CannotDerive (Qualified (ProperName 'ClassName)) [Type]
| CannotFindDerivingType (ProperName 'TypeName)
| DuplicateLabel String (Maybe Expr)
| DuplicateValueDeclaration Ident
| ArgListLengthsDiffer Ident
| OverlappingArgNames (Maybe Ident)
| MissingClassMember Ident
| ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))
| ExpectedType Type Kind
| IncorrectConstructorArity (Qualified (ProperName 'ConstructorName))
| ExprDoesNotHaveType Expr Type
| PropertyIsMissing String
| AdditionalProperty String
| CannotApplyFunction Type Expr
| TypeSynonymInstance
| OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]
| InvalidNewtype (ProperName 'TypeName)
| InvalidInstanceHead Type
| TransitiveExportError DeclarationRef [DeclarationRef]
| TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)
| ShadowedName Ident
| ShadowedTypeVar String
| UnusedTypeVar String
| WildcardInferredType Type Context
| HoleInferredType String Type Context
| MissingTypeDeclaration Ident Type
| OverlappingPattern [[Binder]] Bool
| IncompleteExhaustivityCheck
| MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)
| ImportHidingModule ModuleName
| UnusedImport ModuleName
| UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]
| UnusedDctorImport (ProperName 'TypeName)
| UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]
| DuplicateSelectiveImport ModuleName
| DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)
| DuplicateImportRef Name
| DuplicateExportRef Name
| IntOutOfRange Integer String Integer Integer
| ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]
| ImplicitImport ModuleName [DeclarationRef]
| HidingImport ModuleName [DeclarationRef]
| CaseBinderLengthDiffers Int [Binder]
| IncorrectAnonymousArgument
| InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)
| DeprecatedRequirePath
| CannotGeneralizeRecursiveFunction Ident Type
deriving (Show)
data ErrorMessageHint
= ErrorUnifyingTypes Type Type
| ErrorInExpression Expr
| ErrorInModule ModuleName
| ErrorInInstance (Qualified (ProperName 'ClassName)) [Type]
| ErrorInSubsumption Type Type
| ErrorCheckingAccessor Expr String
| ErrorCheckingType Expr Type
| ErrorCheckingKind Type
| ErrorCheckingGuard
| ErrorInferringType Expr
| ErrorInApplication Expr Type Expr
| ErrorInDataConstructor (ProperName 'ConstructorName)
| ErrorInTypeConstructor (ProperName 'TypeName)
| ErrorInBindingGroup [Ident]
| ErrorInDataBindingGroup
| ErrorInTypeSynonym (ProperName 'TypeName)
| ErrorInValueDeclaration Ident
| ErrorInTypeDeclaration Ident
| ErrorInForeignImport Ident
| ErrorSolvingConstraint Constraint
| PositionedError SourceSpan
deriving (Show)
data HintCategory
= ExprHint
| KindHint
| CheckHint
| PositionHint
| SolverHint
| OtherHint
deriving (Show, Eq)
data ErrorMessage = ErrorMessage
[ErrorMessageHint]
SimpleErrorMessage
deriving (Show)
data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])
deriving (Show)
getModuleName :: Module -> ModuleName
getModuleName (Module _ _ name _ _) = name
addDefaultImport :: ModuleName -> Module -> Module
addDefaultImport toImport m@(Module ss coms mn decls exps) =
if isExistingImport `any` decls || mn == toImport then m
else Module ss coms mn (ImportDeclaration toImport Implicit Nothing : decls) exps
where
isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d
isExistingImport _ = False
data DeclarationRef
= TypeRef (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])
| TypeOpRef (OpName 'TypeOpName)
| ValueRef Ident
| ValueOpRef (OpName 'ValueOpName)
| TypeClassRef (ProperName 'ClassName)
| TypeInstanceRef Ident
| ModuleRef ModuleName
| ReExportRef ModuleName DeclarationRef
| PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
deriving (Show)
instance Eq DeclarationRef where
(TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
(TypeOpRef name) == (TypeOpRef name') = name == name'
(ValueRef name) == (ValueRef name') = name == name'
(ValueOpRef name) == (ValueOpRef name') = name == name'
(TypeClassRef name) == (TypeClassRef name') = name == name'
(TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
(ModuleRef name) == (ModuleRef name') = name == name'
(ReExportRef mn ref) == (ReExportRef mn' ref') = mn == mn' && ref == ref'
(PositionedDeclarationRef _ _ r) == r' = r == r'
r == (PositionedDeclarationRef _ _ r') = r == r'
_ == _ = False
getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
getTypeRef (TypeRef name dctors) = Just (name, dctors)
getTypeRef (PositionedDeclarationRef _ _ r) = getTypeRef r
getTypeRef _ = Nothing
getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName)
getTypeOpRef (TypeOpRef op) = Just op
getTypeOpRef (PositionedDeclarationRef _ _ r) = getTypeOpRef r
getTypeOpRef _ = Nothing
getValueRef :: DeclarationRef -> Maybe Ident
getValueRef (ValueRef name) = Just name
getValueRef (PositionedDeclarationRef _ _ r) = getValueRef r
getValueRef _ = Nothing
getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName)
getValueOpRef (ValueOpRef op) = Just op
getValueOpRef (PositionedDeclarationRef _ _ r) = getValueOpRef r
getValueOpRef _ = Nothing
getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)
getTypeClassRef (TypeClassRef name) = Just name
getTypeClassRef (PositionedDeclarationRef _ _ r) = getTypeClassRef r
getTypeClassRef _ = Nothing
isModuleRef :: DeclarationRef -> Bool
isModuleRef (PositionedDeclarationRef _ _ r) = isModuleRef r
isModuleRef (ModuleRef _) = True
isModuleRef _ = False
data ImportDeclarationType
= Implicit
| Explicit [DeclarationRef]
| Hiding [DeclarationRef]
deriving (Eq, Show)
isImplicit :: ImportDeclarationType -> Bool
isImplicit Implicit = True
isImplicit _ = False
isExplicit :: ImportDeclarationType -> Bool
isExplicit (Explicit _) = True
isExplicit _ = False
data Declaration
= DataDeclaration DataDeclType (ProperName 'TypeName) [(String, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]
| DataBindingGroupDeclaration [Declaration]
| TypeSynonymDeclaration (ProperName 'TypeName) [(String, Maybe Kind)] Type
| TypeDeclaration Ident Type
| ValueDeclaration Ident NameKind [Binder] (Either [(Guard, Expr)] Expr)
| BindingGroupDeclaration [(Ident, NameKind, Expr)]
| ExternDeclaration Ident Type
| ExternDataDeclaration (ProperName 'TypeName) Kind
| FixityDeclaration (Either ValueFixity TypeFixity)
| ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
| TypeClassDeclaration (ProperName 'ClassName) [(String, Maybe Kind)] [Constraint] [Declaration]
| TypeInstanceDeclaration Ident [Constraint] (Qualified (ProperName 'ClassName)) [Type] TypeInstanceBody
| PositionedDeclaration SourceSpan [Comment] Declaration
deriving (Show)
data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)
deriving (Eq, Ord, Show)
data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)
deriving (Eq, Ord, Show)
pattern ValueFixityDeclaration :: Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration
pattern ValueFixityDeclaration fixity name op = FixityDeclaration (Left (ValueFixity fixity name op))
pattern TypeFixityDeclaration :: Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration
pattern TypeFixityDeclaration fixity name op = FixityDeclaration (Right (TypeFixity fixity name op))
data TypeInstanceBody
= DerivedInstance
| ExplicitInstance [Declaration]
deriving (Show)
mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody
mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)
traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody
traverseTypeInstanceBody _ DerivedInstance = pure DerivedInstance
traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds
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
isFixityDecl :: Declaration -> Bool
isFixityDecl FixityDeclaration{} = True
isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
isFixityDecl _ = False
getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity)
getFixityDecl (FixityDeclaration fixity) = Just fixity
getFixityDecl (PositionedDeclaration _ _ d) = getFixityDecl d
getFixityDecl _ = Nothing
isExternDecl :: Declaration -> Bool
isExternDecl ExternDeclaration{} = True
isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
isExternDecl _ = False
isTypeClassInstanceDeclaration :: Declaration -> Bool
isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True
isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d
isTypeClassInstanceDeclaration _ = False
isTypeClassDeclaration :: Declaration -> Bool
isTypeClassDeclaration TypeClassDeclaration{} = 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
= Literal (Literal Expr)
| UnaryMinus Expr
| BinaryNoParens Expr Expr Expr
| Parens Expr
| ObjectGetter String
| Accessor String Expr
| ObjectUpdate Expr [(String, Expr)]
| Abs (Either Ident Binder) Expr
| App Expr Expr
| Var (Qualified Ident)
| Op (Qualified (OpName 'ValueOpName))
| IfThenElse Expr Expr Expr
| Constructor (Qualified (ProperName 'ConstructorName))
| Case [Expr] [CaseAlternative]
| TypedValue Bool Expr Type
| Let [Declaration] Expr
| Do [DoNotationElement]
| TypeClassDictionaryConstructorApp (Qualified (ProperName 'ClassName)) Expr
| TypeClassDictionary Constraint
(M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))
[ErrorMessageHint]
| TypeClassDictionaryAccessor (Qualified (ProperName 'ClassName)) Ident
| SuperClassDictionary (Qualified (ProperName 'ClassName)) [Type]
| AnonymousArgument
| Hole String
| PositionedValue SourceSpan [Comment] Expr
deriving (Show)
data CaseAlternative = CaseAlternative
{
caseAlternativeBinders :: [Binder]
, caseAlternativeResult :: Either [(Guard, Expr)] Expr
} deriving (Show)
data DoNotationElement
= DoNotationValue Expr
| DoNotationBind Binder Expr
| DoNotationLet [Declaration]
| PositionedDoNotationElement SourceSpan [Comment] DoNotationElement
deriving (Show)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)