{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier0.Graph 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


hydraGraphModule :: Module
hydraGraphModule :: Module
hydraGraphModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraComputeModule] [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
"The extension to graphs of Hydra's core type system (hydra/core)"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/graph"
    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
ns
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"Comparison" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An equality judgement: less than, equal to, or greater than" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [
          String
"lessThan",
          String
"equalTo",
          String
"greaterThan"],

      String -> Type -> Element
def String
"Graph" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A graph, or set of name/term bindings together with parameters (annotations, primitives) and a schema graph" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [

          -- TODO: remove this; replace it with 'environment'
          String
"elements"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All of the elements in the graph" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map (String -> Type
core String
"Name") (String -> Type
graph String
"Element"),

          String
"environment"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The lambda environment of this graph context; it indicates whether a variable is bound by a lambda (Nothing) or a let (Just term)" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map (String -> Type
core String
"Name") (Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
core String
"Term"),
          String
"types"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The typing environment of the graph" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map (String -> Type
core String
"Name") (String -> Type
core String
"TypeScheme"),
          String
"body"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The body of the term which generated this context" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
core String
"Term",
          String
"primitives"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"All supported primitive constants and functions, by name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map (String -> Type
core String
"Name") (String -> Type
graph String
"Primitive"),
          String
"schema"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The schema of this graph. If this parameter is omitted (nothing), the graph is its own schema graph." (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
graph String
"Graph"],

      String -> Type -> Element
def String
"Element" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A graph element, having a name, data term (value), and schema term (type)" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: String -> Type
core String
"Name",
          String
"data"String -> Type -> FieldType
>: String -> Type
core String
"Term"],

      String -> Type -> Element
def String
"Primitive" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A built-in function" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The unique name of the primitive function" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
core String
"Name",
          String
"type"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The type signature of the primitive function" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
core String
"TypeScheme",
          String
"implementation"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A concrete implementation of the primitive function" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (String -> Type
core String
"Term") Type -> Type -> Type
--> String -> Type
compute String
"Flow" Type -> Type -> Type
@@ (String -> Type
graph String
"Graph") Type -> Type -> Type
@@ (String -> Type
core String
"Term")],

      String -> Type -> Element
def String
"TermCoder" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
lambda String
"x" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [
          String
"type"String -> Type -> FieldType
>: String -> Type
core String
"Type",
          String
"coder"String -> Type -> FieldType
>: String -> Type
compute String
"Coder" Type -> Type -> Type
@@ (String -> Type
graph String
"Graph") Type -> Type -> Type
@@ (String -> Type
graph String
"Graph") Type -> Type -> Type
@@ (String -> Type
core String
"Term") Type -> Type -> Type
@@ Type
"x"],

      String -> Type -> Element
def String
"TypeClass" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Any of a small number of built-in type classes" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [
          String
"equality",
          String
"ordering"]]