{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier2.Tier2 where

-- Standard Tier-2 imports
import           Prelude hiding ((++))
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           Hydra.Dsl.Base            as Base
import qualified Hydra.Dsl.Core            as Core
import qualified Hydra.Dsl.Graph           as Graph
import qualified Hydra.Dsl.Lib.Equality    as Equality
import qualified Hydra.Dsl.Lib.Flows       as Flows
import qualified Hydra.Dsl.Lib.Io          as Io
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 qualified Hydra.Dsl.Lib.Sets        as Sets
import           Hydra.Dsl.Lib.Strings     as Strings
import qualified Hydra.Dsl.Module          as Module
import qualified Hydra.Dsl.Terms           as Terms
import qualified Hydra.Dsl.Types           as Types
import           Hydra.Sources.Tier1.All


tier2Definition :: String -> TTerm a -> TElement a
tier2Definition :: forall a. String -> TTerm a -> TElement a
tier2Definition = Module -> String -> TTerm a -> TElement a
forall a. Module -> String -> TTerm a -> TElement a
definitionInModule Module
hydraTier2Module

hydraTier2Module :: Module
hydraTier2Module :: Module
hydraTier2Module = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module (String -> Namespace
Namespace String
"hydra/tier2") [Element]
elements
   [Module
hydraGraphModule, Module
hydraMantleModule, Module
hydraComputeModule, Module
hydraStripModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just (String
"A module for miscellaneous tier-2 functions and constants.")
  where
   elements :: [Element]
elements = [
     TElement (Flow Any Any) -> Element
forall a. TElement a -> Element
el TElement (Flow Any Any)
forall s. TElement (Flow s s)
getStateDef,
     TElement (Term -> Flow Graph (Maybe Type)) -> Element
forall a. TElement a -> Element
el TElement (Term -> Flow Graph (Maybe Type))
getTermTypeDef,
     TElement (Any -> Flow Any ()) -> Element
forall a. TElement a -> Element
el TElement (Any -> Flow Any ())
forall s. TElement (s -> Flow s ())
putStateDef,
     TElement (Element -> Flow Graph Type) -> Element
forall a. TElement a -> Element
el TElement (Element -> Flow Graph Type)
requireElementTypeDef,
     TElement (Term -> Flow Graph Type) -> Element
forall a. TElement a -> Element
el TElement (Term -> Flow Graph Type)
requireTermTypeDef,
     TElement (String -> String -> Flow Any Any) -> Element
forall a. TElement a -> Element
el TElement (String -> String -> Flow Any Any)
forall s x. TElement (String -> String -> Flow s x)
unexpectedDef
     ]

getStateDef :: TElement (Flow s s)
getStateDef :: forall s. TElement (Flow s s)
getStateDef = String -> TTerm (Flow s s) -> TElement (Flow s s)
forall a. String -> TTerm a -> TElement a
tier2Definition String
"getState" (TTerm (Flow s s) -> TElement (Flow s s))
-> TTerm (Flow s s) -> TElement (Flow s s)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (Flow s s) -> TTerm (Flow s s)
forall a. String -> TTerm a -> TTerm a
doc String
"Get the state of the current flow" (TTerm (Flow s s) -> TTerm (Flow s s))
-> TTerm (Flow s s) -> TTerm (Flow s s)
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm (Flow s s) -> TTerm (Flow s s)
forall a. Type -> TTerm a -> TTerm a
typed Type
flowSST (TTerm (Flow s s) -> TTerm (Flow s s))
-> TTerm (Flow s s) -> TTerm (Flow s s)
forall a b. (a -> b) -> a -> b
$
  Name -> TTerm (Any -> Any) -> TTerm (Flow s s)
forall a b. Name -> TTerm a -> TTerm b
wrap Name
_Flow (String -> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"s0" (TTerm (Any -> Any) -> TTerm (Any -> Any))
-> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> TTerm Any -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t0" (TTerm Any -> TTerm (Any -> Any))
-> TTerm Any -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ (
    (String
-> TTerm (Any -> Any) -> TTerm (Maybe Any -> Any -> Trace -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"v" (TTerm (Any -> Any) -> TTerm (Maybe Any -> Any -> Trace -> Any))
-> TTerm (Any -> Any) -> TTerm (Maybe Any -> Any -> Trace -> Any)
forall a b. (a -> b) -> a -> b
$ String -> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"s" (TTerm (Any -> Any) -> TTerm (Any -> Any))
-> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> TTerm (FlowState Any Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t" (TTerm (FlowState Any Any) -> TTerm (Any -> Any))
-> TTerm (FlowState Any Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ (
      (TTerm (FlowState Any Any)
-> TTerm (Any -> FlowState Any Any)
-> TTerm (Maybe Any -> FlowState Any Any)
forall b a. TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)
matchOpt
        (TTerm (Maybe Any)
-> TTerm Any -> TTerm Trace -> TTerm (FlowState Any Any)
forall x s.
TTerm (Maybe x) -> TTerm s -> TTerm Trace -> TTerm (FlowState s x)
Flows.flowState TTerm (Maybe Any)
forall a. TTerm a
nothing (String -> TTerm Any
forall a. String -> TTerm a
var String
"s") (String -> TTerm Trace
forall a. String -> TTerm a
var String
"t"))
        (TTerm (FlowState Any Any) -> TTerm (Any -> FlowState Any Any)
forall a b. TTerm a -> TTerm (b -> a)
constant (TTerm (Maybe Any)
-> TTerm Any -> TTerm Trace -> TTerm (FlowState Any Any)
forall x s.
TTerm (Maybe x) -> TTerm s -> TTerm Trace -> TTerm (FlowState s x)
Flows.flowState (TTerm Any -> TTerm (Maybe Any)
forall x. TTerm x -> TTerm (Maybe x)
just (TTerm Any -> TTerm (Maybe Any)) -> TTerm Any -> TTerm (Maybe Any)
forall a b. (a -> b) -> a -> b
$ String -> TTerm Any
forall a. String -> TTerm a
var String
"s") (String -> TTerm Any
forall a. String -> TTerm a
var String
"s") (String -> TTerm Trace
forall a. String -> TTerm a
var String
"t"))))
       TTerm (Maybe Any -> FlowState Any Any)
-> TTerm (Maybe Any) -> TTerm (FlowState Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (Maybe Any)
forall a. String -> TTerm a
var String
"v"))
    TTerm (Maybe Any -> Any -> Trace -> Any)
-> TTerm (Maybe Any) -> TTerm (Any -> Trace -> Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (FlowState Any Any -> Maybe Any)
forall s x. TTerm (FlowState s x -> Maybe x)
Flows.flowStateValue TTerm (FlowState Any Any -> Maybe Any)
-> TTerm (FlowState Any Any) -> TTerm (Maybe Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (FlowState Any Any)
forall a. String -> TTerm a
var String
"fs1") TTerm (Any -> Trace -> Any) -> TTerm Any -> TTerm (Trace -> Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (FlowState Any Any -> Any)
forall s x. TTerm (FlowState s x -> s)
Flows.flowStateState TTerm (FlowState Any Any -> Any)
-> TTerm (FlowState Any Any) -> TTerm Any
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (FlowState Any Any)
forall a. String -> TTerm a
var String
"fs1") TTerm (Trace -> Any) -> TTerm Trace -> TTerm Any
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (FlowState Any Any -> Trace)
forall s x. TTerm (FlowState s x -> Trace)
Flows.flowStateTrace TTerm (FlowState Any Any -> Trace)
-> TTerm (FlowState Any Any) -> TTerm Trace
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (FlowState Any Any)
forall a. String -> TTerm a
var String
"fs1"))
  TTerm Any -> [Field] -> TTerm Any
forall a. TTerm a -> [Field] -> TTerm a
`with` [
    String
"fs1"String -> TTerm (FlowState Any Any) -> Field
forall a. String -> TTerm a -> Field
>:
      Type -> TTerm (FlowState Any Any) -> TTerm (FlowState Any Any)
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type -> Type
Types.apply (Type -> Type -> Type
Types.apply (Name -> Type
TypeVariable Name
_FlowState) Type
sT) Type
unitT) (TTerm (FlowState Any Any) -> TTerm (FlowState Any Any))
-> TTerm (FlowState Any Any) -> TTerm (FlowState Any Any)
forall a b. (a -> b) -> a -> b
$
      TTerm (Flow Any Any -> Any -> Trace -> FlowState Any Any)
forall s x. TTerm (Flow s x -> s -> Trace -> FlowState s x)
Flows.unFlow TTerm (Flow Any Any -> Any -> Trace -> FlowState Any Any)
-> TTerm (Flow Any Any)
-> TTerm (Any -> Trace -> FlowState Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Any -> Flow Any Any)
forall x s. TTerm (x -> Flow s x)
Flows.pure TTerm (Any -> Flow Any Any) -> TTerm Any -> TTerm (Flow Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm Any
forall a. TTerm a
unit) TTerm (Any -> Trace -> FlowState Any Any)
-> TTerm Any -> TTerm (Trace -> FlowState Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Any
forall a. String -> TTerm a
var String
"s0" TTerm (Trace -> FlowState Any Any)
-> TTerm Trace -> TTerm (FlowState Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Trace
forall a. String -> TTerm a
var String
"t0"])

getTermTypeDef :: TElement (Term -> Flow Graph (Maybe Type))
getTermTypeDef :: TElement (Term -> Flow Graph (Maybe Type))
getTermTypeDef = String
-> TTerm (Term -> Flow Graph (Maybe Type))
-> TElement (Term -> Flow Graph (Maybe Type))
forall a. String -> TTerm a -> TElement a
tier2Definition String
"getTermType" (TTerm (Term -> Flow Graph (Maybe Type))
 -> TElement (Term -> Flow Graph (Maybe Type)))
-> TTerm (Term -> Flow Graph (Maybe Type))
-> TElement (Term -> Flow Graph (Maybe Type))
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph (Maybe Type))
forall a. String -> TTerm a -> TTerm a
doc String
"Get the annotated type of a given term, if any" (TTerm (Term -> Flow Graph (Maybe Type))
 -> TTerm (Term -> Flow Graph (Maybe Type)))
-> TTerm (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph (Maybe Type))
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph (Maybe Type))
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
termT (Type -> Type
optionalT Type
typeT) (TTerm (Term -> Flow Graph (Maybe Type))
 -> TTerm (Term -> Flow Graph (Maybe Type)))
-> TTerm (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph (Maybe Type))
forall a b. (a -> b) -> a -> b
$
  Name
-> Maybe (TTerm (Flow Graph (Maybe Type)))
-> [Field]
-> TTerm (Term -> Flow Graph (Maybe Type))
forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
_Term (TTerm (Flow Graph (Maybe Type))
-> Maybe (TTerm (Flow Graph (Maybe Type)))
forall a. a -> Maybe a
Just TTerm (Flow Graph (Maybe Type))
forall a. TTerm a
nothing) [
    String
"annotated"String -> TTerm (Any -> Flow Graph (Maybe Type)) -> Field
forall a. String -> TTerm a -> Field
>: TElement (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph (Maybe Type))
forall a. TElement a -> TTerm a
ref TElement (Term -> Flow Graph (Maybe Type))
getTermTypeDef TTerm (Term -> Flow Graph (Maybe Type))
-> TTerm (Any -> Term) -> TTerm (Any -> Flow Graph (Maybe Type))
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> Name -> Name -> TTerm (Any -> Term)
forall a b. Name -> Name -> TTerm (a -> b)
project Name
_AnnotatedTerm Name
_AnnotatedTerm_subject,
    String
"typed"String -> TTerm (Any -> Any) -> Field
forall a. String -> TTerm a -> Field
>: String -> TTerm (Maybe Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"tt" (TTerm (Maybe Any) -> TTerm (Any -> Any))
-> TTerm (Maybe Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ TTerm Any -> TTerm (Maybe Any)
forall x. TTerm x -> TTerm (Maybe x)
just (Name -> Name -> TTerm (Any -> Any)
forall a b. Name -> Name -> TTerm (a -> b)
project Name
_TypedTerm Name
_TypedTerm_type TTerm (Any -> Any) -> TTerm Any -> TTerm Any
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Any
forall a. String -> TTerm a
var String
"tt")]

putStateDef :: TElement (s -> Flow s ())
putStateDef :: forall s. TElement (s -> Flow s ())
putStateDef = String -> TTerm (s -> Flow s ()) -> TElement (s -> Flow s ())
forall a. String -> TTerm a -> TElement a
tier2Definition String
"putState" (TTerm (s -> Flow s ()) -> TElement (s -> Flow s ()))
-> TTerm (s -> Flow s ()) -> TElement (s -> Flow s ())
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (s -> Flow s ()) -> TTerm (s -> Flow s ())
forall a. String -> TTerm a -> TTerm a
doc String
"Set the state of a flow" (TTerm (s -> Flow s ()) -> TTerm (s -> Flow s ()))
-> TTerm (s -> Flow s ()) -> TTerm (s -> Flow s ())
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (s -> Flow s ()) -> TTerm (s -> Flow s ())
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
sT (Type -> Type -> Type
flowT Type
sT Type
unitT) (TTerm (s -> Flow s ()) -> TTerm (s -> Flow s ()))
-> TTerm (s -> Flow s ()) -> TTerm (s -> Flow s ())
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Any -> TTerm (s -> Flow s ())
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"cx" (TTerm Any -> TTerm (s -> Flow s ()))
-> TTerm Any -> TTerm (s -> Flow s ())
forall a b. (a -> b) -> a -> b
$ Name -> TTerm (Any -> Any) -> TTerm Any
forall a b. Name -> TTerm a -> TTerm b
wrap Name
_Flow (TTerm (Any -> Any) -> TTerm Any)
-> TTerm (Any -> Any) -> TTerm Any
forall a b. (a -> b) -> a -> b
$ String -> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"s0" (TTerm (Any -> Any) -> TTerm (Any -> Any))
-> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> TTerm (FlowState Any Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t0" (
    (TTerm (Maybe Any)
-> TTerm Any -> TTerm Trace -> TTerm (FlowState Any Any)
forall x s.
TTerm (Maybe x) -> TTerm s -> TTerm Trace -> TTerm (FlowState s x)
Flows.flowState
      (TTerm (FlowState Any Any -> Maybe Any)
forall s x. TTerm (FlowState s x -> Maybe x)
Flows.flowStateValue TTerm (FlowState Any Any -> Maybe Any)
-> TTerm (FlowState Any Any) -> TTerm (Maybe Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (FlowState Any Any)
forall a. String -> TTerm a
var String
"f1")
      (String -> TTerm Any
forall a. String -> TTerm a
var String
"cx")
      (TTerm (FlowState Any Any -> Trace)
forall s x. TTerm (FlowState s x -> Trace)
Flows.flowStateTrace TTerm (FlowState Any Any -> Trace)
-> TTerm (FlowState Any Any) -> TTerm Trace
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (FlowState Any Any)
forall a. String -> TTerm a
var String
"f1"))
    TTerm (FlowState Any Any) -> [Field] -> TTerm (FlowState Any Any)
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"f1"String -> TTerm (FlowState Any Any) -> Field
forall a. String -> TTerm a -> Field
>: TTerm (Flow Any Any -> Any -> Trace -> FlowState Any Any)
forall s x. TTerm (Flow s x -> s -> Trace -> FlowState s x)
Flows.unFlow TTerm (Flow Any Any -> Any -> Trace -> FlowState Any Any)
-> TTerm (Flow Any Any)
-> TTerm (Any -> Trace -> FlowState Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Any -> Flow Any Any)
forall x s. TTerm (x -> Flow s x)
Flows.pure TTerm (Any -> Flow Any Any) -> TTerm Any -> TTerm (Flow Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm Any
forall a. TTerm a
unit) TTerm (Any -> Trace -> FlowState Any Any)
-> TTerm Any -> TTerm (Trace -> FlowState Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Any
forall a. String -> TTerm a
var String
"s0" TTerm (Trace -> FlowState Any Any)
-> TTerm Trace -> TTerm (FlowState Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Trace
forall a. String -> TTerm a
var String
"t0"])

requireElementTypeDef :: TElement (Element -> Flow Graph Type)
requireElementTypeDef :: TElement (Element -> Flow Graph Type)
requireElementTypeDef = String
-> TTerm (Element -> Flow Graph Type)
-> TElement (Element -> Flow Graph Type)
forall a. String -> TTerm a -> TElement a
tier2Definition String
"requireElementType" (TTerm (Element -> Flow Graph Type)
 -> TElement (Element -> Flow Graph Type))
-> TTerm (Element -> Flow Graph Type)
-> TElement (Element -> Flow Graph Type)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Element -> Flow Graph Type)
-> TTerm (Element -> Flow Graph Type)
forall a. String -> TTerm a -> TTerm a
doc String
"Get the annotated type of a given element, or fail if it is missing" (TTerm (Element -> Flow Graph Type)
 -> TTerm (Element -> Flow Graph Type))
-> TTerm (Element -> Flow Graph Type)
-> TTerm (Element -> Flow Graph Type)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Element -> Flow Graph Type)
-> TTerm (Element -> Flow Graph Type)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
elementT (Type -> Type -> Type
flowT Type
graphT Type
typeT) (TTerm (Element -> Flow Graph Type)
 -> TTerm (Element -> Flow Graph Type))
-> TTerm (Element -> Flow Graph Type)
-> TTerm (Element -> Flow Graph Type)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Any -> TTerm (Element -> Flow Graph Type)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"el" (TTerm Any -> TTerm (Element -> Flow Graph Type))
-> TTerm Any -> TTerm (Element -> Flow Graph Type)
forall a b. (a -> b) -> a -> b
$ ((String -> TTerm (Flow Graph (Maybe Type) -> Any)
forall a. String -> TTerm a
var String
"withType" TTerm (Flow Graph (Maybe Type) -> Any)
-> TTerm (Flow Graph (Maybe Type)) -> TTerm Any
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TElement (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph (Maybe Type))
forall a. TElement a -> TTerm a
ref TElement (Term -> Flow Graph (Maybe Type))
getTermTypeDef TTerm (Term -> Flow Graph (Maybe Type))
-> TTerm Term -> TTerm (Flow Graph (Maybe Type))
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (Name -> Name -> TTerm (Any -> Term)
forall a b. Name -> Name -> TTerm (a -> b)
project Name
_Element Name
_Element_data TTerm (Any -> Term) -> TTerm Any -> TTerm Term
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Any
forall a. String -> TTerm a
var String
"el")))
    TTerm Any -> [Field] -> TTerm Any
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"withType"String -> TTerm (Maybe Any -> Flow Any Any) -> Field
forall a. String -> TTerm a -> Field
>: TTerm (Flow Any Any)
-> TTerm (Any -> Flow Any Any) -> TTerm (Maybe Any -> Flow Any Any)
forall b a. TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)
matchOpt
       (TTerm (String -> Flow Any Any)
forall s x. TTerm (String -> Flow s x)
Flows.fail TTerm (String -> Flow Any Any)
-> TTerm String -> TTerm (Flow Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm String
"missing type annotation for element " TTerm String -> TTerm String -> TTerm String
++ (Name -> TTerm (Any -> String)
forall a b. Name -> TTerm (a -> b)
unwrap Name
_Name TTerm (Any -> String) -> TTerm Any -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (Name -> Name -> TTerm (Any -> Any)
forall a b. Name -> Name -> TTerm (a -> b)
project Name
_Element Name
_Element_name TTerm (Any -> Any) -> TTerm Any -> TTerm Any
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Any
forall a. String -> TTerm a
var String
"el"))))
       TTerm (Any -> Flow Any Any)
forall x s. TTerm (x -> Flow s x)
Flows.pure])

requireTermTypeDef :: TElement (Term -> Flow Graph Type)
requireTermTypeDef :: TElement (Term -> Flow Graph Type)
requireTermTypeDef = String
-> TTerm (Term -> Flow Graph Type)
-> TElement (Term -> Flow Graph Type)
forall a. String -> TTerm a -> TElement a
tier2Definition String
"requireTermType" (TTerm (Term -> Flow Graph Type)
 -> TElement (Term -> Flow Graph Type))
-> TTerm (Term -> Flow Graph Type)
-> TElement (Term -> Flow Graph Type)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Term -> Flow Graph Type)
-> TTerm (Term -> Flow Graph Type)
forall a. String -> TTerm a -> TTerm a
doc String
"Get the annotated type of a given term, or fail if it is missing" (TTerm (Term -> Flow Graph Type)
 -> TTerm (Term -> Flow Graph Type))
-> TTerm (Term -> Flow Graph Type)
-> TTerm (Term -> Flow Graph Type)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Term -> Flow Graph Type)
-> TTerm (Term -> Flow Graph Type)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
termT (Type -> Type -> Type
flowT Type
graphT Type
typeT) (TTerm (Term -> Flow Graph Type)
 -> TTerm (Term -> Flow Graph Type))
-> TTerm (Term -> Flow Graph Type)
-> TTerm (Term -> Flow Graph Type)
forall a b. (a -> b) -> a -> b
$
  (String -> TTerm (Flow Graph (Maybe Type) -> Flow Graph Type)
forall a. String -> TTerm a
var String
"withType" TTerm (Flow Graph (Maybe Type) -> Flow Graph Type)
-> TTerm (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph Type)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (Term -> Flow Graph (Maybe Type))
-> TTerm (Term -> Flow Graph (Maybe Type))
forall a. TElement a -> TTerm a
ref TElement (Term -> Flow Graph (Maybe Type))
getTermTypeDef)
    TTerm (Term -> Flow Graph Type)
-> [Field] -> TTerm (Term -> Flow Graph Type)
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"withType"String -> TTerm (Maybe Any -> Flow Any Any) -> Field
forall a. String -> TTerm a -> Field
>: TTerm (Flow Any Any)
-> TTerm (Any -> Flow Any Any) -> TTerm (Maybe Any -> Flow Any Any)
forall b a. TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)
matchOpt
       (TTerm (String -> Flow Any Any)
forall s x. TTerm (String -> Flow s x)
Flows.fail TTerm (String -> Flow Any Any)
-> TTerm String -> TTerm (Flow Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"missing type annotation")
       TTerm (Any -> Flow Any Any)
forall x s. TTerm (x -> Flow s x)
Flows.pure]

unexpectedDef :: TElement (String -> String -> Flow s x)
unexpectedDef :: forall s x. TElement (String -> String -> Flow s x)
unexpectedDef = String
-> TTerm (String -> String -> Flow s x)
-> TElement (String -> String -> Flow s x)
forall a. String -> TTerm a -> TElement a
tier2Definition String
"unexpected" (TTerm (String -> String -> Flow s x)
 -> TElement (String -> String -> Flow s x))
-> TTerm (String -> String -> Flow s x)
-> TElement (String -> String -> Flow s x)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (String -> String -> Flow s x)
-> TTerm (String -> String -> Flow s x)
forall a. String -> TTerm a -> TTerm a
doc String
"Fail if an actual value does not match an expected value" (TTerm (String -> String -> Flow s x)
 -> TTerm (String -> String -> Flow s x))
-> TTerm (String -> String -> Flow s x)
-> TTerm (String -> String -> Flow s x)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (String -> String -> Flow s x)
-> TTerm (String -> String -> Flow s x)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
stringT (Type -> Type -> Type
funT Type
stringT (Type -> Type -> Type
flowT Type
sT Type
xT)) (TTerm (String -> String -> Flow s x)
 -> TTerm (String -> String -> Flow s x))
-> TTerm (String -> String -> Flow s x)
-> TTerm (String -> String -> Flow s x)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Any -> Any) -> TTerm (String -> String -> Flow s x)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"expected" (TTerm (Any -> Any) -> TTerm (String -> String -> Flow s x))
-> TTerm (Any -> Any) -> TTerm (String -> String -> Flow s x)
forall a b. (a -> b) -> a -> b
$ String -> TTerm (Flow Any Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"actual" (TTerm (Flow Any Any) -> TTerm (Any -> Any))
-> TTerm (Flow Any Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ TTerm (String -> Flow Any Any)
forall s x. TTerm (String -> Flow s x)
Flows.fail TTerm (String -> Flow Any Any)
-> TTerm String -> TTerm (Flow Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm String
"expected " TTerm String -> TTerm String -> TTerm String
++ String -> TTerm String
forall a. String -> TTerm a
var String
"expected" TTerm String -> TTerm String -> TTerm String
++ TTerm String
" but found: " TTerm String -> TTerm String -> TTerm String
++ String -> TTerm String
forall a. String -> TTerm a
var String
"actual")