content: module Hydra.Sources.Kernel.Terms.Decoding where
  
  -- Standard imports for term-level kernel modules
  import Hydra.Kernel
  import Hydra.Sources.Libraries
  import qualified Hydra.Dsl.Accessors     as Accessors
  import qualified Hydra.Dsl.Ast           as Ast
  import qualified Hydra.Dsl.Coders        as Coders
  import qualified Hydra.Dsl.Compute       as Compute
  import qualified Hydra.Dsl.Core          as Core
  import qualified Hydra.Dsl.Grammar       as Grammar
  import qualified Hydra.Dsl.Graph         as Graph
  import qualified Hydra.Dsl.Json          as Json
  import qualified Hydra.Dsl.Lib.Chars     as Chars
  import qualified Hydra.Dsl.Lib.Equality  as Equality
  import qualified Hydra.Dsl.Lib.Flows     as Flows
  import qualified Hydra.Dsl.Lib.Lists     as Lists
  import qualified Hydra.Dsl.Lib.Literals  as Literals
  import qualified Hydra.Dsl.Lib.Logic     as Logic
  import qualified Hydra.Dsl.Lib.Maps      as Maps
  import qualified Hydra.Dsl.Lib.Math      as Math
  import qualified Hydra.Dsl.Lib.Optionals as Optionals
  import           Hydra.Dsl.Phantoms      as Phantoms
  import qualified Hydra.Dsl.Lib.Sets      as Sets
  import           Hydra.Dsl.Lib.Strings   as Strings
  import qualified Hydra.Dsl.Mantle        as Mantle
  import qualified Hydra.Dsl.Module        as Module
  import qualified Hydra.Dsl.TTerms        as TTerms
  import qualified Hydra.Dsl.TTypes        as TTypes
  import qualified Hydra.Dsl.Terms         as Terms
  import qualified Hydra.Dsl.Topology      as Topology
  import qualified Hydra.Dsl.Types         as Types
  import qualified Hydra.Dsl.Typing        as Typing
  import           Hydra.Sources.Kernel.Types.All
  import           Prelude hiding ((++))
  import qualified Data.Int                as I
  import qualified Data.List               as L
  import qualified Data.Map                as M
  import qualified Data.Set                as S
  import qualified Data.Maybe              as Y
  
  import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting
  
  
  module_ :: Module
  module_ = Module (Namespace "hydra.decoding") elements
      [Rewriting.module_]
      kernelTypesModules $
      Just "A module for decoding terms to native objects"
    where
      elements = [
        el bigfloatDef,
        el bigfloatValueDef,
        el bigintDef,
        el bigintValueDef,
        el binaryDef,
        el binaryLiteralDef,
        el booleanDef,
        el booleanLiteralDef,
        el caseFieldDef,
        el casesDef,
        el fieldDef,
        el float32Def,
        el float32ValueDef,
        el float64Def,
        el float64ValueDef,
        el floatLiteralDef,
        el int16Def,
        el int16ValueDef,
        el int32Def,
        el int32ValueDef,
        el int64Def,
        el int64ValueDef,
        el int8Def,
        el int8ValueDef,
        el integerLiteralDef,
        el lambdaDef,
        el letBindingDef,
        el letBindingWithKeyDef,
        el letTermDef,
        el listDef,
        el literalDef,
        el mapDef,
        el nameDef,
        el nominalDef,
        el optionalDef,
        el pairDef,
        el recordDef,
        el setDef,
        el stringDef,
        el stringLiteralDef,
        el uint16Def,
        el uint16ValueDef,
        el uint32Def,
        el uint32ValueDef,
        el uint64Def,
        el uint64ValueDef,
        el uint8Def,
        el uint8ValueDef,
        el unitDef,
        el unitVariantDef,
        el variableDef,
        el variantDef,
        el wrapDef]
  
  define :: String -> TTerm a -> TBinding a
  define = definitionInModule module_
  
  bigfloatDef :: TBinding (Term -> Maybe Float)
  bigfloatDef = define "bigfloat" $
    compose3 (ref literalDef) (ref floatLiteralDef) (ref bigfloatValueDef)
  
  bigfloatValueDef :: TBinding (FloatValue -> Maybe Float)
  bigfloatValueDef = define "bigfloatValue" $
    matchVariant _FloatValue _FloatValue_bigfloat
  
  bigintDef :: TBinding (Term -> Maybe Int)
  bigintDef = define "bigint" $
    compose3 (ref literalDef) (ref integerLiteralDef) (ref bigintValueDef)
  
  bigintValueDef :: TBinding (IntegerValue -> Maybe Int)
  bigintValueDef = define "bigintValue" $
    matchVariant _IntegerValue _IntegerValue_bigint
  
  binaryDef :: TBinding (Term -> Maybe String)
  binaryDef = define "binary" $
    compose2 (ref literalDef) (ref binaryLiteralDef)
  
  binaryLiteralDef :: TBinding (Literal -> Maybe String)
  binaryLiteralDef = define "binaryLiteral" $
    matchVariant _Literal _Literal_binary
  
  booleanDef :: TBinding (Term -> Maybe Bool)
  booleanDef = define "boolean" $
    compose2 (ref literalDef) (ref booleanLiteralDef)
  
  booleanLiteralDef :: TBinding (Literal -> Maybe Bool)
  booleanLiteralDef = define "booleanLiteral" $
    matchVariant _Literal _Literal_boolean
  
  casesDef :: TBinding (Name -> Term -> Maybe [Field])
  casesDef = define "cases" $
    lets [
      "matchFunction">: matchTermVariant _Term_function,
      "matchElimination">: matchVariant _Function _Function_elimination,
      "matchUnion">: matchVariant _Elimination _Elimination_union]
      $ ref nominalDef
        @@ (unaryFunction Core.caseStatementTypeName)
        @@ (unaryFunction Core.caseStatementCases)
        @@ compose3 (var "matchFunction") (var "matchElimination") (var "matchUnion")
  
  caseFieldDef :: TBinding (Name -> Name -> Term -> Y.Maybe Term)
  caseFieldDef = define "caseField" $
   lambda "tname" $ lambda "fname" $
     compose2
       (ref casesDef @@ var "tname" )
       (ref fieldDef @@ var "fname")
  
  fieldDef :: TBinding (Name -> [Field] -> Maybe Term)
  fieldDef = define "field" $
    lambdas ["fname", "fields"] $ lets [
      "matches">: Lists.filter
        (lambda "f" $ Equality.equal (Core.fieldName $ var "f") $ var "fname")
        (var "fields")]
      $ Logic.ifElse (Equality.equal (int32 1) (Lists.length $ var "matches"))
        (just (Core.fieldTerm $ (Lists.head $ var "matches")))
        nothing
  
  float32Def :: TBinding (Term -> Maybe Float)
  float32Def = define "float32" $
    compose3
      (ref literalDef)
      (ref floatLiteralDef)
      (ref float32ValueDef)
  
  float32ValueDef :: TBinding (FloatValue -> Maybe Float)
  float32ValueDef = define "float32Value" $
    matchVariant _FloatValue _FloatValue_float32
  
  float64Def :: TBinding (Term -> Maybe Float)
  float64Def = define "float64" $
    compose3
      (ref literalDef)
      (ref floatLiteralDef)
      (ref float64ValueDef)
  
  float64ValueDef :: TBinding (FloatValue -> Maybe Float)
  float64ValueDef = define "float64Value" $
    matchVariant _FloatValue _FloatValue_float64
  
  floatLiteralDef = define "floatLiteral" $
    matchVariant _Literal _Literal_float
  
  int8Def :: TBinding (Term -> Maybe Int)
  int8Def = define "int8" $
    compose3
      (ref literalDef)
      (ref integerLiteralDef)
      (ref int8ValueDef)
  
  int8ValueDef :: TBinding (IntegerValue -> Maybe Int)
  int8ValueDef = define "int8Value" $
    matchVariant _IntegerValue _IntegerValue_int8
  
  int16Def :: TBinding (Term -> Maybe Int)
  int16Def = define "int16" $
    compose3
      (ref literalDef)
      (ref integerLiteralDef)
      (ref int16ValueDef)
  
  int16ValueDef :: TBinding (IntegerValue -> Maybe Int)
  int16ValueDef = define "int16Value" $
    matchVariant _IntegerValue _IntegerValue_int16
  
  int32Def :: TBinding (Term -> Maybe Int)
  int32Def = define "int32" $
    compose3
      (ref literalDef)
      (ref integerLiteralDef)
      (ref int32ValueDef)
  
  int32ValueDef :: TBinding (IntegerValue -> Maybe Int)
  int32ValueDef = define "int32Value" $
    matchVariant _IntegerValue _IntegerValue_int32
  
  int64Def :: TBinding (Term -> Maybe Int)
  int64Def = define "int64" $
    compose3
      (ref literalDef)
      (ref integerLiteralDef)
      (ref int64ValueDef)
  
  int64ValueDef :: TBinding (IntegerValue -> Maybe Int)
  int64ValueDef = define "int64Value" $
    matchVariant _IntegerValue _IntegerValue_int64
  
  integerLiteralDef :: TBinding (Literal -> Maybe IntegerValue)
  integerLiteralDef = define "integerLiteral" $
    matchVariant _Literal _Literal_integer
  
  lambdaDef :: TBinding (Term -> Maybe Lambda)
  lambdaDef = define "lambda" $
    lets [
      "matchFunction">: matchTermVariant _Term_function,
      "matchLambda">: matchVariant _Function _Function_lambda]
      $ compose2 (var "matchFunction") (var "matchLambda")
  
  letBindingDef :: TBinding (Name -> Term -> Maybe Binding)
  letBindingDef = define "letBinding" $
    lambda "fname" $ lambda "term" $ Optionals.bind
      (Optionals.map
        (unaryFunction Core.letBindings)
        (ref letTermDef @@ var "term"))
      (ref letBindingWithKeyDef @@ var "fname")
  
  letBindingWithKeyDef :: TBinding (Name -> [Binding] -> Maybe Binding)
  letBindingWithKeyDef = define "letBindingWithKey" $
    lambda "fname" $ lambda "bindings" $ lets [
      "matches">: Lists.filter
        (lambda "b" $ Equality.equal (Core.bindingName $ var "b") $ var "fname")
        (var "bindings")]
      $ Logic.ifElse (Equality.equal (int32 1) (Lists.length $ var "matches"))
        (just (Lists.head $ var "matches"))
        nothing
  
  letTermDef :: TBinding (Term -> Maybe Let)
  letTermDef = define "letTerm" $
    matchTermVariant _Term_let
  
  listDef :: TBinding (Term -> Maybe [Term])
  listDef = define "list" $
    matchTermVariant _Term_list
  
  literalDef :: TBinding (Term -> Maybe Literal)
  literalDef = define "literal" $
    matchTermVariant _Term_literal
  
  mapDef :: TBinding (Term -> Maybe (M.Map Term Term))
  mapDef = define "map" $
    matchTermVariant _Term_map
  
  nameDef :: TBinding (Term -> Maybe Name)
  nameDef = define "name" $
    lambda "term" $ Optionals.map nm
      (Optionals.bind
        (ref wrapDef @@ Core.nameLift _Name @@ var "term")
        (ref stringDef))
    where
      nm :: TTerm (String -> Name)
      nm = TTerm $ Terms.lambda "s" $ TermWrap $ WrappedTerm _Name $ Terms.var "s"
  
  nominalDef :: TBinding ((a -> Name) -> (a -> b) -> (c -> Maybe a) -> Name -> c -> Maybe b)
  nominalDef = define "nominal" $
    lambda "getName" $ lambda "getB" $ lambda "getA" $ lambda "expected" $
      lets [
        "namesEqual">: lambda "n1" $ lambda "n2" $ Equality.equal (Core.unName $ var "n1") (Core.unName $ var "n2")] $
        compose2
          (var "getA")
          (lambda "a" $ (Logic.ifElse (var "namesEqual" @@ (var "getName" @@ var "a") @@ (var "expected")))
            (just (var "getB" @@ var "a"))
            nothing)
  
  optionalDef :: TBinding (Term -> Maybe (Maybe Term))
  optionalDef = define "optional" $
    matchTermVariant _Term_optional
  
  pairDef :: TBinding (Term -> Maybe (Term, Term))
  pairDef = define "pair" $
    lets [
      "matchProduct">: matchTermVariant _Term_product]
      $ compose2
        (var "matchProduct")
        (lambda "l" $ Logic.ifElse (Equality.equal (int32 2) (Lists.length $ var "l"))
          (just $ pair (Lists.at (int32 0) $ var "l") (Lists.at (int32 1) $ var "l"))
          nothing)
  
  recordDef :: TBinding (Name -> Term -> Maybe [Field])
  recordDef = define "record" $
    matchNominal _Term_record
      (unaryFunction Core.recordTypeName)
      (unaryFunction Core.recordFields)
  
  setDef :: TBinding (Term -> Maybe (S.Set Term))
  setDef = define "set" $
    matchTermVariant _Term_set
  
  stringDef :: TBinding (Term -> Maybe String)
  stringDef = define "string" $
    compose2 (ref literalDef) (ref stringLiteralDef)
  
  stringLiteralDef :: TBinding (Literal -> Maybe String)
  stringLiteralDef = define "stringLiteral" $
    matchVariant _Literal _Literal_string
  
  uint8Def :: TBinding (Term -> Maybe Int)
  uint8Def = define "uint8" $
    compose3 (ref literalDef) (ref integerLiteralDef) (ref uint8ValueDef)
  
  uint8ValueDef :: TBinding (IntegerValue -> Maybe Int)
  uint8ValueDef = define "uint8Value" $
    matchVariant _IntegerValue _IntegerValue_uint8
  
  uint16Def :: TBinding (Term -> Maybe Int)
  uint16Def = define "uint16" $
    compose3 (ref literalDef) (ref integerLiteralDef) (ref uint16ValueDef)
  
  uint16ValueDef :: TBinding (IntegerValue -> Maybe Int)
  uint16ValueDef = define "uint16Value" $
    matchVariant _IntegerValue _IntegerValue_uint16
  
  uint32Def :: TBinding (Term -> Maybe Int)
  uint32Def = define "uint32" $
    compose3 (ref literalDef) (ref integerLiteralDef) (ref uint32ValueDef)
  
  uint32ValueDef :: TBinding (IntegerValue -> Maybe Int)
  uint32ValueDef = define "uint32Value" $
    matchVariant _IntegerValue _IntegerValue_uint32
  
  uint64Def :: TBinding (Term -> Maybe Int)
  uint64Def = define "uint64" $
    compose3 (ref literalDef) (ref integerLiteralDef) (ref uint64ValueDef)
  
  uint64ValueDef :: TBinding (IntegerValue -> Maybe Int)
  uint64ValueDef = define "uint64Value" $
    matchVariant _IntegerValue _IntegerValue_uint64
  
  unitDef :: TBinding (Term -> Maybe ())
  unitDef = define "unit" $
    lambda "term" $ cases _Term (var "term") (Just nothing) [
      _Term_unit>>: constant $ just unit]
  
  unitVariantDef :: TBinding (Name -> Term -> Maybe Name)
  unitVariantDef = define "unitVariant" $
    lambda "tname" $ lambda "term" $ Optionals.map
      (unaryFunction Core.fieldName)
      (ref variantDef @@ var "tname" @@ var "term")
  
  variableDef :: TBinding (Term -> Y.Maybe Name)
  variableDef = define "variable" $
    matchTermVariant _Term_variable
  
  variantDef :: TBinding (Name -> Term -> Maybe Field)
  variantDef = define "variant" $
    matchNominal _Term_union
      (unaryFunction Core.injectionTypeName)
      (unaryFunction Core.injectionField)
  
  wrapDef :: TBinding (Name -> Term -> Maybe Term)
  wrapDef = define "wrap" $
    matchNominal _Term_wrap
      (unaryFunction Core.wrappedTermTypeName)
      (unaryFunction Core.wrappedTermObject)
  
  --
  
  compose2 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (a -> Maybe c)
  compose2 = Optionals.compose
  
  compose3 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (c -> Maybe d) -> TTerm (a -> Maybe d)
  compose3 f g h = Optionals.compose (Optionals.compose f g) h
  
  matchNominal :: Name -> TTerm (a -> Name) -> TTerm (a -> b) -> TTerm (Name -> Term -> Maybe b)
  matchNominal fname getName getB = ref nominalDef @@ getName @@ getB @@ matchTermVariant fname
  
  matchTermVariant :: Name -> TTerm (Term -> Maybe a)
  matchTermVariant fname = matchVariant _Term fname <.> ref Rewriting.deannotateTermDef
  
  matchVariant :: Name -> Name -> TTerm (a -> Maybe b)
  matchVariant tname fname = match tname (Just nothing) [
    fname>>: lambda "matched_" $ Optionals.pure $ var "matched_"]
  