1{-# LANGUAGE DeriveAnyClass #-} 2{-# LANGUAGE TemplateHaskell #-} 3 4-- | 5-- Data types for modules and declarations 6-- 7module Language.PureScript.AST.Declarations where 8 9import Prelude.Compat 10import Protolude.Exceptions (hush) 11 12import Codec.Serialise (Serialise) 13import Control.DeepSeq (NFData) 14import Data.Functor.Identity 15 16import Data.Aeson.TH 17import qualified Data.Map as M 18import Data.Text (Text) 19import qualified Data.List.NonEmpty as NEL 20import GHC.Generics (Generic) 21 22import Language.PureScript.AST.Binders 23import Language.PureScript.AST.Literals 24import Language.PureScript.AST.Operators 25import Language.PureScript.AST.SourcePos 26import Language.PureScript.AST.Declarations.ChainId (ChainId) 27import Language.PureScript.Types 28import Language.PureScript.PSString (PSString) 29import Language.PureScript.Label (Label) 30import Language.PureScript.Names 31import Language.PureScript.Roles 32import Language.PureScript.TypeClassDictionaries 33import Language.PureScript.Comments 34import Language.PureScript.Environment 35import qualified Language.PureScript.Constants.Prim as C 36 37-- | A map of locally-bound names in scope. 38type Context = [(Ident, SourceType)] 39 40-- | Holds the data necessary to do type directed search for typed holes 41data TypeSearch 42 = TSBefore Environment 43 -- ^ An Environment captured for later consumption by type directed search 44 | TSAfter 45 { tsAfterIdentifiers :: [(Qualified Text, SourceType)] 46 -- ^ The identifiers that fully satisfy the subsumption check 47 , tsAfterRecordFields :: Maybe [(Label, SourceType)] 48 -- ^ Record fields that are available on the first argument to the typed 49 -- hole 50 } 51 -- ^ Results of applying type directed search to the previously captured 52 -- Environment 53 deriving Show 54 55onTypeSearchTypes :: (SourceType -> SourceType) -> TypeSearch -> TypeSearch 56onTypeSearchTypes f = runIdentity . onTypeSearchTypesM (Identity . f) 57 58onTypeSearchTypesM :: (Applicative m) => (SourceType -> m SourceType) -> TypeSearch -> m TypeSearch 59onTypeSearchTypesM f (TSAfter i r) = TSAfter <$> traverse (traverse f) i <*> traverse (traverse (traverse f)) r 60onTypeSearchTypesM _ (TSBefore env) = pure (TSBefore env) 61 62-- | Error message hints, providing more detailed information about failure. 63data ErrorMessageHint 64 = ErrorUnifyingTypes SourceType SourceType 65 | ErrorInExpression Expr 66 | ErrorInModule ModuleName 67 | ErrorInInstance (Qualified (ProperName 'ClassName)) [SourceType] 68 | ErrorInSubsumption SourceType SourceType 69 | ErrorCheckingAccessor Expr PSString 70 | ErrorCheckingType Expr SourceType 71 | ErrorCheckingKind SourceType SourceType 72 | ErrorCheckingGuard 73 | ErrorInferringType Expr 74 | ErrorInferringKind SourceType 75 | ErrorInApplication Expr SourceType Expr 76 | ErrorInDataConstructor (ProperName 'ConstructorName) 77 | ErrorInTypeConstructor (ProperName 'TypeName) 78 | ErrorInBindingGroup (NEL.NonEmpty Ident) 79 | ErrorInDataBindingGroup [ProperName 'TypeName] 80 | ErrorInTypeSynonym (ProperName 'TypeName) 81 | ErrorInValueDeclaration Ident 82 | ErrorInTypeDeclaration Ident 83 | ErrorInTypeClassDeclaration (ProperName 'ClassName) 84 | ErrorInKindDeclaration (ProperName 'TypeName) 85 | ErrorInRoleDeclaration (ProperName 'TypeName) 86 | ErrorInForeignImport Ident 87 | ErrorInForeignImportData (ProperName 'TypeName) 88 | ErrorSolvingConstraint SourceConstraint 89 | MissingConstructorImportForCoercible (Qualified (ProperName 'ConstructorName)) 90 | PositionedError (NEL.NonEmpty SourceSpan) 91 deriving (Show) 92 93-- | Categories of hints 94data HintCategory 95 = ExprHint 96 | KindHint 97 | CheckHint 98 | PositionHint 99 | SolverHint 100 | OtherHint 101 deriving (Show, Eq) 102 103-- | 104-- A module declaration, consisting of comments about the module, a module name, 105-- a list of declarations, and a list of the declarations that are 106-- explicitly exported. If the export list is Nothing, everything is exported. 107-- 108data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef]) 109 deriving (Show) 110 111-- | Return a module's name. 112getModuleName :: Module -> ModuleName 113getModuleName (Module _ _ name _ _) = name 114 115-- | Return a module's source span. 116getModuleSourceSpan :: Module -> SourceSpan 117getModuleSourceSpan (Module ss _ _ _ _) = ss 118 119-- | Return a module's declarations. 120getModuleDeclarations :: Module -> [Declaration] 121getModuleDeclarations (Module _ _ _ declarations _) = declarations 122 123-- | 124-- Add an import declaration for a module if it does not already explicitly import it. 125-- 126-- Will not import an unqualified module if that module has already been imported qualified. 127-- (See #2197) 128-- 129addDefaultImport :: Qualified ModuleName -> Module -> Module 130addDefaultImport (Qualified toImportAs toImport) m@(Module ss coms mn decls exps) = 131 if isExistingImport `any` decls || mn == toImport then m 132 else Module ss coms mn (ImportDeclaration (ss, []) toImport Implicit toImportAs : decls) exps 133 where 134 isExistingImport (ImportDeclaration _ mn' _ as') 135 | mn' == toImport = 136 case toImportAs of 137 Nothing -> True 138 _ -> as' == toImportAs 139 isExistingImport _ = False 140 141-- | Adds import declarations to a module for an implicit Prim import and Prim 142-- | qualified as Prim, as necessary. 143importPrim :: Module -> Module 144importPrim = 145 let 146 primModName = C.Prim 147 in 148 addDefaultImport (Qualified (Just primModName) primModName) 149 . addDefaultImport (Qualified Nothing primModName) 150 151data NameSource = UserNamed | CompilerNamed 152 deriving (Show, Generic, NFData, Serialise) 153 154-- | 155-- An item in a list of explicit imports or exports 156-- 157data DeclarationRef 158 -- | 159 -- A type class 160 -- 161 = TypeClassRef SourceSpan (ProperName 'ClassName) 162 -- | 163 -- A type operator 164 -- 165 | TypeOpRef SourceSpan (OpName 'TypeOpName) 166 -- | 167 -- A type constructor with data constructors 168 -- 169 | TypeRef SourceSpan (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName]) 170 -- | 171 -- A value 172 -- 173 | ValueRef SourceSpan Ident 174 -- | 175 -- A value-level operator 176 -- 177 | ValueOpRef SourceSpan (OpName 'ValueOpName) 178 -- | 179 -- A type class instance, created during typeclass desugaring 180 -- 181 | TypeInstanceRef SourceSpan Ident NameSource 182 -- | 183 -- A module, in its entirety 184 -- 185 | ModuleRef SourceSpan ModuleName 186 -- | 187 -- A value re-exported from another module. These will be inserted during 188 -- elaboration in name desugaring. 189 -- 190 | ReExportRef SourceSpan ExportSource DeclarationRef 191 deriving (Show, Generic, NFData, Serialise) 192 193instance Eq DeclarationRef where 194 (TypeClassRef _ name) == (TypeClassRef _ name') = name == name' 195 (TypeOpRef _ name) == (TypeOpRef _ name') = name == name' 196 (TypeRef _ name dctors) == (TypeRef _ name' dctors') = name == name' && dctors == dctors' 197 (ValueRef _ name) == (ValueRef _ name') = name == name' 198 (ValueOpRef _ name) == (ValueOpRef _ name') = name == name' 199 (TypeInstanceRef _ name _) == (TypeInstanceRef _ name' _) = name == name' 200 (ModuleRef _ name) == (ModuleRef _ name') = name == name' 201 (ReExportRef _ mn ref) == (ReExportRef _ mn' ref') = mn == mn' && ref == ref' 202 _ == _ = False 203 204instance Ord DeclarationRef where 205 TypeClassRef _ name `compare` TypeClassRef _ name' = compare name name' 206 TypeOpRef _ name `compare` TypeOpRef _ name' = compare name name' 207 TypeRef _ name dctors `compare` TypeRef _ name' dctors' = compare name name' <> compare dctors dctors' 208 ValueRef _ name `compare` ValueRef _ name' = compare name name' 209 ValueOpRef _ name `compare` ValueOpRef _ name' = compare name name' 210 TypeInstanceRef _ name _ `compare` TypeInstanceRef _ name' _ = compare name name' 211 ModuleRef _ name `compare` ModuleRef _ name' = compare name name' 212 ReExportRef _ mn ref `compare` ReExportRef _ mn' ref' = compare mn mn' <> compare ref ref' 213 compare ref ref' = 214 compare (orderOf ref) (orderOf ref') 215 where 216 orderOf :: DeclarationRef -> Int 217 orderOf TypeClassRef{} = 0 218 orderOf TypeOpRef{} = 1 219 orderOf TypeRef{} = 2 220 orderOf ValueRef{} = 3 221 orderOf ValueOpRef{} = 4 222 orderOf TypeInstanceRef{} = 5 223 orderOf ModuleRef{} = 6 224 orderOf ReExportRef{} = 7 225 226data ExportSource = 227 ExportSource 228 { exportSourceImportedFrom :: Maybe ModuleName 229 , exportSourceDefinedIn :: ModuleName 230 } 231 deriving (Eq, Ord, Show, Generic, NFData, Serialise) 232 233declRefSourceSpan :: DeclarationRef -> SourceSpan 234declRefSourceSpan (TypeRef ss _ _) = ss 235declRefSourceSpan (TypeOpRef ss _) = ss 236declRefSourceSpan (ValueRef ss _) = ss 237declRefSourceSpan (ValueOpRef ss _) = ss 238declRefSourceSpan (TypeClassRef ss _) = ss 239declRefSourceSpan (TypeInstanceRef ss _ _) = ss 240declRefSourceSpan (ModuleRef ss _) = ss 241declRefSourceSpan (ReExportRef ss _ _) = ss 242 243declRefName :: DeclarationRef -> Name 244declRefName (TypeRef _ n _) = TyName n 245declRefName (TypeOpRef _ n) = TyOpName n 246declRefName (ValueRef _ n) = IdentName n 247declRefName (ValueOpRef _ n) = ValOpName n 248declRefName (TypeClassRef _ n) = TyClassName n 249declRefName (TypeInstanceRef _ n _) = IdentName n 250declRefName (ModuleRef _ n) = ModName n 251declRefName (ReExportRef _ _ ref) = declRefName ref 252 253getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName]) 254getTypeRef (TypeRef _ name dctors) = Just (name, dctors) 255getTypeRef _ = Nothing 256 257getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName) 258getTypeOpRef (TypeOpRef _ op) = Just op 259getTypeOpRef _ = Nothing 260 261getValueRef :: DeclarationRef -> Maybe Ident 262getValueRef (ValueRef _ name) = Just name 263getValueRef _ = Nothing 264 265getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName) 266getValueOpRef (ValueOpRef _ op) = Just op 267getValueOpRef _ = Nothing 268 269getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName) 270getTypeClassRef (TypeClassRef _ name) = Just name 271getTypeClassRef _ = Nothing 272 273isModuleRef :: DeclarationRef -> Bool 274isModuleRef ModuleRef{} = True 275isModuleRef _ = False 276 277-- | 278-- The data type which specifies type of import declaration 279-- 280data ImportDeclarationType 281 -- | 282 -- An import with no explicit list: `import M`. 283 -- 284 = Implicit 285 -- | 286 -- An import with an explicit list of references to import: `import M (foo)` 287 -- 288 | Explicit [DeclarationRef] 289 -- | 290 -- An import with a list of references to hide: `import M hiding (foo)` 291 -- 292 | Hiding [DeclarationRef] 293 deriving (Eq, Show, Generic, Serialise) 294 295isExplicit :: ImportDeclarationType -> Bool 296isExplicit (Explicit _) = True 297isExplicit _ = False 298 299-- | A role declaration assigns a list of roles to a type constructor's 300-- parameters, e.g.: 301-- 302-- @type role T representational phantom@ 303-- 304-- In this example, @T@ is the identifier and @[representational, phantom]@ is 305-- the list of roles (@T@ presumably having two parameters). 306data RoleDeclarationData = RoleDeclarationData 307 { rdeclSourceAnn :: !SourceAnn 308 , rdeclIdent :: !(ProperName 'TypeName) 309 , rdeclRoles :: ![Role] 310 } deriving (Show, Eq) 311 312-- | A type declaration assigns a type to an identifier, eg: 313-- 314-- @identity :: forall a. a -> a@ 315-- 316-- In this example @identity@ is the identifier and @forall a. a -> a@ the type. 317data TypeDeclarationData = TypeDeclarationData 318 { tydeclSourceAnn :: !SourceAnn 319 , tydeclIdent :: !Ident 320 , tydeclType :: !SourceType 321 } deriving (Show, Eq) 322 323getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData 324getTypeDeclaration (TypeDeclaration d) = Just d 325getTypeDeclaration _ = Nothing 326 327unwrapTypeDeclaration :: TypeDeclarationData -> (Ident, SourceType) 328unwrapTypeDeclaration td = (tydeclIdent td, tydeclType td) 329 330-- | A value declaration assigns a name and potential binders, to an expression (or multiple guarded expressions). 331-- 332-- @double x = x + x@ 333-- 334-- In this example @double@ is the identifier, @x@ is a binder and @x + x@ is the expression. 335data ValueDeclarationData a = ValueDeclarationData 336 { valdeclSourceAnn :: !SourceAnn 337 , valdeclIdent :: !Ident 338 -- ^ The declared value's name 339 , valdeclName :: !NameKind 340 -- ^ Whether or not this value is exported/visible 341 , valdeclBinders :: ![Binder] 342 , valdeclExpression :: !a 343 } deriving (Show, Functor, Foldable, Traversable) 344 345getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr]) 346getValueDeclaration (ValueDeclaration d) = Just d 347getValueDeclaration _ = Nothing 348 349pattern ValueDecl :: SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration 350pattern ValueDecl sann ident name binders expr 351 = ValueDeclaration (ValueDeclarationData sann ident name binders expr) 352 353data DataConstructorDeclaration = DataConstructorDeclaration 354 { dataCtorAnn :: !SourceAnn 355 , dataCtorName :: !(ProperName 'ConstructorName) 356 , dataCtorFields :: ![(Ident, SourceType)] 357 } deriving (Show, Eq) 358 359mapDataCtorFields :: ([(Ident, SourceType)] -> [(Ident, SourceType)]) -> DataConstructorDeclaration -> DataConstructorDeclaration 360mapDataCtorFields f DataConstructorDeclaration{..} = DataConstructorDeclaration { dataCtorFields = f dataCtorFields, .. } 361 362traverseDataCtorFields :: Monad m => ([(Ident, SourceType)] -> m [(Ident, SourceType)]) -> DataConstructorDeclaration -> m DataConstructorDeclaration 363traverseDataCtorFields f DataConstructorDeclaration{..} = DataConstructorDeclaration dataCtorAnn dataCtorName <$> f dataCtorFields 364 365-- | 366-- The data type of declarations 367-- 368data Declaration 369 -- | 370 -- A data type declaration (data or newtype, name, arguments, data constructors) 371 -- 372 = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe SourceType)] [DataConstructorDeclaration] 373 -- | 374 -- A minimal mutually recursive set of data type declarations 375 -- 376 | DataBindingGroupDeclaration (NEL.NonEmpty Declaration) 377 -- | 378 -- A type synonym declaration (name, arguments, type) 379 -- 380 | TypeSynonymDeclaration SourceAnn (ProperName 'TypeName) [(Text, Maybe SourceType)] SourceType 381 -- | 382 -- A kind signature declaration 383 -- 384 | KindDeclaration SourceAnn KindSignatureFor (ProperName 'TypeName) SourceType 385 -- | 386 -- A role declaration (name, roles) 387 -- 388 | RoleDeclaration {-# UNPACK #-} !RoleDeclarationData 389 -- | 390 -- A type declaration for a value (name, ty) 391 -- 392 | TypeDeclaration {-# UNPACK #-} !TypeDeclarationData 393 -- | 394 -- A value declaration (name, top-level binders, optional guard, value) 395 -- 396 | ValueDeclaration {-# UNPACK #-} !(ValueDeclarationData [GuardedExpr]) 397 -- | 398 -- A declaration paired with pattern matching in let-in expression (binder, optional guard, value) 399 | BoundValueDeclaration SourceAnn Binder Expr 400 -- | 401 -- A minimal mutually recursive set of value declarations 402 -- 403 | BindingGroupDeclaration (NEL.NonEmpty ((SourceAnn, Ident), NameKind, Expr)) 404 -- | 405 -- A foreign import declaration (name, type) 406 -- 407 | ExternDeclaration SourceAnn Ident SourceType 408 -- | 409 -- A data type foreign import (name, kind) 410 -- 411 | ExternDataDeclaration SourceAnn (ProperName 'TypeName) SourceType 412 -- | 413 -- A fixity declaration 414 -- 415 | FixityDeclaration SourceAnn (Either ValueFixity TypeFixity) 416 -- | 417 -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name) 418 -- 419 | ImportDeclaration SourceAnn ModuleName ImportDeclarationType (Maybe ModuleName) 420 -- | 421 -- A type class declaration (name, argument, implies, member declarations) 422 -- 423 | TypeClassDeclaration SourceAnn (ProperName 'ClassName) [(Text, Maybe SourceType)] [SourceConstraint] [FunctionalDependency] [Declaration] 424 -- | 425 -- A type instance declaration (instance chain, chain index, name, 426 -- dependencies, class name, instance types, member declarations) 427 -- 428 | TypeInstanceDeclaration SourceAnn ChainId Integer (Either Text Ident) [SourceConstraint] (Qualified (ProperName 'ClassName)) [SourceType] TypeInstanceBody 429 deriving (Show) 430 431data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName) 432 deriving (Eq, Ord, Show) 433 434data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName) 435 deriving (Eq, Ord, Show) 436 437pattern ValueFixityDeclaration :: SourceAnn -> Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration 438pattern ValueFixityDeclaration sa fixity name op = FixityDeclaration sa (Left (ValueFixity fixity name op)) 439 440pattern TypeFixityDeclaration :: SourceAnn -> Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration 441pattern TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (TypeFixity fixity name op)) 442 443-- | The members of a type class instance declaration 444data TypeInstanceBody 445 = DerivedInstance 446 -- ^ This is a derived instance 447 | NewtypeInstance 448 -- ^ This is an instance derived from a newtype 449 | NewtypeInstanceWithDictionary Expr 450 -- ^ This is an instance derived from a newtype, desugared to include a 451 -- dictionary for the type under the newtype. 452 | ExplicitInstance [Declaration] 453 -- ^ This is a regular (explicit) instance 454 deriving (Show) 455 456mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody 457mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f) 458 459-- | A traversal for TypeInstanceBody 460traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody 461traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds 462traverseTypeInstanceBody _ other = pure other 463 464-- | What sort of declaration the kind signature applies to. 465data KindSignatureFor 466 = DataSig 467 | NewtypeSig 468 | TypeSynonymSig 469 | ClassSig 470 deriving (Eq, Ord, Show, Generic) 471 472instance NFData KindSignatureFor 473 474declSourceAnn :: Declaration -> SourceAnn 475declSourceAnn (DataDeclaration sa _ _ _ _) = sa 476declSourceAnn (DataBindingGroupDeclaration ds) = declSourceAnn (NEL.head ds) 477declSourceAnn (TypeSynonymDeclaration sa _ _ _) = sa 478declSourceAnn (KindDeclaration sa _ _ _) = sa 479declSourceAnn (RoleDeclaration rd) = rdeclSourceAnn rd 480declSourceAnn (TypeDeclaration td) = tydeclSourceAnn td 481declSourceAnn (ValueDeclaration vd) = valdeclSourceAnn vd 482declSourceAnn (BoundValueDeclaration sa _ _) = sa 483declSourceAnn (BindingGroupDeclaration ds) = let ((sa, _), _, _) = NEL.head ds in sa 484declSourceAnn (ExternDeclaration sa _ _) = sa 485declSourceAnn (ExternDataDeclaration sa _ _) = sa 486declSourceAnn (FixityDeclaration sa _) = sa 487declSourceAnn (ImportDeclaration sa _ _ _) = sa 488declSourceAnn (TypeClassDeclaration sa _ _ _ _ _) = sa 489declSourceAnn (TypeInstanceDeclaration sa _ _ _ _ _ _ _) = sa 490 491declSourceSpan :: Declaration -> SourceSpan 492declSourceSpan = fst . declSourceAnn 493 494-- Note: Kind Declarations' names can refer to either a `TyClassName` 495-- or a `TypeName`. Use a helper function for handling `KindDeclaration`s 496-- specifically in the context in which it is needed. 497declName :: Declaration -> Maybe Name 498declName (DataDeclaration _ _ n _ _) = Just (TyName n) 499declName (TypeSynonymDeclaration _ n _ _) = Just (TyName n) 500declName (ValueDeclaration vd) = Just (IdentName (valdeclIdent vd)) 501declName (ExternDeclaration _ n _) = Just (IdentName n) 502declName (ExternDataDeclaration _ n _) = Just (TyName n) 503declName (FixityDeclaration _ (Left (ValueFixity _ _ n))) = Just (ValOpName n) 504declName (FixityDeclaration _ (Right (TypeFixity _ _ n))) = Just (TyOpName n) 505declName (TypeClassDeclaration _ n _ _ _ _) = Just (TyClassName n) 506declName (TypeInstanceDeclaration _ _ _ n _ _ _ _) = IdentName <$> hush n 507declName ImportDeclaration{} = Nothing 508declName BindingGroupDeclaration{} = Nothing 509declName DataBindingGroupDeclaration{} = Nothing 510declName BoundValueDeclaration{} = Nothing 511declName KindDeclaration{} = Nothing 512declName TypeDeclaration{} = Nothing 513declName RoleDeclaration{} = Nothing 514 515-- | 516-- Test if a declaration is a value declaration 517-- 518isValueDecl :: Declaration -> Bool 519isValueDecl ValueDeclaration{} = True 520isValueDecl _ = False 521 522-- | 523-- Test if a declaration is a data type declaration 524-- 525isDataDecl :: Declaration -> Bool 526isDataDecl DataDeclaration{} = True 527isDataDecl _ = False 528 529-- | 530-- Test if a declaration is a type synonym declaration 531-- 532isTypeSynonymDecl :: Declaration -> Bool 533isTypeSynonymDecl TypeSynonymDeclaration{} = True 534isTypeSynonymDecl _ = False 535 536-- | 537-- Test if a declaration is a module import 538-- 539isImportDecl :: Declaration -> Bool 540isImportDecl ImportDeclaration{} = True 541isImportDecl _ = False 542 543-- | 544-- Test if a declaration is a role declaration 545-- 546isRoleDecl :: Declaration -> Bool 547isRoleDecl RoleDeclaration{} = True 548isRoleDecl _ = False 549 550-- | 551-- Test if a declaration is a data type foreign import 552-- 553isExternDataDecl :: Declaration -> Bool 554isExternDataDecl ExternDataDeclaration{} = True 555isExternDataDecl _ = False 556 557-- | 558-- Test if a declaration is a fixity declaration 559-- 560isFixityDecl :: Declaration -> Bool 561isFixityDecl FixityDeclaration{} = True 562isFixityDecl _ = False 563 564getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity) 565getFixityDecl (FixityDeclaration _ fixity) = Just fixity 566getFixityDecl _ = Nothing 567 568-- | 569-- Test if a declaration is a foreign import 570-- 571isExternDecl :: Declaration -> Bool 572isExternDecl ExternDeclaration{} = True 573isExternDecl _ = False 574 575-- | 576-- Test if a declaration is a type class instance declaration 577-- 578isTypeClassInstanceDecl :: Declaration -> Bool 579isTypeClassInstanceDecl TypeInstanceDeclaration{} = True 580isTypeClassInstanceDecl _ = False 581 582-- | 583-- Test if a declaration is a type class declaration 584-- 585isTypeClassDecl :: Declaration -> Bool 586isTypeClassDecl TypeClassDeclaration{} = True 587isTypeClassDecl _ = False 588 589-- | 590-- Test if a declaration is a kind signature declaration. 591-- 592isKindDecl :: Declaration -> Bool 593isKindDecl KindDeclaration{} = True 594isKindDecl _ = False 595 596-- | 597-- Recursively flatten data binding groups in the list of declarations 598flattenDecls :: [Declaration] -> [Declaration] 599flattenDecls = concatMap flattenOne 600 where flattenOne :: Declaration -> [Declaration] 601 flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls 602 flattenOne d = [d] 603 604-- | 605-- A guard is just a boolean-valued expression that appears alongside a set of binders 606-- 607data Guard = ConditionGuard Expr 608 | PatternGuard Binder Expr 609 deriving (Show) 610 611-- | 612-- The right hand side of a binder in value declarations 613-- and case expressions. 614data GuardedExpr = GuardedExpr [Guard] Expr 615 deriving (Show) 616 617pattern MkUnguarded :: Expr -> GuardedExpr 618pattern MkUnguarded e = GuardedExpr [] e 619 620-- | 621-- Data type for expressions and terms 622-- 623data Expr 624 -- | 625 -- A literal value 626 -- 627 = Literal SourceSpan (Literal Expr) 628 -- | 629 -- A prefix -, will be desugared 630 -- 631 | UnaryMinus SourceSpan Expr 632 -- | 633 -- Binary operator application. During the rebracketing phase of desugaring, this data constructor 634 -- will be removed. 635 -- 636 | BinaryNoParens Expr Expr Expr 637 -- | 638 -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor 639 -- will be removed. 640 -- 641 -- Note: although it seems this constructor is not used, it _is_ useful, since it prevents 642 -- certain traversals from matching. 643 -- 644 | Parens Expr 645 -- | 646 -- An record property accessor expression (e.g. `obj.x` or `_.x`). 647 -- Anonymous arguments will be removed during desugaring and expanded 648 -- into a lambda that reads a property from a record. 649 -- 650 | Accessor PSString Expr 651 -- | 652 -- Partial record update 653 -- 654 | ObjectUpdate Expr [(PSString, Expr)] 655 -- | 656 -- Object updates with nested support: `x { foo { bar = e } }` 657 -- Replaced during desugaring into a `Let` and nested `ObjectUpdate`s 658 -- 659 | ObjectUpdateNested Expr (PathTree Expr) 660 -- | 661 -- Function introduction 662 -- 663 | Abs Binder Expr 664 -- | 665 -- Function application 666 -- 667 | App Expr Expr 668 -- | 669 -- Hint that an expression is unused. 670 -- This is used to ignore type class dictionaries that are necessarily empty. 671 -- The inner expression lets us solve subgoals before eliminating the whole expression. 672 -- The code gen will render this as `undefined`, regardless of what the inner expression is. 673 | Unused Expr 674 -- | 675 -- Variable 676 -- 677 | Var SourceSpan (Qualified Ident) 678 -- | 679 -- An operator. This will be desugared into a function during the "operators" 680 -- phase of desugaring. 681 -- 682 | Op SourceSpan (Qualified (OpName 'ValueOpName)) 683 -- | 684 -- Conditional (if-then-else expression) 685 -- 686 | IfThenElse Expr Expr Expr 687 -- | 688 -- A data constructor 689 -- 690 | Constructor SourceSpan (Qualified (ProperName 'ConstructorName)) 691 -- | 692 -- A case expression. During the case expansion phase of desugaring, top-level binders will get 693 -- desugared into case expressions, hence the need for guards and multiple binders per branch here. 694 -- 695 | Case [Expr] [CaseAlternative] 696 -- | 697 -- A value with a type annotation 698 -- 699 | TypedValue Bool Expr SourceType 700 -- | 701 -- A let binding 702 -- 703 | Let WhereProvenance [Declaration] Expr 704 -- | 705 -- A do-notation block 706 -- 707 | Do (Maybe ModuleName) [DoNotationElement] 708 -- | 709 -- An ado-notation block 710 -- 711 | Ado (Maybe ModuleName) [DoNotationElement] Expr 712 -- | 713 -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these 714 -- placeholders will be replaced with actual expressions representing type classes dictionaries which 715 -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look 716 -- at superclass implementations when searching for a dictionary, the type class name and 717 -- instance type, and the type class dictionaries in scope. 718 -- 719 | TypeClassDictionary SourceConstraint 720 (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict)))) 721 [ErrorMessageHint] 722 -- | 723 -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking 724 -- 725 | DeferredDictionary (Qualified (ProperName 'ClassName)) [SourceType] 726 -- | 727 -- A placeholder for an anonymous function argument 728 -- 729 | AnonymousArgument 730 -- | 731 -- A typed hole that will be turned into a hint/error during typechecking 732 -- 733 | Hole Text 734 -- | 735 -- A value with source position information 736 -- 737 | PositionedValue SourceSpan [Comment] Expr 738 deriving (Show) 739 740-- | 741-- Metadata that tells where a let binding originated 742-- 743data WhereProvenance 744 -- | 745 -- The let binding was originally a where clause 746 -- 747 = FromWhere 748 -- | 749 -- The let binding was always a let binding 750 -- 751 | FromLet 752 deriving (Show) 753 754-- | 755-- An alternative in a case statement 756-- 757data CaseAlternative = CaseAlternative 758 { -- | 759 -- A collection of binders with which to match the inputs 760 -- 761 caseAlternativeBinders :: [Binder] 762 -- | 763 -- The result expression or a collect of guarded expressions 764 -- 765 , caseAlternativeResult :: [GuardedExpr] 766 } deriving (Show) 767 768-- | 769-- A statement in a do-notation block 770-- 771data DoNotationElement 772 -- | 773 -- A monadic value without a binder 774 -- 775 = DoNotationValue Expr 776 -- | 777 -- A monadic value with a binder 778 -- 779 | DoNotationBind Binder Expr 780 -- | 781 -- A let statement, i.e. a pure value with a binder 782 -- 783 | DoNotationLet [Declaration] 784 -- | 785 -- A do notation element with source position information 786 -- 787 | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement 788 deriving (Show) 789 790 791-- For a record update such as: 792-- 793-- x { foo = 0 794-- , bar { baz = 1 795-- , qux = 2 } } 796-- 797-- We represent the updates as the `PathTree`: 798-- 799-- [ ("foo", Leaf 3) 800-- , ("bar", Branch [ ("baz", Leaf 1) 801-- , ("qux", Leaf 2) ]) ] 802-- 803-- Which we then convert to an expression representing the following: 804-- 805-- let x' = x 806-- in x' { foo = 0 807-- , bar = x'.bar { baz = 1 808-- , qux = 2 } } 809-- 810-- The `let` here is required to prevent re-evaluating the object expression `x`. 811-- However we don't generate this when using an anonymous argument for the object. 812-- 813 814newtype PathTree t = PathTree (AssocList PSString (PathNode t)) 815 deriving (Show, Eq, Ord, Functor, Foldable, Traversable) 816 817data PathNode t = Leaf t | Branch (PathTree t) 818 deriving (Show, Eq, Ord, Functor, Foldable, Traversable) 819 820newtype AssocList k t = AssocList { runAssocList :: [(k, t)] } 821 deriving (Show, Eq, Ord, Foldable, Functor, Traversable) 822 823$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''NameSource) 824$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef) 825$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType) 826$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExportSource) 827 828isTrueExpr :: Expr -> Bool 829isTrueExpr (Literal _ (BooleanLiteral True)) = True 830isTrueExpr (Var _ (Qualified (Just (ModuleName "Prelude")) (Ident "otherwise"))) = True 831isTrueExpr (Var _ (Qualified (Just (ModuleName "Data.Boolean")) (Ident "otherwise"))) = True 832isTrueExpr (TypedValue _ e _) = isTrueExpr e 833isTrueExpr (PositionedValue _ _ e) = isTrueExpr e 834isTrueExpr _ = False 835