module Hydra.Sources.Tier4.Test.Lib.Lists (listPrimitiveTests) where

import Hydra.Dsl.Tests
import Hydra.Dsl.Terms


listPrimitiveTests :: TestGroup
listPrimitiveTests :: TestGroup
listPrimitiveTests = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"hydra/lib/lists primitives" Maybe String
forall a. Maybe a
Nothing [TestGroup]
groups []
  where
    groups :: [TestGroup]
groups = [
      TestGroup
listsApply,
      TestGroup
listsBind,
      TestGroup
listsConcat,
      TestGroup
listsHead,
      TestGroup
listsIntercalate,
      TestGroup
listsIntersperse,
      TestGroup
listsLast,
      TestGroup
listsLength,
      TestGroup
listsMap,
      TestGroup
listsPure]

listsApply :: TestGroup
listsApply :: TestGroup
listsApply = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"apply" Maybe String
forall a. Maybe a
Nothing [] [
    [Term] -> [String] -> [String] -> TestCase
test [Name -> Term
primitive Name
_strings_toUpper, Name -> Term
primitive Name
_strings_toLower] [String
"One", String
"Two", String
"Three"] [String
"ONE", String
"TWO", String
"THREE", String
"one", String
"two", String
"three"]]
  where
    test :: [Term] -> [String] -> [String] -> TestCase
test [Term]
funs [String]
lst [String]
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_apply [[Term] -> Term
list [Term]
funs, [String] -> Term
stringList [String]
lst] ([String] -> Term
stringList [String]
result)

listsBind :: TestGroup
listsBind :: TestGroup
listsBind = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"bind" Maybe String
forall a. Maybe a
Nothing [] [
    [Int] -> Term -> [Int] -> TestCase
test [Int
1, Int
2, Int
3, Int
4] (Name -> Term
primitive Name
_lists_pure Term -> Term -> Term
<.> Name -> Term
primitive Name
_math_neg) (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1, Int
2, Int
3, Int
4])]
  where
    test :: [Int] -> Term -> [Int] -> TestCase
test [Int]
lst Term
fun [Int]
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_bind [[Int] -> Term
intList [Int]
lst, Term
fun] ([Int] -> Term
intList [Int]
result)

listsConcat :: TestGroup
listsConcat :: TestGroup
listsConcat = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"concat" Maybe String
forall a. Maybe a
Nothing [] [
    [[Int]] -> [Int] -> TestCase
test [[Int
1, Int
2, Int
3], [Int
4, Int
5], [Int
6, Int
7, Int
8]] [Int
1, Int
2, Int
3, Int
4, Int
5, Int
6, Int
7, Int
8]]
  where
    test :: [[Int]] -> [Int] -> TestCase
test [[Int]]
lists [Int]
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_concat [[[Int]] -> Term
intListList [[Int]]
lists] ([Int] -> Term
intList [Int]
result)

listsHead :: TestGroup
listsHead :: TestGroup
listsHead = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"head" Maybe String
forall a. Maybe a
Nothing [] [
    [Int] -> Int -> TestCase
test [Int
1, Int
2, Int
3] Int
1]
  where
    test :: [Int] -> Int -> TestCase
test [Int]
lst Int
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_head [[Int] -> Term
intList [Int]
lst] (Int -> Term
int32 Int
result)

listsIntercalate :: TestGroup
listsIntercalate :: TestGroup
listsIntercalate = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"intercalate" Maybe String
forall a. Maybe a
Nothing [] [
    [Int] -> [[Int]] -> [Int] -> TestCase
test [Int
0, Int
0] [[Int
1, Int
2, Int
3], [Int
4, Int
5], [Int
6, Int
7, Int
8]] [Int
1, Int
2, Int
3, Int
0, Int
0, Int
4, Int
5, Int
0, Int
0, Int
6, Int
7, Int
8]]
  where
    test :: [Int] -> [[Int]] -> [Int] -> TestCase
test [Int]
ifx [[Int]]
lists [Int]
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_intercalate [[Int] -> Term
intList [Int]
ifx, [[Int]] -> Term
intListList [[Int]]
lists] ([Int] -> Term
intList [Int]
result)

listsIntersperse :: TestGroup
listsIntersperse :: TestGroup
listsIntersperse = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"intersperse" Maybe String
forall a. Maybe a
Nothing [] [
    String -> [String] -> [String] -> TestCase
test String
"and" [String
"one", String
"two", String
"three"] [String
"one", String
"and", String
"two", String
"and", String
"three"]]
  where
    test :: String -> [String] -> [String] -> TestCase
test String
ifx [String]
lst [String]
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_intersperse [String -> Term
string String
ifx, [String] -> Term
stringList [String]
lst] ([String] -> Term
stringList [String]
result)

listsLast :: TestGroup
listsLast :: TestGroup
listsLast = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"last" Maybe String
forall a. Maybe a
Nothing [] [
    [Int] -> Int -> TestCase
test [Int
1, Int
2, Int
3] Int
3]
  where
    test :: [Int] -> Int -> TestCase
test [Int]
lst Int
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_last [[Int] -> Term
intList [Int]
lst] (Int -> Term
int32 Int
result)

listsLength :: TestGroup
listsLength :: TestGroup
listsLength = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"length" Maybe String
forall a. Maybe a
Nothing [] [
    [Int] -> Int -> TestCase
test [Int
1, Int
2, Int
3] Int
3]
  where
    test :: [Int] -> Int -> TestCase
test [Int]
lst Int
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_length [[Int] -> Term
intList [Int]
lst] (Int -> Term
int32 Int
result)

listsMap :: TestGroup
listsMap :: TestGroup
listsMap = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"map" Maybe String
forall a. Maybe a
Nothing [] [
    Term -> [String] -> [String] -> TestCase
test (Name -> Term
primitive Name
_strings_toUpper) [String
"one", String
"two"] [String
"ONE", String
"TWO"]]
  where
    test :: Term -> [String] -> [String] -> TestCase
test Term
fun [String]
lst [String]
result = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_map [Term
fun, [String] -> Term
stringList [String]
lst] ([String] -> Term
stringList [String]
result)

listsPure :: TestGroup
listsPure :: TestGroup
listsPure = String -> Maybe String -> [TestGroup] -> [TestCase] -> TestGroup
TestGroup String
"pure" Maybe String
forall a. Maybe a
Nothing [] [
    String -> TestCase
test String
"one"]
  where
    test :: String -> TestCase
test String
arg = Name -> [Term] -> Term -> TestCase
primCase Name
_lists_pure [String -> Term
string String
arg] ([String] -> Term
stringList [String
arg])