Skip to content

Commit

Permalink
Add some basic tests for mapIncremental
Browse files Browse the repository at this point in the history
  • Loading branch information
oliver-batchelor committed Aug 19, 2018
1 parent e3c97ac commit ce9a877
Show file tree
Hide file tree
Showing 3 changed files with 45 additions and 1 deletion.
3 changes: 2 additions & 1 deletion src/Reflex/Class.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
/{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
Expand Down Expand Up @@ -38,6 +38,7 @@ module Reflex.Class
, EventSelector (..)
, EventSelectorInt (..)
-- ** 'Incremental'-related types
, mapIncremental
-- * Convenience functions
, constDyn
, pushAlways
Expand Down
2 changes: 2 additions & 0 deletions test/Reflex/Plan/Pure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,9 @@ instance MonadHold (Pure Int) PurePlan where
hold initial = liftPlan . hold initial
holdDyn initial = liftPlan . holdDyn initial
holdIncremental initial = liftPlan . holdIncremental initial

buildDynamic getInitial = liftPlan . buildDynamic getInitial
buildIncremental getInitial = liftPlan . buildIncremental getInitial
headE = liftPlan . headE

instance MonadSample (Pure Int) PurePlan where
Expand Down
41 changes: 41 additions & 0 deletions test/Reflex/Test/Micro.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,7 @@ scanInnerDyns d = do




{-# ANN testCases "HLint: ignore Functor law" #-}
testCases :: [(String, TestCase)]
testCases =
Expand Down Expand Up @@ -282,6 +283,31 @@ testCases =
d' <- pushDyn scanInnerDyns d >>= scanInnerDyns
return $ current d'

, testB "holdIncremental" $ do
inc <- makeIncremental
return (currentIncremental inc)

, testB "unsafeMapIncremental" $ do
inc <- makeIncremental
let f = Map.mapKeys (+1)
g (PatchMap m) = PatchMap (Map.mapKeys (+1) m)

let inc' = unsafeMapIncremental f g inc
return (currentIncremental inc')

, testB "mapIncremental" $ do

-- Not be safe with 'unsafeBuildIncremental' due to key changes
let f = Map.mapKeys (+1)
g (PatchMap m) = PatchMap (Map.mapKeys (+2) m)

rec -- Backwards order, test laziness
inc'' <- mapIncremental f g inc'
inc' <- mapIncremental f g inc
inc <- makeIncremental

return $ currentIncremental inc''

, testE "fan-1" $ do
e <- fmap toMap <$> events1
let es = select (fanMap e) . Const2 <$> values
Expand Down Expand Up @@ -331,6 +357,7 @@ testCases =
events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
events3 = liftA2 mappend events1 events2


eithers :: TestPlan t m => m (Event t (Either String String))
eithers = plan [(1, Left "e"), (3, Left "d"), (4, Right "c"), (6, Right "b"), (7, Left "a")]

Expand All @@ -344,3 +371,17 @@ testCases =

deep e = leftmost [e, e]
leftmost2 e1 e2 = leftmost [e1, e2]


makeIncremental :: forall t m. TestPlan t m => m (Incremental t (PatchMap Int String))
makeIncremental = do
e1 <- events1
e2 <- events2

e <- zipListWithEvent (,) [(0::Int)..] (leftmost [e1, e2])
let f (k, v) = Map.fromList $ if odd k
then [(k, Just v)]
else [(k, Nothing)]

holdIncremental (Map.fromList [((1 :: Int), "g"), (2, "b"), (5, "b")])
(PatchMap . f <$> e)

0 comments on commit ce9a877

Please sign in to comment.