zwirn-core-0.1.1.0: tests/test.hs

-- import Test.Tasty.SmallCheck as SC
-- import Test.Tasty.QuickCheck as QC

import Control.Monad
import Data.Bifunctor (first)
import Data.Functor.Identity
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Ratio as R
import Test.Tasty
import Test.Tasty.HUnit
import Zwirn.Core.Conditional
import Zwirn.Core.Cord as Z
import Zwirn.Core.Core
import Zwirn.Core.Map
import Zwirn.Core.Modulate
import Zwirn.Core.Number
import Zwirn.Core.Query
import Zwirn.Core.Structure
import Zwirn.Core.Time
import Zwirn.Core.Types

main = defaultMain tests

tests :: TestTree
tests = testGroup "Tests" [unitTests]

queryFirst :: Cord () () a -> [(Time, a)]
queryFirst = findAllValuesWithTime (Time 0 1, Time 1 1) ()

queryN :: Rational -> Cord () () a -> [(Time, a)]
queryN n = findAllValuesWithTime (Time 0 1, Time n 1) ()

(@?~) :: (Show a, Eq a) => [(Time, a)] -> [(Time, a)] -> Assertion
(@?~) actual expected = unless (Prelude.and check && length actual == length expected) (assertFailure msg)
  where
    msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual
    check = zipWith (\(a, v1) (b, v2) -> abs (a - b) < 0.001 && v1 == v2) expected actual

-- | should be used for signals
(~@?~) :: (Show a, Eq a, Fractional a, Ord a) => [(Time, a)] -> [(Time, a)] -> Assertion
(~@?~) actual expected = unless (Prelude.and check && length actual == length expected) (assertFailure msg)
  where
    msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual
    check = zipWith (\(a, v1) (b, v2) -> abs (a - b) < 0.001 && (abs (v1 - v2) < 0.001)) expected actual

(%) :: Integer -> Integer -> Time
(%) x y = Time (x R.% y) (0 R.% 1)

simpleZwirn :: Cord () () Int
simpleZwirn = fastcat [pure 1, pure 2, pure 3, pure 4]

nestedZwirn :: Cord () () Int
nestedZwirn = fastcat [pure 10, pure 20, fastcat [pure 30, pure 40]]

veryNested :: Cord () () Int
veryNested = fastcat [simpleZwirn, nestedZwirn]

simpleCord :: Cord () () Int
simpleCord = stack [pure 10, simpleZwirn]

unitTests =
  testGroup
    "Unit tests"
    [ testCase "pure for Zwirns" $
        queryFirst (pure 1 :: Cord () () Int) @?~ [(0, 1)],
      testCase "simple nesting" $
        queryFirst simpleZwirn @?~ [(0, 1), (1 % 4, 2), (1 % 2, 3), (3 % 4, 4)],
      testCase "more nesting" $
        queryFirst nestedZwirn @?~ [(0, 10), (1 % 3, 20), (2 % 3, 30), (5 % 6, 40)],
      testCase "very nested" $
        queryFirst veryNested @?~ [(0, 1), (1 % 8, 2), (2 % 8, 3), (3 % 8, 4), (1 % 2, 10), (4 % 6, 20), (5 % 6, 30), (11 % 12, 40)],
      testCase "reverse simple Zwirn" $
        queryFirst (rev simpleZwirn) @?~ [(0, 4), (1 % 4, 3), (1 % 2, 2), (3 % 4, 1)],
      testCase "reverse more nesting" $
        queryFirst (rev nestedZwirn) @?~ [(0, 40), (1 % 6, 30), (1 % 3, 20), (2 % 3, 10)],
      testCase "reverse inside" $
        queryFirst (fastcat [pure 100, rev simpleZwirn, pure 200, pure 300]) @?~ [(0, 100), (4 % 16, 4), (5 % 16, 3), (6 % 16, 2), (7 % 16, 1), (1 % 2, 200), (3 % 4, 300)],
      testCase "reverse reverse inside" $
        queryFirst (rev $ fastcat [pure 100, rev simpleZwirn, pure 200, pure 300]) @?~ [(0, 300), (1 % 4, 200), (8 % 16, 1), (9 % 16, 2), (10 % 16, 3), (11 % 16, 4), (3 % 4, 100)],
      testCase "squeezeJoin" $
        queryFirst (squeezeJoin $ fmap (const $ fastcat [pure 10, pure 20 :: Cord () () Int]) simpleZwirn) @?~ [(0, 10), (1 % 8, 20), (2 % 8, 10), (3 % 8, 20), (4 % 8, 10), (5 % 8, 20), (6 % 8, 10), (7 % 8, 20)],
      testCase "ply" $
        queryFirst (ply (pure 2) simpleZwirn) @?~ [(0, 1), (1 / 8, 1), (1 / 4, 2), (3 / 8, 2), (1 / 2, 3), (5 / 8, 3), (3 / 4, 4), (7 / 8, 4)],
      testCase "zoom" $
        queryFirst (zoom (pure 0.25) (pure 0.75) simpleZwirn) @?~ [(0, 2), (1 / 4, 3), (1 / 2, 2), (3 / 4, 3)],
      testCase "zoom rev" $
        queryFirst (zoom (pure 1) (pure 0) simpleZwirn) @?~ queryFirst (rev simpleZwirn),
      testCase "timeloop" $
        queryFirst (timeloop (pure 0.25) simpleZwirn) @?~ [(0, 1), (1 / 4, 1), (1 / 2, 1), (3 / 4, 1)],
      testCase "cat" $
        queryN 4 (cat (0.25, pure 1) (0.25, pure 2)) @?~ [(0, 1), (1 / 4, 2), (2, 1), (9 / 4, 2)],
      testCase "cyclecat" $
        queryN 3 (cyclecat [(1, pure 10), (2, slow (pure 2) $ pure 20)]) @?~ [(0, 10), (1, 20)],
      testCase "cyclecat 2" $
        queryN 2 (cyclecat [(0.5, pure 10), (1, pure 20), (0.5, pure 30)]) @?~ [(0, 10), (1 / 2, 20), (3 / 2, 30)],
      testCase "fastcyclecat" $
        queryFirst (fastcyclecat [(0.25, pure 1), (0.25, pure 2)]) @?~ [(0, 1), (1 / 4, 2), (1 / 2, 1), (3 / 4, 2)],
      testCase "everyFor" $
        queryFirst (everyFor (pure 1) (pure 0.5) (pure $ fmap succ) simpleZwirn) @?~ [(0, 2), (1 / 4, 3), (1 / 2, 3), (3 / 4, 4)],
      testCase "everyFor 2" $
        queryN 2 (everyFor (pure 0.75) (pure 0.5) (pure $ fmap (const 100)) simpleZwirn) @?~ [(0, 100), (1 / 4, 100), (1 / 2, 3), (3 / 4, 100), (1, 100), (5 / 4, 2), (3 / 2, 100), (7 / 4, 100)],
      testCase "ifthen" $
        queryFirst (ifthen (fastcat [pure True, pure False]) (pure 10) (fastcat [pure 20, pure 30])) @?~ [(0, 10), (1 / 2, 30)],
      testCase "ifthen 2" $
        queryFirst (ifthen (fastcat [pure True, pure False]) simpleZwirn simpleZwirn) @?~ [(0, 1), (1 / 4, 2), (1 / 2, 3), (3 / 4, 4)],
      testCase "while" $
        queryFirst (while (fastcat [pure True, pure False]) (pure $ fmap succ) simpleZwirn) @?~ [(0, 2), (1 / 4, 3), (1 / 2, 3), (3 / 4, 4)],
      testCase "simpleCord" $
        queryFirst simpleCord @?~ [(0, 10), (0, 1), (1 / 4, 2), (1 / 2, 3), (3 / 4, 4)],
      testCase "enum cord" $
        queryFirst (enumFromToStack (pure 0) (pure 4)) @?~ [(0, 0), (0, 1), (0, 2), (0, 3), (0, 4)],
      testCase "zipApply" $
        queryFirst (zipApply (stack [pure $ fmap (+ 10), pure $ fmap (+ 100)]) (stack [fastcat [pure 1, pure 2], pure 3])) @?~ [(0 % 1, 11), (0 % 1, 103), (1 % 2, 12)],
      testCase "sine" $
        queryFirst (segment (pure 4) sine) ~@?~ [(0, 0.5), (1 / 4, 1), (1 / 2, 0.5), (3 / 4, 0)],
      testCase "rev sine" $
        queryFirst (segment (pure 4) $ rev sine) ~@?~ [(0, 0.5), (1 / 4, 0), (1 / 2, 0.5), (3 / 4, 1)],
      testCase "singleton" $
        queryFirst (singleton (pure "n") (fast (pure 2) $ pure 1)) @?~ [(0, Map.singleton "n" 1), (1 / 2, Map.singleton "n" 1)],
      testCase "union" $
        queryFirst (singleton (pure "n") (fast (pure 2) $ pure 1) `union` singleton (pure "s") (pure 1))
          @?~ [ (0, Map.singleton "n" 1 `Map.union` Map.singleton "s" 1),
                (1 / 2, Map.singleton "n" 1 `Map.union` Map.singleton "s" 1)
              ],
      testCase "fix" $
        queryFirst (fix (fastcat [pure "n"]) (pure $ const $ pure 10) (singleton (pure "n") (fast (pure 2) $ pure 1) `union` singleton (pure "s") (pure 1)))
          @?~ [ (0, Map.singleton "n" 10 `Map.union` Map.singleton "s" 1),
                (1 / 2, Map.singleton "n" 10 `Map.union` Map.singleton "s" 1)
              ],
      testCase "fix 2" $
        queryFirst (fix (fastcat [pure "n", pure "s"]) (pure $ const $ pure 10) (singleton (pure "n") (fast (pure 2) $ pure 1) `union` singleton (pure "s") (pure 1)))
          @?~ [ (0, Map.singleton "n" 10 `Map.union` Map.singleton "s" 1),
                (1 / 2, Map.singleton "n" 1 `Map.union` Map.singleton "s" 10)
              ],
      testCase "fix 2" $
        queryFirst (fix (pure "k") (pure $ const $ pure 10) (singleton (pure "n") (pure 1)))
          @?~ [ (0, Map.singleton "n" 1)
              ]
    ]

-- state tests

-- addOne :: (Functor k, Num st, Zwirned m k st) => m k st a -> m k st a
-- addOne = modify' (+ 1)

-- multTwo :: (Functor k, Num st, Zwirned m k st) => m k st a -> m k st a
-- multTwo = modify' (* 2)

-- stateTest :: ZwirnT Identity Int Int
-- stateTest = addOne $ fastcat (map pure [0 .. 50]) -- fast 2 $ addOne $ fastcat [pure 1, pure 2, multTwo $ fastcat [pure 10, pure 20]]

-- -- stateTest2 :: Zwirn Identity Int Int
-- -- stateTest2 = lift fast (addOne $ fastcat [pure 4, pure 2]) (multTwo $ fastcat [pure 10, pure 20])

-- stateTest3 :: ZwirnT Identity Int Int
-- stateTest3 = fastcat [addOne $ pure 1, addOne $ pure 2, addOne $ pure 3, modify' (const 0) $ pure 4]

-- stateTest4 :: ZwirnT Identity Int Int
-- stateTest4 = modify (\x -> fastcat [x, fmap (+ 1) x]) $ fastcat [pure 1, pure 2, pure 3, pure 4]

-- stateTest5 :: Cord (Map.Map String Int) Int
-- stateTest5 = modifyMap (\(Just i) -> fastcat [pure i, pure i]) (pure "x") (\x -> liftA2 (+) x (pure 1)) $ fastcat [pure 1, pure 2, pure 3, pure 4]

-- stateTest6 :: Cord (Map.Map String Int) Int
-- stateTest6 = setMap (pure "x") (pure 10) $ fastcat [pure 1, pure 2, pure 3, pure 4]

-- cord tests

-- cord :: Cord Int Int
-- cord = stack [fastcat [pure 10, pure 20], fastcat [pure 100, pure 200]]

-- cord2 :: Cord Int Int
-- cord2 = fast (pure 2) (pure 1)

-- treeTry :: Cord Int Int
-- treeTry = project (pure 1) $ liftA2 (+) (fastcat [pure 10, stack [pure 20, pure 100]]) (stack [fastcat [pure 1, pure 2], pure 20])

-- funcTree :: Cord Int Int
-- funcTree = apply (stack [pure rev, pure id]) (stack [fastcat [pure 10, pure 20], fastcat [pure 30, pure 40]])

-- layerTree :: Cord Int Int
-- layerTree = layer (stack [pure rev, pure id]) (stack [fastcat [pure 10, pure 20], fastcat [pure 30, pure 40]])

-- showTree :: String
-- showTree = show $ findAllValuesWithTime (Time 0 1, Time 1 1) 0 treeTry

-- treeTry2 :: Cord Int Int
-- treeTry2 = project (stack [pure 0, pure 0]) $ stack [fastcat [pure 1, pure 2], pure 20]

-- showTree2 :: String
-- showTree2 = show $ findAllValuesWithTime (Time 0 1, Time 1 1) 0 treeTry2