module Hydra.Dsl.ShorthandTypes where

import Hydra.Coders
import Hydra.Core
import Hydra.Compute
import Hydra.Graph
import Hydra.Mantle
import Hydra.Module
import qualified Hydra.Dsl.Types as Types

import qualified Data.Map as M
import qualified Data.Set as S


eqA :: Map Name (Set TypeClass)
eqA = ([(Name, Set TypeClass)] -> Map Name (Set TypeClass)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String -> Name
Name String
"a", [TypeClass] -> Set TypeClass
forall a. Ord a => [a] -> Set a
S.fromList [TypeClass
TypeClassEquality])])
ordA :: Map Name (Set TypeClass)
ordA = ([(Name, Set TypeClass)] -> Map Name (Set TypeClass)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String -> Name
Name String
"a", [TypeClass] -> Set TypeClass
forall a. Ord a => [a] -> Set a
S.fromList [TypeClass
TypeClassOrdering])])

aT :: Type
aT = String -> Type
Types.var String
"a" :: Type
annotatedTermT :: Type
annotatedTermT = Name -> Type
TypeVariable Name
_AnnotatedTerm :: Type
annotatedTypeT :: Type
annotatedTypeT = Name -> Type
TypeVariable Name
_AnnotatedType :: Type
applicationT :: Type
applicationT = Name -> Type
TypeVariable Name
_Application :: Type
applicationTypeT :: Type
applicationTypeT = Name -> Type
TypeVariable Name
_ApplicationType :: Type
bT :: Type
bT = String -> Type
Types.var String
"b" :: Type
bigfloatT :: Type
bigfloatT = Type
Types.bigfloat
bigintT :: Type
bigintT = Type
Types.bigint
binaryT :: Type
binaryT = Type
Types.binary
booleanT :: Type
booleanT = Type
Types.boolean
cT :: Type
cT = String -> Type
Types.var String
"c" :: Type
caseStatementT :: Type
caseStatementT = Name -> Type
TypeVariable Name
_CaseStatement :: Type
elementT :: Type
elementT = Name -> Type
TypeVariable Name
_Element :: Type
eliminationT :: Type
eliminationT = Name -> Type
TypeVariable Name
_Elimination :: Type
eliminationVariantT :: Type
eliminationVariantT = Name -> Type
TypeVariable Name
_EliminationVariant :: Type
fieldT :: Type
fieldT = Name -> Type
TypeVariable Name
_Field :: Type
fieldNameT :: Type
fieldNameT = Name -> Type
TypeVariable Name
_Name :: Type
fieldTypeT :: Type
fieldTypeT = Name -> Type
TypeVariable Name
_FieldType :: Type
fileExtensionT :: Type
fileExtensionT = Name -> Type
TypeVariable Name
_FileExtension :: Type
float32T :: Type
float32T = Type
Types.float32
float64T :: Type
float64T = Type
Types.float64
floatTypeT :: Type
floatTypeT = Name -> Type
TypeVariable Name
_FloatType :: Type
floatValueT :: Type
floatValueT = Name -> Type
TypeVariable Name
_FloatValue :: Type
flowS1AT :: Type
flowS1AT = Type -> Type -> Type
flowT (String -> Type
Types.var String
"s1") Type
aT :: Type
flowS2AT :: Type
flowS2AT = Type -> Type -> Type
flowT (String -> Type
Types.var String
"s2") Type
aT :: Type
flowSAT :: Type
flowSAT = Type -> Type -> Type
flowT Type
sT Type
aT :: Type
flowSST :: Type
flowSST = Type -> Type -> Type
flowT Type
sT Type
sT :: Type
flowStateT :: Type -> Type -> Type
flowStateT Type
s Type
x = Type -> Type -> Type
Types.apply (Type -> Type -> Type
Types.apply (Name -> Type
TypeVariable Name
_FlowState) Type
s) Type
x
flowT :: Type -> Type -> Type
flowT Type
s Type
x = Type -> Type -> Type
Types.apply (Type -> Type -> Type
Types.apply (Name -> Type
TypeVariable Name
_Flow) Type
s) Type
x
funT :: Type -> Type -> Type
funT = Type -> Type -> Type
Types.function
functionT :: Type
functionT = Name -> Type
TypeVariable Name
_Function :: Type
functionTypeT :: Type
functionTypeT = Name -> Type
TypeVariable Name
_FunctionType :: Type
functionVariantT :: Type
functionVariantT = Name -> Type
TypeVariable Name
_FunctionVariant :: Type
graphT :: Type
graphT = Name -> Type
TypeVariable Name
_Graph :: Type
injectionT :: Type
injectionT = Name -> Type
TypeVariable Name
_Injection :: Type
int8T :: Type
int8T = Type
Types.int8
int16T :: Type
int16T = Type
Types.int16
int32T :: Type
int32T = Type
Types.int32
int64T :: Type
int64T = Type
Types.int64
integerTypeT :: Type
integerTypeT = Name -> Type
TypeVariable Name
_IntegerType :: Type
integerValueT :: Type
integerValueT = Name -> Type
TypeVariable Name
_IntegerValue :: Type
kvT :: Type
kvT = Type -> Type -> Type
mapT Type
nameT Type
termT :: Type
lambdaT :: Type
lambdaT = Name -> Type
TypeVariable Name
_Lambda :: Type
lambdaTypeT :: Type
lambdaTypeT = Name -> Type
TypeVariable Name
_LambdaType :: Type
languageT :: Type
languageT = Name -> Type
TypeVariable Name
_Language :: Type
letT :: Type
letT = Name -> Type
TypeVariable Name
_Let :: Type
letBindingT :: Type
letBindingT = Name -> Type
TypeVariable Name
_LetBinding :: Type
listT :: Type -> Type
listT = Type -> Type
Types.list
literalT :: Type
literalT = Name -> Type
TypeVariable Name
_Literal :: Type
literalTypeT :: Type
literalTypeT = Name -> Type
TypeVariable Name
_LiteralType :: Type
literalVariantT :: Type
literalVariantT = Name -> Type
TypeVariable Name
_LiteralVariant :: Type
mapT :: Type -> Type -> Type
mapT = Type -> Type -> Type
Types.map
mapTypeT :: Type
mapTypeT = Name -> Type
TypeVariable Name
_MapType :: Type
nameT :: Type
nameT = Name -> Type
TypeVariable Name
_Name
namespaceT :: Type
namespaceT = Name -> Type
TypeVariable Name
_Namespace
optionalT :: Type -> Type
optionalT = Type -> Type
Types.optional
optionalCasesT :: Type
optionalCasesT = Name -> Type
TypeVariable Name
_OptionalCases :: Type
pairT :: Type -> Type -> Type
pairT = Type -> Type -> Type
Types.pair
precisionT :: Type
precisionT = Name -> Type
TypeVariable Name
_Precision :: Type
primitiveT :: Type
primitiveT = Name -> Type
TypeVariable Name
_Primitive :: Type
projectionT :: Type
projectionT = Name -> Type
TypeVariable Name
_Projection :: Type
qualifiedNameT :: Type
qualifiedNameT = Name -> Type
TypeVariable Name
_QualifiedName
recordT :: Type
recordT = Name -> Type
TypeVariable Name
_Record :: Type
rowTypeT :: Type
rowTypeT = Name -> Type
TypeVariable Name
_RowType :: Type
sT :: Type
sT = String -> Type
Types.var String
"s" :: Type
setT :: Type -> Type
setT = Type -> Type
TypeSet
stringT :: Type
stringT = Type
Types.string :: Type
sumT :: Type
sumT = Name -> Type
TypeVariable Name
_Sum :: Type
termT :: Type
termT = Name -> Type
TypeVariable Name
_Term :: Type
termAccessorT :: Type
termAccessorT = Name -> Type
TypeVariable Name
_TermAccessor :: Type
termVariantT :: Type
termVariantT = Name -> Type
TypeVariable Name
_TermVariant :: Type
traceT :: Type
traceT = Name -> Type
TypeVariable Name
_Trace
tupleProjectionT :: Type
tupleProjectionT = Name -> Type
TypeVariable Name
_TupleProjection :: Type
typeT :: Type
typeT = Name -> Type
TypeVariable Name
_Type :: Type
typeAbstractionT :: Type
typeAbstractionT = Name -> Type
TypeVariable Name
_TypeAbstraction :: Type
typeSchemeT :: Type
typeSchemeT = Name -> Type
TypeVariable Name
_TypeScheme :: Type
typedTermT :: Type
typedTermT = Name -> Type
TypeVariable Name
_TypedTerm :: Type
typeVariantT :: Type
typeVariantT = Name -> Type
TypeVariable Name
_TypeVariant :: Type
uint8T :: Type
uint8T = Type
Types.uint8
uint16T :: Type
uint16T = Type
Types.uint16
uint32T :: Type
uint32T = Type
Types.uint32
uint64T :: Type
uint64T = Type
Types.uint64
unitT :: Type
unitT = Type
Types.unit :: Type
wrappedTermT :: Type
wrappedTermT = Name -> Type
TypeVariable Name
_WrappedTerm :: Type
wrappedTypeT :: Type
wrappedTypeT = Name -> Type
TypeVariable Name
_WrappedType :: Type
xT :: Type
xT = String -> Type
Types.var String
"x" :: Type