{-# LANGUAGE OverloadedStrings #-}

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


hydraTestingModule :: Module
hydraTestingModule :: Module
hydraTestingModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCoreModule] [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 unit testing"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/testing"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    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
    testing :: String -> Type
testing = Namespace -> String -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"EvaluationStyle" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"One of two evaluation styles: eager or lazy" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [String
"eager", String
"lazy"],

      String -> Type -> Element
def String
"TestCase" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A simple test case with an input and an expected output" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"description"String -> Type -> FieldType
>: Type -> Type
optional Type
string,
          String
"evaluationStyle"String -> Type -> FieldType
>: String -> Type
testing String
"EvaluationStyle",
          String
"input"String -> Type -> FieldType
>: String -> Type
core String
"Term",
          String
"output"String -> Type -> FieldType
>: String -> Type
core String
"Term"],

      String -> Type -> Element
def String
"TestGroup" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A collection of test cases with a name and optional description" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: Type
string,
          String
"description"String -> Type -> FieldType
>: Type -> Type
optional Type
string,
          String
"subgroups"String -> Type -> FieldType
>: Type -> Type
list (String -> Type
testing String
"TestGroup"),
          String
"cases"String -> Type -> FieldType
>: Type -> Type
list (String -> Type
testing String
"TestCase")]]