@@ -15,12 +15,18 @@ module Reflex.Query.Class
1515 , MonadQuery (..)
1616 , tellQueryDyn
1717 , queryDyn
18+ , mapQuery
19+ , mapQueryResult
1820 ) where
1921
22+import Control.Category (Category)
23+import qualified Control.Category as Cat
2024import Control.Monad.Reader
2125import Data.Bits
2226import Data.Data
2327import Data.Ix
28+import Data.Map.Monoidal (MonoidalMap)
29+import qualified Data.Map.Monoidal as MonoidalMap
2430import Data.Semigroup
2531import Foreign.Storable
2632
@@ -30,6 +36,10 @@ class (Monoid (QueryResult a), Semigroup (QueryResult a)) => Query a where
3036 type QueryResult a :: *
3137 crop :: a -> QueryResult a -> QueryResult a
3238
39+instance (Ord k, Query v) => Query (MonoidalMap k v) where
40+ type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)
41+ crop q r = MonoidalMap.intersectionWith (flip crop) r q
42+
3343-- | NB: QueryMorphism's must be group homomorphisms when acting on the query type
3444-- and compatible with the query relationship when acting on the query result
3545data QueryMorphism q q' = QueryMorphism
@@ -37,6 +47,19 @@ data QueryMorphism q q' = QueryMorphism
3747 , _queryMorphism_mapQueryResult :: QueryResult q' -> QueryResult q
3848 }
3949
50+instance Category QueryMorphism where
51+ id = QueryMorphism id id
52+ qm . qm' = QueryMorphism
53+ { _queryMorphism_mapQuery = mapQuery qm . mapQuery qm'
54+ , _queryMorphism_mapQueryResult = mapQueryResult qm' . mapQueryResult qm
55+ }
56+
57+mapQuery :: QueryMorphism q q' -> q -> q'
58+mapQuery = _queryMorphism_mapQuery
59+
60+mapQueryResult :: QueryMorphism q q' -> QueryResult q' -> QueryResult q
61+mapQueryResult = _queryMorphism_mapQueryResult
62+
4063-- | This type keeps track of the multiplicity of elements of the view selector that are being used by the app
4164newtype SelectedCount = SelectedCount { unSelectedCount :: Int }
4265 deriving (Eq, Ord, Show, Read, Integral, Num, Bounded, Enum, Real, Ix, Bits, FiniteBits, Storable, Data)