git.iko.soy/patch
on develop help sign in
Move some query morphisms into Reflex.Query.Class
59ef31eRyan Trinkle
src/Reflex/Query/Base.hs−7
compare with develop
unifiedsplit
@@ -278,13 +278,6 @@ instance (Monoid a, Monad m) => Monoid (QueryT t q m a) where
278instance (S.Semigroup a, Monad m) => S.Semigroup (QueryT t q m a) where
278instance (S.Semigroup a, Monad m) => S.Semigroup (QueryT t q m a) where
279 (<>) = liftA2 (S.<>)
279 (<>) = liftA2 (S.<>)
280
280
281−
282−mapQuery :: QueryMorphism q q' -> q -> q'
283−mapQuery = _queryMorphism_mapQuery
284−
285−mapQueryResult :: QueryMorphism q q' -> QueryResult q' -> QueryResult q
286−mapQueryResult = _queryMorphism_mapQueryResult
287−
288-- | withQueryT's QueryMorphism argument needs to be a group homomorphism in order to behave correctly
281-- | withQueryT's QueryMorphism argument needs to be a group homomorphism in order to behave correctly
289withQueryT :: (MonadFix m, PostBuild t m, Group q, Group q', Additive q, Additive q', Query q')
282withQueryT :: (MonadFix m, PostBuild t m, Group q, Group q', Additive q, Additive q', Query q')
290 => QueryMorphism q q'
283 => QueryMorphism q q'
src/Reflex/Query/Class.hs+23
@@ -15,12 +15,18 @@ module Reflex.Query.Class
15 , MonadQuery (..)
15 , MonadQuery (..)
16 , tellQueryDyn
16 , tellQueryDyn
17 , queryDyn
17 , queryDyn
18+ , mapQuery
19+ , mapQueryResult
18 ) where
20 ) where
19
21
22+import Control.Category (Category)
23+import qualified Control.Category as Cat
20import Control.Monad.Reader
24import Control.Monad.Reader
21import Data.Bits
25import Data.Bits
22import Data.Data
26import Data.Data
23import Data.Ix
27import Data.Ix
28+import Data.Map.Monoidal (MonoidalMap)
29+import qualified Data.Map.Monoidal as MonoidalMap
24import Data.Semigroup
30import Data.Semigroup
25import Foreign.Storable
31import Foreign.Storable
26
32
@@ -30,6 +36,10 @@ class (Monoid (QueryResult a), Semigroup (QueryResult a)) => Query a where
30 type QueryResult a :: *
36 type QueryResult a :: *
31 crop :: a -> QueryResult a -> QueryResult a
37 crop :: a -> QueryResult a -> QueryResult a
32
38
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+
33-- | NB: QueryMorphism's must be group homomorphisms when acting on the query type
43-- | 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
44-- and compatible with the query relationship when acting on the query result
35data QueryMorphism q q' = QueryMorphism
45data QueryMorphism q q' = QueryMorphism
@@ -37,6 +47,19 @@ data QueryMorphism q q' = QueryMorphism
37 , _queryMorphism_mapQueryResult :: QueryResult q' -> QueryResult q
47 , _queryMorphism_mapQueryResult :: QueryResult q' -> QueryResult q
38 }
48 }
39
49
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+
40-- | This type keeps track of the multiplicity of elements of the view selector that are being used by the app
63-- | 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 }
64newtype SelectedCount = SelectedCount { unSelectedCount :: Int }
42 deriving (Eq, Ord, Show, Read, Integral, Num, Bounded, Enum, Real, Ix, Bits, FiniteBits, Storable, Data)
65 deriving (Eq, Ord, Show, Read, Integral, Num, Bounded, Enum, Real, Ix, Bits, FiniteBits, Storable, Data)