git.iko.soy/patch
on d2a084d help sign in
patch/src/Reflex/Query/Class.hs
76 lines 3.0 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FunctionalDependencies #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE UndecidableInstances #-}
9module Reflex.Query.Class
10 ( Query (..)
11 , QueryMorphism (..)
12 , SelectedCount (..)
13 , combineSelectedCounts
15 , MonadQuery (..)
16 , tellQueryDyn
17 , queryDyn
18 ) where
20import Control.Monad.Reader
21import Data.Bits
22import Data.Data
23import Data.Ix
24import Data.Semigroup
25import Foreign.Storable
27import Reflex.Class
29class (Monoid (QueryResult a), Semigroup (QueryResult a)) => Query a where
30 type QueryResult a :: *
31 crop :: a -> QueryResult a -> QueryResult a
33-- | NB: QueryMorphism's must be group homomorphisms when acting on the query type
34-- and compatible with the query relationship when acting on the query result
35data QueryMorphism q q' = QueryMorphism
36 { _queryMorphism_mapQuery :: q -> q'
37 , _queryMorphism_mapQueryResult :: QueryResult q' -> QueryResult q
38 }
40-- | This type keeps track of the multiplicity of elements of the view selector that are being used by the app
41newtype SelectedCount = SelectedCount { unSelectedCount :: Int }
42 deriving (Eq, Ord, Show, Read, Integral, Num, Bounded, Enum, Real, Ix, Bits, FiniteBits, Storable, Data)
44instance Semigroup SelectedCount where
45 SelectedCount a <> SelectedCount b = SelectedCount (a + b)
47instance Monoid SelectedCount where
48 mempty = SelectedCount 0
49 mappend = (<>)
51instance Group SelectedCount where
52 negateG (SelectedCount a) = SelectedCount (negate a)
54instance Additive SelectedCount
56-- | The Semigroup/Monoid/Group instances for a ViewSelector should use this function which returns Nothing if the result is 0. This allows the pruning of leaves that are no longer wanted.
57combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount
58combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j then Nothing else Just $ SelectedCount (i + j)
60class (Group q, Additive q, Query q) => MonadQuery t q m | m -> q t where
61 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()
62 askQueryResult :: m (Dynamic t (QueryResult q))
63 queryIncremental :: Incremental t (AdditivePatch q) -> m (Dynamic t (QueryResult q))
65instance (Monad m, MonadQuery t q m) => MonadQuery t q (ReaderT r m) where
66 tellQueryIncremental = lift . tellQueryIncremental
67 askQueryResult = lift askQueryResult
68 queryIncremental = lift . queryIncremental
70tellQueryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m ()
71tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)
73queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))
74queryDyn q = do
75 tellQueryDyn q
76 zipDynWith crop q <$> askQueryResult