test/QueryT.hs · patch

on ae03249 help sign in

patch/test/QueryT.hs

29 lines 875 B history raw

1{-# LANGUAGE TypeFamilies #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3import qualified Data.AppendMap as Map

4import Data.Semigroup

5import Reflex.Dom

7newtype MyQuery = MyQuery SelectedCount

8 deriving (Show, Read, Eq, Ord, Monoid, Semigroup, Additive, Group)

10instance Query MyQuery where

11 type QueryResult MyQuery = ()

12 crop _ _ = ()

14instance (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

18main :: IO ()

19main = 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