git.iko.soy/patch
on 96c446d help sign in
patch/src/Reflex/Query/Class.hs
149 lines 5.7 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FunctionalDependencies #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE UndecidableInstances #-}
9-- |
10-- Module:
11-- Reflex.Query.Class
12-- Description:
13-- A class that ties together queries to some data source and their results,
14-- providing methods for requesting data from the source and accumulating
15-- streamed results.
16module Reflex.Query.Class
17 ( Query (..)
18 , QueryMorphism (..)
19 , SelectedCount (..)
20 , combineSelectedCounts
22 , MonadQuery (..)
23 , tellQueryDyn
24 , queryDyn
25 , subQuery
26 , mapQuery
27 , mapQueryResult
28 ) where
30import Control.Category (Category)
31import qualified Control.Category as Cat
32import Control.Monad.Reader
33import Data.Bits
34import Data.Data
35import Data.Ix
36import Data.Map.Monoidal (MonoidalMap)
37import qualified Data.Map.Monoidal as MonoidalMap
38import Data.Semigroup (Semigroup(..))
39import Foreign.Storable
40import Data.Void
41import Data.Monoid
42import Control.Applicative
44import Reflex.Class
46-- | A 'Query' can be thought of as a declaration of interest in some set of data.
47-- A 'QueryResult' is the set of data associated with that interest set.
48-- The @crop@ function provides a way to determine what part of a given 'QueryResult'
49-- is relevant to a given 'Query'.
50class (Monoid (QueryResult a), Semigroup (QueryResult a)) => Query a where
51 type QueryResult a :: *
52 crop :: a -> QueryResult a -> QueryResult a
54instance (Ord k, Query v) => Query (MonoidalMap k v) where
55 type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)
56 crop q r = MonoidalMap.intersectionWith (flip crop) r q
58-- asking two questions is the same as asking both questions.
59instance (Query a, Query b) => Query (a, b) where
60 type QueryResult (a, b) = (QueryResult a, QueryResult b)
61 crop (x, x') (y, y') = (crop x y, crop x' y')
63-- ¯\_(ﾟヮﾟ)_/¯ ¯\_(ツ)_/¯
64instance Query () where
65 type QueryResult () = ()
66 crop _ _ = ()
68instance Query Void where
69 type QueryResult Void = ()
70 crop = absurd
72#if MIN_VERSION_base(4,12,0)
73-- | We can lift queries into monoidal containers.
74-- But beware of Applicatives who's monoid is different from (pure mempty, liftA2 mappend)
75instance (Query q, Applicative f) => Query (Ap f q) where
76 type QueryResult (Ap f q) = Ap f (QueryResult q)
77 crop = liftA2 crop
78#endif
79-- | QueryMorphism's must be group homomorphisms when acting on the query type
80-- and compatible with the query relationship when acting on the query result.
81data QueryMorphism q q' = QueryMorphism
82 { _queryMorphism_mapQuery :: q -> q'
83 , _queryMorphism_mapQueryResult :: QueryResult q' -> QueryResult q
84 }
86instance Category QueryMorphism where
87 id = QueryMorphism id id
88 qm . qm' = QueryMorphism
89 { _queryMorphism_mapQuery = mapQuery qm . mapQuery qm'
90 , _queryMorphism_mapQueryResult = mapQueryResult qm' . mapQueryResult qm
91 }
93-- | Apply a 'QueryMorphism' to a 'Query'
94mapQuery :: QueryMorphism q q' -> q -> q'
95mapQuery = _queryMorphism_mapQuery
97-- | Map a 'QueryMorphism' to a 'QueryResult'
98mapQueryResult :: QueryMorphism q q' -> QueryResult q' -> QueryResult q
99mapQueryResult = _queryMorphism_mapQueryResult
101-- | This type can be used to track of the frequency of interest in a given 'Query'. See note on
102-- 'combineSelectedCounts'
103newtype SelectedCount = SelectedCount { unSelectedCount :: Int }
104 deriving (Eq, Ord, Show, Read, Integral, Num, Bounded, Enum, Real, Ix, Bits, FiniteBits, Storable, Data)
106instance Semigroup SelectedCount where
107 SelectedCount a <> SelectedCount b = SelectedCount (a + b)
109instance Monoid SelectedCount where
110 mempty = SelectedCount 0
111 mappend = (<>)
113instance Group SelectedCount where
114 negateG (SelectedCount a) = SelectedCount (negate a)
116instance Additive SelectedCount
118-- | The Semigroup/Monoid/Group instances for a Query containing 'SelectedCount's should use
119-- this function which returns Nothing if the result is 0. This allows the pruning of leaves
120-- of the 'Query' that are no longer wanted.
121combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount
122combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j then Nothing else Just $ SelectedCount (i + j)
124-- | A class that allows sending of 'Query's and retrieval of 'QueryResult's. See 'queryDyn' for a commonly
125-- used interface.
126class (Group q, Additive q, Query q) => MonadQuery t q m | m -> q t where
127 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()
128 askQueryResult :: m (Dynamic t (QueryResult q))
129 queryIncremental :: Incremental t (AdditivePatch q) -> m (Dynamic t (QueryResult q))
131instance (Monad m, MonadQuery t q m) => MonadQuery t q (ReaderT r m) where
132 tellQueryIncremental = lift . tellQueryIncremental
133 askQueryResult = lift askQueryResult
134 queryIncremental = lift . queryIncremental
136-- | Produce and send an 'Incremental' 'Query' from a 'Dynamic' 'Query'.
137tellQueryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m ()
138tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)
140-- | Retrieve 'Dynamic'ally updating 'QueryResult's for a 'Dynamic'ally updating 'Query'.
141queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))
142queryDyn q = do
143 tellQueryDyn q
144 zipDynWith crop q <$> askQueryResult
146-- | We can already say this in reflex
147subQuery :: (Reflex t, MonadQuery t q2 m, Monad m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))
148subQuery (QueryMorphism f g) x = fmap g <$> queryDyn (fmap f x)