on 666d885 help sign in
patch/src/Reflex/Dynamic.hs
680 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 , 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.Functor.Product
106import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
107import Data.Map (Map)
108import Data.Maybe
109import Data.Monoid hiding (Product)
110import Data.These
112import Debug.Trace
114-- | Map a sampling function over a 'Dynamic'.
115mapDynM :: 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)
116mapDynM f d = buildDynamic (f =<< sample (current d)) $ pushAlways f (updated d)
118-- | Flipped version of 'mapDynM'
119forDynM :: 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)
120forDynM d f = mapDynM f d
122-- | Create a new 'Dynamic' that only signals changes if the values actually
123-- changed.
124holdUniqDyn :: (Reflex t, MonadHold t m, MonadFix m, Eq a) => Dynamic t a -> m (Dynamic t a)
125holdUniqDyn = holdUniqDynBy (==)
127-- | Create a new 'Dynamic' that changes only when the underlying 'Dynamic'
128-- changes and the given function returns 'False' when given both the old and
129-- the new values.
130holdUniqDynBy :: (Reflex t, MonadHold t m, MonadFix m) => (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
131holdUniqDynBy eq = scanDynMaybe id (\new old -> if new `eq` old then Nothing else Just new)
133-- | Dynamic Maybe that can only update from Nothing to Just or Just to Just (i.e., cannot revert to Nothing)
134improvingMaybe :: (Reflex t, MonadHold t m, MonadFix m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))
135improvingMaybe = scanDynMaybe id (\new _ -> if isJust new then Just new else Nothing)
137-- | Create a 'Dynamic' that accumulates values from another 'Dynamic'. This
138-- function does not force its input 'Dynamic' until the output 'Dynamic' is
139-- forced.
140scanDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)
141scanDyn z f = scanDynMaybe z (\a b -> Just $ f a b)
143-- | Like 'scanDyn', but the the accumulator function may decline to update the
144-- result 'Dynamic''s value.
145scanDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
146scanDynMaybe z f d = do
147 rec d' <- buildDynamic (z <$> sample (current d)) $ flip push (updated d) $ \a -> do
148 b <- sample $ current d'
149 return $ f a b
150 return d'
152-- | Create a 'Dynamic' using the initial value and change it each time the
153-- 'Event' occurs using a folding function on the previous value and the value
154-- of the 'Event'.
155foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
156foldDyn = accumDyn . flip
158-- | Like 'foldDyn', but the combining function is a 'PushM' action, so it
159-- can 'sample' existing 'Behaviors' and 'hold' new ones.
160foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
161foldDynM = accumMDyn . flip
163-- | Create a 'Dynamic' using the provided initial value and change it each time
164-- the provided 'Event' occurs, using a function to combine the old value with
165-- the 'Event''s value. If the function returns 'Nothing', the value is not
166-- changed; this is distinct from returning 'Just' the old value, since the
167-- 'Dynamic''s 'updated' 'Event' will fire in the 'Just' case, and will not fire
168-- in the 'Nothing' case.
169foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
170foldDynMaybe = accumMaybeDyn . flip
172-- | Like 'foldDynMaybe', but the combining function is a 'PushM' action, so it
173-- can 'sample' existing 'Behaviors' and 'hold' new ones.
174foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
175foldDynMaybeM = accumMaybeMDyn . flip
177-- | Create a new 'Dynamic' that counts the occurrences of the 'Event'.
178count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
179count e = holdDyn 0 =<< zipListWithEvent const (iterate (+1) 1) e
181-- | Create a new 'Dynamic' using the initial value that flips its
182-- value every time the 'Event' occurs.
183toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
184toggle = foldDyn (const not)
186-- | Switches to the new 'Event' whenever it receives one. Only the old event is
187-- considered the moment a new one is switched in; the output event will fire at
188-- that moment if only if the old event does.
189--
190-- Prefer this to 'switchPromptlyDyn' where possible. The lack of doing double
191-- work when the outer and (new) inner fires means this imposes fewer "timing
192-- requirements" and thus is far more easy to use without introducing fresh
193-- failure cases. 'switchDyn' is also more performant.
194switchDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
195switchDyn d = switch (current d)
197-- | Switches to the new 'Event' whenever it receives one. Switching occurs
198-- *before* the inner 'Event' fires - so if the 'Dynamic' changes and both the
199-- old and new inner Events fire simultaneously, the output will fire with the
200-- value of the *new* 'Event'.
201--
202-- Prefer 'switchDyn' to this where possible. The timing requirements that
203-- switching before imposes are likely to bring down your app unless you are
204-- very careful. 'switchDyn' is also more performant.
205switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
206switchPromptlyDyn de =
207 let eLag = switch $ current de
208 eCoincidences = coincidence $ updated de
209 in leftmost [eCoincidences, eLag]
211-- | Split a 'Dynamic' pair into a pair of 'Dynamic's
212splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
213splitDynPure d = (fmap fst d, fmap snd d)
215-- | Convert a 'Map' with 'Dynamic' elements into a 'Dynamic' of a 'Map' with
216-- non-'Dynamic' elements.
217distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
218distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap
220-- | Convert a list with 'Dynamic' elements into a 'Dynamic' of a list with
221-- non-'Dynamic' elements, preserving the order of the elements.
222distributeListOverDynPure :: Reflex t => [Dynamic t v] -> Dynamic t [v]
223distributeListOverDynPure =
224 fmap (map fromDSum . DMap.toAscList) .
225 distributeDMapOverDynPure .
226 DMap.fromDistinctAscList .
227 zipWith toDSum [0..]
228 where
229 toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)
230 toDSum k v = Const2 k :=> v
231 fromDSum :: DSum (Const2 Int a) Identity -> a
232 fromDSum (Const2 _ :=> Identity v) = v
234--TODO: Generalize this to functors other than Maps
235-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
236-- with the current values of the 'Dynamic's in a map.
237joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
238joinDynThroughMap = joinDyn . fmap distributeMapOverDynPure
240-- | Print the value of the 'Dynamic' when it is first read and on each
241-- subsequent change that is observed (as traceEvent), prefixed with the
242-- provided string. This should /only/ be used for debugging.
243--
244-- Note: Just like Debug.Trace.trace, the value will only be shown if something
245-- else in the system is depending on it.
246traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
247traceDyn s = traceDynWith $ \x -> s <> ": " <> show x
249-- | Print the result of applying the provided function to the value
250-- of the 'Dynamic' when it is first read and on each subsequent change
251-- that is observed (as traceEvent). This should /only/ be used for
252-- debugging.
253--
254-- Note: Just like Debug.Trace.trace, the value will only be shown if something
255-- else in the system is depending on it.
256traceDynWith :: Reflex t => (a -> String) -> Dynamic t a -> Dynamic t a
257traceDynWith f d =
258 let e' = traceEventWith f $ updated d
259 getV0 = do
260 x <- sample $ current d
261 trace (f x) $ return x
262 in unsafeBuildDynamic getV0 e'
264-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
265-- each time the 'Event' occurs.
266--
267-- Note: `tagPromptlyDyn d e` differs from `tag (current d) e` in the case that `e` is firing
268-- at the same time that `d` is changing. With `tagPromptlyDyn d e`, the *new* value of `d`
269-- will replace the value of `e`, whereas with `tag (current d) e`, the *old* value
270-- will be used, since the 'Behavior' won't be updated until the end of the frame.
271-- Additionally, this means that the output 'Event' may not be used to directly change
272-- the input 'Dynamic', because that would mean its value depends on itself. When creating
273-- cyclic data flows, generally `tag (current d) e` is preferred.
274tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
275tagPromptlyDyn = attachPromptlyDynWith const
277-- | Attach the current value of the 'Dynamic' to the value of the
278-- 'Event' each time it occurs.
279--
280-- Note: `attachPromptlyDyn d` is not the same as `attach (current d)`. See 'tagPromptlyDyn' for details.
281attachPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
282attachPromptlyDyn = attachPromptlyDynWith (,)
284-- | Combine the current value of the 'Dynamic' with the value of the
285-- 'Event' each time it occurs.
286--
287-- Note: `attachPromptlyDynWith f d` is not the same as `attachWith f (current d)`. See 'tagPromptlyDyn' for details.
288attachPromptlyDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
289attachPromptlyDynWith f = attachPromptlyDynWithMaybe $ \a b -> Just $ f a b
291-- | Create a new 'Event' by combining the value at each occurrence with the
292-- current value of the 'Dynamic' value and possibly filtering if the combining
293-- function returns 'Nothing'.
294--
295-- Note: `attachPromptlyDynWithMaybe f d` is not the same as `attachWithMaybe f
296-- (current d)`. See 'tagPromptlyDyn' for details.
297attachPromptlyDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
298attachPromptlyDynWithMaybe f d e =
299 let e' = attach (current d) e
300 in fforMaybe (align e' $ updated d) $ \case
301 This (a, b) -> f a b -- Only the tagging event is firing, so use that
302 These (_, b) a -> f a b -- Both events are firing, so use the newer value
303 That _ -> Nothing -- The tagging event isn't firing, so don't fire
305-- | Factor a @Dynamic t (Maybe a)@ into a @Dynamic t (Maybe (Dynamic t a))@,
306-- such that the outer 'Dynamic' is updated only when the 'Maybe''s constructor
307-- chages from 'Nothing' to 'Just' or vice-versa. Whenever the constructor
308-- becomes 'Just', an inner 'Dynamic' will be provided, whose value will track
309-- the 'a' inside the 'Just'; when the constructor becomes 'Nothing', the
310-- existing inner 'Dynamic' will become constant, and will not change when the
311-- outer constructor changes back to 'Nothing'.
312maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
313maybeDyn = fmap (fmap unpack) . eitherDyn . fmap pack
314 where pack = \case
315 Nothing -> Left ()
316 Just a -> Right a
317 unpack = \case
318 Left _ -> Nothing
319 Right a -> Just a
321eitherDyn :: 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)))
322eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum
323 where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)
324 unpack = \case
325 LeftTag :=> Compose a -> Left $ coerceDynamic a
326 RightTag :=> Compose b -> Right $ coerceDynamic b
328factorDyn :: forall t m k v. (Reflex t, MonadHold t m, GEq k)
329 => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
330factorDyn d = buildDynamic (sample (current d) >>= holdKey) update where
331 update :: Event t (DSum k (Compose (Dynamic t) v))
332 update = flip push (updated d) $ \(newKey :=> newVal) -> do
333 (oldKey :=> _) <- sample (current d)
334 case newKey `geq` oldKey of
335 Just Refl -> return Nothing
336 Nothing -> Just <$> holdKey (newKey :=> newVal)
338 holdKey (k :=> v) = do
339 inner' <- filterEventKey k (updated d)
340 inner <- holdDyn v inner'
341 return $ k :=> Compose inner
342--------------------------------------------------------------------------------
343-- Demux
344--------------------------------------------------------------------------------
346-- | Represents a time changing value together with an 'EventSelector' that can
347-- efficiently detect when the underlying 'Dynamic' has a particular value.
348-- This is useful for representing data like the current selection of a long
349-- list.
350--
351-- Semantically,
352--
353-- > demuxed (demux d) k === fmap (== k) d
354--
355-- However, the when getDemuxed is used multiple times, the complexity is only
356-- /O(log(n))/, rather than /O(n)/ for fmap.
357data Demux t k = Demux { demuxValue :: Behavior t k
358 , demuxSelector :: EventSelector t (Const2 k Bool)
359 }
361-- | Demultiplex an input value to a 'Demux' with many outputs. At any given
362-- time, whichever output is indicated by the given 'Dynamic' will be 'True'.
363demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
364demux k = Demux (current k)
365 (fan $ attachWith (\k0 k1 -> if k0 == k1
366 then DMap.empty
367 else DMap.fromList [Const2 k0 :=> Identity False,
368 Const2 k1 :=> Identity True])
369 (current k) (updated k))
371-- | Select a particular output of the 'Demux'; this is equivalent to (but much
372-- faster than) mapping over the original 'Dynamic' and checking whether it is
373-- equal to the given key.
374demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
375demuxed d k =
376 let e = select (demuxSelector d) (Const2 k)
377 in unsafeBuildDynamic (fmap (==k) $ sample $ demuxValue d) e
379--------------------------------------------------------------------------------
380-- collectDyn
381--------------------------------------------------------------------------------
383--TODO: This whole section is badly in need of cleanup
385-- | A heterogeneous list whose type and length are fixed statically. This is
386-- reproduced from the 'HList' package due to integration issues, and because
387-- very little other functionality from that library is needed.
388data HList (l::[*]) where
389 HNil :: HList '[]
390 HCons :: e -> HList l -> HList (e ': l)
392infixr 2 `HCons`
394type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
395type instance HRevApp '[] l = l
396type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
398hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
399hRevApp HNil l = l
400hRevApp (HCons x l) l' = hRevApp l (HCons x l')
402hReverse :: HList l -> HList (HRevApp l '[])
403hReverse l = hRevApp l HNil
405hBuild :: (HBuild' '[] r) => r
406hBuild = hBuild' HNil
408class HBuild' l r where
409 hBuild' :: HList l -> r
411instance (l' ~ HRevApp l '[])
412 => HBuild' l (HList l') where
413 hBuild' = hReverse
415instance HBuild' (a ': l) r
416 => HBuild' l (a->r) where
417 hBuild' l x = hBuild' (HCons x l)
419-- | Like 'HList', but with a functor wrapping each element.
420data FHList f l where
421 FHNil :: FHList f '[]
422 FHCons :: f e -> FHList f l -> FHList f (e ': l)
424instance GEq (HListPtr l) where
425 HHeadPtr `geq` HHeadPtr = Just Refl
426 HHeadPtr `geq` HTailPtr _ = Nothing
427 HTailPtr _ `geq` HHeadPtr = Nothing
428 HTailPtr a `geq` HTailPtr b = a `geq` b
430instance GCompare (HListPtr l) where -- Warning: This ordering can't change, dmapTo*HList will break
431 HHeadPtr `gcompare` HHeadPtr = GEQ
432 HHeadPtr `gcompare` HTailPtr _ = GLT
433 HTailPtr _ `gcompare` HHeadPtr = GGT
434 HTailPtr a `gcompare` HTailPtr b = a `gcompare` b
436-- | A typed index into a typed heterogeneous list.
437data HListPtr l a where
438 HHeadPtr :: HListPtr (h ': t) h
439 HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
441deriving instance Eq (HListPtr l a)
442deriving instance Ord (HListPtr l a)
444fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
445fhlistToDMap = DMap.fromList . go
446 where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
447 go = \case
448 FHNil -> []
449 FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> HTailPtr p :=> v) (go t)
451-- | This class allows 'HList's and 'FHlist's to be built from regular lists;
452-- they must be contiguous and sorted.
453class RebuildSortedHList l where
454 rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
455 rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
457instance RebuildSortedHList '[] where
458 rebuildSortedFHList l = case l of
459 [] -> FHNil
460 _ : _ -> error "rebuildSortedFHList{'[]}: empty list expected"
461 rebuildSortedHList l = case l of
462 [] -> HNil
463 _ : _ -> error "rebuildSortedHList{'[]}: empty list expected"
465instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
466 rebuildSortedFHList l = case l of
467 ((HHeadPtr :=> h) : t) -> FHCons h . rebuildSortedFHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
468 _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
469 rebuildSortedHList l = case l of
470 ((HHeadPtr :=> Identity h) : t) -> HCons h . rebuildSortedHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
471 _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
473dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
474dmapToHList = rebuildSortedHList . DMap.toList
476-- | Collect a hetereogeneous list whose elements are all 'Dynamic's into a
477-- single 'Dynamic' whose value represents the current values of all of the
478-- input 'Dynamic's.
479distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
480distributeFHListOverDynPure l = fmap dmapToHList $ distributeDMapOverDynPure $ fhlistToDMap l
482-- | Indicates that all elements in a type-level list are applications of the
483-- same functor.
484class AllAreFunctors (f :: a -> *) (l :: [a]) where
485 type FunctorList f l :: [*]
486 toFHList :: HList (FunctorList f l) -> FHList f l
487 fromFHList :: FHList f l -> HList (FunctorList f l)
489instance AllAreFunctors f '[] where
490 type FunctorList f '[] = '[]
491 toFHList l = case l of
492 HNil -> FHNil
493#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
494 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
495#endif
496 fromFHList FHNil = HNil
498instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
499 type FunctorList f (h ': t) = f h ': FunctorList f t
500 toFHList l = case l of
501 a `HCons` b -> a `FHCons` toFHList b
502#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
503 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
504#endif
505 fromFHList (a `FHCons` b) = a `HCons` fromFHList b
507-- | Convert a datastructure whose constituent parts are all 'Dynamic's into a
508-- single 'Dynamic' whose value represents all the current values of the input's
509-- consitutent 'Dynamic's.
510collectDynPure :: ( RebuildSortedHList (HListElems b)
511 , IsHList a, IsHList b
512 , AllAreFunctors (Dynamic t) (HListElems b)
513 , Reflex t
514 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
515 ) => a -> Dynamic t b
516collectDynPure ds = fmap fromHList $ distributeFHListOverDynPure $ toFHList $ toHList ds
518-- | Poor man's 'Generic's for product types only.
519class IsHList a where
520 type HListElems a :: [*]
521 toHList :: a -> HList (HListElems a)
522 fromHList :: HList (HListElems a) -> a
524instance IsHList (a, b) where
525 type HListElems (a, b) = [a, b]
526 toHList (a, b) = hBuild a b
527 fromHList l = case l of
528 a `HCons` b `HCons` HNil -> (a, b)
529#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
530 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
531#endif
533instance IsHList (a, b, c, d) where
534 type HListElems (a, b, c, d) = [a, b, c, d]
535 toHList (a, b, c, d) = hBuild a b c d
536 fromHList l = case l of
537 a `HCons` b `HCons` c `HCons` d `HCons` HNil -> (a, b, c, d)
538#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
539 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
540#endif
542instance IsHList (a, b, c, d, e, f) where
543 type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
544 toHList (a, b, c, d, e, f) = hBuild a b c d e f
545 fromHList l = case l of
546 a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil -> (a, b, c, d, e, f)
547#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
548 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
549#endif
551--------------------------------------------------------------------------------
552-- Deprecated functions
553--------------------------------------------------------------------------------
555-- | Map a function over a 'Dynamic'.
556{-# DEPRECATED mapDyn "Use 'return . fmap f' instead of 'mapDyn f'; consider eliminating monadic style" #-}
557mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)
558mapDyn f = return . fmap f
560-- | Flipped version of 'mapDyn'.
561{-# DEPRECATED forDyn "Use 'return . ffor a' instead of 'forDyn a'; consider eliminating monadic style" #-}
562forDyn :: (Reflex t, Monad m) => Dynamic t a -> (a -> b) -> m (Dynamic t b)
563forDyn a = return . ffor a
565-- | Split the 'Dynamic' into two 'Dynamic's, each taking the respective value
566-- of the tuple.
567{-# DEPRECATED splitDyn "Use 'return . splitDynPure' instead; consider eliminating monadic style" #-}
568splitDyn :: (Reflex t, Monad m) => Dynamic t (a, b) -> m (Dynamic t a, Dynamic t b)
569splitDyn = return . splitDynPure
571-- | Merge the 'Dynamic' values using their 'Monoid' instance.
572{-# DEPRECATED mconcatDyn "Use 'return . mconcat' instead; consider eliminating monadic style" #-}
573mconcatDyn :: forall t m a. (Reflex t, Monad m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
574mconcatDyn = return . mconcat
576-- | This function no longer needs to be monadic; see 'distributeMapOverDynPure'.
577{-# DEPRECATED distributeDMapOverDyn "Use 'return . distributeDMapOverDynPure' instead; consider eliminating monadic style" #-}
578distributeDMapOverDyn :: (Reflex t, Monad m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
579distributeDMapOverDyn = return . distributeDMapOverDynPure
581-- | Merge two 'Dynamic's into a new one using the provided function. The new
582-- 'Dynamic' changes its value each time one of the original 'Dynamic's changes
583-- its value.
584{-# DEPRECATED combineDyn "Use 'return (zipDynWith f a b)' instead of 'combineDyn f a b'; consider eliminating monadic style" #-}
585combineDyn :: forall t m a b c. (Reflex t, Monad m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
586combineDyn f a b = return $ zipDynWith f a b
588-- | A psuedo applicative version of ap for 'Dynamic'. Example useage:
589--
590-- > do
591-- > person <- Person `mapDyn` dynFirstName
592-- > `apDyn` dynListName
593-- > `apDyn` dynAge
594-- > `apDyn` dynAddress
595{-# 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" #-}
596#ifdef USE_TEMPLATE_HASKELL
597{-# ANN apDyn "HLint: ignore Use fmap" #-}
598#endif
599apDyn :: forall t m a b. (Reflex t, Monad m)
600 => m (Dynamic t (a -> b))
601 -> Dynamic t a
602 -> m (Dynamic t b)
603apDyn m a = fmap (<*> a) m
605--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
606-- | This function no longer needs to be monadic, so it has been replaced by
607-- 'demuxed', which is pure.
608{-# DEPRECATED getDemuxed "Use 'return . demuxed d' instead of 'getDemuxed d'; consider eliminating monadic style" #-}
609getDemuxed :: (Reflex t, Monad m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
610getDemuxed d = return . demuxed d
612-- | This function no longer needs to be monadic, so it has been replaced by
613-- 'distributeFHListOverDynPure', which is pure.
614{-# DEPRECATED distributeFHListOverDyn "Use 'return . distributeFHListOverDynPure' instead; consider eliminating monadic style" #-}
615distributeFHListOverDyn :: forall t m l. (Reflex t, Monad m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
616distributeFHListOverDyn = return . distributeFHListOverDynPure
618-- | This function no longer needs to be monadic, so it has been replaced by
619-- 'collectDynPure', which is pure.
620{-# DEPRECATED collectDyn "Use 'return . collectDynPure' instead; consider eliminating monadic style" #-}
621collectDyn :: ( RebuildSortedHList (HListElems b)
622 , IsHList a, IsHList b
623 , AllAreFunctors (Dynamic t) (HListElems b)
624 , Reflex t, Monad m
625 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
626 ) => a -> m (Dynamic t b)
627collectDyn = return . collectDynPure
629-- | This function has been renamed to 'tagPromptlyDyn' to clarify its
630-- semantics.
631{-# DEPRECATED tagDyn "Use 'tagPromptlyDyn' instead" #-}
632tagDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
633tagDyn = tagPromptlyDyn
635-- | This function has been renamed to 'attachPromptlyDyn' to clarify its
636-- semantics.
637{-# DEPRECATED attachDyn "Use 'attachPromptlyDyn' instead" #-}
638attachDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
639attachDyn = attachPromptlyDyn
641-- | This function has been renamed to 'attachPromptlyDynWith' to clarify its
642-- semantics.
643{-# DEPRECATED attachDynWith "Use 'attachPromptlyDynWith' instead" #-}
644attachDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
645attachDynWith = attachPromptlyDynWith
647-- | This function has been renamed to 'attachPromptlyDynWithMaybe' to clarify
648-- its semantics.
649{-# DEPRECATED attachDynWithMaybe "Use 'attachPromptlyDynWithMaybe' instead" #-}
650attachDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
651attachDynWithMaybe = attachPromptlyDynWithMaybe
653-- | Combine an inner and outer 'Dynamic' such that the resulting 'Dynamic''s
654-- current value will always be equal to the current value's current value, and
655-- will change whenever either the inner or the outer (or both) values change.
656{-# DEPRECATED joinDyn "Use 'join' instead" #-}
657joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a
658joinDyn = join
660-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests
661-- representational equality. Use 'holdUniqDyn' instead, which is pure in all
662-- circumstances. Also, note that, unlike 'nub', this function does not prevent
663-- all recurrences of a value, only consecutive recurrences.
664{-# DEPRECATED nubDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}
665nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
666nubDyn = uniqDyn
668-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests
669-- representational equality. Use 'holdUniqDyn' instead, which is pure in all
670-- circumstances.
671{-# DEPRECATED uniqDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}
672uniqDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
673uniqDyn = uniqDynBy (==)
675-- | WARNING: This function is impure. Use 'holdUniqDynBy' instead.
676{-# DEPRECATED uniqDynBy "Use 'holdUniqDynBy' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}
677uniqDynBy :: Reflex t => (a -> a -> Bool) -> Dynamic t a -> Dynamic t a
678uniqDynBy eq d =
679 let e' = attachWithMaybe (\x x' -> if x' `eq` x then Nothing else Just x') (current d) (updated d)
680 in unsafeDynamic (current d) e'