1{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, GADTs, ScopedTypeVariables, FunctionalDependencies, RecursiveDo, UndecidableInstances, GeneralizedNewtypeDeriving, StandaloneDeriving, EmptyDataDecls, NoMonomorphismRestriction, TypeOperators, DeriveDataTypeable, PackageImports, TemplateHaskell, LambdaCase, DataKinds, PolyKinds #-}
2module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update
25 , distributeDMapOverDyn
35 -- Things that probably aren't very useful:
38 , distributeFHListOverDyn
43import Prelude hiding (mapM, mapM_)
46import Data.Functor.Misc
48import Control.Monad hiding (mapM, mapM_, forM, forM_)
49import Control.Monad.Fix
50import Control.Monad.Identity hiding (mapM, mapM_, forM, forM_)
54import Data.Dependent.Map (DMap)
55import qualified Data.Dependent.Map as DMap
56import Data.Dependent.Sum (DSum (..))
57import Data.GADT.Compare (GCompare (..), GEq (..), (:~:) (..), GOrdering (..))
62data HList (l::[*]) where
64 HCons :: e -> HList l -> HList (e ': l)
68type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
69type instance HRevApp '[] l = l
70type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
72hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
74hRevApp (HCons x l) l' = hRevApp l (HCons x l')
76hReverse :: HList l -> HList (HRevApp l '[])
77hReverse l = hRevApp l HNil
79hBuild :: (HBuild' '[] r) => r
82class HBuild' l r where
83 hBuild' :: HList l -> r
85instance (l' ~ HRevApp l '[])
86 => HBuild' l (HList l') where
87 hBuild' l = hReverse l
89instance HBuild' (a ': l) r
90 => HBuild' l (a->r) where
91 hBuild' l x = hBuild' (HCons x l)
93-- | Create a new 'Dynamic' that only signals changes if the values
95nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
97 let e' = attachWithMaybe (\x x' -> if x' == x then Nothing else Just x') (current d) (updated d)
98 in unsafeDynamic (current d) e' --TODO: Avoid invalidating the outgoing Behavior
100-- | Map a function over a 'Dynamic'.
101mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)
102mapDyn f = return . fmap f
104-- | Flipped version of 'mapDyn'.
105forDyn :: (Reflex t, Monad m) => Dynamic t a -> (a -> b) -> m (Dynamic t b)
108-- | Create a 'Dynamic' using the initial value and change it each
109-- time the 'Event' occurs using a folding function on the previous
110-- value and the value of the 'Event'.
111foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
112foldDyn = accum . flip
114-- | Create a 'Dynamic' using the initial value and change it each
115-- time the 'Event' occurs using a monadic folding function on the
116-- previous value and the value of the 'Event'.
117foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
118foldDynM = accumM . flip
120foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
121foldDynMaybe = accumMaybe . flip
123foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
124foldDynMaybeM = accumMaybeM . flip
126-- | Create a new 'Dynamic' that counts the occurences of the 'Event'.
127count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
128count e = holdDyn 0 =<< zipListWithEvent const (iterate (+1) 1) e
130-- | Create a new 'Dynamic' using the initial value that flips its
131-- value every time the 'Event' occurs.
132toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
133toggle = foldDyn (const not)
135-- | Switches to the new 'Event' whenever it receives one. Switching
136-- occurs *before* the inner 'Event' fires - so if the 'Dynamic' changes and both the old and new
137-- inner Events fire simultaneously, the output will fire with the value of the *new* 'Event'.
138switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
139switchPromptlyDyn de =
140 let eLag = switch $ current de
141 eCoincidences = coincidence $ updated de
142 in leftmost [eCoincidences, eLag]
146mergeEventsWith :: Reflex t m => (a -> a -> a) -> Event t a -> Event t a -> m (Event t a)
147mergeEventsWith f ea eb = mapE (mergeThese f) =<< alignEvents ea eb
149firstE :: (Reflex t m) => [Event t a] -> m (Event t a)
150firstE [] = return never
151firstE (h:t) = mergeEventsLeftBiased h =<< firstE t
153concatEventsWith :: (Reflex t m) => (a -> a -> a) -> [Event t a] -> m (Event t a)
154concatEventsWith _ [] = return never
155concatEventsWith _ [e] = return e
156concatEventsWith 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
157--concatEventsWith f (h:t) = mergeEventsWith f h =<< concatEventsWith f t
159mconcatE :: (Reflex t m, Monoid a) => [Event t a] -> m (Event t a)
160mconcatE = concatEventsWith mappend
163-- | Split the 'Dynamic' into two 'Dynamic's, each taking the
164-- respective value of the tuple.
165splitDyn :: (Reflex t, Monad m) => Dynamic t (a, b) -> m (Dynamic t a, Dynamic t b)
166splitDyn = return . splitDynPure
168splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
169splitDynPure d = (fmap fst d, fmap snd d)
171-- | Merge the 'Dynamic' values using their 'Monoid' instance.
172mconcatDyn :: forall t m a. (Reflex t, Monad m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
173mconcatDyn = return . mconcat
175-- | Create a 'Dynamic' with a 'DMap' of values out of a 'DMap' of
177distributeDMapOverDyn :: (Reflex t, Monad m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
178distributeDMapOverDyn = return . distributeDMapOverDynPure
180distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
181distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap
183-- | Merge two 'Dynamic's into a new one using the provided
184-- function. The new 'Dynamic' changes its value each time one of the
185-- original 'Dynamic's changes its value.
186combineDyn :: forall t m a b c. (Reflex t, Monad m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
187combineDyn f da db = return $ zipDynWith f da db
189-- | A psuedo applicative version of ap for 'Dynamic'. Example useage:
192-- > person <- Person `mapDyn` dynFirstName
193-- > `apDyn` dynListName
195-- > `apDyn` dynAddress
196apDyn :: forall t m a b. (Reflex t, Monad m)
197 => m (Dynamic t (a -> b))
204joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a
207--TODO: Generalize this to functors other than Maps
208-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
209-- with the current values of the 'Dynamic's in a map.
210joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
211joinDynThroughMap = joinDyn . fmap distributeMapOverDynPure
213-- | Print the value of the 'Dynamic' on each change and prefix it
214-- with the provided string. This should /only/ be used for debugging.
216-- Note: Just like Debug.Trace.trace, the value will only be shown if something
217-- else in the system is depending on it.
218traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
219traceDyn s = traceDynWith $ \x -> s <> ": " <> show x
221-- | Print the result of applying the provided function to the value
222-- of the 'Dynamic' on each change. This should /only/ be used for
225-- Note: Just like Debug.Trace.trace, the value will only be shown if something
226-- else in the system is depending on it.
227traceDynWith :: Reflex t => (a -> String) -> Dynamic t a -> Dynamic t a
229 let e' = traceEventWith f $ updated d
231 x <- sample $ current d
232 trace (f x) $ return x
233 in unsafeBuildDynamic getV0 e'
235-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
236-- each time the 'Event' occurs.
238-- Note: `tagDyn d e` differs from `tag (current d) e` in the case that `e` is firing
239-- at the same time that `d` is changing. With `tagDyn d e`, the *new* value of `d`
240-- will replace the value of `e`, whereas with `tag (current d) e`, the *old* value
241-- will be used, since the 'Behavior' won't be updated until the end of the frame.
242-- Additionally, this means that the output 'Event' may not be used to directly change
243-- the input 'Dynamic', because that would mean its value depends on itself. When creating
244-- cyclic data flows, generally `tag (current d) e` is preferred.
245tagDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
246tagDyn = attachDynWith const
248-- | Attach the current value of the 'Dynamic' to the value of the
249-- 'Event' each time it occurs.
251-- Note: `attachDyn d` is not the same as `attach (current d)`. See 'tagDyn' for details.
252attachDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
253attachDyn = attachDynWith (,)
255-- | Combine the current value of the 'Dynamic' with the value of the
256-- 'Event' each time it occurs.
258-- Note: `attachDynWith f d` is not the same as `attachWith f (current d)`. See 'tagDyn' for details.
259attachDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
260attachDynWith f = attachDynWithMaybe $ \a b -> Just $ f a b
262-- | Create a new 'Event' by combining the value at each occurence
263-- with the current value of the 'Dynamic' value and possibly
264-- filtering if the combining function returns 'Nothing'.
266-- Note: `attachDynWithMaybe f d` is not the same as `attachWithMaybe f (current d)`. See 'tagDyn' for details.
267attachDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
268attachDynWithMaybe f d e =
269 let e' = attach (current d) e
270 in fforMaybe (align e' $ updated d) $ \case
271 This (a, b) -> f a b -- Only the tagging event is firing, so use that
272 These (_, b) a -> f a b -- Both events are firing, so use the newer value
273 That _ -> Nothing -- The tagging event isn't firing, so don't fire
275--------------------------------------------------------------------------------
277--------------------------------------------------------------------------------
279-- | Represents a time changing value together with an 'EventSelector'
280-- that can efficiently detect when the underlying Dynamic has a particular value.
281-- This is useful for representing data like the current selection of a long list.
284-- > getDemuxed (demux d) k === mapDyn (== k) d
285-- However, the when getDemuxed is used multiple times, the complexity is only /O(log(n))/,
286-- rather than /O(n)/ for mapDyn.
287data Demux t k = Demux { demuxValue :: Behavior t k
288 , demuxSelector :: EventSelector t (Const2 k Bool)
291-- | 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'.
292demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
293demux k = Demux (current k)
294 (fan $ attachWith (\k0 k1 -> if k0 == k1
296 else DMap.fromList [Const2 k0 :=> Identity False,
297 Const2 k1 :=> Identity True])
298 (current k) (updated k))
300--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
301-- | Select a particular output of the 'Demux'; this is equivalent to (but much faster than)
302-- mapping over the original 'Dynamic' and checking whether it is equal to the given key.
303getDemuxed :: (Reflex t, Monad m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
304getDemuxed d k = return $ demuxed d k
306demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
308 let e = select (demuxSelector d) (Const2 k)
309 in unsafeBuildDynamic (fmap (==k) $ sample $ demuxValue d) e
311--------------------------------------------------------------------------------
313--------------------------------------------------------------------------------
315--TODO: This whole section is badly in need of cleanup
318 FHNil :: FHList f '[]
319 FHCons :: f e -> FHList f l -> FHList f (e ': l)
321instance GEq (HListPtr l) where
322 HHeadPtr `geq` HHeadPtr = Just Refl
323 HHeadPtr `geq` HTailPtr _ = Nothing
324 HTailPtr _ `geq` HHeadPtr = Nothing
325 HTailPtr a `geq` HTailPtr b = a `geq` b
327instance GCompare (HListPtr l) where -- Warning: This ordering can't change, dmapTo*HList will break
328 HHeadPtr `gcompare` HHeadPtr = GEQ
329 HHeadPtr `gcompare` HTailPtr _ = GLT
330 HTailPtr _ `gcompare` HHeadPtr = GGT
331 HTailPtr a `gcompare` HTailPtr b = a `gcompare` b
333data HListPtr l a where
334 HHeadPtr :: HListPtr (h ': t) h
335 HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
337fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
338fhlistToDMap = DMap.fromList . go
339 where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
342 FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> (HTailPtr p) :=> v) (go t)
344class RebuildSortedHList l where
345 rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
346 rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
348instance RebuildSortedHList '[] where
349 rebuildSortedFHList l = case l of
351 _ : _ -> error "rebuildSortedFHList{'[]}: empty list expected"
352 rebuildSortedHList l = case l of
354 _ : _ -> error "rebuildSortedHList{'[]}: empty list expected"
356instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
357 rebuildSortedFHList l = case l of
358 ((HHeadPtr :=> h) : t) -> FHCons h . rebuildSortedFHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
359 _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
360 rebuildSortedHList l = case l of
361 ((HHeadPtr :=> Identity h) : t) -> HCons h . rebuildSortedHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
362 _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
364dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
365dmapToHList = rebuildSortedHList . DMap.toList
367distributeFHListOverDyn :: forall t m l. (Reflex t, Monad m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
368distributeFHListOverDyn = return . distributeFHListOverDynPure
370distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
371distributeFHListOverDynPure l = fmap dmapToHList $ distributeDMapOverDynPure $ fhlistToDMap l
373class AllAreFunctors (f :: a -> *) (l :: [a]) where
374 type FunctorList f l :: [*]
375 toFHList :: HList (FunctorList f l) -> FHList f l
376 fromFHList :: FHList f l -> HList (FunctorList f l)
378instance AllAreFunctors f '[] where
379 type FunctorList f '[] = '[]
380 toFHList l = case l of
382#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
383 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
385 fromFHList FHNil = HNil
387instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
388 type FunctorList f (h ': t) = f h ': FunctorList f t
389 toFHList l = case l of
390 a `HCons` b -> a `FHCons` toFHList b
391#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
392 _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
394 fromFHList (a `FHCons` b) = a `HCons` fromFHList b
396collectDyn :: ( RebuildSortedHList (HListElems b)
397 , IsHList a, IsHList b
398 , AllAreFunctors (Dynamic t) (HListElems b)
400 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
401 ) => a -> m (Dynamic t b)
402collectDyn = return . collectDynPure
404collectDynPure :: ( RebuildSortedHList (HListElems b)
405 , IsHList a, IsHList b
406 , AllAreFunctors (Dynamic t) (HListElems b)
408 , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
409 ) => a -> Dynamic t b
410collectDynPure ds = fmap fromHList $ distributeFHListOverDynPure $ toFHList $ toHList ds
414 type HListElems a :: [*]
415 toHList :: a -> HList (HListElems a)
416 fromHList :: HList (HListElems a) -> a
418instance IsHList (a, b) where
419 type HListElems (a, b) = [a, b]
420 toHList (a, b) = hBuild a b
421 fromHList l = case l of
422 a `HCons` b `HCons` HNil -> (a, b)
423#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
424 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
427instance IsHList (a, b, c, d) where
428 type HListElems (a, b, c, d) = [a, b, c, d]
429 toHList (a, b, c, d) = hBuild a b c d
430 fromHList l = case l of
431 a `HCons` b `HCons` c `HCons` d `HCons` HNil -> (a, b, c, d)
432#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
433 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
436instance IsHList (a, b, c, d, e, f) where
437 type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
438 toHList (a, b, c, d, e, f) = hBuild a b c d e f
439 fromHList l = case l of
440 a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil -> (a, b, c, d, e, f)
441#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
442 _ -> 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