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 -> TTerm a -> TElement a
hydraExtrasDefinition :: forall a. String -> TTerm a -> TElement a
hydraExtrasDefinition = Module -> String -> TTerm a -> TElement a
forall a. Module -> String -> TTerm a -> TElement 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 = [
      TElement (Function -> Int) -> Element
forall a. TElement a -> Element
el TElement (Function -> Int)
functionArityDef,
      TElement (Graph -> Name -> Maybe Primitive) -> Element
forall a. TElement a -> Element
el TElement (Graph -> Name -> Maybe Primitive)
lookupPrimitiveDef,
      TElement (Primitive -> Int) -> Element
forall a. TElement a -> Element
el TElement (Primitive -> Int)
primitiveArityDef,
      TElement (Namespace -> String -> Name) -> Element
forall a. TElement a -> Element
el TElement (Namespace -> String -> Name)
qnameDef,
      TElement (Term -> Int) -> Element
forall a. TElement a -> Element
el TElement (Term -> Int)
termArityDef,
      TElement (Type -> Int) -> Element
forall a. TElement a -> Element
el TElement (Type -> Int)
typeArityDef,
      TElement (Type -> [Type]) -> Element
forall a. TElement a -> Element
el TElement (Type -> [Type])
uncurryTypeDef,
      TElement (Name -> Map Name Term -> Maybe Term) -> Element
forall a. TElement a -> Element
el TElement (Name -> Map Name Term -> Maybe Term)
getAnnotationDef
      ]

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

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

primitiveArityDef :: TElement (Primitive -> Int)
primitiveArityDef :: TElement (Primitive -> Int)
primitiveArityDef = String -> TTerm (Primitive -> Int) -> TElement (Primitive -> Int)
forall a. String -> TTerm a -> TElement a
hydraExtrasDefinition String
"primitiveArity" (TTerm (Primitive -> Int) -> TElement (Primitive -> Int))
-> TTerm (Primitive -> Int) -> TElement (Primitive -> Int)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (Primitive -> Int) -> TTerm (Primitive -> Int)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the arity (expected number of arguments) of a primitive constant or function" (TTerm (Primitive -> Int) -> TTerm (Primitive -> Int))
-> TTerm (Primitive -> Int) -> TTerm (Primitive -> Int)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type -> TTerm (Primitive -> Int) -> TTerm (Primitive -> Int)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
primitiveT Type
Types.int32 (TTerm (Primitive -> Int) -> TTerm (Primitive -> Int))
-> TTerm (Primitive -> Int) -> TTerm (Primitive -> Int)
forall a b. (a -> b) -> a -> b
$
  (TElement (Type -> Int) -> TTerm (Type -> Int)
forall a. TElement a -> TTerm a
ref TElement (Type -> Int)
typeArityDef TTerm (Type -> Int)
-> TTerm (TypeScheme -> Type) -> TTerm (TypeScheme -> Int)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TTerm (TypeScheme -> Type)
Core.typeSchemeType TTerm (TypeScheme -> Int)
-> TTerm (Primitive -> TypeScheme) -> TTerm (Primitive -> Int)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TTerm (Primitive -> TypeScheme)
Graph.primitiveType)

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

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

typeArityDef :: TElement (Type -> Int)
typeArityDef :: TElement (Type -> Int)
typeArityDef = String -> TTerm (Type -> Int) -> TElement (Type -> Int)
forall a. String -> TTerm a -> TElement a
hydraExtrasDefinition String
"typeArity" (TTerm (Type -> Int) -> TElement (Type -> Int))
-> TTerm (Type -> Int) -> TElement (Type -> Int)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Type -> Int) -> TTerm (Type -> Int)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
typeT Type
Types.int32 (TTerm (Type -> Int) -> TTerm (Type -> Int))
-> TTerm (Type -> Int) -> TTerm (Type -> Int)
forall a b. (a -> b) -> a -> b
$
  Name -> Maybe (TTerm Int) -> [Field] -> TTerm (Type -> Int)
forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
_Type (TTerm Int -> Maybe (TTerm Int)
forall a. a -> Maybe a
Just (TTerm Int -> Maybe (TTerm Int)) -> TTerm Int -> Maybe (TTerm Int)
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int32 Int
0) [
    Name -> TCase AnnotatedType
forall a. Name -> TCase a
TCase Name
_Type_annotated TCase AnnotatedType -> TTerm (AnnotatedType -> Int) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> TElement (Type -> Int) -> TTerm (Type -> Int)
forall a. TElement a -> TTerm a
ref TElement (Type -> Int)
typeArityDef TTerm (Type -> Int)
-> TTerm (AnnotatedType -> Type) -> TTerm (AnnotatedType -> Int)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TTerm (AnnotatedType -> Type)
Core.annotatedTypeSubject,
    Name -> TCase ApplicationType
forall a. Name -> TCase a
TCase Name
_Type_application TCase ApplicationType -> TTerm (ApplicationType -> Int) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> TElement (Type -> Int) -> TTerm (Type -> Int)
forall a. TElement a -> TTerm a
ref TElement (Type -> Int)
typeArityDef TTerm (Type -> Int)
-> TTerm (ApplicationType -> Type)
-> TTerm (ApplicationType -> Int)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TTerm (ApplicationType -> Type)
Core.applicationTypeFunction,
    Name -> TCase LambdaType
forall a. Name -> TCase a
TCase Name
_Type_lambda TCase LambdaType -> TTerm (LambdaType -> Int) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> TElement (Type -> Int) -> TTerm (Type -> Int)
forall a. TElement a -> TTerm a
ref TElement (Type -> Int)
typeArityDef TTerm (Type -> Int)
-> TTerm (LambdaType -> Type) -> TTerm (LambdaType -> Int)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TTerm (LambdaType -> Type)
Core.lambdaTypeBody,
    Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Type_function TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> String -> TTerm Int -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"f" (TTerm Int -> TTerm (Any -> Any))
-> TTerm Int -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
      TTerm (Int -> Int -> Int)
Math.add TTerm (Int -> Int -> Int) -> TTerm Int -> TTerm (Int -> Int)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (Int -> TTerm Int
int32 Int
1) TTerm (Int -> Int) -> TTerm Int -> TTerm Int
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TElement (Type -> Int) -> TTerm (Type -> Int)
forall a. TElement a -> TTerm a
ref TElement (Type -> Int)
typeArityDef TTerm (Type -> Int) -> TTerm Type -> TTerm Int
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (FunctionType -> Type)
Core.functionTypeCodomain TTerm (FunctionType -> Type) -> TTerm FunctionType -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm FunctionType
forall a. String -> TTerm a
var String
"f"))]

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

-- hydra/annotations

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