git.iko.soy/patch
on develop help sign in
Buncha instances
f7da8e8dan bornside
src/Reflex/Patch.hs+44
compare with develop
unifiedsplit
@@ -1,4 +1,7 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE StandaloneDeriving #-}
1{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
4+{-# LANGUAGE TypeOperators #-}
2-- |
5-- |
3-- Module:
6-- Module:
4-- Reflex.Patch
7-- Reflex.Patch
@@ -23,6 +26,11 @@ import Reflex.Patch.MapWithMove as X (PatchMapWithMove, patchMapWithMoveNewEleme
23 unsafePatchMapWithMove)
26 unsafePatchMapWithMove)
24import Data.Map.Monoidal (MonoidalMap)
27import Data.Map.Monoidal (MonoidalMap)
25import Data.Semigroup (Semigroup (..), (<>))
28import Data.Semigroup (Semigroup (..), (<>))
29+import GHC.Generics
30+import Data.Functor.Identity
31+import Data.Functor.Const
32+import Data.Proxy
33+import Control.Applicative
26
34
27-- | A 'Group' is a 'Monoid' where every element has an inverse.
35-- | A 'Group' is a 'Monoid' where every element has an inverse.
28class (Semigroup q, Monoid q) => Group q where
36class (Semigroup q, Monoid q) => Group q where
@@ -44,3 +52,39 @@ instance (Ord k, Group q) => Group (MonoidalMap k q) where
44 negateG = fmap negateG
52 negateG = fmap negateG
45
53
46instance (Ord k, Additive q) => Additive (MonoidalMap k q)
54instance (Ord k, Additive q) => Additive (MonoidalMap k q)
55+
56+instance Group () where
57+ negateG _ = ()
58+ _ ~~ _ = ()
59+instance Additive ()
60+
61+instance (Group a, Group b) => Group (a, b) where
62+ negateG (a, b) = (negateG a, negateG b)
63+ (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
64+instance (Additive a, Additive b) => Additive (a, b) where
65+
66+-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
67+-- Base does not define Monoid (Compose f g a) so this has no "home"
68+instance Group (f (g a)) => Group ((f :.: g) a) where
69+ negateG (Comp1 xs) = Comp1 (negateG xs)
70+ Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
71+
72+instance Additive (f (g a)) => Additive ((f :.: g) a) where
73+
74+instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
75+ negateG (a :*: b) = negateG a :*: negateG b
76+ (a :*: b) ~~ (c :*: d) = (a ~~ c :*: b ~~ d)
77+instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a) where
78+
79+instance Group (Proxy x) where
80+ negateG _ = Proxy
81+ _ ~~ _ = Proxy
82+instance Additive (Proxy x)
83+
84+deriving instance Group a => Group (Const a x)
85+deriving instance Group a => Group (Identity a)
86+
87+instance Group b => Group (a -> b) where
88+ negateG f = negateG . f
89+ (~~) = liftA2 (~~)
90+instance Additive b => Additive (a -> b)
src/Reflex/Query/Class.hs+28
@@ -21,6 +21,7 @@ module Reflex.Query.Class
21 , MonadQuery (..)
21 , MonadQuery (..)
22 , tellQueryDyn
22 , tellQueryDyn
23 , queryDyn
23 , queryDyn
24+ , subQuery
24 , mapQuery
25 , mapQuery
25 , mapQueryResult
26 , mapQueryResult
26 ) where
27 ) where
@@ -35,6 +36,9 @@ import Data.Map.Monoidal (MonoidalMap)
35import qualified Data.Map.Monoidal as MonoidalMap
36import qualified Data.Map.Monoidal as MonoidalMap
36import Data.Semigroup (Semigroup(..))
37import Data.Semigroup (Semigroup(..))
37import Foreign.Storable
38import Foreign.Storable
39+import Data.Void
40+import Data.Monoid
41+import Control.Applicative
38
42
39import Reflex.Class
43import Reflex.Class
40
44
@@ -50,6 +54,25 @@ instance (Ord k, Query v) => Query (MonoidalMap k v) where
50 type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)
54 type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)
51 crop q r = MonoidalMap.intersectionWith (flip crop) r q
55 crop q r = MonoidalMap.intersectionWith (flip crop) r q
52
56
57+-- asking two questions is the same as asking both questions.
58+instance (Query a, Query b) => Query (a, b) where
59+ type QueryResult (a, b) = (QueryResult a, QueryResult b)
60+ crop (x, x') (y, y') = (crop x y, crop x' y')
61+
62+-- ¯\_(ﾟヮﾟ)_/¯ ¯\_(ツ)_/¯
63+instance Query () where
64+ type QueryResult () = ()
65+ crop _ _ = ()
66+
67+instance Query Void where
68+ type QueryResult Void = ()
69+ crop = absurd
70+
71+-- | We can lift queries into monoidal containers.
72+-- But beware of Applicatives who's monoid is different from (pure mempty, liftA2 mappend)
73+instance (Query q, Applicative f) => Query (Ap f q) where
74+ type QueryResult (Ap f q) = Ap f (QueryResult q)
75+ crop = liftA2 crop
53-- | QueryMorphism's must be group homomorphisms when acting on the query type
76-- | QueryMorphism's must be group homomorphisms when acting on the query type
54-- and compatible with the query relationship when acting on the query result.
77-- and compatible with the query relationship when acting on the query result.
55data QueryMorphism q q' = QueryMorphism
78data QueryMorphism q q' = QueryMorphism
@@ -116,3 +139,8 @@ queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t
116queryDyn q = do
139queryDyn q = do
117 tellQueryDyn q
140 tellQueryDyn q
118 zipDynWith crop q <$> askQueryResult
141 zipDynWith crop q <$> askQueryResult
142+
143+-- | We can already say this in reflex
144+subQuery :: (Reflex t, MonadQuery t q2 m, Monad m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))
145+subQuery (QueryMorphism f g) x = fmap g <$> queryDyn (fmap f x)
146+