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