{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier2.Basics 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


basicsDefinition :: String -> TTerm a -> TElement a
basicsDefinition :: forall a. String -> TTerm a -> TElement a
basicsDefinition = Module -> String -> TTerm a -> TElement a
forall a. Module -> String -> TTerm a -> TElement a
definitionInModule Module
hydraBasicsModule

hydraBasicsModule :: Module
hydraBasicsModule :: Module
hydraBasicsModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module (String -> Namespace
Namespace String
"hydra/basics") [Element]
elements
    [Module
hydraTier1Module]
    [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 tier-2 module of basic functions for working with types and terms."
  where
   elements :: [Element]
elements = [
     TElement (Elimination -> EliminationVariant) -> Element
forall a. TElement a -> Element
el TElement (Elimination -> EliminationVariant)
eliminationVariantDef,
     TElement [EliminationVariant] -> Element
forall a. TElement a -> Element
el TElement [EliminationVariant]
eliminationVariantsDef,
     TElement (FloatType -> Precision) -> Element
forall a. TElement a -> Element
el TElement (FloatType -> Precision)
floatTypePrecisionDef,
     TElement [FloatType] -> Element
forall a. TElement a -> Element
el TElement [FloatType]
floatTypesDef,
     TElement (FloatValue -> FloatType) -> Element
forall a. TElement a -> Element
el TElement (FloatValue -> FloatType)
floatValueTypeDef,
     TElement (Function -> FunctionVariant) -> Element
forall a. TElement a -> Element
el TElement (Function -> FunctionVariant)
functionVariantDef,
     TElement [FunctionVariant] -> Element
forall a. TElement a -> Element
el TElement [FunctionVariant]
functionVariantsDef,
     TElement (Any -> Any) -> Element
forall a. TElement a -> Element
el TElement (Any -> Any)
forall a. TElement (a -> a)
idDef,
     TElement (IntegerType -> Bool) -> Element
forall a. TElement a -> Element
el TElement (IntegerType -> Bool)
integerTypeIsSignedDef,
     TElement (IntegerType -> Precision) -> Element
forall a. TElement a -> Element
el TElement (IntegerType -> Precision)
integerTypePrecisionDef,
     TElement [IntegerType] -> Element
forall a. TElement a -> Element
el TElement [IntegerType]
integerTypesDef,
     TElement (IntegerValue -> IntegerType) -> Element
forall a. TElement a -> Element
el TElement (IntegerValue -> IntegerType)
integerValueTypeDef,
     TElement (Literal -> LiteralType) -> Element
forall a. TElement a -> Element
el TElement (Literal -> LiteralType)
literalTypeDef,
     TElement (LiteralType -> LiteralVariant) -> Element
forall a. TElement a -> Element
el TElement (LiteralType -> LiteralVariant)
literalTypeVariantDef,
     TElement (Literal -> LiteralVariant) -> Element
forall a. TElement a -> Element
el TElement (Literal -> LiteralVariant)
literalVariantDef,
     TElement [LiteralVariant] -> Element
forall a. TElement a -> Element
el TElement [LiteralVariant]
literalVariantsDef,
     TElement (Term -> TermVariant) -> Element
forall a. TElement a -> Element
el TElement (Term -> TermVariant)
termVariantDef,
     TElement [TermVariant] -> Element
forall a. TElement a -> Element
el TElement [TermVariant]
termVariantsDef,
     TElement (Type -> TypeVariant) -> Element
forall a. TElement a -> Element
el TElement (Type -> TypeVariant)
typeVariantDef,
     TElement [TypeVariant] -> Element
forall a. TElement a -> Element
el TElement [TypeVariant]
typeVariantsDef,
     -- Formatting.hs
     TElement (String -> String) -> Element
forall a. TElement a -> Element
el TElement (String -> String)
capitalizeDef,
     TElement (String -> String) -> Element
forall a. TElement a -> Element
el TElement (String -> String)
decapitalizeDef,
     TElement ((String -> String) -> String -> String) -> Element
forall a. TElement a -> Element
el TElement ((String -> String) -> String -> String)
mapFirstLetterDef,
     -- Common.hs
     TElement ([Field] -> Map Name Term) -> Element
forall a. TElement a -> Element
el TElement ([Field] -> Map Name Term)
fieldMapDef,
     TElement ([FieldType] -> Map Name Type) -> Element
forall a. TElement a -> Element
el TElement ([FieldType] -> Map Name Type)
fieldTypeMapDef,
     TElement (Term -> Bool) -> Element
forall a. TElement a -> Element
el TElement (Term -> Bool)
isEncodedTypeDef,
     TElement (Type -> Bool) -> Element
forall a. TElement a -> Element
el TElement (Type -> Bool)
isTypeDef,
     TElement (Term -> Bool) -> Element
forall a. TElement a -> Element
el TElement (Term -> Bool)
isUnitTermDef,
     TElement (Term -> Bool) -> Element
forall a. TElement a -> Element
el TElement (Term -> Bool)
isUnitTypeDef,
     TElement (Graph -> Maybe Graph -> [Element] -> Graph) -> Element
forall a. TElement a -> Element
el TElement (Graph -> Maybe Graph -> [Element] -> Graph)
elementsToGraphDef,
     TElement (Name -> String) -> Element
forall a. TElement a -> Element
el TElement (Name -> String)
localNameOfEagerDef,
     TElement (Name -> String) -> Element
forall a. TElement a -> Element
el TElement (Name -> String)
localNameOfLazyDef,
     TElement (Name -> Maybe Namespace) -> Element
forall a. TElement a -> Element
el TElement (Name -> Maybe Namespace)
namespaceOfEagerDef,
     TElement (Name -> Maybe Namespace) -> Element
forall a. TElement a -> Element
el TElement (Name -> Maybe Namespace)
namespaceOfLazyDef,
     TElement (Bool -> FileExtension -> Namespace -> String) -> Element
forall a. TElement a -> Element
el TElement (Bool -> FileExtension -> Namespace -> String)
namespaceToFilePathDef,
     TElement (Name -> QualifiedName) -> Element
forall a. TElement a -> Element
el TElement (Name -> QualifiedName)
qualifyNameEagerDef,
     TElement (Name -> QualifiedName) -> Element
forall a. TElement a -> Element
el TElement (Name -> QualifiedName)
qualifyNameLazyDef
     ]

eliminationVariantDef :: TElement (Elimination -> EliminationVariant)
eliminationVariantDef :: TElement (Elimination -> EliminationVariant)
eliminationVariantDef = String
-> TTerm (Elimination -> EliminationVariant)
-> TElement (Elimination -> EliminationVariant)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"eliminationVariant" (TTerm (Elimination -> EliminationVariant)
 -> TElement (Elimination -> EliminationVariant))
-> TTerm (Elimination -> EliminationVariant)
-> TElement (Elimination -> EliminationVariant)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Elimination -> EliminationVariant)
-> TTerm (Elimination -> EliminationVariant)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the elimination variant (constructor) for a given elimination term" (TTerm (Elimination -> EliminationVariant)
 -> TTerm (Elimination -> EliminationVariant))
-> TTerm (Elimination -> EliminationVariant)
-> TTerm (Elimination -> EliminationVariant)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Elimination -> EliminationVariant)
-> TTerm (Elimination -> EliminationVariant)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
eliminationT Type
eliminationVariantT (TTerm (Elimination -> EliminationVariant)
 -> TTerm (Elimination -> EliminationVariant))
-> TTerm (Elimination -> EliminationVariant)
-> TTerm (Elimination -> EliminationVariant)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm EliminationVariant)
-> [(Name, Name)]
-> TTerm (Elimination -> EliminationVariant)
forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
_Elimination Name
_EliminationVariant Maybe (TTerm EliminationVariant)
forall a. Maybe a
Nothing [
    Name
_Elimination_list     Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_EliminationVariant_list,
    Name
_Elimination_optional Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_EliminationVariant_optional,
    Name
_Elimination_product  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_EliminationVariant_product,
    Name
_Elimination_record   Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_EliminationVariant_record,
    Name
_Elimination_union    Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_EliminationVariant_union,
    Name
_Elimination_wrap     Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_EliminationVariant_wrap]

eliminationVariantsDef :: TElement [EliminationVariant]
eliminationVariantsDef :: TElement [EliminationVariant]
eliminationVariantsDef = String
-> TTerm [EliminationVariant] -> TElement [EliminationVariant]
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"eliminationVariants" (TTerm [EliminationVariant] -> TElement [EliminationVariant])
-> TTerm [EliminationVariant] -> TElement [EliminationVariant]
forall a b. (a -> b) -> a -> b
$
  String -> TTerm [EliminationVariant] -> TTerm [EliminationVariant]
forall a. String -> TTerm a -> TTerm a
doc String
"All elimination variants (constructors), in a canonical order" (TTerm [EliminationVariant] -> TTerm [EliminationVariant])
-> TTerm [EliminationVariant] -> TTerm [EliminationVariant]
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm [EliminationVariant] -> TTerm [EliminationVariant]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
eliminationVariantT) (TTerm [EliminationVariant] -> TTerm [EliminationVariant])
-> TTerm [EliminationVariant] -> TTerm [EliminationVariant]
forall a b. (a -> b) -> a -> b
$
  [TTerm EliminationVariant] -> TTerm [EliminationVariant]
forall a. [TTerm a] -> TTerm [a]
list ([TTerm EliminationVariant] -> TTerm [EliminationVariant])
-> [TTerm EliminationVariant] -> TTerm [EliminationVariant]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm EliminationVariant
forall a. Name -> Name -> TTerm a
unitVariant Name
_EliminationVariant (Name -> TTerm EliminationVariant)
-> [Name] -> [TTerm EliminationVariant]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    Name
_EliminationVariant_list,
    Name
_EliminationVariant_wrap,
    Name
_EliminationVariant_optional,
    Name
_EliminationVariant_product,
    Name
_EliminationVariant_record,
    Name
_EliminationVariant_union]

floatTypePrecisionDef :: TElement (FloatType -> Precision)
floatTypePrecisionDef :: TElement (FloatType -> Precision)
floatTypePrecisionDef = String
-> TTerm (FloatType -> Precision)
-> TElement (FloatType -> Precision)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"floatTypePrecision" (TTerm (FloatType -> Precision)
 -> TElement (FloatType -> Precision))
-> TTerm (FloatType -> Precision)
-> TElement (FloatType -> Precision)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (FloatType -> Precision) -> TTerm (FloatType -> Precision)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the precision of a given floating-point type" (TTerm (FloatType -> Precision) -> TTerm (FloatType -> Precision))
-> TTerm (FloatType -> Precision) -> TTerm (FloatType -> Precision)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (FloatType -> Precision)
-> TTerm (FloatType -> Precision)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
floatTypeT Type
precisionT (TTerm (FloatType -> Precision) -> TTerm (FloatType -> Precision))
-> TTerm (FloatType -> Precision) -> TTerm (FloatType -> Precision)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm Precision)
-> [(Name, Field)]
-> TTerm (FloatType -> Precision)
forall b a.
Name
-> Name -> Maybe (TTerm b) -> [(Name, Field)] -> TTerm (a -> b)
matchToUnion Name
_FloatType Name
_Precision Maybe (TTerm Precision)
forall a. Maybe a
Nothing [
    Name
_FloatType_bigfloat Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Any -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_arbitrary TTerm Any
forall a. TTerm a
unit,
    Name
_FloatType_float32  Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
32,
    Name
_FloatType_float64  Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
64]

floatTypesDef :: TElement [FloatType]
floatTypesDef :: TElement [FloatType]
floatTypesDef = String -> TTerm [FloatType] -> TElement [FloatType]
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"floatTypes" (TTerm [FloatType] -> TElement [FloatType])
-> TTerm [FloatType] -> TElement [FloatType]
forall a b. (a -> b) -> a -> b
$
  String -> TTerm [FloatType] -> TTerm [FloatType]
forall a. String -> TTerm a -> TTerm a
doc String
"All floating-point types in a canonical order" (TTerm [FloatType] -> TTerm [FloatType])
-> TTerm [FloatType] -> TTerm [FloatType]
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm [FloatType] -> TTerm [FloatType]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
floatTypeT) (TTerm [FloatType] -> TTerm [FloatType])
-> TTerm [FloatType] -> TTerm [FloatType]
forall a b. (a -> b) -> a -> b
$
  [TTerm FloatType] -> TTerm [FloatType]
forall a. [TTerm a] -> TTerm [a]
list ([TTerm FloatType] -> TTerm [FloatType])
-> [TTerm FloatType] -> TTerm [FloatType]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm FloatType
forall a. Name -> Name -> TTerm a
unitVariant Name
_FloatType (Name -> TTerm FloatType) -> [Name] -> [TTerm FloatType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    Name
_FloatType_bigfloat,
    Name
_FloatType_float32,
    Name
_FloatType_float64]

floatValueTypeDef :: TElement (FloatValue -> FloatType)
floatValueTypeDef :: TElement (FloatValue -> FloatType)
floatValueTypeDef = String
-> TTerm (FloatValue -> FloatType)
-> TElement (FloatValue -> FloatType)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"floatValueType" (TTerm (FloatValue -> FloatType)
 -> TElement (FloatValue -> FloatType))
-> TTerm (FloatValue -> FloatType)
-> TElement (FloatValue -> FloatType)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (FloatValue -> FloatType)
-> TTerm (FloatValue -> FloatType)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the float type for a given floating-point value" (TTerm (FloatValue -> FloatType)
 -> TTerm (FloatValue -> FloatType))
-> TTerm (FloatValue -> FloatType)
-> TTerm (FloatValue -> FloatType)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (FloatValue -> FloatType)
-> TTerm (FloatValue -> FloatType)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
floatValueT Type
floatTypeT (TTerm (FloatValue -> FloatType)
 -> TTerm (FloatValue -> FloatType))
-> TTerm (FloatValue -> FloatType)
-> TTerm (FloatValue -> FloatType)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm FloatType)
-> [(Name, Name)]
-> TTerm (FloatValue -> FloatType)
forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
_FloatValue Name
_FloatType Maybe (TTerm FloatType)
forall a. Maybe a
Nothing [
    Name
_FloatValue_bigfloat Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_FloatType_bigfloat,
    Name
_FloatValue_float32  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_FloatType_float32,
    Name
_FloatValue_float64  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_FloatType_float64]

functionVariantDef :: TElement (Function -> FunctionVariant)
functionVariantDef :: TElement (Function -> FunctionVariant)
functionVariantDef = String
-> TTerm (Function -> FunctionVariant)
-> TElement (Function -> FunctionVariant)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"functionVariant" (TTerm (Function -> FunctionVariant)
 -> TElement (Function -> FunctionVariant))
-> TTerm (Function -> FunctionVariant)
-> TElement (Function -> FunctionVariant)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Function -> FunctionVariant)
-> TTerm (Function -> FunctionVariant)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the function variant (constructor) for a given function" (TTerm (Function -> FunctionVariant)
 -> TTerm (Function -> FunctionVariant))
-> TTerm (Function -> FunctionVariant)
-> TTerm (Function -> FunctionVariant)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Function -> FunctionVariant)
-> TTerm (Function -> FunctionVariant)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
functionT Type
functionVariantT (TTerm (Function -> FunctionVariant)
 -> TTerm (Function -> FunctionVariant))
-> TTerm (Function -> FunctionVariant)
-> TTerm (Function -> FunctionVariant)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm FunctionVariant)
-> [(Name, Name)]
-> TTerm (Function -> FunctionVariant)
forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
_Function Name
_FunctionVariant Maybe (TTerm FunctionVariant)
forall a. Maybe a
Nothing [
    Name
_Function_elimination Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_FunctionVariant_elimination,
    Name
_Function_lambda      Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_FunctionVariant_lambda,
    Name
_Function_primitive   Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_FunctionVariant_primitive]

functionVariantsDef :: TElement [FunctionVariant]
functionVariantsDef :: TElement [FunctionVariant]
functionVariantsDef = String -> TTerm [FunctionVariant] -> TElement [FunctionVariant]
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"functionVariants" (TTerm [FunctionVariant] -> TElement [FunctionVariant])
-> TTerm [FunctionVariant] -> TElement [FunctionVariant]
forall a b. (a -> b) -> a -> b
$
  String -> TTerm [FunctionVariant] -> TTerm [FunctionVariant]
forall a. String -> TTerm a -> TTerm a
doc String
"All function variants (constructors), in a canonical order" (TTerm [FunctionVariant] -> TTerm [FunctionVariant])
-> TTerm [FunctionVariant] -> TTerm [FunctionVariant]
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm [FunctionVariant] -> TTerm [FunctionVariant]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
functionVariantT) (TTerm [FunctionVariant] -> TTerm [FunctionVariant])
-> TTerm [FunctionVariant] -> TTerm [FunctionVariant]
forall a b. (a -> b) -> a -> b
$
  [TTerm FunctionVariant] -> TTerm [FunctionVariant]
forall a. [TTerm a] -> TTerm [a]
list ([TTerm FunctionVariant] -> TTerm [FunctionVariant])
-> [TTerm FunctionVariant] -> TTerm [FunctionVariant]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm FunctionVariant
forall a. Name -> Name -> TTerm a
unitVariant Name
_FunctionVariant (Name -> TTerm FunctionVariant)
-> [Name] -> [TTerm FunctionVariant]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    Name
_FunctionVariant_elimination,
    Name
_FunctionVariant_lambda,
    Name
_FunctionVariant_primitive]

idDef :: TElement (a -> a)
idDef :: forall a. TElement (a -> a)
idDef = String -> TTerm (a -> a) -> TElement (a -> a)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"id" (TTerm (a -> a) -> TElement (a -> a))
-> TTerm (a -> a) -> TElement (a -> a)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (a -> a) -> TTerm (a -> a)
forall a. String -> TTerm a -> TTerm a
doc String
"The identity function" (TTerm (a -> a) -> TTerm (a -> a))
-> TTerm (a -> a) -> TTerm (a -> a)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (a -> a) -> TTerm (a -> a)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
aT Type
aT (TTerm (a -> a) -> TTerm (a -> a))
-> TTerm (a -> a) -> TTerm (a -> a)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Any -> TTerm (a -> a)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"x" (TTerm Any -> TTerm (a -> a)) -> TTerm Any -> TTerm (a -> a)
forall a b. (a -> b) -> a -> b
$ String -> TTerm Any
forall a. String -> TTerm a
var String
"x"

integerTypeIsSignedDef :: TElement (IntegerType -> Bool)
integerTypeIsSignedDef :: TElement (IntegerType -> Bool)
integerTypeIsSignedDef = String
-> TTerm (IntegerType -> Bool) -> TElement (IntegerType -> Bool)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"integerTypeIsSigned" (TTerm (IntegerType -> Bool) -> TElement (IntegerType -> Bool))
-> TTerm (IntegerType -> Bool) -> TElement (IntegerType -> Bool)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (IntegerType -> Bool) -> TTerm (IntegerType -> Bool)
forall a. String -> TTerm a -> TTerm a
doc String
"Find whether a given integer type is signed (true) or unsigned (false)" (TTerm (IntegerType -> Bool) -> TTerm (IntegerType -> Bool))
-> TTerm (IntegerType -> Bool) -> TTerm (IntegerType -> Bool)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (IntegerType -> Bool)
-> TTerm (IntegerType -> Bool)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
integerTypeT Type
booleanT (TTerm (IntegerType -> Bool) -> TTerm (IntegerType -> Bool))
-> TTerm (IntegerType -> Bool) -> TTerm (IntegerType -> Bool)
forall a b. (a -> b) -> a -> b
$
  Name
-> Maybe (TTerm Bool)
-> [(Name, TTerm (Any -> Bool))]
-> TTerm (IntegerType -> Bool)
forall b x a.
Name
-> Maybe (TTerm b) -> [(Name, TTerm (x -> b))] -> TTerm (a -> b)
matchData Name
_IntegerType Maybe (TTerm Bool)
forall a. Maybe a
Nothing [
    Name
_IntegerType_bigint Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
true,
    Name
_IntegerType_int8   Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
true,
    Name
_IntegerType_int16  Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
true,
    Name
_IntegerType_int32  Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
true,
    Name
_IntegerType_int64  Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
true,
    Name
_IntegerType_uint8  Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
false,
    Name
_IntegerType_uint16 Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
false,
    Name
_IntegerType_uint32 Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
false,
    Name
_IntegerType_uint64 Name -> TTerm (Any -> Bool) -> (Name, TTerm (Any -> Bool))
forall a b. a -> b -> (a, b)
@-> TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
false]

integerTypePrecisionDef :: TElement (IntegerType -> Precision)
integerTypePrecisionDef :: TElement (IntegerType -> Precision)
integerTypePrecisionDef = String
-> TTerm (IntegerType -> Precision)
-> TElement (IntegerType -> Precision)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"integerTypePrecision" (TTerm (IntegerType -> Precision)
 -> TElement (IntegerType -> Precision))
-> TTerm (IntegerType -> Precision)
-> TElement (IntegerType -> Precision)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (IntegerType -> Precision)
-> TTerm (IntegerType -> Precision)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the precision of a given integer type" (TTerm (IntegerType -> Precision)
 -> TTerm (IntegerType -> Precision))
-> TTerm (IntegerType -> Precision)
-> TTerm (IntegerType -> Precision)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (IntegerType -> Precision)
-> TTerm (IntegerType -> Precision)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
integerTypeT Type
precisionT (TTerm (IntegerType -> Precision)
 -> TTerm (IntegerType -> Precision))
-> TTerm (IntegerType -> Precision)
-> TTerm (IntegerType -> Precision)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm Precision)
-> [(Name, Field)]
-> TTerm (IntegerType -> Precision)
forall b a.
Name
-> Name -> Maybe (TTerm b) -> [(Name, Field)] -> TTerm (a -> b)
matchToUnion Name
_IntegerType Name
_Precision Maybe (TTerm Precision)
forall a. Maybe a
Nothing [
    Name
_IntegerType_bigint Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Any -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_arbitrary TTerm Any
forall a. TTerm a
unit,
    Name
_IntegerType_int8   Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
8,
    Name
_IntegerType_int16  Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
16,
    Name
_IntegerType_int32  Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
32,
    Name
_IntegerType_int64  Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
64,
    Name
_IntegerType_uint8  Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
8,
    Name
_IntegerType_uint16 Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
16,
    Name
_IntegerType_uint32 Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
32,
    Name
_IntegerType_uint64 Name -> Field -> (Name, Field)
forall a b. a -> b -> (a, b)
@-> Name -> TTerm Int -> Field
forall a. Name -> TTerm a -> Field
field Name
_Precision_bits (TTerm Int -> Field) -> TTerm Int -> Field
forall a b. (a -> b) -> a -> b
$ Int -> TTerm Int
int Int
64]

integerTypesDef :: TElement [IntegerType]
integerTypesDef :: TElement [IntegerType]
integerTypesDef = String -> TTerm [IntegerType] -> TElement [IntegerType]
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"integerTypes" (TTerm [IntegerType] -> TElement [IntegerType])
-> TTerm [IntegerType] -> TElement [IntegerType]
forall a b. (a -> b) -> a -> b
$
  String -> TTerm [IntegerType] -> TTerm [IntegerType]
forall a. String -> TTerm a -> TTerm a
doc String
"All integer types, in a canonical order" (TTerm [IntegerType] -> TTerm [IntegerType])
-> TTerm [IntegerType] -> TTerm [IntegerType]
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm [IntegerType] -> TTerm [IntegerType]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
integerTypeT) (TTerm [IntegerType] -> TTerm [IntegerType])
-> TTerm [IntegerType] -> TTerm [IntegerType]
forall a b. (a -> b) -> a -> b
$
  [TTerm IntegerType] -> TTerm [IntegerType]
forall a. [TTerm a] -> TTerm [a]
list ([TTerm IntegerType] -> TTerm [IntegerType])
-> [TTerm IntegerType] -> TTerm [IntegerType]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm IntegerType
forall a. Name -> Name -> TTerm a
unitVariant Name
_IntegerType (Name -> TTerm IntegerType) -> [Name] -> [TTerm IntegerType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    Name
_IntegerType_bigint,
    Name
_IntegerType_int8,
    Name
_IntegerType_int16,
    Name
_IntegerType_int32,
    Name
_IntegerType_int64,
    Name
_IntegerType_uint8,
    Name
_IntegerType_uint16,
    Name
_IntegerType_uint32,
    Name
_IntegerType_uint64]

integerValueTypeDef :: TElement (IntegerValue -> IntegerType)
integerValueTypeDef :: TElement (IntegerValue -> IntegerType)
integerValueTypeDef = String
-> TTerm (IntegerValue -> IntegerType)
-> TElement (IntegerValue -> IntegerType)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"integerValueType" (TTerm (IntegerValue -> IntegerType)
 -> TElement (IntegerValue -> IntegerType))
-> TTerm (IntegerValue -> IntegerType)
-> TElement (IntegerValue -> IntegerType)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (IntegerValue -> IntegerType)
-> TTerm (IntegerValue -> IntegerType)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the integer type for a given integer value" (TTerm (IntegerValue -> IntegerType)
 -> TTerm (IntegerValue -> IntegerType))
-> TTerm (IntegerValue -> IntegerType)
-> TTerm (IntegerValue -> IntegerType)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (IntegerValue -> IntegerType)
-> TTerm (IntegerValue -> IntegerType)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
integerValueT Type
integerTypeT (TTerm (IntegerValue -> IntegerType)
 -> TTerm (IntegerValue -> IntegerType))
-> TTerm (IntegerValue -> IntegerType)
-> TTerm (IntegerValue -> IntegerType)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm IntegerType)
-> [(Name, Name)]
-> TTerm (IntegerValue -> IntegerType)
forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
_IntegerValue Name
_IntegerType Maybe (TTerm IntegerType)
forall a. Maybe a
Nothing [
    Name
_IntegerValue_bigint Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_bigint,
    Name
_IntegerValue_int8   Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_int8,
    Name
_IntegerValue_int16  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_int16,
    Name
_IntegerValue_int32  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_int32,
    Name
_IntegerValue_int64  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_int64,
    Name
_IntegerValue_uint8  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_uint8,
    Name
_IntegerValue_uint16 Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_uint16,
    Name
_IntegerValue_uint32 Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_uint32,
    Name
_IntegerValue_uint64 Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_IntegerType_uint64]

literalTypeDef :: TElement (Literal -> LiteralType)
literalTypeDef :: TElement (Literal -> LiteralType)
literalTypeDef = String
-> TTerm (Literal -> LiteralType)
-> TElement (Literal -> LiteralType)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"literalType" (TTerm (Literal -> LiteralType)
 -> TElement (Literal -> LiteralType))
-> TTerm (Literal -> LiteralType)
-> TElement (Literal -> LiteralType)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Literal -> LiteralType) -> TTerm (Literal -> LiteralType)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the literal type for a given literal value" (TTerm (Literal -> LiteralType) -> TTerm (Literal -> LiteralType))
-> TTerm (Literal -> LiteralType) -> TTerm (Literal -> LiteralType)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Literal -> LiteralType)
-> TTerm (Literal -> LiteralType)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
literalT Type
literalTypeT (TTerm (Literal -> LiteralType) -> TTerm (Literal -> LiteralType))
-> TTerm (Literal -> LiteralType) -> TTerm (Literal -> LiteralType)
forall a b. (a -> b) -> a -> b
$
  Name
-> Maybe (TTerm LiteralType)
-> [Field]
-> TTerm (Literal -> LiteralType)
forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
_Literal Maybe (TTerm LiteralType)
forall a. Maybe a
Nothing [
    Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Literal_binary  TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> TTerm Any -> TTerm (Any -> Any)
forall a b. TTerm a -> TTerm (b -> a)
constant (TTerm Any -> TTerm (Any -> Any))
-> TTerm Any -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm Any -> TTerm Any
forall a b. Name -> Name -> TTerm a -> TTerm b
variant Name
_LiteralType Name
_LiteralType_binary TTerm Any
forall a. TTerm a
unit,
    Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Literal_boolean TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> TTerm Any -> TTerm (Any -> Any)
forall a b. TTerm a -> TTerm (b -> a)
constant (TTerm Any -> TTerm (Any -> Any))
-> TTerm Any -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm Any -> TTerm Any
forall a b. Name -> Name -> TTerm a -> TTerm b
variant Name
_LiteralType Name
_LiteralType_boolean TTerm Any
forall a. TTerm a
unit,
    Name -> TCase FloatValue
forall a. Name -> TCase a
TCase Name
_Literal_float   TCase FloatValue -> TTerm (FloatValue -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> Name -> Name -> TTerm (FloatType -> Any)
forall a b. Name -> Name -> TTerm (a -> b)
inject2 Name
_LiteralType Name
_LiteralType_float TTerm (FloatType -> Any)
-> TTerm (FloatValue -> FloatType) -> TTerm (FloatValue -> Any)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (FloatValue -> FloatType)
-> TTerm (FloatValue -> FloatType)
forall a. TElement a -> TTerm a
ref TElement (FloatValue -> FloatType)
floatValueTypeDef,
    Name -> TCase IntegerValue
forall a. Name -> TCase a
TCase Name
_Literal_integer TCase IntegerValue -> TTerm (IntegerValue -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> Name -> Name -> TTerm (IntegerType -> Any)
forall a b. Name -> Name -> TTerm (a -> b)
inject2 Name
_LiteralType Name
_LiteralType_integer TTerm (IntegerType -> Any)
-> TTerm (IntegerValue -> IntegerType)
-> TTerm (IntegerValue -> Any)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (IntegerValue -> IntegerType)
-> TTerm (IntegerValue -> IntegerType)
forall a. TElement a -> TTerm a
ref TElement (IntegerValue -> IntegerType)
integerValueTypeDef,
    Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Literal_string  TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> TTerm Any -> TTerm (Any -> Any)
forall a b. TTerm a -> TTerm (b -> a)
constant (TTerm Any -> TTerm (Any -> Any))
-> TTerm Any -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm Any -> TTerm Any
forall a b. Name -> Name -> TTerm a -> TTerm b
variant Name
_LiteralType Name
_LiteralType_string TTerm Any
forall a. TTerm a
unit]

literalTypeVariantDef :: TElement (LiteralType -> LiteralVariant)
literalTypeVariantDef :: TElement (LiteralType -> LiteralVariant)
literalTypeVariantDef = String
-> TTerm (LiteralType -> LiteralVariant)
-> TElement (LiteralType -> LiteralVariant)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"literalTypeVariant" (TTerm (LiteralType -> LiteralVariant)
 -> TElement (LiteralType -> LiteralVariant))
-> TTerm (LiteralType -> LiteralVariant)
-> TElement (LiteralType -> LiteralVariant)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (LiteralType -> LiteralVariant)
-> TTerm (LiteralType -> LiteralVariant)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the literal type variant (constructor) for a given literal value" (TTerm (LiteralType -> LiteralVariant)
 -> TTerm (LiteralType -> LiteralVariant))
-> TTerm (LiteralType -> LiteralVariant)
-> TTerm (LiteralType -> LiteralVariant)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (LiteralType -> LiteralVariant)
-> TTerm (LiteralType -> LiteralVariant)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
literalTypeT Type
literalVariantT (TTerm (LiteralType -> LiteralVariant)
 -> TTerm (LiteralType -> LiteralVariant))
-> TTerm (LiteralType -> LiteralVariant)
-> TTerm (LiteralType -> LiteralVariant)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm LiteralVariant)
-> [(Name, Name)]
-> TTerm (LiteralType -> LiteralVariant)
forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
_LiteralType Name
_LiteralVariant Maybe (TTerm LiteralVariant)
forall a. Maybe a
Nothing [
    Name
_LiteralType_binary  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_LiteralVariant_binary,
    Name
_LiteralType_boolean Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_LiteralVariant_boolean,
    Name
_LiteralType_float   Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_LiteralVariant_float,
    Name
_LiteralType_integer Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_LiteralVariant_integer,
    Name
_LiteralType_string  Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_LiteralVariant_string]

literalVariantDef :: TElement (Literal -> LiteralVariant)
literalVariantDef :: TElement (Literal -> LiteralVariant)
literalVariantDef = String
-> TTerm (Literal -> LiteralVariant)
-> TElement (Literal -> LiteralVariant)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"literalVariant" (TTerm (Literal -> LiteralVariant)
 -> TElement (Literal -> LiteralVariant))
-> TTerm (Literal -> LiteralVariant)
-> TElement (Literal -> LiteralVariant)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Literal -> LiteralVariant)
-> TTerm (Literal -> LiteralVariant)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the literal variant (constructor) for a given literal value" (TTerm (Literal -> LiteralVariant)
 -> TTerm (Literal -> LiteralVariant))
-> TTerm (Literal -> LiteralVariant)
-> TTerm (Literal -> LiteralVariant)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Literal -> LiteralVariant)
-> TTerm (Literal -> LiteralVariant)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
literalT Type
literalVariantT (TTerm (Literal -> LiteralVariant)
 -> TTerm (Literal -> LiteralVariant))
-> TTerm (Literal -> LiteralVariant)
-> TTerm (Literal -> LiteralVariant)
forall a b. (a -> b) -> a -> b
$
  TElement (LiteralType -> LiteralVariant)
-> TTerm (LiteralType -> LiteralVariant)
forall a. TElement a -> TTerm a
ref TElement (LiteralType -> LiteralVariant)
literalTypeVariantDef TTerm (LiteralType -> LiteralVariant)
-> TTerm (Literal -> LiteralType)
-> TTerm (Literal -> LiteralVariant)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (Literal -> LiteralType) -> TTerm (Literal -> LiteralType)
forall a. TElement a -> TTerm a
ref TElement (Literal -> LiteralType)
literalTypeDef

literalVariantsDef :: TElement [LiteralVariant]
literalVariantsDef :: TElement [LiteralVariant]
literalVariantsDef = String -> TTerm [LiteralVariant] -> TElement [LiteralVariant]
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"literalVariants" (TTerm [LiteralVariant] -> TElement [LiteralVariant])
-> TTerm [LiteralVariant] -> TElement [LiteralVariant]
forall a b. (a -> b) -> a -> b
$
  String -> TTerm [LiteralVariant] -> TTerm [LiteralVariant]
forall a. String -> TTerm a -> TTerm a
doc String
"All literal variants, in a canonical order" (TTerm [LiteralVariant] -> TTerm [LiteralVariant])
-> TTerm [LiteralVariant] -> TTerm [LiteralVariant]
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm [LiteralVariant] -> TTerm [LiteralVariant]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
literalVariantT) (TTerm [LiteralVariant] -> TTerm [LiteralVariant])
-> TTerm [LiteralVariant] -> TTerm [LiteralVariant]
forall a b. (a -> b) -> a -> b
$
  [TTerm LiteralVariant] -> TTerm [LiteralVariant]
forall a. [TTerm a] -> TTerm [a]
list ([TTerm LiteralVariant] -> TTerm [LiteralVariant])
-> [TTerm LiteralVariant] -> TTerm [LiteralVariant]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm LiteralVariant
forall a. Name -> Name -> TTerm a
unitVariant Name
_LiteralVariant (Name -> TTerm LiteralVariant) -> [Name] -> [TTerm LiteralVariant]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    Name
_LiteralVariant_binary,
    Name
_LiteralVariant_boolean,
    Name
_LiteralVariant_float,
    Name
_LiteralVariant_integer,
    Name
_LiteralVariant_string]

termVariantDef :: TElement (Term -> TermVariant)
termVariantDef :: TElement (Term -> TermVariant)
termVariantDef = String
-> TTerm (Term -> TermVariant) -> TElement (Term -> TermVariant)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"termVariant" (TTerm (Term -> TermVariant) -> TElement (Term -> TermVariant))
-> TTerm (Term -> TermVariant) -> TElement (Term -> TermVariant)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Term -> TermVariant) -> TTerm (Term -> TermVariant)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the term variant (constructor) for a given term" (TTerm (Term -> TermVariant) -> TTerm (Term -> TermVariant))
-> TTerm (Term -> TermVariant) -> TTerm (Term -> TermVariant)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Term -> TermVariant)
-> TTerm (Term -> TermVariant)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
termT Type
termVariantT (TTerm (Term -> TermVariant) -> TTerm (Term -> TermVariant))
-> TTerm (Term -> TermVariant) -> TTerm (Term -> TermVariant)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm TermVariant)
-> [(Name, Name)]
-> TTerm (Term -> TermVariant)
forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
_Term Name
_TermVariant Maybe (TTerm TermVariant)
forall a. Maybe a
Nothing [
    Name
_Term_annotated   Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_annotated,
    Name
_Term_application Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_application,
    Name
_Term_function    Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_function,
    Name
_Term_let         Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_let,
    Name
_Term_list        Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_list,
    Name
_Term_literal     Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_literal,
    Name
_Term_map         Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_map,
    Name
_Term_optional    Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_optional,
    Name
_Term_product     Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_product,
    Name
_Term_record      Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_record,
    Name
_Term_set         Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_set,
    Name
_Term_sum         Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_sum,
    Name
_Term_typeAbstraction Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_typeAbstraction,
    Name
_Term_typeApplication Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_typeApplication,
    Name
_Term_typed       Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_typed,
    Name
_Term_union       Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_union,
    Name
_Term_variable    Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_variable,
    Name
_Term_wrap        Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TermVariant_wrap]

termVariantsDef :: TElement [TermVariant]
termVariantsDef :: TElement [TermVariant]
termVariantsDef = String -> TTerm [TermVariant] -> TElement [TermVariant]
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"termVariants" (TTerm [TermVariant] -> TElement [TermVariant])
-> TTerm [TermVariant] -> TElement [TermVariant]
forall a b. (a -> b) -> a -> b
$
  String -> TTerm [TermVariant] -> TTerm [TermVariant]
forall a. String -> TTerm a -> TTerm a
doc String
"All term (expression) variants, in a canonical order" (TTerm [TermVariant] -> TTerm [TermVariant])
-> TTerm [TermVariant] -> TTerm [TermVariant]
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm [TermVariant] -> TTerm [TermVariant]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
termVariantT) (TTerm [TermVariant] -> TTerm [TermVariant])
-> TTerm [TermVariant] -> TTerm [TermVariant]
forall a b. (a -> b) -> a -> b
$
  [TTerm TermVariant] -> TTerm [TermVariant]
forall a. [TTerm a] -> TTerm [a]
list ([TTerm TermVariant] -> TTerm [TermVariant])
-> [TTerm TermVariant] -> TTerm [TermVariant]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm TermVariant
forall a. Name -> Name -> TTerm a
unitVariant Name
_TermVariant (Name -> TTerm TermVariant) -> [Name] -> [TTerm TermVariant]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    Name
_TermVariant_annotated,
    Name
_TermVariant_application,
    Name
_TermVariant_literal,
    Name
_TermVariant_function,
    Name
_TermVariant_list,
    Name
_TermVariant_map,
    Name
_TermVariant_optional,
    Name
_TermVariant_product,
    Name
_TermVariant_record,
    Name
_TermVariant_set,
    Name
_TermVariant_sum,
    Name
_TermVariant_typeAbstraction,
    Name
_TermVariant_typeApplication,
    Name
_TermVariant_typed,
    Name
_TermVariant_union,
    Name
_TermVariant_variable,
    Name
_TermVariant_wrap]

typeVariantDef :: TElement (Type -> TypeVariant)
typeVariantDef :: TElement (Type -> TypeVariant)
typeVariantDef = String
-> TTerm (Type -> TypeVariant) -> TElement (Type -> TypeVariant)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"typeVariant" (TTerm (Type -> TypeVariant) -> TElement (Type -> TypeVariant))
-> TTerm (Type -> TypeVariant) -> TElement (Type -> TypeVariant)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Type -> TypeVariant) -> TTerm (Type -> TypeVariant)
forall a. String -> TTerm a -> TTerm a
doc String
"Find the type variant (constructor) for a given type" (TTerm (Type -> TypeVariant) -> TTerm (Type -> TypeVariant))
-> TTerm (Type -> TypeVariant) -> TTerm (Type -> TypeVariant)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Type -> TypeVariant)
-> TTerm (Type -> TypeVariant)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
typeT Type
typeVariantT (TTerm (Type -> TypeVariant) -> TTerm (Type -> TypeVariant))
-> TTerm (Type -> TypeVariant) -> TTerm (Type -> TypeVariant)
forall a b. (a -> b) -> a -> b
$
  Name
-> Name
-> Maybe (TTerm TypeVariant)
-> [(Name, Name)]
-> TTerm (Type -> TypeVariant)
forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
_Type Name
_TypeVariant Maybe (TTerm TypeVariant)
forall a. Maybe a
Nothing [
    Name
_Type_annotated   Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_annotated,
    Name
_Type_application Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_application,
    Name
_Type_function    Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_function,
    Name
_Type_lambda      Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_lambda,
    Name
_Type_list        Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_list,
    Name
_Type_literal     Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_literal,
    Name
_Type_map         Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_map,
    Name
_Type_optional    Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_optional,
    Name
_Type_product     Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_product,
    Name
_Type_record      Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_record,
    Name
_Type_set         Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_set,
    Name
_Type_sum         Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_sum,
    Name
_Type_union       Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_union,
    Name
_Type_variable    Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_variable,
    Name
_Type_wrap        Name -> Name -> (Name, Name)
forall a b. a -> b -> (a, b)
@-> Name
_TypeVariant_wrap]

typeVariantsDef :: TElement [TypeVariant]
typeVariantsDef :: TElement [TypeVariant]
typeVariantsDef = String -> TTerm [TypeVariant] -> TElement [TypeVariant]
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"typeVariants" (TTerm [TypeVariant] -> TElement [TypeVariant])
-> TTerm [TypeVariant] -> TElement [TypeVariant]
forall a b. (a -> b) -> a -> b
$
  String -> TTerm [TypeVariant] -> TTerm [TypeVariant]
forall a. String -> TTerm a -> TTerm a
doc String
"All type variants, in a canonical order" (TTerm [TypeVariant] -> TTerm [TypeVariant])
-> TTerm [TypeVariant] -> TTerm [TypeVariant]
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm [TypeVariant] -> TTerm [TypeVariant]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
typeVariantT) (TTerm [TypeVariant] -> TTerm [TypeVariant])
-> TTerm [TypeVariant] -> TTerm [TypeVariant]
forall a b. (a -> b) -> a -> b
$
  [TTerm TypeVariant] -> TTerm [TypeVariant]
forall a. [TTerm a] -> TTerm [a]
list ([TTerm TypeVariant] -> TTerm [TypeVariant])
-> [TTerm TypeVariant] -> TTerm [TypeVariant]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm TypeVariant
forall a. Name -> Name -> TTerm a
unitVariant Name
_TypeVariant (Name -> TTerm TypeVariant) -> [Name] -> [TTerm TypeVariant]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    Name
_TypeVariant_annotated,
    Name
_TypeVariant_application,
    Name
_TypeVariant_function,
    Name
_TypeVariant_lambda,
    Name
_TypeVariant_list,
    Name
_TypeVariant_literal,
    Name
_TypeVariant_map,
    Name
_TypeVariant_wrap,
    Name
_TypeVariant_optional,
    Name
_TypeVariant_product,
    Name
_TypeVariant_record,
    Name
_TypeVariant_set,
    Name
_TypeVariant_sum,
    Name
_TypeVariant_union,
    Name
_TypeVariant_variable]

-- Formatting.hs

capitalizeDef :: TElement (String -> String)
capitalizeDef :: TElement (String -> String)
capitalizeDef = String -> TTerm (String -> String) -> TElement (String -> String)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"capitalize" (TTerm (String -> String) -> TElement (String -> String))
-> TTerm (String -> String) -> TElement (String -> String)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (String -> String) -> TTerm (String -> String)
forall a. String -> TTerm a -> TTerm a
doc String
"Capitalize the first letter of a string" (TTerm (String -> String) -> TTerm (String -> String))
-> TTerm (String -> String) -> TTerm (String -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type -> TTerm (String -> String) -> TTerm (String -> String)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
stringT Type
stringT (TTerm (String -> String) -> TTerm (String -> String))
-> TTerm (String -> String) -> TTerm (String -> String)
forall a b. (a -> b) -> a -> b
$
  TElement ((String -> String) -> String -> String)
-> TTerm ((String -> String) -> String -> String)
forall a. TElement a -> TTerm a
ref TElement ((String -> String) -> String -> String)
mapFirstLetterDef TTerm ((String -> String) -> String -> String)
-> TTerm (String -> String) -> TTerm (String -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (String -> String)
Strings.toUpper

decapitalizeDef :: TElement (String -> String)
decapitalizeDef :: TElement (String -> String)
decapitalizeDef = String -> TTerm (String -> String) -> TElement (String -> String)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"decapitalize" (TTerm (String -> String) -> TElement (String -> String))
-> TTerm (String -> String) -> TElement (String -> String)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (String -> String) -> TTerm (String -> String)
forall a. String -> TTerm a -> TTerm a
doc String
"Decapitalize the first letter of a string" (TTerm (String -> String) -> TTerm (String -> String))
-> TTerm (String -> String) -> TTerm (String -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type -> TTerm (String -> String) -> TTerm (String -> String)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
stringT Type
stringT (TTerm (String -> String) -> TTerm (String -> String))
-> TTerm (String -> String) -> TTerm (String -> String)
forall a b. (a -> b) -> a -> b
$
  TElement ((String -> String) -> String -> String)
-> TTerm ((String -> String) -> String -> String)
forall a. TElement a -> TTerm a
ref TElement ((String -> String) -> String -> String)
mapFirstLetterDef TTerm ((String -> String) -> String -> String)
-> TTerm (String -> String) -> TTerm (String -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (String -> String)
Strings.toLower

-- TODO: simplify this helper
mapFirstLetterDef :: TElement ((String -> String) -> String -> String)
mapFirstLetterDef :: TElement ((String -> String) -> String -> String)
mapFirstLetterDef = String
-> TTerm ((String -> String) -> String -> String)
-> TElement ((String -> String) -> String -> String)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"mapFirstLetter" (TTerm ((String -> String) -> String -> String)
 -> TElement ((String -> String) -> String -> String))
-> TTerm ((String -> String) -> String -> String)
-> TElement ((String -> String) -> String -> String)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm ((String -> String) -> String -> String)
-> TTerm ((String -> String) -> String -> String)
forall a. String -> TTerm a -> TTerm a
doc String
"A helper which maps the first letter of a string to another string" (TTerm ((String -> String) -> String -> String)
 -> TTerm ((String -> String) -> String -> String))
-> TTerm ((String -> String) -> String -> String)
-> TTerm ((String -> String) -> String -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm ((String -> String) -> String -> String)
-> TTerm ((String -> String) -> String -> String)
forall a. Type -> Type -> TTerm a -> TTerm a
function (Type -> Type -> Type
funT Type
stringT Type
stringT) (Type -> Type -> Type
funT Type
stringT Type
stringT) (TTerm ((String -> String) -> String -> String)
 -> TTerm ((String -> String) -> String -> String))
-> TTerm ((String -> String) -> String -> String)
-> TTerm ((String -> String) -> String -> String)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Any -> Any)
-> TTerm ((String -> String) -> String -> String)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"mapping" (TTerm (Any -> Any)
 -> TTerm ((String -> String) -> String -> String))
-> TTerm (Any -> Any)
-> TTerm ((String -> String) -> String -> String)
forall a b. (a -> b) -> a -> b
$ String -> TTerm String -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"s" ((TTerm (String -> String -> Bool -> String)
forall a. TTerm (a -> a -> Bool -> a)
Logic.ifElse
       TTerm (String -> String -> Bool -> String)
-> TTerm String -> TTerm (String -> Bool -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm String
forall a. String -> TTerm a
var String
"s"
       TTerm (String -> Bool -> String)
-> TTerm String -> TTerm (Bool -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (String -> String -> String)
Strings.cat2 TTerm (String -> String -> String)
-> TTerm String -> TTerm (String -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm String
forall a. String -> TTerm a
var String
"firstLetter" TTerm (String -> String) -> TTerm String -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([Int] -> String)
Strings.fromList TTerm ([Int] -> String) -> TTerm [Int] -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([Int] -> [Int])
forall a. TTerm ([a] -> [a])
Lists.tail TTerm ([Int] -> [Int]) -> TTerm [Int] -> TTerm [Int]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [Int]
forall a. String -> TTerm a
var String
"list")))
       TTerm (Bool -> String) -> TTerm Bool -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (String -> Bool)
Strings.isEmpty TTerm (String -> Bool) -> TTerm String -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm String
forall a. String -> TTerm a
var String
"s"))
    TTerm String -> [Field] -> TTerm String
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"firstLetter"String -> TTerm Any -> Field
forall a. String -> TTerm a -> Field
>: String -> TTerm (String -> Any)
forall a. String -> TTerm a
var String
"mapping" TTerm (String -> Any) -> TTerm String -> TTerm Any
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([Int] -> String)
Strings.fromList TTerm ([Int] -> String) -> TTerm [Int] -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Int -> [Int])
forall a. TTerm (a -> [a])
Lists.pure TTerm (Int -> [Int]) -> TTerm Int -> TTerm [Int]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([Int] -> Int)
forall a. TTerm ([a] -> a)
Lists.head TTerm ([Int] -> Int) -> TTerm [Int] -> TTerm Int
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [Int]
forall a. String -> TTerm a
var String
"list"))),
      String
"list"String -> TTerm [Int] -> Field
forall a. String -> TTerm a -> Field
>: Type -> TTerm [Int] -> TTerm [Int]
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
listT Type
int32T) (TTerm [Int] -> TTerm [Int]) -> TTerm [Int] -> TTerm [Int]
forall a b. (a -> b) -> a -> b
$ TTerm (String -> [Int])
Strings.toList TTerm (String -> [Int]) -> TTerm String -> TTerm [Int]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm String
forall a. String -> TTerm a
var String
"s"])

-- Common.hs

fieldMapDef :: TElement ([Field] -> M.Map Name Term)
fieldMapDef :: TElement ([Field] -> Map Name Term)
fieldMapDef = String
-> TTerm ([Field] -> Map Name Term)
-> TElement ([Field] -> Map Name Term)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"fieldMap" (TTerm ([Field] -> Map Name Term)
 -> TElement ([Field] -> Map Name Term))
-> TTerm ([Field] -> Map Name Term)
-> TElement ([Field] -> Map Name Term)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm ([Field] -> Map Name Term)
-> TTerm ([Field] -> Map Name Term)
forall a. Type -> Type -> TTerm a -> TTerm a
function (Type -> Type
TypeList Type
fieldT) (Type -> Type -> Type
mapT Type
fieldNameT Type
termT) (TTerm ([Field] -> Map Name Term)
 -> TTerm ([Field] -> Map Name Term))
-> TTerm ([Field] -> Map Name Term)
-> TTerm ([Field] -> Map Name Term)
forall a b. (a -> b) -> a -> b
$
  (String -> TTerm (Map Any Any) -> TTerm ([Field] -> Map Name Term)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"fields" (TTerm (Map Any Any) -> TTerm ([Field] -> Map Name Term))
-> TTerm (Map Any Any) -> TTerm ([Field] -> Map Name Term)
forall a b. (a -> b) -> a -> b
$ TTerm ([(Any, Any)] -> Map Any Any)
forall k v. TTerm ([(k, v)] -> Map k v)
Maps.fromList TTerm ([(Any, Any)] -> Map Any Any)
-> TTerm [(Any, Any)] -> TTerm (Map Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ((Any -> (Any, Any)) -> [Any] -> [(Any, Any)])
forall a b. TTerm ((a -> b) -> [a] -> [b])
Lists.map TTerm ((Any -> (Any, Any)) -> [Any] -> [(Any, Any)])
-> TTerm (Any -> (Any, Any)) -> TTerm ([Any] -> [(Any, Any)])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (Any -> (Any, Any))
forall a. String -> TTerm a
var String
"toPair" TTerm ([Any] -> [(Any, Any)]) -> TTerm [Any] -> TTerm [(Any, Any)]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [Any]
forall a. String -> TTerm a
var String
"fields"))
    TTerm ([Field] -> Map Name Term)
-> [Field] -> TTerm ([Field] -> Map Name Term)
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"toPair"String -> TTerm (Any -> Any) -> Field
forall a. String -> TTerm a -> Field
>: String -> TTerm (Name, Term) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"f" (TTerm (Name, Term) -> TTerm (Any -> Any))
-> TTerm (Name, Term) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ TTerm Name -> TTerm Term -> TTerm (Name, Term)
forall a b. TTerm a -> TTerm b -> TTerm (a, b)
pair (TTerm (Field -> Name)
Core.fieldName TTerm (Field -> Name) -> TTerm Field -> TTerm Name
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Field
forall a. String -> TTerm a
var String
"f") (TTerm (Field -> Term)
Core.fieldTerm TTerm (Field -> Term) -> TTerm Field -> TTerm Term
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Field
forall a. String -> TTerm a
var String
"f")]

fieldTypeMapDef :: TElement ([FieldType] -> M.Map Name Type)
fieldTypeMapDef :: TElement ([FieldType] -> Map Name Type)
fieldTypeMapDef = String
-> TTerm ([FieldType] -> Map Name Type)
-> TElement ([FieldType] -> Map Name Type)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"fieldTypeMap" (TTerm ([FieldType] -> Map Name Type)
 -> TElement ([FieldType] -> Map Name Type))
-> TTerm ([FieldType] -> Map Name Type)
-> TElement ([FieldType] -> Map Name Type)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm ([FieldType] -> Map Name Type)
-> TTerm ([FieldType] -> Map Name Type)
forall a. Type -> Type -> TTerm a -> TTerm a
function (Type -> Type
TypeList Type
fieldTypeT) (Type -> Type -> Type
mapT Type
fieldNameT Type
typeT) (TTerm ([FieldType] -> Map Name Type)
 -> TTerm ([FieldType] -> Map Name Type))
-> TTerm ([FieldType] -> Map Name Type)
-> TTerm ([FieldType] -> Map Name Type)
forall a b. (a -> b) -> a -> b
$
    (String
-> TTerm (Map Any Any) -> TTerm ([FieldType] -> Map Name Type)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"fields" (TTerm (Map Any Any) -> TTerm ([FieldType] -> Map Name Type))
-> TTerm (Map Any Any) -> TTerm ([FieldType] -> Map Name Type)
forall a b. (a -> b) -> a -> b
$ TTerm ([(Any, Any)] -> Map Any Any)
forall k v. TTerm ([(k, v)] -> Map k v)
Maps.fromList TTerm ([(Any, Any)] -> Map Any Any)
-> TTerm [(Any, Any)] -> TTerm (Map Any Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ((Any -> (Any, Any)) -> [Any] -> [(Any, Any)])
forall a b. TTerm ((a -> b) -> [a] -> [b])
Lists.map TTerm ((Any -> (Any, Any)) -> [Any] -> [(Any, Any)])
-> TTerm (Any -> (Any, Any)) -> TTerm ([Any] -> [(Any, Any)])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (Any -> (Any, Any))
forall a. String -> TTerm a
var String
"toPair" TTerm ([Any] -> [(Any, Any)]) -> TTerm [Any] -> TTerm [(Any, Any)]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [Any]
forall a. String -> TTerm a
var String
"fields"))
  TTerm ([FieldType] -> Map Name Type)
-> [Field] -> TTerm ([FieldType] -> Map Name Type)
forall a. TTerm a -> [Field] -> TTerm a
`with` [
    String
"toPair"String -> TTerm (Any -> Any) -> Field
forall a. String -> TTerm a -> Field
>: String -> TTerm (Name, Type) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"f" (TTerm (Name, Type) -> TTerm (Any -> Any))
-> TTerm (Name, Type) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ TTerm Name -> TTerm Type -> TTerm (Name, Type)
forall a b. TTerm a -> TTerm b -> TTerm (a, b)
pair (TTerm (FieldType -> Name)
Core.fieldTypeName TTerm (FieldType -> Name) -> TTerm FieldType -> TTerm Name
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm FieldType
forall a. String -> TTerm a
var String
"f") (TTerm (FieldType -> Type)
Core.fieldTypeType TTerm (FieldType -> Type) -> TTerm FieldType -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm FieldType
forall a. String -> TTerm a
var String
"f")]

isEncodedTypeDef :: TElement (Term -> Bool)
isEncodedTypeDef :: TElement (Term -> Bool)
isEncodedTypeDef = String -> TTerm (Term -> Bool) -> TElement (Term -> Bool)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"isEncodedType" (TTerm (Term -> Bool) -> TElement (Term -> Bool))
-> TTerm (Term -> Bool) -> TElement (Term -> Bool)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Term -> Bool) -> TTerm (Term -> Bool)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
termT Type
booleanT (TTerm (Term -> Bool) -> TTerm (Term -> Bool))
-> TTerm (Term -> Bool) -> TTerm (Term -> Bool)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Bool -> TTerm (Term -> Bool)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t" (TTerm Bool -> TTerm (Term -> Bool))
-> TTerm Bool -> TTerm (Term -> Bool)
forall a b. (a -> b) -> a -> b
$ (Name -> Maybe (TTerm Bool) -> [Field] -> TTerm (Term -> Bool)
forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
_Term (TTerm Bool -> Maybe (TTerm Bool)
forall a. a -> Maybe a
Just TTerm Bool
false) [
      Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Term_application TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> String -> TTerm Bool -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"a" (TTerm Bool -> TTerm (Any -> Any))
-> TTerm Bool -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
        TElement (Term -> Bool) -> TTerm (Term -> Bool)
forall a. TElement a -> TTerm a
ref TElement (Term -> Bool)
isEncodedTypeDef TTerm (Term -> Bool) -> TTerm Term -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Application -> Term)
Core.applicationFunction TTerm (Application -> Term) -> TTerm Application -> TTerm Term
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Application
forall a. String -> TTerm a
var String
"a"),
      Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Term_union       TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> String -> TTerm Bool -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"i" (TTerm Bool -> TTerm (Any -> Any))
-> TTerm Bool -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
        TTerm (String -> String -> Bool)
Equality.equalString TTerm (String -> String -> Bool)
-> TTerm String -> TTerm (String -> Bool)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (String -> TTerm String
string (String -> TTerm String) -> String -> TTerm String
forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
_Type) TTerm (String -> Bool) -> TTerm String -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Name -> String)
Core.unName TTerm (Name -> String) -> TTerm Name -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Injection -> Name)
Core.injectionTypeName TTerm (Injection -> Name) -> TTerm Injection -> TTerm Name
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Injection
forall a. String -> TTerm a
var String
"i"))
    ]) TTerm (Term -> Bool) -> TTerm Term -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TElement (Term -> Term) -> TTerm (Term -> Term)
forall a. TElement a -> TTerm a
ref TElement (Term -> Term)
stripTermDef TTerm (Term -> Term) -> TTerm Term -> TTerm Term
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Term
forall a. String -> TTerm a
var String
"t")

isTypeDef :: TElement (Type -> Bool)
isTypeDef :: TElement (Type -> Bool)
isTypeDef = String -> TTerm (Type -> Bool) -> TElement (Type -> Bool)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"isType" (TTerm (Type -> Bool) -> TElement (Type -> Bool))
-> TTerm (Type -> Bool) -> TElement (Type -> Bool)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Type -> Bool) -> TTerm (Type -> Bool)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
typeT Type
booleanT (TTerm (Type -> Bool) -> TTerm (Type -> Bool))
-> TTerm (Type -> Bool) -> TTerm (Type -> Bool)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Bool -> TTerm (Type -> Bool)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t" (TTerm Bool -> TTerm (Type -> Bool))
-> TTerm Bool -> TTerm (Type -> Bool)
forall a b. (a -> b) -> a -> b
$ (Name -> Maybe (TTerm Bool) -> [Field] -> TTerm (Type -> Bool)
forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
_Type (TTerm Bool -> Maybe (TTerm Bool)
forall a. a -> Maybe a
Just TTerm Bool
false) [
      Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Type_application TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> String -> TTerm Bool -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"a" (TTerm Bool -> TTerm (Any -> Any))
-> TTerm Bool -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
        TElement (Type -> Bool) -> TTerm (Type -> Bool)
forall a. TElement a -> TTerm a
ref TElement (Type -> Bool)
isTypeDef TTerm (Type -> Bool) -> TTerm Type -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (ApplicationType -> Type)
Core.applicationTypeFunction TTerm (ApplicationType -> Type)
-> TTerm ApplicationType -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm ApplicationType
forall a. String -> TTerm a
var String
"a"),
      Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Type_lambda TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> String -> TTerm Bool -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"l" (TTerm Bool -> TTerm (Any -> Any))
-> TTerm Bool -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
        TElement (Type -> Bool) -> TTerm (Type -> Bool)
forall a. TElement a -> TTerm a
ref TElement (Type -> Bool)
isTypeDef TTerm (Type -> Bool) -> TTerm Type -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (LambdaType -> Type)
Core.lambdaTypeBody TTerm (LambdaType -> Type) -> TTerm LambdaType -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm LambdaType
forall a. String -> TTerm a
var String
"l"),
      Name -> TCase Any
forall a. Name -> TCase a
TCase Name
_Type_union TCase Any -> TTerm (Any -> Any) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
--> String -> TTerm Bool -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"rt" (TTerm Bool -> TTerm (Any -> Any))
-> TTerm Bool -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
        TTerm (String -> String -> Bool)
Equality.equalString TTerm (String -> String -> Bool)
-> TTerm String -> TTerm (String -> Bool)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (String -> TTerm String
string (String -> TTerm String) -> String -> TTerm String
forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
_Type) TTerm (String -> Bool) -> TTerm String -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Name -> String)
Core.unName TTerm (Name -> String) -> TTerm Name -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (RowType -> Name)
Core.rowTypeTypeName TTerm (RowType -> Name) -> TTerm RowType -> TTerm Name
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm RowType
forall a. String -> TTerm a
var String
"rt"))
--      TCase _Type_variable --> constant true
    ]) TTerm (Type -> Bool) -> TTerm Type -> TTerm Bool
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)
stripTypeDef TTerm (Type -> Type) -> TTerm Type -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Type
forall a. String -> TTerm a
var String
"t")

isUnitTermDef :: TElement (Term -> Bool)
isUnitTermDef :: TElement (Term -> Bool)
isUnitTermDef = String -> TTerm (Term -> Bool) -> TElement (Term -> Bool)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"isUnitTerm" (TTerm (Term -> Bool) -> TElement (Term -> Bool))
-> TTerm (Term -> Bool) -> TElement (Term -> Bool)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Term -> Bool) -> TTerm (Term -> Bool)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
termT Type
booleanT (TTerm (Term -> Bool) -> TTerm (Term -> Bool))
-> TTerm (Term -> Bool) -> TTerm (Term -> Bool)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Bool -> TTerm (Term -> Bool)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t" (TTerm Bool -> TTerm (Term -> Bool))
-> TTerm Bool -> TTerm (Term -> Bool)
forall a b. (a -> b) -> a -> b
$ TTerm (Term -> Term -> Bool)
Equality.equalTerm TTerm (Term -> Term -> Bool) -> TTerm Term -> TTerm (Term -> Bool)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TElement (Term -> Term) -> TTerm (Term -> Term)
forall a. TElement a -> TTerm a
ref TElement (Term -> Term)
fullyStripTermDef TTerm (Term -> Term) -> TTerm Term -> TTerm Term
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Term
forall a. String -> TTerm a
var String
"t") TTerm (Term -> Bool) -> TTerm Term -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ Term -> TTerm Term
forall a. Term -> TTerm a
TTerm (Term -> Term
coreEncodeTerm Term
Terms.unit)

isUnitTypeDef :: TElement (Term -> Bool)
isUnitTypeDef :: TElement (Term -> Bool)
isUnitTypeDef = String -> TTerm (Term -> Bool) -> TElement (Term -> Bool)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"isUnitType" (TTerm (Term -> Bool) -> TElement (Term -> Bool))
-> TTerm (Term -> Bool) -> TElement (Term -> Bool)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Term -> Bool) -> TTerm (Term -> Bool)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
typeT Type
booleanT (TTerm (Term -> Bool) -> TTerm (Term -> Bool))
-> TTerm (Term -> Bool) -> TTerm (Term -> Bool)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Bool -> TTerm (Term -> Bool)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t" (TTerm Bool -> TTerm (Term -> Bool))
-> TTerm Bool -> TTerm (Term -> Bool)
forall a b. (a -> b) -> a -> b
$ TTerm (Type -> Type -> Bool)
Equality.equalType TTerm (Type -> Type -> Bool) -> TTerm Type -> TTerm (Type -> Bool)
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)
stripTypeDef TTerm (Type -> Type) -> TTerm Type -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Type
forall a. String -> TTerm a
var String
"t") TTerm (Type -> Bool) -> TTerm Type -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ Term -> TTerm Type
forall a. Term -> TTerm a
TTerm (Type -> Term
coreEncodeType Type
unitT)

elementsToGraphDef :: TElement (Graph -> Maybe Graph -> [Element] -> Graph)
elementsToGraphDef :: TElement (Graph -> Maybe Graph -> [Element] -> Graph)
elementsToGraphDef = String
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
-> TElement (Graph -> Maybe Graph -> [Element] -> Graph)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"elementsToGraph" (TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
 -> TElement (Graph -> Maybe Graph -> [Element] -> Graph))
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
-> TElement (Graph -> Maybe Graph -> [Element] -> Graph)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
graphT (Type -> Type -> Type
funT (Type -> Type
optionalT Type
graphT) (Type -> Type -> Type
funT (Type -> Type
TypeList Type
elementT) Type
graphT)) (TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
 -> TTerm (Graph -> Maybe Graph -> [Element] -> Graph))
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Any -> Any)
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"parent" (TTerm (Any -> Any)
 -> TTerm (Graph -> Maybe Graph -> [Element] -> Graph))
-> TTerm (Any -> Any)
-> TTerm (Graph -> Maybe Graph -> [Element] -> Graph)
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
"schema" (TTerm (Any -> Any) -> TTerm (Any -> Any))
-> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> TTerm Graph -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"elements" (TTerm Graph -> TTerm (Any -> Any))
-> TTerm Graph -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
    TTerm (Map Name Element)
-> TTerm (Map Name (Maybe Term))
-> TTerm (Map Name TypeScheme)
-> TTerm Term
-> TTerm (Map Name Primitive)
-> TTerm (Maybe Graph)
-> TTerm Graph
Graph.graph
      (TTerm ([(Name, Element)] -> Map Name Element)
forall k v. TTerm ([(k, v)] -> Map k v)
Maps.fromList TTerm ([(Name, Element)] -> Map Name Element)
-> TTerm [(Name, Element)] -> TTerm (Map Name Element)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ((Any -> (Name, Element)) -> [Any] -> [(Name, Element)])
forall a b. TTerm ((a -> b) -> [a] -> [b])
Lists.map TTerm ((Any -> (Name, Element)) -> [Any] -> [(Name, Element)])
-> TTerm (Any -> (Name, Element))
-> TTerm ([Any] -> [(Name, Element)])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (Any -> (Name, Element))
forall a. String -> TTerm a
var String
"toPair" TTerm ([Any] -> [(Name, Element)])
-> TTerm [Any] -> TTerm [(Name, Element)]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [Any]
forall a. String -> TTerm a
var String
"elements"))
      (TTerm (Graph -> Map Name (Maybe Term))
Graph.graphEnvironment TTerm (Graph -> Map Name (Maybe Term))
-> TTerm Graph -> TTerm (Map Name (Maybe Term))
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Graph
forall a. String -> TTerm a
var String
"parent")
      (TTerm (Graph -> Map Name TypeScheme)
Graph.graphTypes TTerm (Graph -> Map Name TypeScheme)
-> TTerm Graph -> TTerm (Map Name TypeScheme)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Graph
forall a. String -> TTerm a
var String
"parent")
      (TTerm (Graph -> Term)
Graph.graphBody TTerm (Graph -> Term) -> TTerm Graph -> TTerm Term
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Graph
forall a. String -> TTerm a
var String
"parent")
      (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
"parent")
      (String -> TTerm (Maybe Graph)
forall a. String -> TTerm a
var String
"schema")
  TTerm Graph -> [Field] -> TTerm Graph
forall a. TTerm a -> [Field] -> TTerm a
`with` [
    String
"toPair" String -> TTerm (Any -> Any) -> Field
forall a. String -> TTerm a -> Field
>: String -> TTerm (Name, Any) -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"el" (TTerm (Name, Any) -> TTerm (Any -> Any))
-> TTerm (Name, Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ TTerm Name -> TTerm Any -> TTerm (Name, Any)
forall a b. TTerm a -> TTerm b -> TTerm (a, b)
pair (TTerm (Element -> Name)
Graph.elementName TTerm (Element -> Name) -> TTerm Element -> TTerm Name
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Element
forall a. String -> TTerm a
var String
"el") (String -> TTerm Any
forall a. String -> TTerm a
var String
"el")]

localNameOfEagerDef :: TElement (Name -> String)
localNameOfEagerDef :: TElement (Name -> String)
localNameOfEagerDef = String -> TTerm (Name -> String) -> TElement (Name -> String)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"localNameOfEager" (TTerm (Name -> String) -> TElement (Name -> String))
-> TTerm (Name -> String) -> TElement (Name -> String)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Name -> String) -> TTerm (Name -> String)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
nameT Type
stringT (TTerm (Name -> String) -> TTerm (Name -> String))
-> TTerm (Name -> String) -> TTerm (Name -> String)
forall a b. (a -> b) -> a -> b
$
  TTerm (QualifiedName -> String)
Module.qualifiedNameLocal TTerm (QualifiedName -> String)
-> TTerm (Name -> QualifiedName) -> TTerm (Name -> String)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (Name -> QualifiedName) -> TTerm (Name -> QualifiedName)
forall a. TElement a -> TTerm a
ref TElement (Name -> QualifiedName)
qualifyNameEagerDef

localNameOfLazyDef :: TElement (Name -> String)
localNameOfLazyDef :: TElement (Name -> String)
localNameOfLazyDef = String -> TTerm (Name -> String) -> TElement (Name -> String)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"localNameOfLazy" (TTerm (Name -> String) -> TElement (Name -> String))
-> TTerm (Name -> String) -> TElement (Name -> String)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Name -> String) -> TTerm (Name -> String)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
nameT Type
stringT (TTerm (Name -> String) -> TTerm (Name -> String))
-> TTerm (Name -> String) -> TTerm (Name -> String)
forall a b. (a -> b) -> a -> b
$
  TTerm (QualifiedName -> String)
Module.qualifiedNameLocal TTerm (QualifiedName -> String)
-> TTerm (Name -> QualifiedName) -> TTerm (Name -> String)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (Name -> QualifiedName) -> TTerm (Name -> QualifiedName)
forall a. TElement a -> TTerm a
ref TElement (Name -> QualifiedName)
qualifyNameLazyDef

namespaceOfEagerDef :: TElement (Name -> Maybe Namespace)
namespaceOfEagerDef :: TElement (Name -> Maybe Namespace)
namespaceOfEagerDef = String
-> TTerm (Name -> Maybe Namespace)
-> TElement (Name -> Maybe Namespace)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"namespaceOfEager" (TTerm (Name -> Maybe Namespace)
 -> TElement (Name -> Maybe Namespace))
-> TTerm (Name -> Maybe Namespace)
-> TElement (Name -> Maybe Namespace)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Name -> Maybe Namespace)
-> TTerm (Name -> Maybe Namespace)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
nameT (Type -> Type
optionalT Type
namespaceT) (TTerm (Name -> Maybe Namespace)
 -> TTerm (Name -> Maybe Namespace))
-> TTerm (Name -> Maybe Namespace)
-> TTerm (Name -> Maybe Namespace)
forall a b. (a -> b) -> a -> b
$
  TTerm (QualifiedName -> Maybe Namespace)
Module.qualifiedNameNamespace TTerm (QualifiedName -> Maybe Namespace)
-> TTerm (Name -> QualifiedName) -> TTerm (Name -> Maybe Namespace)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (Name -> QualifiedName) -> TTerm (Name -> QualifiedName)
forall a. TElement a -> TTerm a
ref TElement (Name -> QualifiedName)
qualifyNameEagerDef

namespaceOfLazyDef :: TElement (Name -> Maybe Namespace)
namespaceOfLazyDef :: TElement (Name -> Maybe Namespace)
namespaceOfLazyDef = String
-> TTerm (Name -> Maybe Namespace)
-> TElement (Name -> Maybe Namespace)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"namespaceOfLazy" (TTerm (Name -> Maybe Namespace)
 -> TElement (Name -> Maybe Namespace))
-> TTerm (Name -> Maybe Namespace)
-> TElement (Name -> Maybe Namespace)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Name -> Maybe Namespace)
-> TTerm (Name -> Maybe Namespace)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
nameT (Type -> Type
optionalT Type
namespaceT) (TTerm (Name -> Maybe Namespace)
 -> TTerm (Name -> Maybe Namespace))
-> TTerm (Name -> Maybe Namespace)
-> TTerm (Name -> Maybe Namespace)
forall a b. (a -> b) -> a -> b
$
  TTerm (QualifiedName -> Maybe Namespace)
Module.qualifiedNameNamespace TTerm (QualifiedName -> Maybe Namespace)
-> TTerm (Name -> QualifiedName) -> TTerm (Name -> Maybe Namespace)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TElement (Name -> QualifiedName) -> TTerm (Name -> QualifiedName)
forall a. TElement a -> TTerm a
ref TElement (Name -> QualifiedName)
qualifyNameLazyDef

namespaceToFilePathDef :: TElement (Bool -> FileExtension -> Namespace -> String)
namespaceToFilePathDef :: TElement (Bool -> FileExtension -> Namespace -> String)
namespaceToFilePathDef = String
-> TTerm (Bool -> FileExtension -> Namespace -> String)
-> TElement (Bool -> FileExtension -> Namespace -> String)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"namespaceToFilePath" (TTerm (Bool -> FileExtension -> Namespace -> String)
 -> TElement (Bool -> FileExtension -> Namespace -> String))
-> TTerm (Bool -> FileExtension -> Namespace -> String)
-> TElement (Bool -> FileExtension -> Namespace -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Bool -> FileExtension -> Namespace -> String)
-> TTerm (Bool -> FileExtension -> Namespace -> String)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
booleanT (Type -> Type -> Type
funT Type
fileExtensionT (Type -> Type -> Type
funT Type
namespaceT Type
stringT)) (TTerm (Bool -> FileExtension -> Namespace -> String)
 -> TTerm (Bool -> FileExtension -> Namespace -> String))
-> TTerm (Bool -> FileExtension -> Namespace -> String)
-> TTerm (Bool -> FileExtension -> Namespace -> String)
forall a b. (a -> b) -> a -> b
$
  String
-> TTerm (Any -> Any)
-> TTerm (Bool -> FileExtension -> Namespace -> String)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"caps" (TTerm (Any -> Any)
 -> TTerm (Bool -> FileExtension -> Namespace -> String))
-> TTerm (Any -> Any)
-> TTerm (Bool -> FileExtension -> Namespace -> String)
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
"ext" (TTerm (Any -> Any) -> TTerm (Any -> Any))
-> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> TTerm String -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"ns" (TTerm String -> TTerm (Any -> Any))
-> TTerm String -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
    (((TTerm (String -> [String] -> String)
Strings.intercalate TTerm (String -> [String] -> String)
-> TTerm String -> TTerm ([String] -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"/" TTerm ([String] -> String) -> TTerm [String] -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [String]
forall a. String -> TTerm a
var String
"parts") TTerm String -> TTerm String -> TTerm String
++ TTerm String
"." TTerm String -> TTerm String -> TTerm String
++ (TTerm (FileExtension -> String)
Module.unFileExtension TTerm (FileExtension -> String)
-> TTerm FileExtension -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm FileExtension
forall a. String -> TTerm a
var String
"ext"))
    TTerm String -> [Field] -> TTerm String
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"parts"String -> TTerm [String] -> Field
forall a. String -> TTerm a -> Field
>: TTerm ((String -> String) -> [String] -> [String])
forall a b. TTerm ((a -> b) -> [a] -> [b])
Lists.map
        TTerm ((String -> String) -> [String] -> [String])
-> TTerm (String -> String) -> TTerm ([String] -> [String])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm
  ((String -> String)
   -> (String -> String) -> Bool -> String -> String)
forall a. TTerm (a -> a -> Bool -> a)
Logic.ifElse
          TTerm
  ((String -> String)
   -> (String -> String) -> Bool -> String -> String)
-> TTerm (String -> String)
-> TTerm ((String -> String) -> Bool -> String -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TElement (String -> String) -> TTerm (String -> String)
forall a. TElement a -> TTerm a
ref TElement (String -> String)
capitalizeDef
          TTerm ((String -> String) -> Bool -> String -> String)
-> TTerm (String -> String) -> TTerm (Bool -> String -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TElement (String -> String) -> TTerm (String -> String)
forall a. TElement a -> TTerm a
ref TElement (String -> String)
forall a. TElement (a -> a)
idDef
          TTerm (Bool -> String -> String)
-> TTerm Bool -> TTerm (String -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Bool
forall a. String -> TTerm a
var String
"caps")
        TTerm ([String] -> [String]) -> TTerm [String] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (String -> String -> [String])
Strings.splitOn TTerm (String -> String -> [String])
-> TTerm String -> TTerm (String -> [String])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"/" TTerm (String -> [String]) -> TTerm String -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Namespace -> String)
Core.unNamespace TTerm (Namespace -> String) -> TTerm Namespace -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Namespace
forall a. String -> TTerm a
var String
"ns"))])

qualifyNameEagerDef :: TElement (Name -> QualifiedName)
qualifyNameEagerDef :: TElement (Name -> QualifiedName)
qualifyNameEagerDef = String
-> TTerm (Name -> QualifiedName)
-> TElement (Name -> QualifiedName)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"qualifyNameEager" (TTerm (Name -> QualifiedName) -> TElement (Name -> QualifiedName))
-> TTerm (Name -> QualifiedName)
-> TElement (Name -> QualifiedName)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Name -> QualifiedName)
-> TTerm (Name -> QualifiedName)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
nameT Type
qualifiedNameT (TTerm (Name -> QualifiedName) -> TTerm (Name -> QualifiedName))
-> TTerm (Name -> QualifiedName) -> TTerm (Name -> QualifiedName)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm QualifiedName -> TTerm (Name -> QualifiedName)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"name" (TTerm QualifiedName -> TTerm (Name -> QualifiedName))
-> TTerm QualifiedName -> TTerm (Name -> QualifiedName)
forall a b. (a -> b) -> a -> b
$ ((TTerm (QualifiedName -> QualifiedName -> Bool -> QualifiedName)
forall a. TTerm (a -> a -> Bool -> a)
Logic.ifElse
      TTerm (QualifiedName -> QualifiedName -> Bool -> QualifiedName)
-> TTerm QualifiedName
-> TTerm (QualifiedName -> Bool -> QualifiedName)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (Maybe Namespace) -> TTerm String -> TTerm QualifiedName
Module.qualifiedName TTerm (Maybe Namespace)
forall a. TTerm a
nothing (TTerm (Name -> String)
Core.unName TTerm (Name -> String) -> TTerm Name -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Name
forall a. String -> TTerm a
var String
"name")
      TTerm (QualifiedName -> Bool -> QualifiedName)
-> TTerm QualifiedName -> TTerm (Bool -> QualifiedName)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (Maybe Namespace) -> TTerm String -> TTerm QualifiedName
Module.qualifiedName
        (TTerm Namespace -> TTerm (Maybe Namespace)
forall x. TTerm x -> TTerm (Maybe x)
just (TTerm Namespace -> TTerm (Maybe Namespace))
-> TTerm Namespace -> TTerm (Maybe Namespace)
forall a b. (a -> b) -> a -> b
$ Name -> TTerm Any -> TTerm Namespace
forall a b. Name -> TTerm a -> TTerm b
wrap Name
_Namespace (TTerm ([Any] -> Any)
forall a. TTerm ([a] -> a)
Lists.head 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
"parts"))
        (TTerm (String -> [String] -> String)
Strings.intercalate TTerm (String -> [String] -> String)
-> TTerm String -> TTerm ([String] -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"." TTerm ([String] -> String) -> TTerm [String] -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([String] -> [String])
forall a. TTerm ([a] -> [a])
Lists.tail TTerm ([String] -> [String]) -> TTerm [String] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [String]
forall a. String -> TTerm a
var String
"parts"))
      TTerm (Bool -> QualifiedName) -> TTerm Bool -> TTerm QualifiedName
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Int -> Int -> Bool)
Equality.equalInt32 TTerm (Int -> Int -> Bool) -> TTerm Int -> TTerm (Int -> Bool)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ Int -> TTerm Int
int32 Int
1 TTerm (Int -> Bool) -> TTerm Int -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([Any] -> Int)
forall a. TTerm ([a] -> Int)
Lists.length TTerm ([Any] -> Int) -> TTerm [Any] -> TTerm Int
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [Any]
forall a. String -> TTerm a
var String
"parts")))
    TTerm QualifiedName -> [Field] -> TTerm QualifiedName
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"parts"String -> TTerm [String] -> Field
forall a. String -> TTerm a -> Field
>: TTerm (String -> String -> [String])
Strings.splitOn TTerm (String -> String -> [String])
-> TTerm String -> TTerm (String -> [String])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"." TTerm (String -> [String]) -> TTerm String -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Name -> String)
Core.unName TTerm (Name -> String) -> TTerm Name -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Name
forall a. String -> TTerm a
var String
"name")])

qualifyNameLazyDef :: TElement (Name -> QualifiedName)
qualifyNameLazyDef :: TElement (Name -> QualifiedName)
qualifyNameLazyDef = String
-> TTerm (Name -> QualifiedName)
-> TElement (Name -> QualifiedName)
forall a. String -> TTerm a -> TElement a
basicsDefinition String
"qualifyNameLazy" (TTerm (Name -> QualifiedName) -> TElement (Name -> QualifiedName))
-> TTerm (Name -> QualifiedName)
-> TElement (Name -> QualifiedName)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> TTerm (Name -> QualifiedName)
-> TTerm (Name -> QualifiedName)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
nameT Type
qualifiedNameT (TTerm (Name -> QualifiedName) -> TTerm (Name -> QualifiedName))
-> TTerm (Name -> QualifiedName) -> TTerm (Name -> QualifiedName)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm QualifiedName -> TTerm (Name -> QualifiedName)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"name" (TTerm QualifiedName -> TTerm (Name -> QualifiedName))
-> TTerm QualifiedName -> TTerm (Name -> QualifiedName)
forall a b. (a -> b) -> a -> b
$ (TTerm (QualifiedName -> QualifiedName -> Bool -> QualifiedName)
forall a. TTerm (a -> a -> Bool -> a)
Logic.ifElse
      TTerm (QualifiedName -> QualifiedName -> Bool -> QualifiedName)
-> TTerm QualifiedName
-> TTerm (QualifiedName -> Bool -> QualifiedName)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (Maybe Namespace) -> TTerm String -> TTerm QualifiedName
Module.qualifiedName TTerm (Maybe Namespace)
forall a. TTerm a
nothing (TTerm (Name -> String)
Core.unName TTerm (Name -> String) -> TTerm Name -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Name
forall a. String -> TTerm a
var String
"name")
      TTerm (QualifiedName -> Bool -> QualifiedName)
-> TTerm QualifiedName -> TTerm (Bool -> QualifiedName)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (Maybe Namespace) -> TTerm String -> TTerm QualifiedName
Module.qualifiedName
        (TTerm Namespace -> TTerm (Maybe Namespace)
forall x. TTerm x -> TTerm (Maybe x)
just (TTerm Namespace -> TTerm (Maybe Namespace))
-> TTerm Namespace -> TTerm (Maybe Namespace)
forall a b. (a -> b) -> a -> b
$ Name -> TTerm String -> TTerm Namespace
forall a b. Name -> TTerm a -> TTerm b
wrap Name
_Namespace (TTerm (String -> [String] -> String)
Strings.intercalate TTerm (String -> [String] -> String)
-> TTerm String -> TTerm ([String] -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"." TTerm ([String] -> String) -> TTerm [String] -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([String] -> [String])
forall a. TTerm ([a] -> [a])
Lists.reverse TTerm ([String] -> [String]) -> TTerm [String] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([String] -> [String])
forall a. TTerm ([a] -> [a])
Lists.tail TTerm ([String] -> [String]) -> TTerm [String] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [String]
forall a. String -> TTerm a
var String
"parts"))))
        (TTerm ([String] -> String)
forall a. TTerm ([a] -> a)
Lists.head TTerm ([String] -> String) -> TTerm [String] -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [String]
forall a. String -> TTerm a
var String
"parts")
      TTerm (Bool -> QualifiedName) -> TTerm Bool -> TTerm QualifiedName
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Int -> Int -> Bool)
Equality.equalInt32 TTerm (Int -> Int -> Bool) -> TTerm Int -> TTerm (Int -> Bool)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ Int -> TTerm Int
int32 Int
1 TTerm (Int -> Bool) -> TTerm Int -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([Any] -> Int)
forall a. TTerm ([a] -> Int)
Lists.length TTerm ([Any] -> Int) -> TTerm [Any] -> TTerm Int
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [Any]
forall a. String -> TTerm a
var String
"parts")))
    TTerm QualifiedName -> [Field] -> TTerm QualifiedName
forall a. TTerm a -> [Field] -> TTerm a
`with` [
      String
"parts"String -> TTerm [String] -> Field
forall a. String -> TTerm a -> Field
>: TTerm ([String] -> [String])
forall a. TTerm ([a] -> [a])
Lists.reverse TTerm ([String] -> [String]) -> TTerm [String] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (String -> String -> [String])
Strings.splitOn TTerm (String -> String -> [String])
-> TTerm String -> TTerm (String -> [String])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"." TTerm (String -> [String]) -> TTerm String -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Name -> String)
Core.unName TTerm (Name -> String) -> TTerm Name -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Name
forall a. String -> TTerm a
var String
"name"))]