on develop help sign in
Add an initial test for QueryT
commit13e71e89772880778b8a1f292f689ae30ed1520a authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 2 Jun 2017, 16:16 (9 years ago) parentadb2512
1 file changed+29
test/QueryT.hs+29
test/QueryT.hsnew file+29
@@ -0,0 +1,29 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+import qualified Data.AppendMap as Map
4+import Data.Semigroup
5+import Reflex.Dom
6+
7+newtype MyQuery = MyQuery SelectedCount
8+ deriving (Show, Read, Eq, Ord, Monoid, Semigroup, Additive, Group)
9+
10+instance Query MyQuery where
11+ type QueryResult MyQuery = ()
12+ crop _ _ = ()
13+
14+instance (Ord k, Query a) => Query (Map.AppendMap k a) where
15+ type QueryResult (Map.AppendMap k a) = Map.AppendMap k (QueryResult a)
16+ crop q r = undefined
17+
18+main :: IO ()
19+main = mainWidget $ do
20+ let w = do
21+ n <- count =<< button "Increment"
22+ display n
23+ queryDyn $ zipDynWith Map.singleton n $ pure $ MyQuery $ SelectedCount 1
24+ return ()
25+ outer = do
26+ replace <- button "Replace"
27+ widgetHold w $ w <$ replace
28+ (_, q) <- runQueryT outer $ pure mempty
29+ display $ incrementalToDynamic q