{-# LANGUAGE OverloadedStrings #-}

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

import Hydra.Sources.Tier2.Basics


hydraPrintingModule :: Module
hydraPrintingModule :: Module
hydraPrintingModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module (String -> Namespace
Namespace String
"hydra/printing") [Element]
elements
    [Module
hydraBasicsModule]
    [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
"Utilities for use in transformations"
  where
   elements :: [Element]
elements = [
     Definition (FloatType -> String) -> Element
forall a. Definition a -> Element
el Definition (FloatType -> String)
describeFloatTypeDef,
     Definition (IntegerType -> String) -> Element
forall a. Definition a -> Element
el Definition (IntegerType -> String)
describeIntegerTypeDef,
     Definition (LiteralType -> String) -> Element
forall a. Definition a -> Element
el Definition (LiteralType -> String)
describeLiteralTypeDef,
     Definition (Precision -> String) -> Element
forall a. Definition a -> Element
el Definition (Precision -> String)
describePrecisionDef,
     Definition (Type -> String) -> Element
forall a. Definition a -> Element
el Definition (Type -> String)
describeTypeDef]

printingDefinition :: String -> Datum a -> Definition a
printingDefinition :: forall a. String -> Datum a -> Definition a
printingDefinition = Module -> String -> Datum a -> Definition a
forall a. Module -> String -> Datum a -> Definition a
definitionInModule Module
hydraPrintingModule


describeFloatTypeDef :: Definition (FloatType -> String)
describeFloatTypeDef :: Definition (FloatType -> String)
describeFloatTypeDef = String
-> Datum (FloatType -> String) -> Definition (FloatType -> String)
forall a. String -> Datum a -> Definition a
printingDefinition String
"describeFloatType" (Datum (FloatType -> String) -> Definition (FloatType -> String))
-> Datum (FloatType -> String) -> Definition (FloatType -> String)
forall a b. (a -> b) -> a -> b
$
  String
-> Datum (FloatType -> String) -> Datum (FloatType -> String)
forall a. String -> Datum a -> Datum a
doc String
"Display a floating-point type as a string" (Datum (FloatType -> String) -> Datum (FloatType -> String))
-> Datum (FloatType -> String) -> Datum (FloatType -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> Datum (FloatType -> String)
-> Datum (FloatType -> String)
forall a. Type -> Type -> Datum a -> Datum a
function Type
floatTypeT Type
stringT (Datum (FloatType -> String) -> Datum (FloatType -> String))
-> Datum (FloatType -> String) -> Datum (FloatType -> String)
forall a b. (a -> b) -> a -> b
$
  String -> Datum String -> Datum (FloatType -> String)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" (Datum String -> Datum (FloatType -> String))
-> Datum String -> Datum (FloatType -> String)
forall a b. (a -> b) -> a -> b
$ (Definition (Precision -> String) -> Datum (Precision -> String)
forall a. Definition a -> Datum a
ref Definition (Precision -> String)
describePrecisionDef Datum (Precision -> String)
-> Datum (FloatType -> Precision) -> Datum (FloatType -> String)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> Definition (FloatType -> Precision)
-> Datum (FloatType -> Precision)
forall a. Definition a -> Datum a
ref Definition (FloatType -> Precision)
floatTypePrecisionDef Datum (FloatType -> String) -> Datum FloatType -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum FloatType
forall a. String -> Datum a
var String
"t") Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
" floating-point numbers"

describeIntegerTypeDef :: Definition (IntegerType -> String)
describeIntegerTypeDef :: Definition (IntegerType -> String)
describeIntegerTypeDef = String
-> Datum (IntegerType -> String)
-> Definition (IntegerType -> String)
forall a. String -> Datum a -> Definition a
printingDefinition String
"describeIntegerType" (Datum (IntegerType -> String)
 -> Definition (IntegerType -> String))
-> Datum (IntegerType -> String)
-> Definition (IntegerType -> String)
forall a b. (a -> b) -> a -> b
$
  String
-> Datum (IntegerType -> String) -> Datum (IntegerType -> String)
forall a. String -> Datum a -> Datum a
doc String
"Display an integer type as a string" (Datum (IntegerType -> String) -> Datum (IntegerType -> String))
-> Datum (IntegerType -> String) -> Datum (IntegerType -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> Datum (IntegerType -> String)
-> Datum (IntegerType -> String)
forall a. Type -> Type -> Datum a -> Datum a
function Type
integerTypeT Type
stringT (Datum (IntegerType -> String) -> Datum (IntegerType -> String))
-> Datum (IntegerType -> String) -> Datum (IntegerType -> String)
forall a b. (a -> b) -> a -> b
$
  String -> Datum String -> Datum (IntegerType -> String)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" (Datum String -> Datum (IntegerType -> String))
-> Datum String -> Datum (IntegerType -> String)
forall a b. (a -> b) -> a -> b
$ (Definition (Precision -> String) -> Datum (Precision -> String)
forall a. Definition a -> Datum a
ref Definition (Precision -> String)
describePrecisionDef Datum (Precision -> String)
-> Datum (IntegerType -> Precision)
-> Datum (IntegerType -> String)
forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> Definition (IntegerType -> Precision)
-> Datum (IntegerType -> Precision)
forall a. Definition a -> Datum a
ref Definition (IntegerType -> Precision)
integerTypePrecisionDef Datum (IntegerType -> String) -> Datum IntegerType -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum IntegerType
forall a. String -> Datum a
var String
"t")
    Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
" integers"

describeLiteralTypeDef :: Definition (LiteralType -> String)
describeLiteralTypeDef :: Definition (LiteralType -> String)
describeLiteralTypeDef = String
-> Datum (LiteralType -> String)
-> Definition (LiteralType -> String)
forall a. String -> Datum a -> Definition a
printingDefinition String
"describeLiteralType" (Datum (LiteralType -> String)
 -> Definition (LiteralType -> String))
-> Datum (LiteralType -> String)
-> Definition (LiteralType -> String)
forall a b. (a -> b) -> a -> b
$
  String
-> Datum (LiteralType -> String) -> Datum (LiteralType -> String)
forall a. String -> Datum a -> Datum a
doc String
"Display a literal type as a string" (Datum (LiteralType -> String) -> Datum (LiteralType -> String))
-> Datum (LiteralType -> String) -> Datum (LiteralType -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> Datum (LiteralType -> String)
-> Datum (LiteralType -> String)
forall a. Type -> Type -> Datum a -> Datum a
function Type
literalTypeT Type
stringT (Datum (LiteralType -> String) -> Datum (LiteralType -> String))
-> Datum (LiteralType -> String) -> Datum (LiteralType -> String)
forall a b. (a -> b) -> a -> b
$
  Name
-> Maybe (Datum String) -> [Field] -> Datum (LiteralType -> String)
forall b u. Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)
match Name
_LiteralType Maybe (Datum String)
forall a. Maybe a
Nothing [
    Name -> Case Any
forall a. Name -> Case a
Case Name
_LiteralType_binary  Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"binary strings",
    Name -> Case Any
forall a. Name -> Case a
Case Name
_LiteralType_boolean Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"boolean values",
    Name -> Case FloatType
forall a. Name -> Case a
Case Name
_LiteralType_float   Case FloatType -> Datum (FloatType -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Definition (FloatType -> String) -> Datum (FloatType -> String)
forall a. Definition a -> Datum a
ref Definition (FloatType -> String)
describeFloatTypeDef,
    Name -> Case IntegerType
forall a. Name -> Case a
Case Name
_LiteralType_integer Case IntegerType -> Datum (IntegerType -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Definition (IntegerType -> String) -> Datum (IntegerType -> String)
forall a. Definition a -> Datum a
ref Definition (IntegerType -> String)
describeIntegerTypeDef,
    Name -> Case Any
forall a. Name -> Case a
Case Name
_LiteralType_string  Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"character strings"]

describePrecisionDef :: Definition (Precision -> String)
describePrecisionDef :: Definition (Precision -> String)
describePrecisionDef = String
-> Datum (Precision -> String) -> Definition (Precision -> String)
forall a. String -> Datum a -> Definition a
printingDefinition String
"describePrecision" (Datum (Precision -> String) -> Definition (Precision -> String))
-> Datum (Precision -> String) -> Definition (Precision -> String)
forall a b. (a -> b) -> a -> b
$
  String
-> Datum (Precision -> String) -> Datum (Precision -> String)
forall a. String -> Datum a -> Datum a
doc String
"Display numeric precision as a string" (Datum (Precision -> String) -> Datum (Precision -> String))
-> Datum (Precision -> String) -> Datum (Precision -> String)
forall a b. (a -> b) -> a -> b
$
  Type
-> Type
-> Datum (Precision -> String)
-> Datum (Precision -> String)
forall a. Type -> Type -> Datum a -> Datum a
function Type
precisionT Type
stringT (Datum (Precision -> String) -> Datum (Precision -> String))
-> Datum (Precision -> String) -> Datum (Precision -> String)
forall a b. (a -> b) -> a -> b
$
  Name
-> Maybe (Datum String) -> [Field] -> Datum (Precision -> String)
forall b u. Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)
match Name
_Precision Maybe (Datum String)
forall a. Maybe a
Nothing [
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Precision_arbitrary Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"arbitrary-precision",
    Name -> Case Any
forall a. Name -> Case a
Case Name
_Precision_bits      Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"bits" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ Datum (Int -> String)
Literals.showInt32 Datum (Int -> String) -> Datum Int -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Int
forall a. String -> Datum a
var String
"bits" Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
"-bit"]

describeTypeDef :: Definition (Type -> String)
describeTypeDef :: Definition (Type -> String)
describeTypeDef = String -> Datum (Type -> String) -> Definition (Type -> String)
forall a. String -> Datum a -> Definition a
printingDefinition String
"describeType" (Datum (Type -> String) -> Definition (Type -> String))
-> Datum (Type -> String) -> Definition (Type -> String)
forall a b. (a -> b) -> a -> b
$
  String -> Datum (Type -> String) -> Datum (Type -> String)
forall a. String -> Datum a -> Datum a
doc String
"Display a type as a string" (Datum (Type -> String) -> Datum (Type -> String))
-> Datum (Type -> String) -> Datum (Type -> String)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> Datum (Type -> String) -> Datum (Type -> String)
forall a. Type -> Type -> Datum a -> Datum a
function Type
typeT Type
stringT (Datum (Type -> String) -> Datum (Type -> String))
-> Datum (Type -> String) -> Datum (Type -> String)
forall a b. (a -> b) -> a -> b
$
    Name -> Maybe (Datum String) -> [Field] -> Datum (Type -> String)
forall b u. Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)
match Name
_Type Maybe (Datum String)
forall a. Maybe a
Nothing [
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_annotated   Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"a" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"annotated " Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@
        (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_AnnotatedType Name
_AnnotatedType_subject Datum (Any -> Type) -> Datum Any -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"a")),
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_application Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"instances of an application type",
      Name -> Case LiteralType
forall a. Name -> Case a
Case Name
_Type_literal     Case LiteralType -> Datum (LiteralType -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Definition (LiteralType -> String) -> Datum (LiteralType -> String)
forall a. Definition a -> Datum a
ref Definition (LiteralType -> String)
describeLiteralTypeDef,
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_function    Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"ft" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"functions from "
        Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_FunctionType Name
_FunctionType_domain Datum (Any -> Type) -> Datum Any -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"ft"))
        Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
" to "
        Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_FunctionType Name
_FunctionType_codomain Datum (Any -> Type) -> Datum Any -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"ft")),
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_lambda      Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"polymorphic terms",
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_list        Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"lists of " Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Type
forall a. String -> Datum a
var String
"t"),
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_map         Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"mt" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"maps from "
        Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_MapType Name
_MapType_keys Datum (Any -> Type) -> Datum Any -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"mt"))
        Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
" to "
        Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_MapType Name
_MapType_values  Datum (Any -> Type) -> Datum Any -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"mt")),
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_optional    Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"ot" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"optional " Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Type
forall a. String -> Datum a
var String
"ot"),
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_product     Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"tuples",
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_record      Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"records",
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_set         Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"st" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"sets of " Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Type
forall a. String -> Datum a
var String
"st"),
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_sum         Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"variant tuples",
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_union       Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"unions",
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_variable    Case Any -> Datum (Any -> String) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> Datum String -> Datum (Any -> String)
forall a b. Datum a -> Datum (b -> a)
constant (Datum String -> Datum (Any -> String))
-> Datum String -> Datum (Any -> String)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"instances of a named type",
      Name -> Case Any
forall a. Name -> Case a
Case Name
_Type_wrap        Case Any -> Datum (Any -> Any) -> Field
forall a b. Case a -> Datum (a -> b) -> Field
--> String -> Datum String -> Datum (Any -> Any)
forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"n" (Datum String -> Datum (Any -> Any))
-> Datum String -> Datum (Any -> Any)
forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"wrapper for "
        Datum String -> Datum String -> Datum String
++ (Definition (Type -> String) -> Datum (Type -> String)
forall a. Definition a -> Datum a
ref Definition (Type -> String)
describeTypeDef Datum (Type -> String) -> Datum Type -> Datum String
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (Name -> Name -> Datum (Any -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_WrappedType Name
_WrappedType_object Datum (Any -> Type) -> Datum Any -> Datum Type
forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ String -> Datum Any
forall a. String -> Datum a
var String
"n"))]