2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE NoMonomorphismRestriction #-}
9{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE UndecidableInstances #-}
15module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update
38 , distributeDMapOverDyn
48 -- Things that probably aren't very useful:
51 , distributeFHListOverDyn
56import Prelude hiding (mapM, mapM_)
58import Data.Functor.Misc
61import Control.Monad hiding (forM, forM_, mapM, mapM_)
62import Control.Monad.Fix
63import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)
65import Data.Dependent.Map (DMap)
66import qualified Data.Dependent.Map as DMap
67import Data.Dependent.Sum (DSum (..))
68import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
75data HList (l::[*]) where
77 HCons :: e -> HList l -> HList (e ': l)
81type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
82type instance HRevApp '[] l = l
83type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
85hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
87hRevApp (HCons x l) l' = hRevApp l (HCons x l')
89hReverse :: HList l -> HList (HRevApp l '[])
90hReverse l = hRevApp l HNil
92hBuild :: (HBuild' '[] r) => r
95class HBuild' l r where
96 hBuild' :: HList l -> r
98instance (l' ~ HRevApp l '[])
99 => HBuild' l (HList l') where
102instance HBuild' (a ': l) r
103 => HBuild' l (a->r) where
104 hBuild' l x = hBuild' (HCons x l)
106-- | Create a new 'Dynamic' that only signals changes if the values
108nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
110 let e' = attachWithMaybe (\x x' -> if x' == x then Nothing else Just x') (current d) (updated d)
111 in unsafeDynamic (current d) e' --TODO: Avoid invalidating the outgoing Behavior
113-- | Map a function over a 'Dynamic'.
114mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)
115mapDyn f = return . fmap f
117-- | Flipped version of 'mapDyn'.
118forDyn :: (Reflex t, Monad m) => Dynamic t a -> (a -> b) -> m (Dynamic t b)
121-- | Create a 'Dynamic' using the initial value and change it each
122-- time the 'Event' occurs using a folding function on the previous
123-- value and the value of the 'Event'.
124foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
125foldDyn = accum . flip
127-- | Create a 'Dynamic' using the initial value and change it each
128-- time the 'Event' occurs using a monadic folding function on the
129-- previous value and the value of the 'Event'.
130foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
131foldDynM = accumM . flip
133foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
134foldDynMaybe = accumMaybe . flip
136foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
137foldDynMaybeM = accumMaybeM . flip
139-- | Create a new 'Dynamic' that counts the occurences of the 'Event'.
140count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
141count e = holdDyn 0 =<< zipListWithEvent const (iterate (+1) 1) e
143-- | Create a new 'Dynamic' using the initial value that flips its
144-- value every time the 'Event' occurs.
145toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
146toggle = foldDyn (const not)
148-- | Switches to the new 'Event' whenever it receives one. Switching
149-- occurs *before* the inner 'Event' fires - so if the 'Dynamic' changes and both the old and new
150-- inner Events fire simultaneously, the output will fire with the value of the *new* 'Event'.
151switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
152switchPromptlyDyn de =
153 let eLag = switch $ current de
154 eCoincidences = coincidence $ updated de
155 in leftmost [eCoincidences, eLag]
159mergeEventsWith :: Reflex t m => (a -> a -> a) -> Event t a -> Event t a -> m (Event t a)
160mergeEventsWith f ea eb = mapE (mergeThese f) =<< alignEvents ea eb
162firstE :: (Reflex t m) => [Event t a] -> m (Event t a)
163firstE [] = return never
164firstE (h:t) = mergeEventsLeftBiased h =<< firstE t
166concatEventsWith :: (Reflex t m) => (a -> a -> a) -> [Event t a] -> m (Event t a)
167concatEventsWith _ [] = return never
168concatEventsWith _ [e] = return e
169concatEventsWith f es = mapEM (fmap (foldl1 f . map (\(Const2 _ :=> v) -> v) . DMap.toList) . sequenceDmap) <=< mergeEventDMap $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
170--concatEventsWith f (h:t) = mergeEventsWith f h =<< concatEventsWith f t
172mconcatE :: (Reflex t m, Monoid a) => [Event t a] -> m (Event t a)
173mconcatE = concatEventsWith mappend
176-- | Split the 'Dynamic' into two 'Dynamic's, each taking the
177-- respective value of the tuple.
178splitDyn :: (Reflex t, Monad m) => Dynamic t (a, b) -> m (Dynamic t a, Dynamic t b)
179splitDyn = return . splitDynPure
181splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
182splitDynPure d = (fmap fst d, fmap snd d)
184-- | Merge the 'Dynamic' values using their 'Monoid' instance.
185mconcatDyn :: forall t m a. (Reflex t, Monad m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
186mconcatDyn = return . mconcat
188-- | Create a 'Dynamic' with a 'DMap' of values out of a 'DMap' of
190distributeDMapOverDyn :: (Reflex t, Monad m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
191distributeDMapOverDyn = return . distributeDMapOverDynPure
193distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
194distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap
196-- | Merge two 'Dynamic's into a new one using the provided
197-- function. The new 'Dynamic' changes its value each time one of the
198-- original 'Dynamic's changes its value.
199combineDyn :: forall t m a b c. (Reflex t, Monad m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
200combineDyn f da db = return $ zipDynWith f da db
202-- | A psuedo applicative version of ap for 'Dynamic'. Example useage:
205-- > person <- Person `mapDyn` dynFirstName
206-- > `apDyn` dynListName
208-- > `apDyn` dynAddress
209apDyn :: forall t m a b. (Reflex t, Monad m)
210 => m (Dynamic t (a -> b))
217joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a
220--TODO: Generalize this to functors other than Maps
221-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
222-- with the current values of the 'Dynamic's in a map.
223joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
224joinDynThroughMap = joinDyn . fmap distributeMapOverDynPure
226-- | Print the value of the 'Dynamic' on each change and prefix it
227-- with the provided string. This should /only/ be used for debugging.
229-- Note: Just like Debug.Trace.trace, the value will only be shown if something
230-- else in the system is depending on it.
231traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
232traceDyn s = traceDynWith $ \x -> s <> ": " <> show x
234-- | Print the result of applying the provided function to the value
235-- of the 'Dynamic' on each change. This should /only/ be used for
238-- Note: Just like Debug.Trace.trace, the value will only be shown if something
239-- else in the system is depending on it.
240traceDynWith :: Reflex t => (a -> String) -> Dynamic t a -> Dynamic t a
242 let e' = traceEventWith f $ updated d
244 x <- sample $ current d
245 trace (f x) $ return x
246 in unsafeBuildDynamic getV0 e'
248-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
249-- each time the 'Event' occurs.
251-- Note: `tagDyn d e` differs from `tag (current d) e` in the case that `e` is firing
252-- at the same time that `d` is changing. With `tagDyn d e`, the *new* value of `d`
253-- will replace the value of `e`, whereas with `tag (current d) e`, the *old* value
254-- will be used, since the 'Behavior' won't be updated until the end of the frame.
255-- Additionally, this means that the output 'Event' may not be used to directly change
256-- the input 'Dynamic', because that would mean its value depends on itself. When creating
257-- cyclic data flows, generally `tag (current d) e` is preferred.
258tagDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
259tagDyn = attachDynWith const
261-- | Attach the current value of the 'Dynamic' to the value of the
262-- 'Event' each time it occurs.
264-- Note: `attachDyn d` is not the same as `attach (current d)`. See 'tagDyn' for details.
265attachDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
266attachDyn = attachDynWith (,)
268-- | Combine the current value of the 'Dynamic' with the value of the
269-- 'Event' each time it occurs.
271-- Note: `attachDynWith f d` is not the same as `attachWith f (current d)`. See 'tagDyn' for details.
272attachDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
273attachDynWith f = attachDynWithMaybe $ \a b -> Just $ f a b
275-- | Create a new 'Event' by combining the value at each occurence
276-- with the current value of the 'Dynamic' value and possibly
277-- filtering if the combining function returns 'Nothing'.
279-- Note: `attachDynWithMaybe f d` is not the same as `attachWithMaybe f (current d)`. See 'tagDyn' for details.
280attachDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
281attachDynWithMaybe 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--------------------------------------------------------------------------------
290--------------------------------------------------------------------------------
292-- | Represents a time changing value together with an 'EventSelector'
293-- that can efficiently detect when the underlying Dynamic has a particular value.
294-- This is useful for representing data like the current selection of a long list.
297-- > getDemuxed (demux d) k === mapDyn (== k) d
298-- However, the when getDemuxed is used multiple times, the complexity is only /O(log(n))/,
299-- rather than /O(n)/ for mapDyn.
300data Demux t k = Demux { demuxValue :: Behavior t k
301 , demuxSelector :: EventSelector t (Const2 k Bool)
304-- | Demultiplex an input value to a 'Demux' with many outputs. At any given time, whichever output is indicated by the given 'Dynamic' will be 'True'.
305demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
306demux k = Demux (current k)
307 (fan $ attachWith (\k0 k1 -> if k0 == k1
309 else DMap.fromList [Const2 k0 :=> Identity False,
310 Const2 k1 :=> Identity True])
311 (current k) (updated k))
313--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
314-- | Select a particular output of the 'Demux'; this is equivalent to (but much faster than)
315-- mapping over the original 'Dynamic' and checking whether it is equal to the given key.
316getDemuxed :: (Reflex t, Monad m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
317getDemuxed d k = return $ demuxed d k
319demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
321 let e = select (demuxSelector d) (Const2 k)
322 in unsafeBuildDynamic (fmap (==k) $ sample $ demuxValue d) e
324--------------------------------------------------------------------------------
326--------------------------------------------------------------------------------
328--TODO: This whole section is badly in need of cleanup
331 FHNil :: FHList f '[]
332 FHCons :: f e -> FHList f l -> FHList f (e ': l)
334instance GEq (HListPtr l) where
335 HHeadPtr `geq` HHeadPtr = Just Refl
336 HHeadPtr `geq` HTailPtr _ = Nothing
337 HTailPtr _ `geq` HHeadPtr = Nothing
338 HTailPtr a `geq` HTailPtr b = a `geq` b
340instance GCompare (HListPtr l) where -- Warning: This ordering can't change, dmapTo*HList will break
341 HHeadPtr `gcompare` HHeadPtr = GEQ
342 HHeadPtr `gcompare` HTailPtr _ = GLT
343 HTailPtr _ `gcompare` HHeadPtr = GGT
344 HTailPtr a `gcompare` HTailPtr b = a `gcompare` b
346data HListPtr l a where
347 HHeadPtr :: HListPtr (h ': t) h
348 HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
350fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
351fhlistToDMap = DMap.fromList . go
352 where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
355 FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> HTailPtr p :=> v) (go t)
357class RebuildSortedHList l where
358 rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
359 rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
361instance RebuildSortedHList '[] where
362 rebuildSortedFHList l = case l of
364 _ : _ -> error "rebuildSortedFHList{'[]}: empty list expected"
365 rebuildSortedHList l = case l of
367 _ : _ -> error "rebuildSortedHList{'[]}: empty list expected"
369instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
370 rebuildSortedFHList l = case l of
371 ((HHeadPtr :=> h) : t) -> FHCons h . rebuildSortedFHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
372 _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
373 rebuildSortedHList l = case l of
374 ((HHeadPtr :=> Identity h) : t) -> HCons h . rebuildSortedHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
375 _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
377dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
378dmapToHList = rebuildSortedHList . DMap.toList
380distributeFHListOverDyn :: forall t m l. (Reflex t, Monad m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
381distributeFHListOverDyn = return . distributeFHListOverDynPure
383distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
384distributeFHListOverDynPure l = fmap dmapToHList $ distributeDMapOverDynPure $ fhlistToDMap l
386class AllAreFunctors (f :: a -> *) (l :: [a]) where
387 type FunctorList f l :: [*]
388 toFHList :: HList (FunctorList f l) -> FHList f l
389 fromFHList :: FHList f l -> HList (FunctorList f l)
391instance AllAreFunctors f '[] where
392 type FunctorList f '[] = '[]
393 toFHList l = case l of
395#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
396 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
398 fromFHList FHNil = HNil
400instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
401 type FunctorList f (h ': t) = f h ': FunctorList f t
402 toFHList l = case l of
403 a `HCons` b -> a `FHCons` toFHList b
404#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
405 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
407 fromFHList (a `FHCons` b) = a `HCons` fromFHList b
409collectDyn :: ( RebuildSortedHList (HListElems b)
410 , IsHList a, IsHList b
411 , AllAreFunctors (Dynamic t) (HListElems b)
413 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
414 ) => a -> m (Dynamic t b)
415collectDyn = return . collectDynPure
417collectDynPure :: ( RebuildSortedHList (HListElems b)
418 , IsHList a, IsHList b
419 , AllAreFunctors (Dynamic t) (HListElems b)
421 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
422 ) => a -> Dynamic t b
423collectDynPure ds = fmap fromHList $ distributeFHListOverDynPure $ toFHList $ toHList ds
427 type HListElems a :: [*]
428 toHList :: a -> HList (HListElems a)
429 fromHList :: HList (HListElems a) -> a
431instance IsHList (a, b) where
432 type HListElems (a, b) = [a, b]
433 toHList (a, b) = hBuild a b
434 fromHList l = case l of
435 a `HCons` b `HCons` HNil -> (a, b)
436#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
437 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
440instance IsHList (a, b, c, d) where
441 type HListElems (a, b, c, d) = [a, b, c, d]
442 toHList (a, b, c, d) = hBuild a b c d
443 fromHList l = case l of
444 a `HCons` b `HCons` c `HCons` d `HCons` HNil -> (a, b, c, d)
445#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
446 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
449instance IsHList (a, b, c, d, e, f) where
450 type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
451 toHList (a, b, c, d, e, f) = hBuild a b c d e f
452 fromHList l = case l of
453 a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil -> (a, b, c, d, e, f)
454#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
455 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list