@@ -0,0 +1,54 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE GADTs #-}
5+{-# LANGUAGE RecursiveDo #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
7+module Main where
8+
9+import Control.Lens
10+import Control.Applicative
11+import Control.Monad
12+import Control.Monad.Fix
13+import Data.Functor.Misc
14+import qualified Data.Map as M
15+import Data.These
16+
17+
18+import Reflex
19+import Reflex.EventWriter.Base
20+import Test.Run
21+
22+import Data.Witherable (Filterable)
23+
24+#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
25+import Data.These.Lens
26+#endif
27+
28+
29+connectDyn :: (MonadHold t m, Reflex t, MonadFix m) => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
30+connectDyn e (d, d') = do
31+ dd <- holdDyn d (d' <$ e)
32+ return $ join dd
33+
34+
35+dynLoop :: (MonadHold t m, Reflex t, MonadFix m) => (Event t Int, Event t ()) -> m (Event t Int)
36+dynLoop (e1, e2) = do
37+ -- "heightBagRemove: Height 2 not present in bag HeightBag {_heightBag_size = 2, _heightBag_contents = fromList [(0,1)]}"
38+ rec
39+ d <- count e1
40+ d' <- connectDyn e2 (d, (liftA2 (+) d d'))
41+ return $ updated d'
42+
43+
44+splitThese :: Filterable f => f (These a b) -> (f a, f b)
45+splitThese f = (mapMaybe (preview here) f, mapMaybe (preview there) f)
46+
47+main :: IO ()
48+main = void $ do
49+ runApp' (dynLoop . splitThese) (Just <$> occs)
50+
51+ where
52+ occs = [ This 1, This 2, That (), This 3 ]
53+
54+