content: module Hydra.Sources.Haskell.Ast where
  
  import Hydra.Kernel
  import qualified Hydra.Sources.Kernel.Types.All as KernelTypes
  import qualified Hydra.Sources.Kernel.Terms.All as Tier2
  import Hydra.Dsl.Annotations
  import Hydra.Dsl.Bootstrap
  import Hydra.Dsl.Types as Types
  
  import qualified Hydra.Sources.Kernel.Types.Accessors   as Accessors
  import qualified Hydra.Sources.Kernel.Types.Ast         as Ast
  import qualified Hydra.Sources.Kernel.Types.Coders      as Coders
  import qualified Hydra.Sources.Kernel.Types.Compute     as Compute
  import qualified Hydra.Sources.Kernel.Types.Constraints as Constraints
  import qualified Hydra.Sources.Kernel.Types.Core        as Core
  import qualified Hydra.Sources.Kernel.Types.Grammar     as Grammar
  import qualified Hydra.Sources.Kernel.Types.Graph       as Graph
  import qualified Hydra.Sources.Kernel.Types.Json        as Json
  import qualified Hydra.Sources.Kernel.Types.Mantle      as Mantle
  import qualified Hydra.Sources.Kernel.Types.Module      as Module
  import qualified Hydra.Sources.Kernel.Types.Phantoms    as Phantoms
  import qualified Hydra.Sources.Kernel.Types.Relational  as Relational
  import qualified Hydra.Sources.Kernel.Types.Query       as Query
  import qualified Hydra.Sources.Kernel.Types.Tabular     as Tabular
  import qualified Hydra.Sources.Kernel.Types.Testing     as Testing
  import qualified Hydra.Sources.Kernel.Types.Topology    as Topology
  import qualified Hydra.Sources.Kernel.Types.Typing      as Typing
  import qualified Hydra.Sources.Kernel.Types.Workflow    as Workflow
  
  haskellAstModule :: Module
  haskellAstModule = Module ns elements [Core.module_] [Core.module_] $
      Just "A Haskell syntax model, loosely based on Language.Haskell.Tools.AST"
    where
      ns = Namespace "hydra.ext.haskell.ast"
      def = datatype ns
      ast = typeref ns
  
      elements = [
  
        def "Alternative" $ -- UAlt
          doc "A pattern-matching alternative" $
          record [
            "pattern">: ast "Pattern",
            "rhs">: ast "CaseRhs",
            "binds">: optional $ ast "LocalBindings"],
  
        def "Assertion" $ -- UAssertion (UClassAssert)
          doc "A type assertion" $
          union [
            "class">: ast "ClassAssertion",
            "tuple">: list $ ast "Assertion"],
          -- omitted for now: implicit and infix assertions
  
        def "ClassAssertion" $ -- UClassAssert
          record [
            "name">: ast "Name",
            "types">: list $ ast "Type"],
  
        def "CaseRhs" $ -- UCaseRhs'
          doc "The right-hand side of a pattern-matching alternative" $
          -- omitted for now: guarded
          wrap $ ast "Expression",
  
        def "Constructor" $ -- UConDecl
          doc "A data constructor" $
          -- omitted for now: ordinary (positional), infix
          union [
            "ordinary">: ast "OrdinaryConstructor",
            "record">: ast "RecordConstructor"],
  
        def "OrdinaryConstructor" $
          doc "An ordinary (positional) data constructor" $
          record [
            "name">: ast "Name",
            "fields">: list $ ast "Type"],
  
        def "RecordConstructor" $
          doc "A record-style data constructor" $
          record [
            "name">: ast "Name",
            "fields">: list $ ast "FieldWithComments"],
  
        def "ConstructorWithComments" $
          doc "A data constructor together with any comments" $
          record [
            "body">: ast "Constructor",
            "comments">: optional string],
  
        def "DataDeclaration" $ -- UDataDecl
          doc "A data type declaration" $
          record [
            "keyword">: ast "DataOrNewtype",
            "context">: list $ ast "Assertion",
            "head">: ast "DeclarationHead",
            "constructors">: list $ ast "ConstructorWithComments",
            "deriving">: list $ ast "Deriving"],
  
        def "DataOrNewtype" $
          doc "The 'data' versus 'newtype keyword" $
          enum ["data", "newtype"],
  
        def "DeclarationWithComments" $
          doc "A data declaration together with any comments" $
          record [
            "body">: ast "Declaration",
            "comments">: optional string],
  
        def "Declaration" $ -- UDecl
          doc "A data or value declaration" $
          -- omitted for now: typeFamily, typeSignature, closedTypeFamily, gDataDecl, typeInst, dataInst, gDataInst, class, inst,
          --                  patternSynonym, deriv, fixity, default, patTypeSig, foreignImport, foreignExport, pragma,
          --                  role, splice
          union [
            "data">: ast "DataDeclaration",
            "type">: ast "TypeDeclaration",
            "valueBinding">: ast "ValueBinding",
            "typedBinding">: ast "TypedBinding"],
  
        def "DeclarationHead" $ -- UDeclHead
          doc "The left-hand side of a declaration" $
          -- omitted for now: infix application
          union [
            "application">: ast "ApplicationDeclarationHead",
            "parens">: ast "DeclarationHead",
            "simple">: ast "Name"],
  
        def "ApplicationDeclarationHead" $
          doc "An application-style declaration head" $
          record [
            "function">: ast "DeclarationHead",
            "operand">: ast "Variable"],
  
        def "Deriving" $ -- UDeriving
          doc "A 'deriving' statement" $
          -- omitted for now: infix, parenthesized, and application instance heads
          wrap $ list $ ast "Name",
  
        def "Export" $ -- UExportSpec
          doc "An export statement" $
          union [
            "declaration">: ast "ImportExportSpec",
            "module">: ast "ModuleName"],
  
        def "Expression" $ -- UExpr
          doc "A data expression" $
          -- omitted for now: multi-if, unboxed tuple, tuple section, unboxed tuple section, parallel array,
          --                  enum, parallel array enum, list comp, parallel array comp, type application,
          --                  (all Template Haskell constructors), pragma, arrow definition, arrow application,
          --                  lambda cases, static, unboxed sum, hole
          union [
            "application">: ast "ApplicationExpression",
            "case">: ast "CaseExpression",
            "constructRecord">: ast "ConstructRecordExpression",
            "do">: list $ ast "Statement", -- omitted for now: do vs. mdo
            "if">: ast "IfExpression",
            "infixApplication">: ast "InfixApplicationExpression",
            "literal">: ast "Literal",
            "lambda">: ast "LambdaExpression",
            "leftSection">: ast "SectionExpression",
            "let">: ast "LetExpression",
            "list">: list $ ast "Expression",
            "parens">: ast "Expression",
            "prefixApplication">: ast "PrefixApplicationExpression",
            "rightSection">: ast "SectionExpression",
            "tuple">: list $ ast "Expression",
            "typeSignature">: ast "TypeSignatureExpression",
            "updateRecord">: ast "UpdateRecordExpression",
            "variable">: ast "Name"],
  
        def "ApplicationExpression" $
          doc "An application expression" $
          record [
            "function">: ast "Expression",
            "argument">: ast "Expression"],
  
        def "CaseExpression" $
          doc "A case expression" $
          record [
            "case">: ast "Expression",
            "alternatives">: list $ ast "Alternative"],
  
        def "ConstructRecordExpression" $
          doc "A record constructor expression" $
          record [
            "name">: ast "Name",
            "fields">: list $ ast "FieldUpdate"],
  
        def "IfExpression" $
          doc "An 'if' expression" $
          record [
            "condition">: ast "Expression",
            "then">: ast "Expression",
            "else">: ast "Expression"],
  
        def "InfixApplicationExpression" $
          doc "An infix application expression" $
          record [
            "lhs">: ast "Expression",
            "operator">: ast "Operator",
            "rhs">: ast "Expression"],
  
        def "LambdaExpression" $
          doc "A lambda expression" $
          record [
            "bindings">: list $ ast "Pattern",
            "inner">: ast "Expression"],
  
        def "LetExpression" $
          doc "A 'let' expression" $
          record [
            "bindings">: list $ ast "LocalBinding",
            "inner">: ast "Expression"],
  
        def "PrefixApplicationExpression" $
          doc "A prefix expression" $
          record [
            "operator">: ast "Operator",
            "rhs">: ast "Expression"],
  
        def "SectionExpression" $
          doc "A section expression" $
          record [
            "operator">: ast "Operator",
            "expression">: ast "Expression"],
  
        def "TypeSignatureExpression" $
          doc "A type signature expression" $
          record [
            "inner">: ast "Expression",
            "type">: ast "Type"],
  
        def "UpdateRecordExpression" $
          doc "An update record expression" $
          record [
            "inner">: ast "Expression",
            "fields">: list $ ast "FieldUpdate"],
  
        def "Field" $ -- UFieldDecl
          doc "A field (name/type pair)" $
          record [
            "name">: ast "Name",
            "type">: ast "Type"],
  
        def "FieldWithComments" $
          doc "A field together with any comments" $
          record [
            "field">: ast "Field",
            "comments">: optional string],
  
        def "FieldUpdate" $ -- UFieldUpdate
          doc "A field name and value" $
          -- omitted for now: pun, wildcard
          record [
            "name">: ast "Name",
            "value">: ast "Expression"],
  
        def "Import" $ -- UImportDecl
          doc "An import statement" $
          -- omitted for now: source, safe, pkg
          record [
            "qualified">: boolean,
            "module">: ast "ModuleName",
            "as">: optional $ ast "ModuleName",
            "spec">: optional $ ast "SpecImport"],
  
        def "SpecImport" $
          doc "An import specification" $
          union [
            "list">: list $ ast "ImportExportSpec",
            "hiding">: list $ ast "ImportExportSpec"],
  
        def "ImportModifier" $ -- UImportModifier
          doc "An import modifier ('pattern' or 'type')" $
          enum ["pattern", "type"],
  
        def "ImportExportSpec" $ -- UIESpec
          doc "An import or export specification" $
          record [
            "modifier">: optional $ ast "ImportModifier",
            "name">: ast "Name",
            "subspec">: optional $ ast "SubspecImportExportSpec"],
  
        def "SubspecImportExportSpec" $
          union [
            "all">: unit,
            "list">: list $ ast "Name"],
  
        def "Literal" $ -- ULiteral
          doc "A literal value" $
          -- omitted for now: frac, primChar
          union [
            "char">: uint16,
            "double">: float64,
            "float">: float32,
            "int">: int32,
            "integer">: bigint,
            "string">: string],
  
        def "LocalBinding" $ -- ULocalBind
          -- omitted for now: fixity, pragma
          union [
            "signature">: ast "TypeSignature",
            "value">: ast "ValueBinding"],
  
        def "LocalBindings" $ -- ULocalBinds
          wrap $ list $ ast "LocalBinding",
  
        def "Module" $ -- UModule
          -- omitted for now: pragma
          record [
            "head">: optional $ ast "ModuleHead",
            "imports">: list $ ast "Import",
            "declarations">: list $ ast "DeclarationWithComments"],
  
        def "ModuleHead" $ -- UModuleHead
          -- omitted for now: pragma
          record [
            "comments">: optional string,
            "name">: ast "ModuleName",
            "exports">: list $ ast "Export"], -- UExportSpecs
  
        def "ModuleName" $ -- UModuleName
          wrap string,
  
        def "Name" $ -- UName
          union [
            "implicit">: ast "QualifiedName",
            "normal">: ast "QualifiedName",
            "parens">: ast "QualifiedName"],
  
        def "NamePart" $ -- UNamePart
          wrap string,
  
        def "Operator" $ -- UOperator
          union [
            "backtick">: ast "QualifiedName",
            "normal">: ast "QualifiedName"],
  
        def "Pattern" $ -- UPattern
          -- omitted for now: unboxed tuples, parallel arrays, irrefutable, bang, view, splice, quasiquote, plusk, unboxed sum
          union [
            "application">: ast "ApplicationPattern",
            "as">: ast "AsPattern",
            "list">: list $ ast "Pattern",
            "literal">: ast "Literal",
            "name">: ast "Name",
            "parens">: ast "Pattern",
            "record">: ast "RecordPattern",
            "tuple">: list $ ast "Pattern",
            "typed">: ast "TypedPattern",
            "wildcard">: unit],
  
        def "ApplicationPattern" $
          record [
            "name">: ast "Name",
            "args">: list $ ast "Pattern"],
  
        def "AsPattern" $
          record [
            "name">: ast "Name",
            "inner">: ast "Pattern"],
  
        def "RecordPattern" $
          record [
            "name">: ast "Name",
            "fields">: list $ ast "PatternField"],
  
        def "TypedPattern" $
          record [
            "inner">: ast "Pattern",
            "type">: ast "Type"],
  
        def "PatternField" $ -- UPatternField
          -- omitted for now: puns, wildcards
          record [
            "name">: ast "Name",
            "pattern">: ast "Pattern"],
  
        def "QualifiedName" $ -- UQualifiedName
          record [
            "qualifiers">: list $ ast "NamePart",
            "unqualified">: ast "NamePart"],
  
        def "RightHandSide" $ -- URhs
          -- omitted for now: guarded rhs
          wrap $ ast "Expression",
  
        def "Statement" $ -- UStmt
          wrap $ ast "Expression",
  
        def "Type" $ -- UType
          -- omitted for now: forall, unboxed tuple, parallel array, kinded, promoted, splice, quasiquote, bang,
          --                  lazy, unpack, nounpack, wildcard, named wildcard, sum
          union [
            "application">: ast "ApplicationType",
            "ctx">: ast "ContextType",
            "function">: ast "FunctionType",
            "infix">: ast "InfixType",
            "list">: ast "Type",
            "parens">: ast "Type",
            "tuple">: list $ ast "Type",
            "variable">: ast "Name"],
  
        def "ApplicationType" $
          record [
            "context">: ast "Type",
            "argument">: ast "Type"],
  
        def "ContextType" $
          record [
            "ctx">: ast "Assertion", -- UContext
            "type">: ast "Type"],
  
        def "FunctionType" $
          record [
            "domain">: ast "Type",
            "codomain">: ast "Type"],
  
        def "InfixType" $
          record [
            "lhs">: ast "Type",
            "operator">: ast "Operator",
            "rhs">: ast "Operator"],
  
        def "TypeDeclaration" $ -- UTypeDecl
          record [
            "name">: ast "DeclarationHead",
            "type">: ast "Type"],
  
        def "TypeSignature" $ -- UTypeSignature
          record [
            "name">: ast "Name",
            "type">: ast "Type"],
  
        def "TypedBinding" $ -- Added for convenience
          record [
            "typeSignature">: ast "TypeSignature",
            "valueBinding">: ast "ValueBinding"],
  
        def "ValueBinding" $ -- UValueBind
          -- omitted for now: funBind
          union [
            "simple">: ast "SimpleValueBinding"],
  
        def "SimpleValueBinding" $
          record [
            "pattern">: ast "Pattern",
            "rhs">: ast "RightHandSide",
            "localBindings">: optional $ ast "LocalBindings"],
  
        def "Variable" $
          -- omitted for now: kind constraints
          wrap $ ast "Name"]
  