{-# 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 = [
     TElement (FloatType -> String) -> Element
forall a. TElement a -> Element
el TElement (FloatType -> String)
describeFloatTypeDef,
     TElement (IntegerType -> String) -> Element
forall a. TElement a -> Element
el TElement (IntegerType -> String)
describeIntegerTypeDef,
     TElement (LiteralType -> String) -> Element
forall a. TElement a -> Element
el TElement (LiteralType -> String)
describeLiteralTypeDef,
     TElement (Precision -> String) -> Element
forall a. TElement a -> Element
el TElement (Precision -> String)
describePrecisionDef,
     TElement (Type -> String) -> Element
forall a. TElement a -> Element
el TElement (Type -> String)
describeTypeDef]

printingDefinition :: String -> TTerm a -> TElement a
printingDefinition :: forall a. String -> TTerm a -> TElement a
printingDefinition = Module -> String -> TTerm a -> TElement a
forall a. Module -> String -> TTerm a -> TElement a
definitionInModule Module
hydraPrintingModule


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

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

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

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

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