{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier0.Coders where

-- Standard Tier-0 imports
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.Annotations
import           Hydra.Dsl.Bootstrap
import qualified Hydra.Dsl.Terms       as Terms
import           Hydra.Dsl.Types       as Types
import           Hydra.Sources.Core

import Hydra.Sources.Tier0.Compute
import Hydra.Sources.Tier0.Graph
import Hydra.Sources.Tier0.Mantle


hydraCodersModule :: Module
hydraCodersModule :: Module
hydraCodersModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraMantleModule, Module
hydraGraphModule] [Module
hydraCoreModule] (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just String
"Abstractions for paired transformations between languages"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/coders"
    core :: String -> Type
core = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
hydraCoreModule
    compute :: String -> Type
compute = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
hydraComputeModule
    graph :: String -> Type
graph = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
hydraGraphModule
    mantle :: String -> Type
mantle = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
hydraMantleModule
    coders :: String -> Type
coders = Namespace -> String -> Type
typeref Namespace
ns

    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"AdapterContext" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An evaluation context together with a source language and a target language" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"graph"String -> Type -> FieldType
>: String -> Type
graph String
"Graph",
          String
"language"String -> Type -> FieldType
>: String -> Type
coders String
"Language",
          String
"adapters"String -> Type -> FieldType
>: Type -> Type -> Type
Types.map (String -> Type
core String
"Name") (String -> Type
compute String
"Adapter"
            Type -> Type -> Type
@@ String -> Type
coders String
"AdapterContext" Type -> Type -> Type
@@ String -> Type
coders String
"AdapterContext"
            Type -> Type -> Type
@@ String -> Type
core String
"Type" Type -> Type -> Type
@@ String -> Type
core String
"Type"
            Type -> Type -> Type
@@ String -> Type
core String
"Term" Type -> Type -> Type
@@ String -> Type
core String
"Term")],

      String -> Type -> Element
def String
"CoderDirection" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Indicates either the 'out' or the 'in' direction of a coder" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [
          String
"encode",
          String
"decode"],

      String -> Type -> Element
def String
"Language" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A named language together with language-specific constraints" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: String -> Type
coders String
"LanguageName",
          String
"constraints"String -> Type -> FieldType
>: String -> Type
coders String
"LanguageConstraints"],

      String -> Type -> Element
def String
"LanguageConstraints" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A set of constraints on valid type and term expressions, characterizing a language" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"eliminationVariants"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported elimination variants" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
Types.set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mantle String
"EliminationVariant",
          String
"literalVariants"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported literal variants" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
Types.set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mantle String
"LiteralVariant",
          String
"floatTypes"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported float types" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
Types.set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
core String
"FloatType",
          String
"functionVariants"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported function variants" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
Types.set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mantle String
"FunctionVariant",
          String
"integerTypes"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported integer types" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
Types.set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
core String
"IntegerType",
          String
"termVariants"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported term variants" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
Types.set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mantle String
"TermVariant",
          String
"typeVariants"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported type variants" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
Types.set (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mantle String
"TypeVariant",
          String
"types"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A logical set of types, as a predicate which tests a type for inclusion" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
core String
"Type" Type -> Type -> Type
--> Type
boolean],

      String -> Type -> Element
def String
"LanguageName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"The unique name of a language" Type
string,

      String -> Type -> Element
def String
"TraversalOrder" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Specifies either a pre-order or post-order traversal" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"pre"String -> Type -> FieldType
>: String -> Type -> Type
doc String
"Pre-order traversal" Type
unit,
          String
"post"String -> Type -> FieldType
>: String -> Type -> Type
doc String
"Post-order traversal" Type
unit]]