1{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, GADTs, ScopedTypeVariables, FunctionalDependencies, RecursiveDo, UndecidableInstances, GeneralizedNewtypeDeriving, StandaloneDeriving, EmptyDataDecls, NoMonomorphismRestriction, TypeOperators, DeriveDataTypeable, PackageImports, TemplateHaskell, LambdaCase #-}
2module Reflex.Class where
4import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)
6import Control.Monad.Identity hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
7import Control.Monad.State.Strict hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
8import Control.Monad.Reader hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
9import Data.List.NonEmpty (NonEmpty (..))
12import Data.GADT.Compare (GEq (..), (:~:) (..))
13import Data.GADT.Show (GShow (..))
14import Data.Dependent.Sum (ShowTag (..))
16import Data.Dependent.Map (DMap, DSum (..), GCompare (..), GOrdering (..))
17import qualified Data.Dependent.Map as DMap
18import Data.Functor.Misc
21import Debug.Trace (trace)
23class (MonadHold t (PushM t), MonadSample t (PullM t), Functor (Event t), Functor (Behavior t)) => Reflex t where
24 -- | A container for a value that can change over time. Behaviors can be sampled at will, but it is not possible to be notified when they change
25 data Behavior t :: * -> *
26 -- | A stream of occurrences. During any given frame, an Event is either occurring or not occurring; if it is occurring, it will contain a value of the given type (its "occurrence type")
27 data Event t :: * -> *
28 -- | An Event with no occurrences
30 -- | Create a Behavior that always has the given value
31 constant :: a -> Behavior t a --TODO: Refactor to use 'pure' from Applicative instead; however, we need to make sure that encouraging Applicative-style use of Behaviors doesn't have a negative performance impact
32 -- | Create an Event from another Event; the provided function can sample Behaviors and hold Events, and use the results to produce a occurring (Just) or non-occurring (Nothing) result
33 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
34 -- | A monad for doing complex push-based calculations efficiently
35 type PushM t :: * -> *
36 -- | Create a Behavior by reading from other Behaviors; the result will be recomputed whenever any of the read Behaviors changes
37 pull :: PullM t a -> Behavior t a
38 -- | A monad for doing complex pull-based calculations efficiently
39 type PullM t :: * -> *
40 -- | Merge a collection of events; the resulting Event will only occur if at least one input event is occuring, and will contain all of the input keys that are occurring simultaneously
41 merge :: GCompare k => DMap (WrapArg (Event t) k) -> Event t (DMap k) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
42 -- | Efficiently fan-out an event to many destinations. This function should be partially applied, and then the result applied repeatedly to create child events
43 fan :: GCompare k => Event t (DMap k) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
44 -- | Create an Event that will occur whenever the currently-selected input Event occurs
45 switch :: Behavior t (Event t a) -> Event t a
46 -- | Create an Event that will occur whenever the input event is occurring and its occurrence value, another Event, is also occurring
47 coincidence :: Event t (Event t a) -> Event t a
49class Monad m => MonadSample t m | m -> t where
50 -- | Get the current value in the Behavior
51 sample :: Behavior t a -> m a
53class MonadSample t m => MonadHold t m where
54 -- | Create a new Behavior whose value will initially be equal to the given value and will be updated whenever the given Event occurs
55 hold :: a -> Event t a -> m (Behavior t a)
57newtype EventSelector t k = EventSelector { select :: forall a. k a -> Event t a }
59--------------------------------------------------------------------------------
61--------------------------------------------------------------------------------
63instance MonadSample t m => MonadSample t (ReaderT r m) where
64 sample = lift . sample
66instance MonadHold t m => MonadHold t (ReaderT r m) where
67 hold a0 = lift . hold a0
69--------------------------------------------------------------------------------
70-- Convenience functions
71--------------------------------------------------------------------------------
73-- | Create an Event from another Event.
74-- The provided function can sample 'Behavior's and hold 'Event's.
75pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
76pushAlways f e = push (liftM Just . f) e
78-- | Flipped version of 'fmap'.
79ffor :: Functor f => f a -> (a -> b) -> f b
82instance Reflex t => Functor (Behavior t) where
83 fmap f = pull . liftM f . sample
85--TODO: See if there's a better class in the standard libraries already
86-- | A class for values that combines filtering and mapping using 'Maybe'.
87class FunctorMaybe f where
88 -- | Combined mapping and filtering function.
89 fmapMaybe :: (a -> Maybe b) -> f a -> f b
91-- | Flipped version of 'fmapMaybe'.
92fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b
93fforMaybe = flip fmapMaybe
95-- | Filter 'f a' using the provided predicate.
96-- Relies on 'fforMaybe'.
97ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
98ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
100instance Reflex t => FunctorMaybe (Event t) where
101 fmapMaybe f = push $ return . f
103instance Reflex t => Functor (Event t) where
104 fmap f = fmapMaybe $ Just . f
106-- | Create a new 'Event' by combining each occurence with the next value
107-- of the list using the supplied function. If the list runs out of items,
108-- all subsequent 'Event' occurrences will be ignored.
109zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
110zipListWithEvent f l e = do
111 rec lb <- hold l eTail
112 let eBoth = flip push e $ \o -> do
115 (h : t) -> Just (f h o, t)
117 let eTail = fmap snd eBoth
118 lb `seq` eBoth `seq` eTail `seq` return ()
119 return $ fmap fst eBoth
121-- | Replace each occurrence value of the 'Event' with the value of the
122-- 'Behavior' at the time of that occurrence.
123tag :: Reflex t => Behavior t b -> Event t a -> Event t b
124tag b = pushAlways $ \_ -> sample b
126-- | Create a new 'Event' that combines occurences of supplied 'Event'
127-- with the current value of the 'Behavior'.
128attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
129attach = attachWith (,)
131-- | Create a new 'Event' that occurs when the supplied 'Event' occurs
132-- by combining it with the current value of the 'Behavior'.
133attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
134attachWith f = attachWithMaybe $ \a b -> Just $ f a b
136-- | Create a new 'Event' by combining each occurence with the current
137-- value of the 'Behavior'. The occurrence is discarded if the combining function
139attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
140attachWithMaybe f b e = flip push e $ \o -> liftM (flip f o) $ sample b
142-- | Alias for 'headE'
143onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
146-- | Create a new 'Event' that only occurs on the first occurence of
147-- the supplied 'Event'.
148headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
150 rec be <- hold e $ fmap (const never) e'
155-- | Create a new 'Event' that occurs on all but the first occurence
156-- of the supplied 'Event'.
157tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
158tailE e = liftM snd $ headTailE e
160-- | Create a tuple of two 'Event's with the first one occuring only
161-- the first time the supplied 'Event' occurs and the second occuring
162-- on all but the first occurence.
163headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
166 be <- hold never $ fmap (const e) eHead
167 return (eHead, switch be)
169-- | Split the supplied 'Event' into two individual 'Event's occuring
170-- at the same time with the respective values from the tuple.
171splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
172splitE e = (fmap fst e, fmap snd e)
174-- | Print the supplied 'String' and the value of the 'Event' on each
175-- occurence. This should /only/ be used for debugging.
177-- Note: As with Debug.Trace.trace, the message will only be printed if
178-- the 'Event' is actually used.
179traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
180traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
182-- | Print the output of the supplied function on each occurence of
183-- the 'Event'. This should /only/ be used for debugging.
185-- Note: As with Debug.Trace.trace, the message will only be printed if
186-- the 'Event' is actually used.
187traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
188traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
190-- | Tag type for 'Either' to use it as a 'DSum'.
191data EitherTag l r a where
192 LeftTag :: EitherTag l r l
193 RightTag :: EitherTag l r r
195instance GEq (EitherTag l r) where
196 geq a b = case (a, b) of
197 (LeftTag, LeftTag) -> Just Refl
198 (RightTag, RightTag) -> Just Refl
201instance GCompare (EitherTag l r) where
202 gcompare a b = case (a, b) of
203 (LeftTag, LeftTag) -> GEQ
204 (LeftTag, RightTag) -> GLT
205 (RightTag, LeftTag) -> GGT
206 (RightTag, RightTag) -> GEQ
208instance GShow (EitherTag l r) where
209 gshowsPrec _ a = case a of
210 LeftTag -> showString "LeftTag"
211 RightTag -> showString "RightTag"
213instance (Show l, Show r) => ShowTag (EitherTag l r) where
214 showTaggedPrec t n a = case t of
215 LeftTag -> showsPrec n a
216 RightTag -> showsPrec n a
218-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
219eitherToDSum :: Either a b -> DSum (EitherTag a b)
221 Left a -> LeftTag :=> a
222 Right b -> RightTag :=> b
224-- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
225dsumToEither :: DSum (EitherTag a b) -> Either a b
227 LeftTag :=> a -> Left a
228 RightTag :=> b -> Right b
230-- | Extract the values of a 'DMap' of 'EitherTag's.
231dmapToThese :: DMap (EitherTag a b) -> Maybe (These a b)
232dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
233 (Nothing, Nothing) -> Nothing
234 (Just a, Nothing) -> Just $ This a
235 (Nothing, Just b) -> Just $ That b
236 (Just a, Just b) -> Just $ These a b
238-- | Create a new 'Event' that occurs if at least one of the supplied
239-- 'Event's occurs. If both occur at the same time they are combined
241appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
242appendEvents e1 e2 = fmap (mergeThese mappend) $ align e1 e2
244{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
245sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
246sequenceThese t = case t of
247 This ma -> liftM This ma
248 These ma mb -> liftM2 These ma mb
249 That mb -> liftM That mb
251instance (Semigroup a, Reflex t) => Monoid (Event t a) where
253 mappend a b = mconcat [a, b]
254 mconcat = fmap sconcat . mergeList
256-- | Create a new 'Event' that occurs if at least one of the 'Event's
257-- in the list occurs. If multiple occur at the same time they are
258-- folded from the left with the given function.
259mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
260mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> v) -> v) . DMap.toList) $ merge $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
262-- | Create a new 'Event' that occurs if at least one of the 'Event's
263-- in the list occurs. If multiple occur at the same time the value is
264-- the value of the leftmost event.
265leftmost :: Reflex t => [Event t a] -> Event t a
266leftmost = mergeWith const
268-- | Create a new 'Event' that occurs if at least one of the 'Event's
269-- in the list occurs and has a list of the values of all 'Event's
270-- occuring at that time.
271mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
273mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
275-- | Create a new 'Event' combining the map of 'Event's into an
276-- 'Event' that occurs if at least one of them occurs and has a map of
277-- values of all 'Event's occuring at that time.
278mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
279mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
281-- | Split the event into an 'EventSelector' that allows efficient
282-- selection of the individual 'Event's.
283fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
284fanMap = fan . fmap mapToDMap
286-- | Switches to the new event whenever it receives one; the new event is used immediately, on the same frame that it is switched to
287switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
288switchPromptly ea0 eea = do
290 let eLag = switch bea
291 eCoincidences = coincidence eea
292 return $ leftmost [eCoincidences, eLag]
294instance Reflex t => Align (Event t) where
296 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [WrapArg LeftTag :=> ea, WrapArg RightTag :=> eb]
298-- | Create a new 'Event' that only occurs if the supplied 'Event'
299-- occurs and the 'Behavior' is true at the time of occurence.
300gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
301gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list