{-# LANGUAGE OverloadedStrings #-}

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


hydraModuleModule :: Module
hydraModuleModule :: Module
hydraModuleModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [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
"A model for Hydra namespaces and modules (collections of elements in the same namespace)"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/module"
    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
    mod :: String -> Type
mod = 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
"FileExtension" Type
string,

      String -> Type -> Element
def String
"Library" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A library of primitive functions" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"namespace"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A common prefix for all primitive function names in the library" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
mod String
"Namespace",
          String
"prefix"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A preferred namespace prefix for function names in the library"
            Type
string,
          String
"primitives"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The primitives defined in this library" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
graph String
"Primitive"],

      String -> Type -> Element
def String
"Module" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A logical collection of elements in the same namespace, having dependencies on zero or more other modules" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"namespace"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A common prefix for all element names in the module" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            String -> Type
mod String
"Namespace",
          String
"elements"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"The elements defined in this module" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
graph String
"Element",
          String
"termDependencies"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"Any modules which the term expressions of this module directly depend upon" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mod String
"Module",
          String
"typeDependencies"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"Any modules which the type expressions of this module directly depend upon" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mod String
"Module",
          String
"description"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"An optional human-readable description of the module" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional Type
string],

      String -> Type -> Element
def String
"Namespace" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A prefix for element names"
        Type
string,

      String -> Type -> Element
def String
"QualifiedName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A qualified name consisting of an optional namespace together with a mandatory local name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"namespace"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
mod String
"Namespace",
          String
"local"String -> Type -> FieldType
>: Type
string]]