@@ -0,0 +1,54 @@
2+{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE RecursiveDo #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
10+import Control.Applicative
12+import Control.Monad.Fix
13+import Data.Functor.Misc
14+import qualified Data.Map as M
19+import Reflex.EventWriter.Base
22+import Data.Witherable (Filterable)
24+#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
25+import Data.These.Lens
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)
35+dynLoop :: (MonadHold t m, Reflex t, MonadFix m) => (Event t Int, Event t ()) -> m (Event t Int)
37+ -- "heightBagRemove: Height 2 not present in bag HeightBag {_heightBag_size = 2, _heightBag_contents = fromList [(0,1)]}"
40+ d' <- connectDyn e2 (d, (liftA2 (+) d d'))
44+splitThese :: Filterable f => f (These a b) -> (f a, f b)
45+splitThese f = (mapMaybe (preview here) f, mapMaybe (preview there) f)
49+ runApp' (dynLoop . splitThese) (Just <$> occs)
52+ occs = [ This 1, This 2, That (), This 3 ]