module Hydra.Dsl.Tests (
    module Hydra.Testing,
    module Hydra.Sources.Libraries,
    module Hydra.Dsl.Terms,
    module Hydra.Dsl.Tests,
) where

import Hydra.Core
import Hydra.Testing
import Hydra.Sources.Libraries
import Hydra.Dsl.Terms

import qualified Data.List as L
import qualified Data.Set as S


intList :: [Int] -> Term
intList :: [Int] -> Term
intList [Int]
els = [Term] -> Term
list (Int -> Term
int32 (Int -> Term) -> [Int] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
els)

intListList :: [[Int]] -> Term
intListList :: [[Int]] -> Term
intListList [[Int]]
lists = [Term] -> Term
list ([Int] -> Term
intList ([Int] -> Term) -> [[Int]] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Int]]
lists)

primCase :: Name -> [Term] -> Term -> TestCase
primCase :: Name -> [Term] -> Term -> TestCase
primCase Name
name [Term]
args Term
output = Maybe String -> EvaluationStyle -> Term -> Term -> TestCase
TestCase Maybe String
forall a. Maybe a
Nothing EvaluationStyle
EvaluationStyleEager Term
input Term
output
  where
    input :: Term
input = (Term -> Term -> Term) -> Term -> [Term] -> Term
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (\Term
a Term
arg -> Term
a Term -> Term -> Term
@@ Term
arg) (Name -> Term
primitive Name
name) [Term]
args

stringList :: [String] -> Term
stringList :: [String] -> Term
stringList [String]
els = [Term] -> Term
list (String -> Term
string (String -> Term) -> [String] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
els)

stringSet :: S.Set String -> Term
stringSet :: Set String -> Term
stringSet Set String
strings = Set Term -> Term
set (Set Term -> Term) -> Set Term -> Term
forall a b. (a -> b) -> a -> b
$ [Term] -> Set Term
forall a. Ord a => [a] -> Set a
S.fromList ([Term] -> Set Term) -> [Term] -> Set Term
forall a b. (a -> b) -> a -> b
$ String -> Term
string (String -> Term) -> [String] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set String -> [String]
forall a. Set a -> [a]
S.toList Set String
strings

testCase :: EvaluationStyle -> Term -> Term -> TestCase
testCase = Maybe String -> EvaluationStyle -> Term -> Term -> TestCase
TestCase Maybe String
forall a. Maybe a
Nothing