on 538e879 help sign in
patch/src/Reflex/Dynamic.hs
686 lines 31 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE NoMonomorphismRestriction #-}
9{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE RecursiveDo #-}
12{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE StandaloneDeriving #-}
14{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE TypeOperators #-}
16{-# LANGUAGE UndecidableInstances #-}
17#ifdef USE_REFLEX_OPTIMIZER
18{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
19#endif
20-- | This module contains various functions for working with 'Dynamic' values.
21-- 'Dynamic' and its primitives have been moved to the 'Reflex' class.
22module Reflex.Dynamic
23 ( -- * Basics
24 Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update
25 , current
26 , updated
27 , holdDyn
28 , mapDynM
29 , forDynM
30 , constDyn
31 , count
32 , toggle
33 , switchDyn
34 , switchPromptlyDyn
35 , tagPromptlyDyn
36 , attachPromptlyDyn
37 , attachPromptlyDynWith
38 , attachPromptlyDynWithMaybe
39 , maybeDyn
40 , eitherDyn
41 , factorDyn
42 , scanDyn
43 , scanDynMaybe
44 , holdUniqDyn
45 , holdUniqDynBy
46 , improvingMaybe
47 , foldDyn
48 , foldDynM
49 , foldDynMaybe
50 , foldDynMaybeM
51 , joinDynThroughMap
52 , traceDyn
53 , traceDynWith
54 , splitDynPure
55 , distributeMapOverDynPure
56 , distributeDMapOverDynPure
57 , distributeListOverDynPure
58 , Demux
59 , demux
60 , demuxed
61 -- Things that probably aren't very useful:
62 , HList (..)
63 , FHList (..)
64 , collectDynPure
65 , RebuildSortedHList (..)
66 , IsHList (..)
67 , AllAreFunctors (..)
68 , HListPtr (..)
69 , distributeFHListOverDynPure
70 -- Unsafe
71 , unsafeDynamic
72 -- * Deprecated functions
73 , apDyn
74 , attachDyn
75 , attachDynWith
76 , attachDynWithMaybe
77 , collectDyn
78 , combineDyn
79 , distributeDMapOverDyn
80 , distributeFHListOverDyn
81 , forDyn
82 , getDemuxed
83 , joinDyn
84 , mapDyn
85 , mconcatDyn
86 , nubDyn
87 , splitDyn
88 , tagDyn
89 , uniqDyn
90 , uniqDynBy
91 ) where
93import Data.Functor.Compose
94import Data.Functor.Misc
95import Reflex.Class
97import Control.Applicative ((<*>))
98import Control.Monad
99import Control.Monad.Fix
100import Control.Monad.Identity
101import Data.Align
102import Data.Dependent.Map (DMap)
103import qualified Data.Dependent.Map as DMap
104import Data.Dependent.Sum (DSum (..))
105import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
106import Data.Map (Map)
107import Data.Maybe
108import Data.Monoid
109import Data.These
111import Debug.Trace
113-- | Map a sampling function over a 'Dynamic'.
114mapDynM :: forall t m a b. (Reflex t, MonadHold t m) => (forall m'. MonadSample t m' => a -> m' b) -> Dynamic t a -> m (Dynamic t b)
115mapDynM f d = buildDynamic (f =<< sample (current d)) $ pushAlways f (updated d)
117-- | Flipped version of 'mapDynM'
118forDynM :: forall t m a b. (Reflex t, MonadHold t m) => Dynamic t a -> (forall m'. MonadSample t m' => a -> m' b) -> m (Dynamic t b)
119forDynM d f = mapDynM f d
121-- | Create a new 'Dynamic' that only signals changes if the values actually
122-- changed.
123holdUniqDyn :: (Reflex t, MonadHold t m, MonadFix m, Eq a) => Dynamic t a -> m (Dynamic t a)
124holdUniqDyn = holdUniqDynBy (==)
126-- | Create a new 'Dynamic' that changes only when the underlying 'Dynamic'
127-- changes and the given function returns 'False' when given both the old and
128-- the new values.
129holdUniqDynBy :: (Reflex t, MonadHold t m, MonadFix m) => (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
130holdUniqDynBy eq = scanDynMaybe id (\new old -> if new `eq` old then Nothing else Just new)
132-- | Dynamic Maybe that can only update from Nothing to Just or Just to Just (i.e., cannot revert to Nothing)
133improvingMaybe :: (Reflex t, MonadHold t m, MonadFix m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))
134improvingMaybe = scanDynMaybe id (\new _ -> if isJust new then Just new else Nothing)
136-- | Create a 'Dynamic' that accumulates values from another 'Dynamic'. This
137-- function does not force its input 'Dynamic' until the output 'Dynamic' is
138-- forced.
139scanDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)
140scanDyn z f = scanDynMaybe z (\a b -> Just $ f a b)
142-- | Like 'scanDyn', but the the accumulator function may decline to update the
143-- result 'Dynamic''s value.
144scanDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
145scanDynMaybe z f d = do
146 rec d' <- buildDynamic (z <$> sample (current d)) $ flip push (updated d) $ \a -> do
147 b <- sample $ current d'
148 return $ f a b
149 return d'
151-- | Create a 'Dynamic' using the initial value and change it each time the
152-- 'Event' occurs using a folding function on the previous value and the value
153-- of the 'Event'.
154foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
155foldDyn = accumDyn . flip
157-- | Like 'foldDyn', but the combining function is a 'PushM' action, so it
158-- can 'sample' existing 'Behaviors' and 'hold' new ones.
159foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
160foldDynM = accumMDyn . flip
162-- | Create a 'Dynamic' using the provided initial value and change it each time
163-- the provided 'Event' occurs, using a function to combine the old value with
164-- the 'Event''s value. If the function returns 'Nothing', the value is not
165-- changed; this is distinct from returning 'Just' the old value, since the
166-- 'Dynamic''s 'updated' 'Event' will fire in the 'Just' case, and will not fire
167-- in the 'Nothing' case.
168foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
169foldDynMaybe = accumMaybeDyn . flip
171-- | Like 'foldDynMaybe', but the combining function is a 'PushM' action, so it
172-- can 'sample' existing 'Behaviors' and 'hold' new ones.
173foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
174foldDynMaybeM = accumMaybeMDyn . flip
176-- | Create a new 'Dynamic' that counts the occurences of the 'Event'.
177count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
178count e = holdDyn 0 =<< zipListWithEvent const (iterate (+1) 1) e
180-- | Create a new 'Dynamic' using the initial value that flips its
181-- value every time the 'Event' occurs.
182toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
183toggle = foldDyn (const not)
185-- | Switches to the new 'Event' whenever it receives one. Only the old event is
186-- considered the moment a new one is switched in; the output event will fire at
187-- that moment if only if the old event does.
188--
189-- Prefer this to 'switchPromptlyDyn' where possible. The lack of doing double
190-- work when the outer and (new) inner fires means this imposes fewer "timing
191-- requirements" and thus is far more easy to use without introducing fresh
192-- failure cases. 'switchDyn' is also more performant.
193switchDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
194switchDyn d = switch (current d)
196-- | Switches to the new 'Event' whenever it receives one. Switching occurs
197-- *before* the inner 'Event' fires - so if the 'Dynamic' changes and both the
198-- old and new inner Events fire simultaneously, the output will fire with the
199-- value of the *new* 'Event'.
200--
201-- Prefer 'switchDyn' to this where possible. The timing requirements that
202-- switching before imposes are likely to bring down your app unless you are
203-- very careful. 'switchDyn' is also more performant.
204switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
205switchPromptlyDyn de =
206 let eLag = switch $ current de
207 eCoincidences = coincidence $ updated de
208 in leftmost [eCoincidences, eLag]
210-- | Split a 'Dynamic' pair into a pair of 'Dynamic's
211splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
212splitDynPure d = (fmap fst d, fmap snd d)
214-- | Convert a 'Map' with 'Dynamic' elements into a 'Dynamic' of a 'Map' with
215-- non-'Dynamic' elements.
216distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
217distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap
219-- | Convert a list with 'Dynamic' elements into a 'Dynamic' of a list with
220-- non-'Dynamic' elements, preserving the order of the elements.
221distributeListOverDynPure :: Reflex t => [Dynamic t v] -> Dynamic t [v]
222distributeListOverDynPure =
223 fmap (map fromDSum . DMap.toAscList) .
224 distributeDMapOverDynPure .
225 DMap.fromDistinctAscList .
226 zipWith toDSum [0..]
227 where
228 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
229 toDSum k v = Const2 k :=> v
230 fromDSum :: DSum (Const2 Int a) Identity -> a
231 fromDSum (Const2 _ :=> Identity v) = v
233--TODO: Generalize this to functors other than Maps
234-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
235-- with the current values of the 'Dynamic's in a map.
236joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
237joinDynThroughMap = joinDyn . fmap distributeMapOverDynPure
239-- | Print the value of the 'Dynamic' when it is first read and on each
240-- subsequent change that is observed (as traceEvent), prefixed with the
241-- provided string. This should /only/ be used for debugging.
242--
243-- Note: Just like Debug.Trace.trace, the value will only be shown if something
244-- else in the system is depending on it.
245traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
246traceDyn s = traceDynWith $ \x -> s <> ": " <> show x
248-- | Print the result of applying the provided function to the value
249-- of the 'Dynamic' when it is first read and on each subsequent change
250-- that is observed (as traceEvent). This should /only/ be used for
251-- debugging.
252--
253-- Note: Just like Debug.Trace.trace, the value will only be shown if something
254-- else in the system is depending on it.
255traceDynWith :: Reflex t => (a -> String) -> Dynamic t a -> Dynamic t a
256traceDynWith f d =
257 let e' = traceEventWith f $ updated d
258 getV0 = do
259 x <- sample $ current d
260 trace (f x) $ return x
261 in unsafeBuildDynamic getV0 e'
263-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
264-- each time the 'Event' occurs.
265--
266-- Note: `tagPromptlyDyn d e` differs from `tag (current d) e` in the case that `e` is firing
267-- at the same time that `d` is changing. With `tagPromptlyDyn d e`, the *new* value of `d`
268-- will replace the value of `e`, whereas with `tag (current d) e`, the *old* value
269-- will be used, since the 'Behavior' won't be updated until the end of the frame.
270-- Additionally, this means that the output 'Event' may not be used to directly change
271-- the input 'Dynamic', because that would mean its value depends on itself. When creating
272-- cyclic data flows, generally `tag (current d) e` is preferred.
273tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
274tagPromptlyDyn = attachPromptlyDynWith const
276-- | Attach the current value of the 'Dynamic' to the value of the
277-- 'Event' each time it occurs.
278--
279-- Note: `attachPromptlyDyn d` is not the same as `attach (current d)`. See 'tagPromptlyDyn' for details.
280attachPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
281attachPromptlyDyn = attachPromptlyDynWith (,)
283-- | Combine the current value of the 'Dynamic' with the value of the
284-- 'Event' each time it occurs.
285--
286-- Note: `attachPromptlyDynWith f d` is not the same as `attachWith f (current d)`. See 'tagPromptlyDyn' for details.
287attachPromptlyDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
288attachPromptlyDynWith f = attachPromptlyDynWithMaybe $ \a b -> Just $ f a b
290-- | Create a new 'Event' by combining the value at each occurence with the
291-- current value of the 'Dynamic' value and possibly filtering if the combining
292-- function returns 'Nothing'.
293--
294-- Note: `attachPromptlyDynWithMaybe f d` is not the same as `attachWithMaybe f
295-- (current d)`. See 'tagPromptlyDyn' for details.
296attachPromptlyDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
297attachPromptlyDynWithMaybe f d e =
298 let e' = attach (current d) e
299 in fforMaybe (align e' $ updated d) $ \case
300 This (a, b) -> f a b -- Only the tagging event is firing, so use that
301 These (_, b) a -> f a b -- Both events are firing, so use the newer value
302 That _ -> Nothing -- The tagging event isn't firing, so don't fire
304-- | Factor a @Dynamic t (Maybe a)@ into a @Dynamic t (Maybe (Dynamic t a))@,
305-- such that the outer 'Dynamic' is updated only when the 'Maybe''s constructor
306-- chages from 'Nothing' to 'Just' or vice-versa. Whenever the constructor
307-- becomes 'Just', an inner 'Dynamic' will be provided, whose value will track
308-- the 'a' inside the 'Just'; when the constructor becomes 'Nothing', the
309-- existing inner 'Dynamic' will become constant, and will not change when the
310-- outer constructor changes back to 'Nothing'.
311maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
312maybeDyn = fmap (fmap unpack) . eitherDyn . fmap pack
313 where pack = \case
314 Nothing -> Left ()
315 Just a -> Right a
316 unpack = \case
317 Left _ -> Nothing
318 Right a -> Just a
320eitherDyn :: forall t a b m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Either a b) -> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
321eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum
322 where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)
323 unpack = \case
324 LeftTag :=> Compose a -> Left $ coerceDynamic a
325 RightTag :=> Compose b -> Right $ coerceDynamic b
327factorDyn :: forall t m k v. (Reflex t, MonadFix m, MonadHold t m, GEq k) => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
328factorDyn d = do
329 let inner :: forall m' a. (MonadFix m', MonadHold t m') => k a -> v a -> m' (Dynamic t (v a))
330 inner k v0 = holdDyn v0 . fmapMaybe id =<< takeWhileE isJust newVal
331 where newVal = ffor (updated d) $ \(newK :=> newV) -> case newK `geq` k of
332 Just Refl -> Just newV
333 Nothing -> Nothing
334 getInitial = do
335 k0 :=> (v0 :: v a) <- sample $ current d
336 i0 <- inner k0 v0
337 return $ k0 :=> Compose i0
338 update = flip push (updated d) $ \(newKey :=> newVal) -> do
339 (oldKey :=> _) <- sample $ current d
340 case newKey `geq` oldKey of
341 Just Refl -> return Nothing
342 Nothing -> do
343 newInner <- inner newKey newVal
344 return $ Just $ newKey :=> Compose newInner
345 o0 <- getInitial --TODO: Figure out how to get this to run inside something like the first argument to buildDynamic
346 holdDyn o0 update
348--------------------------------------------------------------------------------
349-- Demux
350--------------------------------------------------------------------------------
352-- | Represents a time changing value together with an 'EventSelector' that can
353-- efficiently detect when the underlying 'Dynamic' has a particular value.
354-- This is useful for representing data like the current selection of a long
355-- list.
356--
357-- Semantically,
358--
359-- > demuxed (demux d) k === fmap (== k) d
360--
361-- However, the when getDemuxed is used multiple times, the complexity is only
362-- /O(log(n))/, rather than /O(n)/ for fmap.
363data Demux t k = Demux { demuxValue :: Behavior t k
364 , demuxSelector :: EventSelector t (Const2 k Bool)
365 }
367-- | Demultiplex an input value to a 'Demux' with many outputs. At any given
368-- time, whichever output is indicated by the given 'Dynamic' will be 'True'.
369demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
370demux k = Demux (current k)
371 (fan $ attachWith (\k0 k1 -> if k0 == k1
372 then DMap.empty
373 else DMap.fromList [Const2 k0 :=> Identity False,
374 Const2 k1 :=> Identity True])
375 (current k) (updated k))
377-- | Select a particular output of the 'Demux'; this is equivalent to (but much
378-- faster than) mapping over the original 'Dynamic' and checking whether it is
379-- equal to the given key.
380demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
381demuxed d k =
382 let e = select (demuxSelector d) (Const2 k)
383 in unsafeBuildDynamic (fmap (==k) $ sample $ demuxValue d) e
385--------------------------------------------------------------------------------
386-- collectDyn
387--------------------------------------------------------------------------------
389--TODO: This whole section is badly in need of cleanup
391-- | A heterogeneous list whose type and length are fixed statically. This is
392-- reproduced from the 'HList' package due to integration issues, and because
393-- very little other functionality from that library is needed.
394data HList (l::[*]) where
395 HNil :: HList '[]
396 HCons :: e -> HList l -> HList (e ': l)
398infixr 2 `HCons`
400type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
401type instance HRevApp '[] l = l
402type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
404hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
405hRevApp HNil l = l
406hRevApp (HCons x l) l' = hRevApp l (HCons x l')
408hReverse :: HList l -> HList (HRevApp l '[])
409hReverse l = hRevApp l HNil
411hBuild :: (HBuild' '[] r) => r
412hBuild = hBuild' HNil
414class HBuild' l r where
415 hBuild' :: HList l -> r
417instance (l' ~ HRevApp l '[])
418 => HBuild' l (HList l') where
419 hBuild' = hReverse
421instance HBuild' (a ': l) r
422 => HBuild' l (a->r) where
423 hBuild' l x = hBuild' (HCons x l)
425-- | Like 'HList', but with a functor wrapping each element.
426data FHList f l where
427 FHNil :: FHList f '[]
428 FHCons :: f e -> FHList f l -> FHList f (e ': l)
430instance GEq (HListPtr l) where
431 HHeadPtr `geq` HHeadPtr = Just Refl
432 HHeadPtr `geq` HTailPtr _ = Nothing
433 HTailPtr _ `geq` HHeadPtr = Nothing
434 HTailPtr a `geq` HTailPtr b = a `geq` b
436instance GCompare (HListPtr l) where -- Warning: This ordering can't change, dmapTo*HList will break
437 HHeadPtr `gcompare` HHeadPtr = GEQ
438 HHeadPtr `gcompare` HTailPtr _ = GLT
439 HTailPtr _ `gcompare` HHeadPtr = GGT
440 HTailPtr a `gcompare` HTailPtr b = a `gcompare` b
442-- | A typed index into a typed heterogeneous list.
443data HListPtr l a where
444 HHeadPtr :: HListPtr (h ': t) h
445 HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
447deriving instance Eq (HListPtr l a)
448deriving instance Ord (HListPtr l a)
450fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
451fhlistToDMap = DMap.fromList . go
452 where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
453 go = \case
454 FHNil -> []
455 FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> HTailPtr p :=> v) (go t)
457-- | This class allows 'HList's and 'FHlist's to be built from regular lists;
458-- they must be contiguous and sorted.
459class RebuildSortedHList l where
460 rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
461 rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
463instance RebuildSortedHList '[] where
464 rebuildSortedFHList l = case l of
465 [] -> FHNil
466 _ : _ -> error "rebuildSortedFHList{'[]}: empty list expected"
467 rebuildSortedHList l = case l of
468 [] -> HNil
469 _ : _ -> error "rebuildSortedHList{'[]}: empty list expected"
471instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
472 rebuildSortedFHList l = case l of
473 ((HHeadPtr :=> h) : t) -> FHCons h . rebuildSortedFHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
474 _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
475 rebuildSortedHList l = case l of
476 ((HHeadPtr :=> Identity h) : t) -> HCons h . rebuildSortedHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
477 _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
479dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
480dmapToHList = rebuildSortedHList . DMap.toList
482-- | Collect a hetereogeneous list whose elements are all 'Dynamic's into a
483-- single 'Dynamic' whose value represents the current values of all of the
484-- input 'Dynamic's.
485distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
486distributeFHListOverDynPure l = fmap dmapToHList $ distributeDMapOverDynPure $ fhlistToDMap l
488-- | Indicates that all elements in a type-level list are applications of the
489-- same functor.
490class AllAreFunctors (f :: a -> *) (l :: [a]) where
491 type FunctorList f l :: [*]
492 toFHList :: HList (FunctorList f l) -> FHList f l
493 fromFHList :: FHList f l -> HList (FunctorList f l)
495instance AllAreFunctors f '[] where
496 type FunctorList f '[] = '[]
497 toFHList l = case l of
498 HNil -> FHNil
499#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
500 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
501#endif
502 fromFHList FHNil = HNil
504instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
505 type FunctorList f (h ': t) = f h ': FunctorList f t
506 toFHList l = case l of
507 a `HCons` b -> a `FHCons` toFHList b
508#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
509 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
510#endif
511 fromFHList (a `FHCons` b) = a `HCons` fromFHList b
513-- | Convert a datastructure whose constituent parts are all 'Dynamic's into a
514-- single 'Dynamic' whose value represents all the current values of the input's
515-- consitutent 'Dynamic's.
516collectDynPure :: ( RebuildSortedHList (HListElems b)
517 , IsHList a, IsHList b
518 , AllAreFunctors (Dynamic t) (HListElems b)
519 , Reflex t
520 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
521 ) => a -> Dynamic t b
522collectDynPure ds = fmap fromHList $ distributeFHListOverDynPure $ toFHList $ toHList ds
524-- | Poor man's 'Generic's for product types only.
525class IsHList a where
526 type HListElems a :: [*]
527 toHList :: a -> HList (HListElems a)
528 fromHList :: HList (HListElems a) -> a
530instance IsHList (a, b) where
531 type HListElems (a, b) = [a, b]
532 toHList (a, b) = hBuild a b
533 fromHList l = case l of
534 a `HCons` b `HCons` HNil -> (a, b)
535#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
536 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
537#endif
539instance IsHList (a, b, c, d) where
540 type HListElems (a, b, c, d) = [a, b, c, d]
541 toHList (a, b, c, d) = hBuild a b c d
542 fromHList l = case l of
543 a `HCons` b `HCons` c `HCons` d `HCons` HNil -> (a, b, c, d)
544#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
545 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
546#endif
548instance IsHList (a, b, c, d, e, f) where
549 type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
550 toHList (a, b, c, d, e, f) = hBuild a b c d e f
551 fromHList l = case l of
552 a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil -> (a, b, c, d, e, f)
553#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
554 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
555#endif
557--------------------------------------------------------------------------------
558-- Deprecated functions
559--------------------------------------------------------------------------------
561-- | Map a function over a 'Dynamic'.
562{-# DEPRECATED mapDyn "Use 'return . fmap f' instead of 'mapDyn f'; consider eliminating monadic style" #-}
563mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)
564mapDyn f = return . fmap f
566-- | Flipped version of 'mapDyn'.
567{-# DEPRECATED forDyn "Use 'return . ffor a' instead of 'forDyn a'; consider eliminating monadic style" #-}
568forDyn :: (Reflex t, Monad m) => Dynamic t a -> (a -> b) -> m (Dynamic t b)
569forDyn a = return . ffor a
571-- | Split the 'Dynamic' into two 'Dynamic's, each taking the respective value
572-- of the tuple.
573{-# DEPRECATED splitDyn "Use 'return . splitDynPure' instead; consider eliminating monadic style" #-}
574splitDyn :: (Reflex t, Monad m) => Dynamic t (a, b) -> m (Dynamic t a, Dynamic t b)
575splitDyn = return . splitDynPure
577-- | Merge the 'Dynamic' values using their 'Monoid' instance.
578{-# DEPRECATED mconcatDyn "Use 'return . mconcat' instead; consider eliminating monadic style" #-}
579mconcatDyn :: forall t m a. (Reflex t, Monad m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
580mconcatDyn = return . mconcat
582-- | This function no longer needs to be monadic; see 'distributeMapOverDynPure'.
583{-# DEPRECATED distributeDMapOverDyn "Use 'return . distributeDMapOverDynPure' instead; consider eliminating monadic style" #-}
584distributeDMapOverDyn :: (Reflex t, Monad m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
585distributeDMapOverDyn = return . distributeDMapOverDynPure
587-- | Merge two 'Dynamic's into a new one using the provided function. The new
588-- 'Dynamic' changes its value each time one of the original 'Dynamic's changes
589-- its value.
590{-# DEPRECATED combineDyn "Use 'return (zipDynWith f a b)' instead of 'combineDyn f a b'; consider eliminating monadic style" #-}
591combineDyn :: forall t m a b c. (Reflex t, Monad m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
592combineDyn f a b = return $ zipDynWith f a b
594-- | A psuedo applicative version of ap for 'Dynamic'. Example useage:
595--
596-- > do
597-- > person <- Person `mapDyn` dynFirstName
598-- > `apDyn` dynListName
599-- > `apDyn` dynAge
600-- > `apDyn` dynAddress
601{-# DEPRECATED apDyn "Use 'ffor m (<*> a)' instead of 'apDyn m a'; consider eliminating monadic style, since Dynamics are now Applicative and can be used with applicative style directly" #-}
602#ifdef USE_TEMPLATE_HASKELL
603{-# ANN apDyn "HLint: ignore Use fmap" #-}
604#endif
605apDyn :: forall t m a b. (Reflex t, Monad m)
606 => m (Dynamic t (a -> b))
607 -> Dynamic t a
608 -> m (Dynamic t b)
609apDyn m a = fmap (<*> a) m
611--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
612-- | This function no longer needs to be monadic, so it has been replaced by
613-- 'demuxed', which is pure.
614{-# DEPRECATED getDemuxed "Use 'return . demuxed d' instead of 'getDemuxed d'; consider eliminating monadic style" #-}
615getDemuxed :: (Reflex t, Monad m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
616getDemuxed d = return . demuxed d
618-- | This function no longer needs to be monadic, so it has been replaced by
619-- 'distributeFHListOverDynPure', which is pure.
620{-# DEPRECATED distributeFHListOverDyn "Use 'return . distributeFHListOverDynPure' instead; consider eliminating monadic style" #-}
621distributeFHListOverDyn :: forall t m l. (Reflex t, Monad m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
622distributeFHListOverDyn = return . distributeFHListOverDynPure
624-- | This function no longer needs to be monadic, so it has been replaced by
625-- 'collectDynPure', which is pure.
626{-# DEPRECATED collectDyn "Use 'return . collectDynPure' instead; consider eliminating monadic style" #-}
627collectDyn :: ( RebuildSortedHList (HListElems b)
628 , IsHList a, IsHList b
629 , AllAreFunctors (Dynamic t) (HListElems b)
630 , Reflex t, Monad m
631 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
632 ) => a -> m (Dynamic t b)
633collectDyn = return . collectDynPure
635-- | This function has been renamed to 'tagPromptlyDyn' to clarify its
636-- semantics.
637{-# DEPRECATED tagDyn "Use 'tagPromptlyDyn' instead" #-}
638tagDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
639tagDyn = tagPromptlyDyn
641-- | This function has been renamed to 'attachPromptlyDyn' to clarify its
642-- semantics.
643{-# DEPRECATED attachDyn "Use 'attachPromptlyDyn' instead" #-}
644attachDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
645attachDyn = attachPromptlyDyn
647-- | This function has been renamed to 'attachPromptlyDynWith' to clarify its
648-- semantics.
649{-# DEPRECATED attachDynWith "Use 'attachPromptlyDynWith' instead" #-}
650attachDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
651attachDynWith = attachPromptlyDynWith
653-- | This function has been renamed to 'attachPromptlyDynWithMaybe' to clarify
654-- its semantics.
655{-# DEPRECATED attachDynWithMaybe "Use 'attachPromptlyDynWithMaybe' instead" #-}
656attachDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
657attachDynWithMaybe = attachPromptlyDynWithMaybe
659-- | Combine an inner and outer 'Dynamic' such that the resulting 'Dynamic''s
660-- current value will always be equal to the current value's current value, and
661-- will change whenever either the inner or the outer (or both) values change.
662{-# DEPRECATED joinDyn "Use 'join' instead" #-}
663joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a
664joinDyn = join
666-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests
667-- representational equality. Use 'holdUniqDyn' instead, which is pure in all
668-- circumstances. Also, note that, unlike 'nub', this function does not prevent
669-- all recurrences of a value, only consecutive recurrences.
670{-# DEPRECATED nubDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}
671nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
672nubDyn = uniqDyn
674-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests
675-- representational equality. Use 'holdUniqDyn' instead, which is pure in all
676-- circumstances.
677{-# DEPRECATED uniqDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}
678uniqDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
679uniqDyn = uniqDynBy (==)
681-- | WARNING: This function is impure. Use 'holdUniqDynBy' instead.
682{-# DEPRECATED uniqDynBy "Use 'holdUniqDynBy' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}
683uniqDynBy :: Reflex t => (a -> a -> Bool) -> Dynamic t a -> Dynamic t a
684uniqDynBy eq d =
685 let e' = attachWithMaybe (\x x' -> if x' `eq` x then Nothing else Just x') (current d) (updated d)
686 in unsafeDynamic (current d) e'