on 13e76bb help sign in
patch/src/Reflex/Dynamic.hs
530 lines 23 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-- |
21-- Module:
22-- Reflex.Dynamic
23-- Description:
24-- This module contains various functions for working with 'Dynamic' values.
25-- 'Dynamic' and its primitives have been moved to the 'Reflex' class.
26module Reflex.Dynamic
27 ( -- * Basics
28 Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update
29 , current
30 , updated
31 , holdDyn
32 , mapDynM
33 , forDynM
34 , constDyn
35 , count
36 , toggle
37 , switchDyn
38 , switchPromptlyDyn
39 , tagPromptlyDyn
40 , attachPromptlyDyn
41 , attachPromptlyDynWith
42 , attachPromptlyDynWithMaybe
43 , maybeDyn
44 , eitherDyn
45 , factorDyn
46 , scanDyn
47 , scanDynMaybe
48 , holdUniqDyn
49 , holdUniqDynBy
50 , improvingMaybe
51 , foldDyn
52 , foldDynM
53 , foldDynMaybe
54 , foldDynMaybeM
55 , joinDynThroughMap
56 , traceDyn
57 , traceDynWith
58 , splitDynPure
59 , distributeMapOverDynPure
60 , distributeDMapOverDynPure
61 , distributeListOverDynPure
62 , Demux
63 , demux
64 , demuxed
65 -- * Miscellaneous
66 -- Things that probably aren't very useful:
67 , HList (..)
68 , FHList (..)
69 , collectDynPure
70 , RebuildSortedHList (..)
71 , IsHList (..)
72 , AllAreFunctors (..)
73 , HListPtr (..)
74 , distributeFHListOverDynPure
75 -- * Unsafe
76 , unsafeDynamic
77 ) where
79import Data.Functor.Compose
80import Data.Functor.Misc
81import Reflex.Class
83import Control.Monad
84import Control.Monad.Fix
85import Control.Monad.Identity
86import Data.Align
87import Data.Dependent.Map (DMap)
88import qualified Data.Dependent.Map as DMap
89import Data.Dependent.Sum (DSum (..))
90import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
91import Data.Map (Map)
92import Data.Maybe
93import Data.Monoid ((<>))
94import Data.These
96import Debug.Trace
98-- | Map a sampling function over a 'Dynamic'.
99mapDynM :: 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)
100mapDynM f d = buildDynamic (f =<< sample (current d)) $ pushAlways f (updated d)
102-- | Flipped version of 'mapDynM'
103forDynM :: 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)
104forDynM d f = mapDynM f d
106-- | Create a new 'Dynamic' that only signals changes if the values actually
107-- changed.
108holdUniqDyn :: (Reflex t, MonadHold t m, MonadFix m, Eq a) => Dynamic t a -> m (Dynamic t a)
109holdUniqDyn = holdUniqDynBy (==)
111-- | Create a new 'Dynamic' that changes only when the underlying 'Dynamic'
112-- changes and the given function returns 'False' when given both the old and
113-- the new values.
114holdUniqDynBy :: (Reflex t, MonadHold t m, MonadFix m) => (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
115holdUniqDynBy eq = scanDynMaybe id (\new old -> if new `eq` old then Nothing else Just new)
117-- | @/Dynamic Maybe/@ that can only update from @/Nothing/@ to @/Just/@ or @/Just/@ to @/Just/@ (i.e., cannot revert to @/Nothing/@)
118improvingMaybe :: (Reflex t, MonadHold t m, MonadFix m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))
119improvingMaybe = scanDynMaybe id (\new _ -> if isJust new then Just new else Nothing)
121-- | Create a 'Dynamic' that accumulates values from another 'Dynamic'. This
122-- function does not force its input 'Dynamic' until the output 'Dynamic' is
123-- forced.
124scanDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)
125scanDyn z f = scanDynMaybe z (\a b -> Just $ f a b)
127-- | Like 'scanDyn', but the the accumulator function may decline to update the
128-- result 'Dynamic''s value.
129scanDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
130scanDynMaybe z f d = do
131 rec d' <- buildDynamic (z <$> sample (current d)) $ flip push (updated d) $ \a -> do
132 b <- sample $ current d'
133 return $ f a b
134 return d'
136-- | Create a 'Dynamic' using the initial value and change it each time the
137-- 'Event' occurs using a folding function on the previous value and the value
138-- of the 'Event'.
139foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
140foldDyn = accumDyn . flip
142-- | Like 'foldDyn', but the combining function is a 'PushM' action, so it
143-- can 'sample' existing 'Behaviors' and 'hold' new ones.
144foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
145foldDynM = accumMDyn . flip
147-- | Create a 'Dynamic' using the provided initial value and change it each time
148-- the provided 'Event' occurs, using a function to combine the old value with
149-- the 'Event''s value. If the function returns 'Nothing', the value is not
150-- changed; this is distinct from returning 'Just' the old value, since the
151-- 'Dynamic''s 'updated' 'Event' will fire in the 'Just' case, and will not fire
152-- in the 'Nothing' case.
153foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
154foldDynMaybe = accumMaybeDyn . flip
156-- | Like 'foldDynMaybe', but the combining function is a 'PushM' action, so it
157-- can 'sample' existing 'Behaviors' and 'hold' new ones.
158foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
159foldDynMaybeM = accumMaybeMDyn . flip
161-- | Create a new 'Dynamic' that counts the occurrences of the 'Event'.
162count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
163count e = holdDyn 0 =<< zipListWithEvent const (iterate (+1) 1) e
165-- | Create a new 'Dynamic' using the initial value that flips its
166-- value every time the 'Event' occurs.
167toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
168toggle = foldDyn (const not)
170-- | Switches to the new 'Event' whenever it receives one. Only the old event is
171-- considered the moment a new one is switched in; the output event will fire at
172-- that moment if only if the old event does.
173--
174-- Prefer this to 'switchPromptlyDyn' where possible. The lack of doing double
175-- work when the outer and (new) inner fires means this imposes fewer "timing
176-- requirements" and thus is far more easy to use without introducing fresh
177-- failure cases. 'switchDyn' is also more performant.
178switchDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
179switchDyn d = switch (current d)
181-- | Switches to the new 'Event' whenever it receives one. Switching occurs
182-- __before__ the inner 'Event' fires - so if the 'Dynamic' changes and both the
183-- old and new inner Events fire simultaneously, the output will fire with the
184-- value of the __new__ 'Event'.
185--
186-- Prefer 'switchDyn' to this where possible. The timing requirements that
187-- switching before imposes are likely to bring down your app unless you are
188-- very careful. 'switchDyn' is also more performant.
189switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
190switchPromptlyDyn de =
191 let eLag = switch $ current de
192 eCoincidences = coincidence $ updated de
193 in leftmost [eCoincidences, eLag]
195-- | Split a 'Dynamic' pair into a pair of 'Dynamic's
196splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
197splitDynPure d = (fmap fst d, fmap snd d)
199-- | Convert a 'Map' with 'Dynamic' elements into a 'Dynamic' of a 'Map' with
200-- non-'Dynamic' elements.
201distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
202distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap
204-- | Convert a list with 'Dynamic' elements into a 'Dynamic' of a list with
205-- non-'Dynamic' elements, preserving the order of the elements.
206{-# DEPRECATED distributeListOverDynPure "Use 'distributeListOverDyn' instead" #-}
207distributeListOverDynPure :: Reflex t => [Dynamic t v] -> Dynamic t [v]
208distributeListOverDynPure = distributeListOverDyn
210--TODO: Generalize this to functors other than Maps
211-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
212-- with the current values of the 'Dynamic's in a map.
213joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
214joinDynThroughMap = (distributeMapOverDynPure =<<)
216-- | Print the value of the 'Dynamic' when it is first read and on each
217-- subsequent change that is observed (as 'traceEvent'), prefixed with the
218-- provided string. This should /only/ be used for debugging.
219--
220-- Note: Just like Debug.Trace.trace, the value will only be shown if something
221-- else in the system is depending on it.
222traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
223traceDyn s = traceDynWith $ \x -> s <> ": " <> show x
225-- | Print the result of applying the provided function to the value
226-- of the 'Dynamic' when it is first read and on each subsequent change
227-- that is observed (as 'traceEvent'). This should /only/ be used for
228-- debugging.
229--
230-- Note: Just like Debug.Trace.trace, the value will only be shown if something
231-- else in the system is depending on it.
232traceDynWith :: Reflex t => (a -> String) -> Dynamic t a -> Dynamic t a
233traceDynWith f d =
234 let e' = traceEventWith f $ updated d
235 getV0 = do
236 x <- sample $ current d
237 trace (f x) $ return x
238 in unsafeBuildDynamic getV0 e'
240-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
241-- each time the 'Event' occurs.
242--
243-- Note: @/tagPromptlyDyn d e/@ differs from @/tag (current d) e/@ in the case that @/e/@ is firing
244-- at the same time that @/d/@ is changing. With @/tagPromptlyDyn d e/@, the __new__ value of @/d/@
245-- will replace the value of @/e/@, whereas with @/tag (current d) e/@, the __old__ value
246-- will be used, since the 'Behavior' won't be updated until the end of the frame.
247-- Additionally, this means that the output 'Event' may not be used to directly change
248-- the input 'Dynamic', because that would mean its value depends on itself. __When creating__
249-- __cyclic data flows, generally @/tag (current d) e/@ is preferred.__
250tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
251tagPromptlyDyn = attachPromptlyDynWith const
253-- | Attach the current value of the 'Dynamic' to the value of the
254-- 'Event' each time it occurs.
255--
256-- Note: @/attachPromptlyDyn d/@ is not the same as @/attach (current d)/@. See 'tagPromptlyDyn' for details.
257attachPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
258attachPromptlyDyn = attachPromptlyDynWith (,)
260-- | Combine the current value of the 'Dynamic' with the value of the
261-- 'Event' each time it occurs.
262--
263-- Note: @/attachPromptlyDynWith f d/@ is not the same as @/attachWith f (current d)/@. See 'tagPromptlyDyn' for details.
264attachPromptlyDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
265attachPromptlyDynWith f = attachPromptlyDynWithMaybe $ \a b -> Just $ f a b
267-- | Create a new 'Event' by combining the value at each occurrence with the
268-- current value of the 'Dynamic' value and possibly filtering if the combining
269-- function returns 'Nothing'.
270--
271-- Note: @/attachPromptlyDynWithMaybe f d/@ is not the same as @/attachWithMaybe f (current d)/@. See 'tagPromptlyDyn' for details.
272attachPromptlyDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
273attachPromptlyDynWithMaybe f d e =
274 let e' = attach (current d) e
275 in fforMaybe (align e' $ updated d) $ \case
276 This (a, b) -> f a b -- Only the tagging event is firing, so use that
277 These (_, b) a -> f a b -- Both events are firing, so use the newer value
278 That _ -> Nothing -- The tagging event isn't firing, so don't fire
280-- | Factor a @/Dynamic t (Maybe a)/@ into a @/Dynamic t (Maybe (Dynamic t a))/@,
281-- such that the outer 'Dynamic' is updated only when the "Maybe"'s constructor
282-- chages from 'Nothing' to 'Just' or vice-versa. Whenever the constructor
283-- becomes 'Just', an inner 'Dynamic' will be provided, whose value will track
284-- the 'a' inside the 'Just'; when the constructor becomes 'Nothing', the
285-- existing inner 'Dynamic' will become constant, and will not change when the
286-- outer constructor changes back to 'Nothing'.
287maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
288maybeDyn = fmap (fmap unpack) . eitherDyn . fmap pack
289 where pack = \case
290 Nothing -> Left ()
291 Just a -> Right a
292 unpack = \case
293 Left _ -> Nothing
294 Right a -> Just a
296-- | Turns a 'Dynamic t (Either a b)' into a 'Dynamic t (Either (Dynamic t a) (Dynamic t b))' such that
297-- the outer 'Dynamic' is updated only when the 'Either' constructor changes (e.g., from 'Left' to 'Right').
298eitherDyn :: 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)))
299eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum
300 where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)
301 unpack = \case
302 LeftTag :=> Compose a -> Left $ coerceDynamic a
303 RightTag :=> Compose b -> Right $ coerceDynamic b
305-- | Factor a 'Dynamic t DSum' into a 'Dynamic' 'DSum' containing nested 'Dynamic' values.
306-- The outer 'Dynamic' updates only when the key of the 'DSum' changes, while the update of the inner
307-- 'Dynamic' represents updates within the current key.
308factorDyn :: forall t m k v. (Reflex t, MonadHold t m, GEq k)
309 => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
310factorDyn d = buildDynamic (sample (current d) >>= holdKey) update where
311 update :: Event t (DSum k (Compose (Dynamic t) v))
312 update = flip push (updated d) $ \(newKey :=> newVal) -> do
313 (oldKey :=> _) <- sample (current d)
314 case newKey `geq` oldKey of
315 Just Refl -> return Nothing
316 Nothing -> Just <$> holdKey (newKey :=> newVal)
318 holdKey (k :=> v) = do
319 inner' <- filterEventKey k (updated d)
320 inner <- holdDyn v inner'
321 return $ k :=> Compose inner
323--------------------------------------------------------------------------------
324-- Demux
325--------------------------------------------------------------------------------
327-- | Represents a time changing value together with an 'EventSelector' that can
328-- efficiently detect when the underlying 'Dynamic' has a particular value.
329-- This is useful for representing data like the current selection of a long
330-- list.
331--
332-- Semantically,
333--
334-- > demuxed (demux d) k === fmap (== k) d
335--
336-- However, when getDemuxed is used multiple times, the complexity is only
337-- /O(log(n))/, rather than /O(n)/ for fmap.
338data Demux t k = Demux { demuxValue :: Behavior t k
339 , demuxSelector :: EventSelector t (Const2 k Bool)
340 }
342-- | Demultiplex an input value to a 'Demux' with many outputs. At any given
343-- time, whichever output is indicated by the given 'Dynamic' will be 'True'.
344demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
345demux k = Demux (current k)
346 (fan $ attachWith (\k0 k1 -> if k0 == k1
347 then DMap.empty
348 else DMap.fromList [Const2 k0 :=> Identity False,
349 Const2 k1 :=> Identity True])
350 (current k) (updated k))
352-- | Select a particular output of the 'Demux'; this is equivalent to (but much
353-- faster than) mapping over the original 'Dynamic' and checking whether it is
354-- equal to the given key.
355demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
356demuxed d k =
357 let e = select (demuxSelector d) (Const2 k)
358 in unsafeBuildDynamic (fmap (==k) $ sample $ demuxValue d) e
360--------------------------------------------------------------------------------
361-- collectDyn
362--------------------------------------------------------------------------------
364--TODO: This whole section is badly in need of cleanup
366-- | A heterogeneous list whose type and length are fixed statically. This is
367-- reproduced from the 'HList' package due to integration issues, and because
368-- very little other functionality from that library is needed.
369data HList (l::[*]) where
370 HNil :: HList '[]
371 HCons :: e -> HList l -> HList (e ': l)
373infixr 2 `HCons`
375type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
376type instance HRevApp '[] l = l
377type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
379hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
380hRevApp HNil l = l
381hRevApp (HCons x l) l' = hRevApp l (HCons x l')
383hReverse :: HList l -> HList (HRevApp l '[])
384hReverse l = hRevApp l HNil
386hBuild :: (HBuild' '[] r) => r
387hBuild = hBuild' HNil
389class HBuild' l r where
390 hBuild' :: HList l -> r
392instance (l' ~ HRevApp l '[])
393 => HBuild' l (HList l') where
394 hBuild' = hReverse
396instance HBuild' (a ': l) r
397 => HBuild' l (a->r) where
398 hBuild' l x = hBuild' (HCons x l)
400-- | Like 'HList', but with a functor wrapping each element.
401data FHList f l where
402 FHNil :: FHList f '[]
403 FHCons :: f e -> FHList f l -> FHList f (e ': l)
405instance GEq (HListPtr l) where
406 HHeadPtr `geq` HHeadPtr = Just Refl
407 HHeadPtr `geq` HTailPtr _ = Nothing
408 HTailPtr _ `geq` HHeadPtr = Nothing
409 HTailPtr a `geq` HTailPtr b = a `geq` b
411instance GCompare (HListPtr l) where -- Warning: This ordering can't change, dmapTo*HList will break
412 HHeadPtr `gcompare` HHeadPtr = GEQ
413 HHeadPtr `gcompare` HTailPtr _ = GLT
414 HTailPtr _ `gcompare` HHeadPtr = GGT
415 HTailPtr a `gcompare` HTailPtr b = a `gcompare` b
417-- | A typed index into a typed heterogeneous list.
418data HListPtr l a where
419 HHeadPtr :: HListPtr (h ': t) h
420 HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
422deriving instance Eq (HListPtr l a)
423deriving instance Ord (HListPtr l a)
425fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
426fhlistToDMap = DMap.fromList . go
427 where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
428 go = \case
429 FHNil -> []
430 FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> HTailPtr p :=> v) (go t)
432-- | This class allows 'HList's and 'FHlist's to be built from regular lists;
433-- they must be contiguous and sorted.
434class RebuildSortedHList l where
435 rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
436 rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
438instance RebuildSortedHList '[] where
439 rebuildSortedFHList l = case l of
440 [] -> FHNil
441 _ : _ -> error "rebuildSortedFHList{'[]}: empty list expected"
442 rebuildSortedHList l = case l of
443 [] -> HNil
444 _ : _ -> error "rebuildSortedHList{'[]}: empty list expected"
446instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
447 rebuildSortedFHList l = case l of
448 ((HHeadPtr :=> h) : t) -> FHCons h . rebuildSortedFHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
449 _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
450 rebuildSortedHList l = case l of
451 ((HHeadPtr :=> Identity h) : t) -> HCons h . rebuildSortedHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
452 _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
454dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
455dmapToHList = rebuildSortedHList . DMap.toList
457-- | Collect a hetereogeneous list whose elements are all 'Dynamic's into a
458-- single 'Dynamic' whose value represents the current values of all of the
459-- input 'Dynamic's.
460distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
461distributeFHListOverDynPure l = fmap dmapToHList $ distributeDMapOverDynPure $ fhlistToDMap l
463-- | Indicates that all elements in a type-level list are applications of the
464-- same functor.
465class AllAreFunctors (f :: a -> *) (l :: [a]) where
466 type FunctorList f l :: [*]
467 toFHList :: HList (FunctorList f l) -> FHList f l
468 fromFHList :: FHList f l -> HList (FunctorList f l)
470instance AllAreFunctors f '[] where
471 type FunctorList f '[] = '[]
472 toFHList l = case l of
473 HNil -> FHNil
474#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
475 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
476#endif
477 fromFHList FHNil = HNil
479instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
480 type FunctorList f (h ': t) = f h ': FunctorList f t
481 toFHList l = case l of
482 a `HCons` b -> a `FHCons` toFHList b
483#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
484 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
485#endif
486 fromFHList (a `FHCons` b) = a `HCons` fromFHList b
488-- | Convert a datastructure whose constituent parts are all 'Dynamic's into a
489-- single 'Dynamic' whose value represents all the current values of the input's
490-- constituent 'Dynamic's.
491collectDynPure :: ( RebuildSortedHList (HListElems b)
492 , IsHList a, IsHList b
493 , AllAreFunctors (Dynamic t) (HListElems b)
494 , Reflex t
495 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
496 ) => a -> Dynamic t b
497collectDynPure ds = fmap fromHList $ distributeFHListOverDynPure $ toFHList $ toHList ds
499-- | Poor man's 'Generic's for product types only.
500class IsHList a where
501 type HListElems a :: [*]
502 toHList :: a -> HList (HListElems a)
503 fromHList :: HList (HListElems a) -> a
505instance IsHList (a, b) where
506 type HListElems (a, b) = [a, b]
507 toHList (a, b) = hBuild a b
508 fromHList l = case l of
509 a `HCons` b `HCons` HNil -> (a, b)
510#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
511 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
512#endif
514instance IsHList (a, b, c, d) where
515 type HListElems (a, b, c, d) = [a, b, c, d]
516 toHList (a, b, c, d) = hBuild a b c d
517 fromHList l = case l of
518 a `HCons` b `HCons` c `HCons` d `HCons` HNil -> (a, b, c, d)
519#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
520 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
521#endif
523instance IsHList (a, b, c, d, e, f) where
524 type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
525 toHList (a, b, c, d, e, f) = hBuild a b c d e f
526 fromHList l = case l of
527 a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil -> (a, b, c, d, e, f)
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