git.iko.soy/patch
on develop help sign in
add QueryT runWithReplace test
04ed6acDan Haraj
test/QueryT.hs+25−10
compare with develop
unifiedsplit
@@ -4,6 +4,9 @@
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE LambdaCase #-}
5{-# LANGUAGE LambdaCase #-}
6{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
7+
8+import Control.Lens
9+import Control.Monad.Fix
7import Data.Align
10import Data.Align
8import qualified Data.AppendMap as Map
11import qualified Data.AppendMap as Map
9import Data.Semigroup
12import Data.Semigroup
@@ -46,14 +49,26 @@ instance (Eq a, Ord k, Group a) => Group (Selector k a) where
46instance (Eq a, Ord k, Group a) => Additive (Selector k a)
49instance (Eq a, Ord k, Group a) => Additive (Selector k a)
47
50
48main :: IO ()
51main :: IO ()
49−main = mainWidget $ do
52+main = do
53+ [0, 1, 1, 0] <- fmap (map fst . concat) $ runApp app () $ map (Just . That) $
54+ [ That ()
55+ , This ()
56+ , That ()
57+ ]
58+ return ()
59+
60+app :: (Reflex t, MonadHold t m, MonadAdjust t m, MonadFix m)
61+ => AppIn t () (These () ())
62+ -> m (AppOut t Int Int)
63+app (AppIn _ pulse) = do
64+ let replace = fmapMaybe (^? here) pulse
65+ increment = fmapMaybe (^? there) pulse
50− let w = do
66+ w = do
51− n <- count =<< button "Increment"
67+ n <- count increment
52− display n
53 queryDyn $ zipDynWith (\x y -> Selector (Map.singleton (x :: Int) y)) n $ pure $ MyQuery $ SelectedCount 1
68 queryDyn $ zipDynWith (\x y -> Selector (Map.singleton (x :: Int) y)) n $ pure $ MyQuery $ SelectedCount 1
54− return ()
55− outer = do
56− replace <- button "Replace"
57− widgetHold w $ w <$ replace
58− (_, q) <- runQueryT outer $ pure mempty
69+ (_, q) <- runQueryT (runWithReplace w $ w <$ replace) $ pure mempty
59− display $ incrementalToDynamic q
70+ let qDyn = fmap (head . Map.keys . unSelector) $ incrementalToDynamic q
71+ return $ AppOut
72+ { _appOut_behavior = current qDyn
73+ , _appOut_event = updated qDyn
74+ }