module Hydra.Sources.Tier4.Test.TestSuite (testSuiteModule) where

import Hydra.Testing
import qualified Hydra.Dsl.Terms as Terms
import qualified Hydra.Dsl.Types as Types
import Hydra.Sources.Tier3.All

import Hydra.Sources.Tier4.Test.Lib.Lists
import Hydra.Sources.Tier4.Test.Lib.Strings


testSuiteNs :: Namespace
testSuiteNs = String -> Namespace
Namespace String
"hydra/test/testSuite"

testSuiteModule :: Module
testSuiteModule :: Module
testSuiteModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
testSuiteNs [Element]
elements [] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just String
"Test cases for primitive functions"
  where
    elements :: [Element]
elements = [
      String -> TestGroup -> Element
groupElement String
"allTests" TestGroup
allTests]

groupElement :: String -> TestGroup -> Element
groupElement :: String -> TestGroup -> Element
groupElement String
lname TestGroup
group = Name -> Term -> Element
Element Name
name (Term -> Element) -> Term -> Element
forall a b. (a -> b) -> a -> b
$ Maybe Type -> Term -> Term
setTermType (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
typ) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ TestGroup -> Term
encodeGroup TestGroup
group
  where
    encodeGroup :: TestGroup -> Term
encodeGroup (TestGroup String
name Maybe String
desc [TestGroup]
groups [TestCase]
cases) = Name -> [Field] -> Term
Terms.record Name
_TestGroup [
      Name -> Term -> Field
Field Name
_TestGroup_name (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.string String
name,
      Name -> Term -> Field
Field Name
_TestGroup_description (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Maybe Term -> Term
Terms.optional (String -> Term
Terms.string (String -> Term) -> Maybe String -> Maybe Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
desc),
      Name -> Term -> Field
Field Name
_TestGroup_subgroups (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ [Term] -> Term
Terms.list (TestGroup -> Term
encodeGroup (TestGroup -> Term) -> [TestGroup] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TestGroup]
groups),
      Name -> Term -> Field
Field Name
_TestGroup_cases (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ [Term] -> Term
Terms.list (TestCase -> Term
encodeCase (TestCase -> Term) -> [TestCase] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TestCase]
cases)]
    encodeCase :: TestCase -> Term
encodeCase (TestCase Maybe String
desc EvaluationStyle
style Term
input Term
output) = Name -> [Field] -> Term
Terms.record Name
_TestCase [
      Name -> Term -> Field
Field Name
_TestCase_description (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Maybe Term -> Term
Terms.optional (String -> Term
Terms.string (String -> Term) -> Maybe String -> Maybe Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
desc),
      Name -> Term -> Field
Field Name
_TestCase_evaluationStyle (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Term -> Term
Terms.variant Name
_EvaluationStyle (case EvaluationStyle
style of
        EvaluationStyle
EvaluationStyleEager -> Name
_EvaluationStyle_eager
        EvaluationStyle
EvaluationStyleLazy -> Name
_EvaluationStyle_lazy) Term
Terms.unit,
      Name -> Term -> Field
Field Name
_TestCase_input (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Term -> Term
coreEncodeTerm Term
input,
      Name -> Term -> Field
Field Name
_TestCase_output (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Term -> Term
coreEncodeTerm Term
output]
    name :: Name
name = QualifiedName -> Name
unqualifyName (QualifiedName -> Name) -> QualifiedName -> Name
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> String -> QualifiedName
QualifiedName (Namespace -> Maybe Namespace
forall a. a -> Maybe a
Just Namespace
testSuiteNs) String
lname
    typ :: Type
typ = Name -> Type
TypeVariable Name
_TestGroup

allTests :: TestGroup
allTests :: TestGroup
allTests = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"All tests" Maybe String
forall a. Maybe a
Nothing [TestGroup]
primTests []
  where
    primTests :: [TestGroup]
primTests = [
      TestGroup
listPrimitiveTests,
      TestGroup
stringPrimitiveTests]