module Hydra.Impl.Haskell.Sources.Adapters.Utils where

import Hydra.All
import qualified Hydra.Impl.Haskell.Dsl.Types as Types
import Hydra.Impl.Haskell.Sources.Basics
import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard
import Hydra.Impl.Haskell.Dsl.Base as Base
import Hydra.Impl.Haskell.Dsl.Lib.Literals as Literals

import Prelude hiding ((++))


utilsNs :: Namespace
utilsNs = String -> Namespace
Namespace String
"hydra/adapters/utils"

adapterUtilsModule :: Module Meta
adapterUtilsModule :: Module Meta
adapterUtilsModule = forall m.
Namespace -> [Element m] -> [Module m] -> Maybe String -> Module m
Module Namespace
utilsNs [Element Meta]
elements [Module Meta
hydraBasicsModule] forall a b. (a -> b) -> a -> b
$
    forall a. a -> Maybe a
Just String
"Utilities for use in transformations"
  where
   elements :: [Element Meta]
elements = [
     forall a. Definition a -> Element Meta
el Definition (FloatType -> String)
describeFloatTypeSource,
     forall a. Definition a -> Element Meta
el Definition (IntegerType -> String)
describeIntegerTypeSource,
     forall a. Definition a -> Element Meta
el Definition (LiteralType -> String)
describeLiteralTypeSource,
     forall a. Definition a -> Element Meta
el Definition (Precision -> String)
describePrecisionSource,
     forall a. Definition a -> Element Meta
el forall m string. Definition (Type m -> string)
describeTypeSource]

utils :: String -> Datum a -> Definition a
utils :: forall a. String -> Datum a -> Definition a
utils = forall a. Name -> Datum a -> Definition a
Definition forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace -> String -> Name
fromQname Namespace
utilsNs

describeFloatTypeSource :: Definition (FloatType -> String)
describeFloatTypeSource :: Definition (FloatType -> String)
describeFloatTypeSource = forall a. String -> Datum a -> Definition a
utils String
"describeFloatType" forall a b. (a -> b) -> a -> b
$
  forall a. String -> Datum a -> Datum a
doc String
"Display a floating-point type as a string" forall a b. (a -> b) -> a -> b
$
  forall a. Type Meta -> Type Meta -> Datum a -> Datum a
function (forall m. Name -> Type m
Types.nominal Name
_FloatType) forall m. Type m
Types.string forall a b. (a -> b) -> a -> b
$
  forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" forall a b. (a -> b) -> a -> b
$ (forall a. Definition a -> Datum a
ref Definition (Precision -> String)
describePrecisionSource forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> forall a. Definition a -> Datum a
ref Definition (FloatType -> Precision)
floatTypePrecisionSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"t") Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
" floating-point numbers"

describeIntegerTypeSource :: Definition (IntegerType -> String)
describeIntegerTypeSource :: Definition (IntegerType -> String)
describeIntegerTypeSource = forall a. String -> Datum a -> Definition a
utils String
"describeIntegerType" forall a b. (a -> b) -> a -> b
$
  forall a. String -> Datum a -> Datum a
doc String
"Display an integer type as a string" forall a b. (a -> b) -> a -> b
$
  forall a. Type Meta -> Type Meta -> Datum a -> Datum a
function (forall m. Name -> Type m
Types.nominal Name
_IntegerType) forall m. Type m
Types.string forall a b. (a -> b) -> a -> b
$
  forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" forall a b. (a -> b) -> a -> b
$ (forall a. Definition a -> Datum a
ref Definition (Precision -> String)
describePrecisionSource forall b c a. Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)
<.> forall a. Definition a -> Datum a
ref Definition (IntegerType -> Precision)
integerTypePrecisionSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"t")
    Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
" integers"

describeLiteralTypeSource :: Definition (LiteralType -> String)
describeLiteralTypeSource :: Definition (LiteralType -> String)
describeLiteralTypeSource = forall a. String -> Datum a -> Definition a
utils String
"describeLiteralType" forall a b. (a -> b) -> a -> b
$
  forall a. String -> Datum a -> Datum a
doc String
"Display a literal type as a string" forall a b. (a -> b) -> a -> b
$
  forall u b. Name -> Type Meta -> [Field Meta] -> Datum (u -> b)
match Name
_LiteralType forall m. Type m
Types.string [
    forall a. FieldName -> Case a
Case FieldName
_LiteralType_binary  forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"binary strings",
    forall a. FieldName -> Case a
Case FieldName
_LiteralType_boolean forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"boolean values",
    forall a. FieldName -> Case a
Case FieldName
_LiteralType_float   forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a. Definition a -> Datum a
ref Definition (FloatType -> String)
describeFloatTypeSource,
    forall a. FieldName -> Case a
Case FieldName
_LiteralType_integer forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a. Definition a -> Datum a
ref Definition (IntegerType -> String)
describeIntegerTypeSource,
    forall a. FieldName -> Case a
Case FieldName
_LiteralType_string  forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"character strings"]

describePrecisionSource :: Definition (Precision -> String)
describePrecisionSource :: Definition (Precision -> String)
describePrecisionSource = forall a. String -> Datum a -> Definition a
utils String
"describePrecision" forall a b. (a -> b) -> a -> b
$
  forall a. String -> Datum a -> Datum a
doc String
"Display numeric precision as a string" forall a b. (a -> b) -> a -> b
$
  forall u b. Name -> Type Meta -> [Field Meta] -> Datum (u -> b)
match Name
_Precision forall m. Type m
Types.string [
    forall a. FieldName -> Case a
Case FieldName
_Precision_arbitrary forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"arbitrary-precision",
    forall a. FieldName -> Case a
Case FieldName
_Precision_bits      forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"bits" forall a b. (a -> b) -> a -> b
$
      Datum (Int -> String)
showInt32 forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"bits" Datum String -> Datum String -> Datum String
++ String -> Datum String
string String
"-bit"]

describeTypeSource :: Definition (Type m -> string)
describeTypeSource :: forall m string. Definition (Type m -> string)
describeTypeSource = forall a. String -> Datum a -> Definition a
utils String
"describeType" forall a b. (a -> b) -> a -> b
$
  forall a. String -> Datum a -> Datum a
doc String
"Display a type as a string" forall a b. (a -> b) -> a -> b
$
  forall a. Type Meta -> Type Meta -> Datum a -> Datum a
function (forall m. Type m -> Type m -> Type m
Types.apply (forall m. Name -> Type m
Types.nominal Name
_Type) (forall m. String -> Type m
Types.variable String
"m")) forall m. Type m
Types.string forall a b. (a -> b) -> a -> b
$
  forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"typ" forall a b. (a -> b) -> a -> b
$ forall a b. Datum (a -> b) -> Datum a -> Datum b
apply
    (forall u b. Name -> Type Meta -> [Field Meta] -> Datum (u -> b)
match Name
_Type forall m. Type m
Types.string [
      forall a. FieldName -> Case a
Case FieldName
_Type_annotated   forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"a" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"annotated " Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@
        (forall a b. Name -> Type Meta -> FieldName -> Datum (a -> b)
project Name
_Annotated forall m. Type m
typeM FieldName
_Annotated_subject forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"a")),
      forall a. FieldName -> Case a
Case FieldName
_Type_application forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"instances of an application type",
      forall a. FieldName -> Case a
Case FieldName
_Type_literal     forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a. Definition a -> Datum a
ref Definition (LiteralType -> String)
describeLiteralTypeSource,
      forall a. FieldName -> Case a
Case FieldName
_Type_element     forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"elements containing " Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"t"),
      forall a. FieldName -> Case a
Case FieldName
_Type_function    forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"ft" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"functions from "
        Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (forall a b. Name -> Type Meta -> FieldName -> Datum (a -> b)
project Name
_FunctionType forall m. Type m
typeM FieldName
_FunctionType_domain forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ 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
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (forall a b. Name -> Type Meta -> FieldName -> Datum (a -> b)
project Name
_FunctionType forall m. Type m
typeM FieldName
_FunctionType_codomain forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"ft")),
      forall a. FieldName -> Case a
Case FieldName
_Type_lambda      forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"polymorphic terms",
      forall a. FieldName -> Case a
Case FieldName
_Type_list        forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"lists of " Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"t"),
      forall a. FieldName -> Case a
Case FieldName
_Type_map         forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"mt" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"maps from "
        Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (forall a b. Name -> Type Meta -> FieldName -> Datum (a -> b)
project Name
_MapType forall m. Type m
typeM FieldName
_MapType_keys forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ 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
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ (forall a b. Name -> Type Meta -> FieldName -> Datum (a -> b)
project Name
_MapType forall m. Type m
typeM FieldName
_MapType_values  forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"mt")),
      forall a. FieldName -> Case a
Case FieldName
_Type_nominal     forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"name" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"alias for " Datum String -> Datum String -> Datum String
++ (forall a b. Name -> Datum (a -> b)
denom Name
_Name forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"name"),
      forall a. FieldName -> Case a
Case FieldName
_Type_optional    forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"ot" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"optional " Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"ot"),
      forall a. FieldName -> Case a
Case FieldName
_Type_product     forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"tuples",
      forall a. FieldName -> Case a
Case FieldName
_Type_record      forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"records",
      forall a. FieldName -> Case a
Case FieldName
_Type_set         forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"st" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"sets of " Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"st"),
      forall a. FieldName -> Case a
Case FieldName
_Type_stream      forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall x a b. String -> Datum x -> Datum (a -> b)
lambda String
"t" forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"streams of " Datum String -> Datum String -> Datum String
++ (forall a. Definition a -> Datum a
ref forall m string. Definition (Type m -> string)
describeTypeSource forall a b. Datum (a -> b) -> Datum a -> Datum b
@@ forall a. String -> Datum a
var String
"t"),
      forall a. FieldName -> Case a
Case FieldName
_Type_sum         forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"variant tuples",
      forall a. FieldName -> Case a
Case FieldName
_Type_union       forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"unions",
      forall a. FieldName -> Case a
Case FieldName
_Type_variable    forall a b. Case a -> Datum (a -> b) -> Field Meta
--> forall a b. Datum a -> Datum (b -> a)
constant forall a b. (a -> b) -> a -> b
$ String -> Datum String
string String
"unspecified/parametric terms"])
    (forall a. String -> Datum a
var String
"typ")
  where
    annotatedTypeM :: Type m
annotatedTypeM = forall m. Type m -> Type m -> Type m
Types.apply (forall m. Type m -> Type m -> Type m
Types.apply (forall m. Name -> Type m
Types.nominal Name
_Annotated) (forall m. Type m -> Type m -> Type m
Types.apply (forall m. Name -> Type m
Types.nominal Name
_Type) (forall m. String -> Type m
Types.variable String
"m"))) (forall m. String -> Type m
Types.variable String
"m")
    functionTypeM :: Type m
functionTypeM = forall m. Type m -> Type m -> Type m
Types.apply (forall m. Name -> Type m
Types.nominal Name
_FunctionType) (forall m. String -> Type m
Types.variable String
"m")
    typeM :: Type m
typeM = forall m. Type m -> Type m -> Type m
Types.apply (forall m. Name -> Type m
Types.nominal Name
_Type) (forall m. String -> Type m
Types.variable String
"m")
    mapTypeM :: Type m
mapTypeM = forall m. Type m -> Type m -> Type m
Types.apply (forall m. Name -> Type m
Types.nominal Name
_MapType) (forall m. String -> Type m
Types.variable String
"m")