{-# LANGUAGE OverloadedStrings #-}

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


hydraPhantomsModule :: Module
hydraPhantomsModule :: Module
hydraPhantomsModule = 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
"Phantom types for use in model definitions"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/phantoms"
    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
    phantoms :: String -> Type
phantoms = 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
"Case" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An association of a field name (as in a case statement) with a phantom type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
lambda String
"a" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
core String
"Name",

      String -> Type -> Element
def String
"Datum" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An association of a term with a phantom type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
lambda String
"a" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
core String
"Term",

      String -> Type -> Element
def String
"Definition" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An association with a named term with a phantom type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
lambda String
"a" (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
"datum"String -> Type -> FieldType
>: String -> Type
phantoms String
"Datum" Type -> Type -> Type
@@ Type
"a"],

      String -> Type -> Element
def String
"Fld" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"An association with a term-level field with a phantom type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
lambda String
"a" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
core String
"Field",

      String -> Type -> Element
def String
"Reference" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A pure association with a phantom type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
lambda String
"a" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type
unit]