@@ -13,6 +13,7 @@ import Control.Monad.Fix
1313import Data.Functor.Misc
1414import qualified Data.Map as M
1515import Data.These
16+import Data.Align
1617
1718
1819import Reflex
@@ -41,14 +42,48 @@ dynLoop (e1, e2) = do
4142 return $ updated d'
4243
4344
45+connectButtonPromptly :: (MonadHold t m, Reflex t, MonadFix m) => Event t () -> Event t a -> m (Event t a)
46+connectButtonPromptly click e = do
47+ d <- holdDyn never (e <$ click)
48+ return (switchDyn d)
49+
50+connectButton :: (MonadHold t m, Reflex t, MonadFix m) => Event t () -> Event t a -> m (Event t a)
51+connectButton click e = do
52+ d <- hold never (e <$ click)
53+ return (switch d)
54+
55+
56+switchLoop :: (MonadHold t m, Reflex t, MonadFix m) => (Event t Int, Event t ()) -> m (Event t Int)
57+switchLoop (e1, e2) = do
58+ rec
59+ e' <- connectButton e2 (updated d)
60+ d <- count (align e' e1)
61+
62+ return $ updated d
63+
64+staticLoop :: AppWidget t m => m ()
65+staticLoop = do
66+ el "p" $ do
67+ text "Typical error: GHC stack-space overflow: current limit is 33624 bytes"
68+ text "(or consumes all available memory)"
69+
70+ e <- getPostBuild
71+ rec
72+ d <- foldDyn (+) (0 :: Int) (leftmost [1 <$ e, updated d])
73+ dynText (T.pack . show <$> d)
74+
75+
76+
4477splitThese :: Filterable f => f (These a b) -> (f a, f b)
4578splitThese f = (mapMaybe (preview here) f, mapMaybe (preview there) f)
4679
4780main :: IO ()
4881main = void $ do
82+
83+ runApp' (switchLoop . splitThese) (Just <$> occs)
4984 runApp' (dynLoop . splitThese) (Just <$> occs)
5085
5186 where
52− occs = [ This 1, This 2, That (), This 3 ]
87+ occs = [ This 1, This 2, That (), This 3 ]
5388
5489