module Hydra.Sources.Tier2.Extras (hydraExtrasModule) 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


hydraExtrasDefinition :: String -> Datum a -> Definition a
hydraExtrasDefinition :: forall a. String -> Datum a -> Definition a
hydraExtrasDefinition = Module -> String -> Datum a -> Definition a
forall a. Module -> String -> Datum a -> Definition a
definitionInModule Module
hydraExtrasModule

hydraExtrasModule :: Module
hydraExtrasModule :: Module
hydraExtrasModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module (String -> Namespace
Namespace String
"hydra/extras") [Element]
elements
    [Module
hydraGraphModule, Module
hydraMantleModule, Module
hydraComputeModule]
    [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
"Basic functions which depend on primitive functions"
  where
    elements :: [Element]
elements = [
      Definition (Function -> Int) -> Element
forall a. Definition a -> Element
el Definition (Function -> Int)
functionArityDef,
      Definition (Graph -> Name -> Maybe Primitive) -> Element
forall a. Definition a -> Element
el Definition (Graph -> Name -> Maybe Primitive)
lookupPrimitiveDef,
      Definition (Primitive -> Int) -> Element
forall a. Definition a -> Element
el Definition (Primitive -> Int)
primitiveArityDef,
      Definition (Namespace -> String -> Name) -> Element
forall a. Definition a -> Element
el Definition (Namespace -> String -> Name)
qnameDef,
      Definition (Term -> Int) -> Element
forall a. Definition a -> Element
el Definition (Term -> Int)
termArityDef,
      Definition (Type -> Int) -> Element
forall a. Definition a -> Element
el Definition (Type -> Int)
typeArityDef,
      Definition (Type -> [Type]) -> Element
forall a. Definition a -> Element
el Definition (Type -> [Type])
uncurryTypeDef,
      Definition (String -> Map String Term -> Maybe Term) -> Element
forall a. Definition a -> Element
el Definition (String -> Map String Term -> Maybe Term)
getAnnotationDef
--      el getAttrDef
      ]

functionArityDef :: Definition (Function -> Int)
functionArityDef :: Definition (Function -> Int)
functionArityDef = String -> Datum (Function -> Int) -> Definition (Function -> Int)
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"functionArity" (Datum (Function -> Int) -> Definition (Function -> Int))
-> Datum (Function -> Int) -> Definition (Function -> Int)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> Datum (Function -> Int) -> Datum (Function -> Int)
forall a. Type -> Type -> Datum a -> Datum a
function (Name -> Type
TypeVariable Name
_Function) Type
Types.int32 (Datum (Function -> Int) -> Datum (Function -> Int))
-> Datum (Function -> Int) -> Datum (Function -> Int)
forall a b. (a -> b) -> a -> b
$
  Name -> Maybe (Datum Int) -> [Field] -> Datum (Function -> Int)
forall b u. Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)
match Name
_Function Maybe (Datum Int)
forall a. Maybe a
Nothing [
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Function_elimination Case Any -> Datum (Any -> Int) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum Int -> Datum (Any -> Int)
forall a b. Datum a -> Datum (b -> a)
constant (Int -> Datum Int
int32 Int
1),
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Function_lambda Case Any -> Datum (Any -> Int) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> (Datum (Int -> Int -> Int)
Math.add Datum (Int -> Int -> Int) -> Datum Int -> Datum (Int -> Int)
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ Int -> Datum Int
int32 Int
1) Datum (Int -> Int) -> Datum (Any -> Int) -> Datum (Any -> Int)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> (Definition (Term -> Int) -> Datum (Term -> Int)
forall a. Definition a -> Datum a
ref Definition (Term -> Int)
termArityDef Datum (Term -> Int) -> Datum (Any -> Term) -> Datum (Any -> Int)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> Name -> Name -> Datum (Any -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Lambda Name
_Lambda_body),
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Function_primitive Case Any -> Datum (Any -> Int) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum Int -> Datum (Any -> Int)
forall a b. Datum a -> Datum (b -> a)
constant (Datum Int -> Datum (Any -> Int))
-> Datum Int -> Datum (Any -> Int)
forall a b. (a -> b) -> a -> b
$
      String -> Datum Int -> Datum Int
forall a. String -> Datum a -> Datum a
doc String
"TODO: This function needs to be monadic, so we can look up the primitive" (Int -> Datum Int
int32 Int
42)]

lookupPrimitiveDef :: Definition (Graph -> Name -> Maybe (Primitive))
lookupPrimitiveDef :: Definition (Graph -> Name -> Maybe Primitive)
lookupPrimitiveDef = String
-> Datum (Graph -> Name -> Maybe Primitive)
-> Definition (Graph -> Name -> Maybe Primitive)
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"lookupPrimitive" (Datum (Graph -> Name -> Maybe Primitive)
 -> Definition (Graph -> Name -> Maybe Primitive))
-> Datum (Graph -> Name -> Maybe Primitive)
-> Definition (Graph -> Name -> Maybe Primitive)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> Datum (Graph -> Name -> Maybe Primitive)
-> Datum (Graph -> Name -> Maybe Primitive)
forall a. Type -> Type -> Datum a -> Datum a
function
    Type
graphT
    (Type -> Type -> Type
Types.function Type
nameT (Type -> Type
optionalT Type
primitiveT)) (Datum (Graph -> Name -> Maybe Primitive)
 -> Datum (Graph -> Name -> Maybe Primitive))
-> Datum (Graph -> Name -> Maybe Primitive)
-> Datum (Graph -> Name -> Maybe Primitive)
forall a b. (a -> b) -> a -> b
$
  String
-> Datum (Any -> Any) -> Datum (Graph -> Name -> Maybe Primitive)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"g" (Datum (Any -> Any) -> Datum (Graph -> Name -> Maybe Primitive))
-> Datum (Any -> Any) -> Datum (Graph -> Name -> Maybe Primitive)
forall a b. (a -> b) -> a -> b
$ String -> Datum (Maybe Any) -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"name" (Datum (Maybe Any) -> Datum (Any -> Any))
-> Datum (Maybe Any) -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$
    Datum (Map Any Any -> Maybe Any)
-> Datum (Map Any Any) -> Datum (Maybe Any)
forall a b. Datum (a -> b) -> Datum a -> Datum b
apply (Datum (Any -> Map Any Any -> Maybe Any)
forall k v. Datum (k -> Map k v -> Maybe v)
Maps.lookup Datum (Any -> Map Any Any -> Maybe Any)
-> Datum Any -> Datum (Map Any Any -> Maybe Any)
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"name") (Name -> Name -> Datum (Any -> Map Any Any)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Graph Name
_Graph_primitives Datum (Any -> Map Any Any) -> Datum Any -> Datum (Map Any Any)
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"g")

primitiveArityDef :: Definition (Primitive -> Int)
primitiveArityDef :: Definition (Primitive -> Int)
primitiveArityDef = String -> Datum (Primitive -> Int) -> Definition (Primitive -> Int)
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"primitiveArity" (Datum (Primitive -> Int) -> Definition (Primitive -> Int))
-> Datum (Primitive -> Int) -> Definition (Primitive -> Int)
forall a b. (a -> b) -> a -> b
$
  String -> Datum (Primitive -> Int) -> Datum (Primitive -> Int)
forall a. String -> Datum a -> Datum a
doc String
"Find the arity (expected number of arguments) of a primitive constant or function" (Datum (Primitive -> Int) -> Datum (Primitive -> Int))
-> Datum (Primitive -> Int) -> Datum (Primitive -> Int)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type -> Datum (Primitive -> Int) -> Datum (Primitive -> Int)
forall a. Type -> Type -> Datum a -> Datum a
function Type
primitiveT Type
Types.int32 (Datum (Primitive -> Int) -> Datum (Primitive -> Int))
-> Datum (Primitive -> Int) -> Datum (Primitive -> Int)
forall a b. (a -> b) -> a -> b
$
  (Definition (Type -> Int) -> Datum (Type -> Int)
forall a. Definition a -> Datum a
ref Definition (Type -> Int)
typeArityDef Datum (Type -> Int)
-> Datum (Primitive -> Type) -> Datum (Primitive -> Int)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> (Name -> Name -> Datum (Primitive -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Primitive Name
_Primitive_type))

qnameDef :: Definition (Namespace -> String -> Name)
qnameDef :: Definition (Namespace -> String -> Name)
qnameDef = String
-> Datum (Namespace -> String -> Name)
-> Definition (Namespace -> String -> Name)
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"qname" (Datum (Namespace -> String -> Name)
 -> Definition (Namespace -> String -> Name))
-> Datum (Namespace -> String -> Name)
-> Definition (Namespace -> String -> Name)
forall a b. (a -> b) -> a -> b
$
  String
-> Datum (Namespace -> String -> Name)
-> Datum (Namespace -> String -> Name)
forall a. String -> Datum a -> Datum a
doc String
"Construct a qualified (dot-separated) name" (Datum (Namespace -> String -> Name)
 -> Datum (Namespace -> String -> Name))
-> Datum (Namespace -> String -> Name)
-> Datum (Namespace -> String -> Name)
forall a b. (a -> b) -> a -> b
$
  [Type]
-> Datum (Namespace -> String -> Name)
-> Datum (Namespace -> String -> Name)
forall a. [Type] -> Datum a -> Datum a
functionN [Type
namespaceT, Type
stringT, Type
nameT] (Datum (Namespace -> String -> Name)
 -> Datum (Namespace -> String -> Name))
-> Datum (Namespace -> String -> Name)
-> Datum (Namespace -> String -> Name)
forall a b. (a -> b) -> a -> b
$
  String -> Datum (Any -> Any) -> Datum (Namespace -> String -> Name)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"ns" (Datum (Any -> Any) -> Datum (Namespace -> String -> Name))
-> Datum (Any -> Any) -> Datum (Namespace -> String -> Name)
forall a b. (a -> b) -> a -> b
$ String -> Datum Any -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"name" (Datum Any -> Datum (Any -> Any))
-> Datum Any -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$
    Name -> Datum String -> Datum Any
forall a b. Name -> Datum a -> Datum b
nom Name
_Name (Datum String -> Datum Any) -> Datum String -> Datum Any
forall a b. (a -> b) -> a -> b
$
      Datum ([String] -> String) -> Datum [String] -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
apply Datum ([String] -> String)
Strings.cat (Datum [String] -> Datum String) -> Datum [String] -> Datum String
forall a b. (a -> b) -> a -> b
$
        [Datum String] -> Datum [String]
forall a. [Datum a] -> Datum [a]
list [Datum (Any -> String) -> Datum Any -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
apply (Name -> Datum (Any -> String)
forall a b. Name -> Datum (a -> b)
unwrap Name
_Namespace) (String -> Datum Any
forall a. String -> Datum a
var String
"ns"), String -> Datum String
string String
".", String -> Datum String
forall a. String -> Datum a
var String
"name"]

termArityDef :: Definition (Term -> Int)
termArityDef :: Definition (Term -> Int)
termArityDef = String -> Datum (Term -> Int) -> Definition (Term -> Int)
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"termArity" (Datum (Term -> Int) -> Definition (Term -> Int))
-> Datum (Term -> Int) -> Definition (Term -> Int)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> Datum (Term -> Int) -> Datum (Term -> Int)
forall a. Type -> Type -> Datum a -> Datum a
function Type
termT Type
Types.int32 (Datum (Term -> Int) -> Datum (Term -> Int))
-> Datum (Term -> Int) -> Datum (Term -> Int)
forall a b. (a -> b) -> a -> b
$
  Name -> Maybe (Datum Int) -> [Field] -> Datum (Term -> Int)
forall b u. Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)
match Name
_Term (Datum Int -> Maybe (Datum Int)
forall a. a -> Maybe a
Just (Datum Int -> Maybe (Datum Int)) -> Datum Int -> Maybe (Datum Int)
forall a b. (a -> b) -> a -> b
$ Int -> Datum Int
int32 Int
0) [
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Term_application Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> (String -> Datum Int -> Datum (Int -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"x" (Datum Int -> Datum (Int -> Any))
-> Datum Int -> Datum (Int -> Any)
forall a b. (a -> b) -> a -> b
$ Datum (Int -> Int -> Int)
Math.sub Datum (Int -> Int -> Int) -> Datum Int -> Datum (Int -> Int)
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Int
forall a. String -> Datum a
var String
"x" Datum (Int -> Int) -> Datum Int -> Datum Int
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ Int -> Datum Int
int32 Int
1) Datum (Int -> Any) -> Datum (Any -> Int) -> Datum (Any -> Any)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> (Definition (Term -> Int) -> Datum (Term -> Int)
forall a. Definition a -> Datum a
ref Definition (Term -> Int)
termArityDef Datum (Term -> Int) -> Datum (Any -> Term) -> Datum (Any -> Int)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> (Name -> Name -> Datum (Any -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Application Name
_Application_function)),
    Name -> Case Function
forall a. Name -> Case a
Case Name
_Term_function Case Function -> Datum (Function -> Int) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Definition (Function -> Int) -> Datum (Function -> Int)
forall a. Definition a -> Datum a
ref Definition (Function -> Int)
functionArityDef]
    -- Note: ignoring variables which might resolve to functions

typeArityDef :: Definition (Type -> Int)
typeArityDef :: Definition (Type -> Int)
typeArityDef = String -> Datum (Type -> Int) -> Definition (Type -> Int)
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"typeArity" (Datum (Type -> Int) -> Definition (Type -> Int))
-> Datum (Type -> Int) -> Definition (Type -> Int)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> Datum (Type -> Int) -> Datum (Type -> Int)
forall a. Type -> Type -> Datum a -> Datum a
function Type
typeT Type
Types.int32 (Datum (Type -> Int) -> Datum (Type -> Int))
-> Datum (Type -> Int) -> Datum (Type -> Int)
forall a b. (a -> b) -> a -> b
$
  Name -> Maybe (Datum Int) -> [Field] -> Datum (Type -> Int)
forall b u. Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)
match Name
_Type (Datum Int -> Maybe (Datum Int)
forall a. a -> Maybe a
Just (Datum Int -> Maybe (Datum Int)) -> Datum Int -> Maybe (Datum Int)
forall a b. (a -> b) -> a -> b
$ Int -> Datum Int
int32 Int
0) [
    Name -> Case AnnotatedType
forall a. Name -> Case a
Case Name
_Type_annotated Case AnnotatedType -> Datum (AnnotatedType -> Int) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Definition (Type -> Int) -> Datum (Type -> Int)
forall a. Definition a -> Datum a
ref Definition (Type -> Int)
typeArityDef Datum (Type -> Int)
-> Datum (AnnotatedType -> Type) -> Datum (AnnotatedType -> Int)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> Datum (AnnotatedType -> Type)
Core.annotatedTypeSubject,
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_application Case Any -> Datum (Any -> Int) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Definition (Type -> Int) -> Datum (Type -> Int)
forall a. Definition a -> Datum a
ref Definition (Type -> Int)
typeArityDef Datum (Type -> Int) -> Datum (Any -> Type) -> Datum (Any -> Int)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_ApplicationType Name
_ApplicationType_function),
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_lambda Case Any -> Datum (Any -> Int) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Definition (Type -> Int) -> Datum (Type -> Int)
forall a. Definition a -> Datum a
ref Definition (Type -> Int)
typeArityDef Datum (Type -> Int) -> Datum (Any -> Type) -> Datum (Any -> Int)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_LambdaType Name
_LambdaType_body),
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_function Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum Int -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"f" (Datum Int -> Datum (Any -> Any))
-> Datum Int -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$
      Datum (Int -> Int -> Int)
Math.add Datum (Int -> Int -> Int) -> Datum Int -> Datum (Int -> Int)
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Int -> Datum Int
int32 Int
1) Datum (Int -> Int) -> Datum Int -> Datum Int
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Definition (Type -> Int) -> Datum (Type -> Int)
forall a. Definition a -> Datum a
ref Definition (Type -> Int)
typeArityDef Datum (Type -> Int) -> Datum Type -> Datum Int
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Datum (Any -> Type) -> Datum Any -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
apply (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_FunctionType Name
_FunctionType_codomain) (String -> Datum Any
forall a. String -> Datum a
var String
"f")))]

uncurryTypeDef :: Definition (Type -> [Type])
uncurryTypeDef :: Definition (Type -> [Type])
uncurryTypeDef = String -> Datum (Type -> [Type]) -> Definition (Type -> [Type])
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"uncurryType" (Datum (Type -> [Type]) -> Definition (Type -> [Type]))
-> Datum (Type -> [Type]) -> Definition (Type -> [Type])
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> Datum (Type -> [Type]) -> Datum (Type -> [Type])
forall a. Type -> Type -> Datum a -> Datum a
function Type
typeT (Type -> Type
listT Type
typeT) (Datum (Type -> [Type]) -> Datum (Type -> [Type]))
-> Datum (Type -> [Type]) -> Datum (Type -> [Type])
forall a b. (a -> b) -> a -> b
$
  String -> Datum (Type -> [Type]) -> Datum (Type -> [Type])
forall a. String -> Datum a -> Datum a
doc String
"Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b)" (Datum (Type -> [Type]) -> Datum (Type -> [Type]))
-> Datum (Type -> [Type]) -> Datum (Type -> [Type])
forall a b. (a -> b) -> a -> b
$
  String -> Datum [Any] -> Datum (Type -> [Type])
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" ((Name -> Maybe (Datum [Any]) -> [Field] -> Datum (Any -> [Any])
forall b u. Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)
match Name
_Type (Datum [Any] -> Maybe (Datum [Any])
forall a. a -> Maybe a
Just (Datum [Any] -> Maybe (Datum [Any]))
-> Datum [Any] -> Maybe (Datum [Any])
forall a b. (a -> b) -> a -> b
$ [Datum Any] -> Datum [Any]
forall a. [Datum a] -> Datum [a]
list [String -> Datum Any
forall a. String -> Datum a
var String
"t"]) [
    Name
_Type_annotatedName -> Datum (AnnotatedType -> [Type]) -> Field
forall a. Name -> Datum a -> Field
>>: Definition (Type -> [Type]) -> Datum (Type -> [Type])
forall a. Definition a -> Datum a
ref Definition (Type -> [Type])
uncurryTypeDef Datum (Type -> [Type])
-> Datum (AnnotatedType -> Type) -> Datum (AnnotatedType -> [Type])
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> Datum (AnnotatedType -> Type)
Core.annotatedTypeSubject,
    Name
_Type_applicationName -> Datum (ApplicationType -> [Type]) -> Field
forall a. Name -> Datum a -> Field
>>: Definition (Type -> [Type]) -> Datum (Type -> [Type])
forall a. Definition a -> Datum a
ref Definition (Type -> [Type])
uncurryTypeDef Datum (Type -> [Type])
-> Datum (ApplicationType -> Type)
-> Datum (ApplicationType -> [Type])
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> Datum (ApplicationType -> Type)
Core.applicationTypeFunction,
    Name
_Type_lambdaName -> Datum (LambdaType -> [Type]) -> Field
forall a. Name -> Datum a -> Field
>>: Definition (Type -> [Type]) -> Datum (Type -> [Type])
forall a. Definition a -> Datum a
ref Definition (Type -> [Type])
uncurryTypeDef Datum (Type -> [Type])
-> Datum (LambdaType -> Type) -> Datum (LambdaType -> [Type])
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> Datum (LambdaType -> Type)
Core.lambdaTypeBody,
    Name
_Type_functionName -> Datum (Any -> Any) -> Field
forall a. Name -> Datum a -> Field
>>: String -> Datum [Type] -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"ft" (Datum [Type] -> Datum (Any -> Any))
-> Datum [Type] -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ Datum (Type -> [Type] -> [Type])
forall a. Datum (a -> [a] -> [a])
Lists.cons
      Datum (Type -> [Type] -> [Type])
-> Datum Type -> Datum ([Type] -> [Type])
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Datum (FunctionType -> Type)
Core.functionTypeDomain Datum (FunctionType -> Type) -> Datum FunctionType -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum FunctionType
forall a. String -> Datum a
var String
"ft")
      Datum ([Type] -> [Type]) -> Datum [Type] -> Datum [Type]
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Definition (Type -> [Type]) -> Datum (Type -> [Type])
forall a. Definition a -> Datum a
ref Definition (Type -> [Type])
uncurryTypeDef Datum (Type -> [Type]) -> Datum Type -> Datum [Type]
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Datum (FunctionType -> Type)
Core.functionTypeCodomain Datum (FunctionType -> Type) -> Datum FunctionType -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum FunctionType
forall a. String -> Datum a
var String
"ft"))]) Datum (Any -> [Any]) -> Datum Any -> Datum [Any]
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"t")

-- hydra/kv

getAnnotationDef :: Definition (String -> M.Map String Term -> Maybe Term)
getAnnotationDef :: Definition (String -> Map String Term -> Maybe Term)
getAnnotationDef = String
-> Datum (String -> Map String Term -> Maybe Term)
-> Definition (String -> Map String Term -> Maybe Term)
forall a. String -> Datum a -> Definition a
hydraExtrasDefinition String
"getAnnotation" (Datum (String -> Map String Term -> Maybe Term)
 -> Definition (String -> Map String Term -> Maybe Term))
-> Datum (String -> Map String Term -> Maybe Term)
-> Definition (String -> Map String Term -> Maybe Term)
forall a b. (a -> b) -> a -> b
$
  [Type]
-> Datum (String -> Map String Term -> Maybe Term)
-> Datum (String -> Map String Term -> Maybe Term)
forall a. [Type] -> Datum a -> Datum a
functionN [Type
stringT, Type
kvT, Type -> Type
optionalT Type
termT] (Datum (String -> Map String Term -> Maybe Term)
 -> Datum (String -> Map String Term -> Maybe Term))
-> Datum (String -> Map String Term -> Maybe Term)
-> Datum (String -> Map String Term -> Maybe Term)
forall a b. (a -> b) -> a -> b
$
  String
-> Datum (Any -> Any)
-> Datum (String -> Map String Term -> Maybe Term)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"key" (Datum (Any -> Any)
 -> Datum (String -> Map String Term -> Maybe Term))
-> Datum (Any -> Any)
-> Datum (String -> Map String Term -> Maybe Term)
forall a b. (a -> b) -> a -> b
$ String -> Datum (Maybe Any) -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"ann" (Datum (Maybe Any) -> Datum (Any -> Any))
-> Datum (Maybe Any) -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$
    Datum (Any -> Map Any Any -> Maybe Any)
forall k v. Datum (k -> Map k v -> Maybe v)
Maps.lookup Datum (Any -> Map Any Any -> Maybe Any)
-> Datum Any -> Datum (Map Any Any -> Maybe Any)
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"key" Datum (Map Any Any -> Maybe Any)
-> Datum (Map Any Any) -> Datum (Maybe Any)
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum (Map Any Any)
forall a. String -> Datum a
var String
"ann"


--getAttrDef :: Definition (String -> Flow s (Maybe Term))
--getAttrDef = hydraExtrasDefinition "getAttr" $
--  lambda "key" $ wrap _Flow $
--    function Types.string (Types.apply (Types.apply (TypeVariable _Flow) (Types.var "s")) (Types.optional $ Types.apply (TypeVariable _Term) (TypeVariable _Kv))) $
--    lambda "s0" $ lambda "t0" $ record _FlowState [
--      fld _FlowState_value (just (Maps.lookup @@ var "key" @@ (project _Trace _Trace_other @@ var "t0"))),
--      fld _FlowState_state $ var "s0",
--      fld _FlowState_trace $ var "t0"]