{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif
-- |
-- Module:
--   Reflex.Dynamic
-- Description:
--   This module contains various functions for working with 'Dynamic' values.
--   'Dynamic' and its primitives have been moved to the 'Reflex' class.
module Reflex.Dynamic
  ( -- * Basics
    Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update
  , current
  , updated
  , holdDyn
  , mapDynM
  , forDynM
  , constDyn
  , count
  , toggle
  , switchDyn
  , switchPromptlyDyn
  , tagPromptlyDyn
  , attachPromptlyDyn
  , attachPromptlyDynWith
  , attachPromptlyDynWithMaybe
  , maybeDyn
  , eitherDyn
  , factorDyn
  , scanDyn
  , scanDynMaybe
  , holdUniqDyn
  , holdUniqDynBy
  , improvingMaybe
  , foldDyn
  , foldDynM
  , foldDynMaybe
  , foldDynMaybeM
  , joinDynThroughMap
  , joinDynThroughIntMap
  , traceDyn
  , traceDynWith
  , splitDynPure
  , distributeMapOverDynPure
  , distributeIntMapOverDynPure
  , distributeDMapOverDynPure
  , distributeListOverDynPure
  , Demux
  , demux
  , demuxed
    -- * Miscellaneous
    -- Things that probably aren't very useful:
  , HList (..)
  , FHList (..)
  , collectDynPure
  , RebuildSortedHList (..)
  , IsHList (..)
  , AllAreFunctors (..)
  , HListPtr (..)
  , distributeFHListOverDynPure
    -- * Unsafe
  , unsafeDynamic
  ) where

import Data.Functor.Compose
import Data.Functor.Misc
import Reflex.Class

import Control.Monad
import Control.Monad.Fix
import Control.Monad.Identity
import Data.Align
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum (DSum (..))
import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Map (Map)
import Data.Maybe
import Data.Monoid ((<>))
import Data.These
import Data.Type.Equality ((:~:) (..))

import Debug.Trace

-- | Map a sampling function over a 'Dynamic'.
mapDynM :: 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)
mapDynM :: (forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> Dynamic t a -> m (Dynamic t b)
mapDynM f :: forall (m' :: * -> *). MonadSample t m' => a -> m' b
f d :: Dynamic t a
d = PushM t b -> Event t b -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (a -> PushM t b
forall (m' :: * -> *). MonadSample t m' => a -> m' b
f (a -> PushM t b) -> PushM t a -> PushM t b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d)) (Event t b -> m (Dynamic t b)) -> Event t b -> m (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ (a -> PushM t b) -> Event t a -> Event t b
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t b) -> Event t a -> Event t b
pushAlways a -> PushM t b
forall (m' :: * -> *). MonadSample t m' => a -> m' b
f (Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d)

-- | Flipped version of 'mapDynM'
forDynM :: 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)
forDynM :: Dynamic t a
-> (forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> m (Dynamic t b)
forDynM d :: Dynamic t a
d f :: forall (m' :: * -> *). MonadSample t m' => a -> m' b
f = (forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> Dynamic t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m) =>
(forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> Dynamic t a -> m (Dynamic t b)
mapDynM forall (m' :: * -> *). MonadSample t m' => a -> m' b
f Dynamic t a
d

-- | Create a new 'Dynamic' that only signals changes if the values actually
-- changed.
holdUniqDyn :: (Reflex t, MonadHold t m, MonadFix m, Eq a) => Dynamic t a -> m (Dynamic t a)
holdUniqDyn :: Dynamic t a -> m (Dynamic t a)
holdUniqDyn = (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
holdUniqDynBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Create a new 'Dynamic' that changes only when the underlying 'Dynamic'
-- changes and the given function returns 'False' when given both the old and
-- the new values.
holdUniqDynBy :: (Reflex t, MonadHold t m, MonadFix m) => (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
holdUniqDynBy :: (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
holdUniqDynBy eq :: a -> a -> Bool
eq = (a -> a) -> (a -> a -> Maybe a) -> Dynamic t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe a -> a
forall a. a -> a
id (\new :: a
new old :: a
old -> if a
new a -> a -> Bool
`eq` a
old then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
new)

-- | @/Dynamic Maybe/@ that can only update from @/Nothing/@ to @/Just/@ or @/Just/@ to @/Just/@ (i.e., cannot revert to @/Nothing/@)
improvingMaybe :: (Reflex t, MonadHold t m, MonadFix m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))
improvingMaybe :: Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))
improvingMaybe = (Maybe a -> Maybe a)
-> (Maybe a -> Maybe a -> Maybe (Maybe a))
-> Dynamic t (Maybe a)
-> m (Dynamic t (Maybe a))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe Maybe a -> Maybe a
forall a. a -> a
id (\new :: Maybe a
new _ -> if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
new then Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
new else Maybe (Maybe a)
forall a. Maybe a
Nothing)

-- | Create a 'Dynamic' that accumulates values from another 'Dynamic'.  This
-- function does not force its input 'Dynamic' until the output 'Dynamic' is
-- forced.
scanDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)
scanDyn :: (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)
scanDyn z :: a -> b
z f :: a -> b -> b
f = (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe a -> b
z (\a :: a
a b :: b
b -> b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ a -> b -> b
f a
a b
b)

-- | Like 'scanDyn', but the the accumulator function may decline to update the
-- result 'Dynamic''s value.
scanDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe :: (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe z :: a -> b
z f :: a -> b -> Maybe b
f d :: Dynamic t a
d = do
  rec Dynamic t b
d' <- PushM t b -> Event t b -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (a -> b
z (a -> b) -> PushM t a -> PushM t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d)) (Event t b -> m (Dynamic t b)) -> Event t b -> m (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ ((a -> PushM t (Maybe b)) -> Event t a -> Event t b)
-> Event t a -> (a -> PushM t (Maybe b)) -> Event t b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> PushM t (Maybe b)) -> Event t a -> Event t b
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push (Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d) ((a -> PushM t (Maybe b)) -> Event t b)
-> (a -> PushM t (Maybe b)) -> Event t b
forall a b. (a -> b) -> a -> b
$ \a :: a
a -> do
        b
b <- Behavior t b -> PushM t b
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t b -> PushM t b) -> Behavior t b -> PushM t b
forall a b. (a -> b) -> a -> b
$ Dynamic t b -> Behavior t b
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t b
d'
        Maybe b -> PushM t (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> PushM t (Maybe b)) -> Maybe b -> PushM t (Maybe b)
forall a b. (a -> b) -> a -> b
$ a -> b -> Maybe b
f a
a b
b
  Dynamic t b -> m (Dynamic t b)
forall (m :: * -> *) a. Monad m => a -> m a
return Dynamic t b
d'

-- | Create a 'Dynamic' using the initial value and change it each time the
-- 'Event' occurs using a folding function on the previous value and the value
-- of the 'Event'.
foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn :: (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn = (b -> a -> b) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
accumDyn ((b -> a -> b) -> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> b) -> b -> a -> b)
-> (a -> b -> b)
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip

-- | Like 'foldDyn', but the combining function is a 'PushM' action, so it
-- can 'sample' existing 'Behaviors' and 'hold' new ones.
foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
foldDynM :: (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
foldDynM = (b -> a -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
accumMDyn ((b -> a -> PushM t b) -> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> PushM t b) -> b -> a -> PushM t b)
-> (a -> b -> PushM t b)
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> PushM t b) -> b -> a -> PushM t b
forall a b c. (a -> b -> c) -> b -> a -> c
flip

-- | Create a 'Dynamic' using the provided initial value and change it each time
-- the provided 'Event' occurs, using a function to combine the old value with
-- the 'Event''s value.  If the function returns 'Nothing', the value is not
-- changed; this is distinct from returning 'Just' the old value, since the
-- 'Dynamic''s 'updated' 'Event' will fire in the 'Just' case, and will not fire
-- in the 'Nothing' case.
foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybe :: (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybe = (b -> a -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
accumMaybeDyn ((b -> a -> Maybe b) -> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> Maybe b) -> b -> a -> Maybe b)
-> (a -> b -> Maybe b)
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> Maybe b) -> b -> a -> Maybe b
forall a b c. (a -> b -> c) -> b -> a -> c
flip

-- | Like 'foldDynMaybe', but the combining function is a 'PushM' action, so it
-- can 'sample' existing 'Behaviors' and 'hold' new ones.
foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybeM :: (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybeM = (b -> a -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
accumMaybeMDyn ((b -> a -> PushM t (Maybe b))
 -> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> PushM t (Maybe b)) -> b -> a -> PushM t (Maybe b))
-> (a -> b -> PushM t (Maybe b))
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> PushM t (Maybe b)) -> b -> a -> PushM t (Maybe b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip

-- | Create a new 'Dynamic' that counts the occurrences of the 'Event'.
count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
count :: Event t a -> m (Dynamic t b)
count e :: Event t a
e = b -> Event t b -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn 0 (Event t b -> m (Dynamic t b)) -> m (Event t b) -> m (Dynamic t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (b -> a -> b) -> [b] -> Event t a -> m (Event t b)
forall k (t :: k) (m :: * -> *) a b c.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> c) -> [a] -> Event t b -> m (Event t c)
zipListWithEvent b -> a -> b
forall a b. a -> b -> a
const ((b -> b) -> b -> [b]
forall a. (a -> a) -> a -> [a]
iterate (b -> b -> b
forall a. Num a => a -> a -> a
+1) 1) Event t a
e

-- | Create a new 'Dynamic' using the initial value that flips its
-- value every time the 'Event' occurs.
toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
toggle :: Bool -> Event t a -> m (Dynamic t Bool)
toggle = (a -> Bool -> Bool) -> Bool -> Event t a -> m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn ((Bool -> Bool) -> a -> Bool -> Bool
forall a b. a -> b -> a
const Bool -> Bool
not)

-- | Switches to the new 'Event' whenever it receives one. Only the old event is
-- considered the moment a new one is switched in; the output event will fire at
-- that moment if only if the old event does.
--
-- Prefer this to 'switchPromptlyDyn' where possible. The lack of doing double
-- work when the outer and (new) inner fires means this imposes fewer "timing
-- requirements" and thus is far more easy to use without introducing fresh
-- failure cases. 'switchDyn' is also more performant.
switchDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
switchDyn :: Dynamic t (Event t a) -> Event t a
switchDyn d :: Dynamic t (Event t a)
d = Behavior t (Event t a) -> Event t a
forall k (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Dynamic t (Event t a) -> Behavior t (Event t a)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Event t a)
d)

-- | Switches to the new 'Event' whenever it receives one.  Switching occurs
-- __before__ the inner 'Event' fires - so if the 'Dynamic' changes and both the
-- old and new inner Events fire simultaneously, the output will fire with the
-- value of the __new__ 'Event'.
--
-- Prefer 'switchDyn' to this where possible. The timing requirements that
-- switching before imposes are likely to bring down your app unless you are
-- very careful. 'switchDyn' is also more performant.
switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
switchPromptlyDyn :: Dynamic t (Event t a) -> Event t a
switchPromptlyDyn de :: Dynamic t (Event t a)
de =
  let eLag :: Event t a
eLag = Behavior t (Event t a) -> Event t a
forall k (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Behavior t (Event t a) -> Event t a)
-> Behavior t (Event t a) -> Event t a
forall a b. (a -> b) -> a -> b
$ Dynamic t (Event t a) -> Behavior t (Event t a)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Event t a)
de
      eCoincidences :: Event t a
eCoincidences = Event t (Event t a) -> Event t a
forall k (t :: k) a. Reflex t => Event t (Event t a) -> Event t a
coincidence (Event t (Event t a) -> Event t a)
-> Event t (Event t a) -> Event t a
forall a b. (a -> b) -> a -> b
$ Dynamic t (Event t a) -> Event t (Event t a)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Event t a)
de
  in [Event t a] -> Event t a
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t a
eCoincidences, Event t a
eLag]

-- | Split a 'Dynamic' pair into a pair of 'Dynamic's
splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
splitDynPure :: Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
splitDynPure d :: Dynamic t (a, b)
d = (((a, b) -> a) -> Dynamic t (a, b) -> Dynamic t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst Dynamic t (a, b)
d, ((a, b) -> b) -> Dynamic t (a, b) -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd Dynamic t (a, b)
d)

-- | Convert a 'Map' with 'Dynamic' elements into a 'Dynamic' of a 'Map' with
-- non-'Dynamic' elements.
distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
distributeMapOverDynPure :: Map k (Dynamic t v) -> Dynamic t (Map k v)
distributeMapOverDynPure = (DMap (Const2 k v) Identity -> Map k v)
-> Dynamic t (DMap (Const2 k v) Identity) -> Dynamic t (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap (Const2 k v) Identity -> Map k v
forall k v. DMap (Const2 k v) Identity -> Map k v
dmapToMap (Dynamic t (DMap (Const2 k v) Identity) -> Dynamic t (Map k v))
-> (Map k (Dynamic t v) -> Dynamic t (DMap (Const2 k v) Identity))
-> Map k (Dynamic t v)
-> Dynamic t (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap (Const2 k v) (Dynamic t)
-> Dynamic t (DMap (Const2 k v) Identity)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
DMap k2 (Dynamic t) -> Dynamic t (DMap k2 Identity)
distributeDMapOverDynPure (DMap (Const2 k v) (Dynamic t)
 -> Dynamic t (DMap (Const2 k v) Identity))
-> (Map k (Dynamic t v) -> DMap (Const2 k v) (Dynamic t))
-> Map k (Dynamic t v)
-> Dynamic t (DMap (Const2 k v) Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Dynamic t v) -> DMap (Const2 k v) (Dynamic t)
forall k1 k2 (f :: k1 -> *) (v :: k1).
Map k2 (f v) -> DMap (Const2 k2 v) f
mapWithFunctorToDMap

-- | Convert an 'IntMap' with 'Dynamic' elements into a 'Dynamic' of an 'IntMap' with
-- non-'Dynamic' elements.
distributeIntMapOverDynPure :: (Reflex t) => IntMap (Dynamic t v) -> Dynamic t (IntMap v)
distributeIntMapOverDynPure :: IntMap (Dynamic t v) -> Dynamic t (IntMap v)
distributeIntMapOverDynPure = (DMap (Const2 Key v) Identity -> IntMap v)
-> Dynamic t (DMap (Const2 Key v) Identity) -> Dynamic t (IntMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap (Const2 Key v) Identity -> IntMap v
forall v. DMap (Const2 Key v) Identity -> IntMap v
dmapToIntMap (Dynamic t (DMap (Const2 Key v) Identity) -> Dynamic t (IntMap v))
-> (IntMap (Dynamic t v)
    -> Dynamic t (DMap (Const2 Key v) Identity))
-> IntMap (Dynamic t v)
-> Dynamic t (IntMap v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap (Const2 Key v) (Dynamic t)
-> Dynamic t (DMap (Const2 Key v) Identity)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
DMap k2 (Dynamic t) -> Dynamic t (DMap k2 Identity)
distributeDMapOverDynPure (DMap (Const2 Key v) (Dynamic t)
 -> Dynamic t (DMap (Const2 Key v) Identity))
-> (IntMap (Dynamic t v) -> DMap (Const2 Key v) (Dynamic t))
-> IntMap (Dynamic t v)
-> Dynamic t (DMap (Const2 Key v) Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (Dynamic t v) -> DMap (Const2 Key v) (Dynamic t)
forall k (f :: k -> *) (v :: k).
IntMap (f v) -> DMap (Const2 Key v) f
intMapWithFunctorToDMap

-- | Convert a list with 'Dynamic' elements into a 'Dynamic' of a list with
-- non-'Dynamic' elements, preserving the order of the elements.
{-# DEPRECATED distributeListOverDynPure "Use 'distributeListOverDyn' instead" #-}
distributeListOverDynPure :: Reflex t => [Dynamic t v] -> Dynamic t [v]
distributeListOverDynPure :: [Dynamic t v] -> Dynamic t [v]
distributeListOverDynPure = [Dynamic t v] -> Dynamic t [v]
forall k (t :: k) a. Reflex t => [Dynamic t a] -> Dynamic t [a]
distributeListOverDyn

--TODO: Generalize this to functors other than Maps
-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
-- with the current values of the 'Dynamic's in a map.
joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
joinDynThroughMap :: Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
joinDynThroughMap = (Map k (Dynamic t a) -> Dynamic t (Map k a)
forall k (t :: k) k v.
(Reflex t, Ord k) =>
Map k (Dynamic t v) -> Dynamic t (Map k v)
distributeMapOverDynPure (Map k (Dynamic t a) -> Dynamic t (Map k a))
-> Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

-- | Combine a 'Dynamic' of an 'IntMap' of 'Dynamic's into a 'Dynamic'
-- with the current values of the 'Dynamic's in a map.
joinDynThroughIntMap :: forall t a. (Reflex t) => Dynamic t (IntMap (Dynamic t a)) -> Dynamic t (IntMap a)
joinDynThroughIntMap :: Dynamic t (IntMap (Dynamic t a)) -> Dynamic t (IntMap a)
joinDynThroughIntMap = (IntMap (Dynamic t a) -> Dynamic t (IntMap a)
forall k (t :: k) v.
Reflex t =>
IntMap (Dynamic t v) -> Dynamic t (IntMap v)
distributeIntMapOverDynPure (IntMap (Dynamic t a) -> Dynamic t (IntMap a))
-> Dynamic t (IntMap (Dynamic t a)) -> Dynamic t (IntMap a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

-- | Print the value of the 'Dynamic' when it is first read and on each
-- subsequent change that is observed (as 'traceEvent'), prefixed with the
-- provided string. This should /only/ be used for debugging.
--
-- Note: Just like Debug.Trace.trace, the value will only be shown if something
-- else in the system is depending on it.
traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
traceDyn :: String -> Dynamic t a -> Dynamic t a
traceDyn s :: String
s = (a -> String) -> Dynamic t a -> Dynamic t a
forall k (t :: k) a.
Reflex t =>
(a -> String) -> Dynamic t a -> Dynamic t a
traceDynWith ((a -> String) -> Dynamic t a -> Dynamic t a)
-> (a -> String) -> Dynamic t a -> Dynamic t a
forall a b. (a -> b) -> a -> b
$ \x :: a
x -> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x

-- | Print the result of applying the provided function to the value
-- of the 'Dynamic' when it is first read and on each subsequent change
-- that is observed (as 'traceEvent'). This should /only/ be used for
-- debugging.
--
-- Note: Just like Debug.Trace.trace, the value will only be shown if something
-- else in the system is depending on it.
traceDynWith :: Reflex t => (a -> String) -> Dynamic t a -> Dynamic t a
traceDynWith :: (a -> String) -> Dynamic t a -> Dynamic t a
traceDynWith f :: a -> String
f d :: Dynamic t a
d =
  let e' :: Event t a
e' = (a -> String) -> Event t a -> Event t a
forall k (t :: k) a.
Reflex t =>
(a -> String) -> Event t a -> Event t a
traceEventWith a -> String
f (Event t a -> Event t a) -> Event t a -> Event t a
forall a b. (a -> b) -> a -> b
$ Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d
      getV0 :: PullM t a
getV0 = do
        a
x <- Behavior t a -> PullM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t a -> PullM t a) -> Behavior t a -> PullM t a
forall a b. (a -> b) -> a -> b
$ Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d
        String -> PullM t a -> PullM t a
forall a. String -> a -> a
trace (a -> String
f a
x) (PullM t a -> PullM t a) -> PullM t a -> PullM t a
forall a b. (a -> b) -> a -> b
$ a -> PullM t a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  in PullM t a -> Event t a -> Dynamic t a
forall k (t :: k) a.
Reflex t =>
PullM t a -> Event t a -> Dynamic t a
unsafeBuildDynamic PullM t a
getV0 Event t a
e'

-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
-- each time the 'Event' occurs.
--
-- Note: @/tagPromptlyDyn d e/@ differs from @/tag (current d) e/@ in the case that @/e/@ is firing
-- at the same time that @/d/@ is changing.  With @/tagPromptlyDyn d e/@, the __new__ value of @/d/@
-- will replace the value of @/e/@, whereas with @/tag (current d) e/@, the __old__ value
-- will be used, since the 'Behavior' won't be updated until the end of the frame.
-- Additionally, this means that the output 'Event' may not be used to directly change
-- the input 'Dynamic', because that would mean its value depends on itself.  __When creating__
-- __cyclic data flows, generally @/tag (current d) e/@ is preferred.__
tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
tagPromptlyDyn :: Dynamic t a -> Event t b -> Event t a
tagPromptlyDyn = (a -> b -> a) -> Dynamic t a -> Event t b -> Event t a
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith a -> b -> a
forall a b. a -> b -> a
const

-- | Attach the current value of the 'Dynamic' to the value of the
-- 'Event' each time it occurs.
--
-- Note: @/attachPromptlyDyn d/@ is not the same as @/attach (current d)/@.  See 'tagPromptlyDyn' for details.
attachPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
attachPromptlyDyn :: Dynamic t a -> Event t b -> Event t (a, b)
attachPromptlyDyn = (a -> b -> (a, b)) -> Dynamic t a -> Event t b -> Event t (a, b)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith (,)

-- | Combine the current value of the 'Dynamic' with the value of the
-- 'Event' each time it occurs.
--
-- Note: @/attachPromptlyDynWith f d/@ is not the same as @/attachWith f (current d)/@.  See 'tagPromptlyDyn' for details.
attachPromptlyDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith :: (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith f :: a -> b -> c
f = (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWithMaybe ((a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c)
-> (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
forall a b. (a -> b) -> a -> b
$ \a :: a
a b :: b
b -> c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b

-- | Create a new 'Event' by combining the value at each occurrence with the
-- current value of the 'Dynamic' value and possibly filtering if the combining
-- function returns 'Nothing'.
--
-- Note: @/attachPromptlyDynWithMaybe f d/@ is not the same as @/attachWithMaybe f (current d)/@.  See 'tagPromptlyDyn' for details.
attachPromptlyDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWithMaybe :: (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWithMaybe f :: a -> b -> Maybe c
f d :: Dynamic t a
d e :: Event t b
e =
  let e' :: Event t (a, b)
e' = Behavior t a -> Event t b -> Event t (a, b)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d) Event t b
e
  in Event t (These (a, b) a)
-> (These (a, b) a -> Maybe c) -> Event t c
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe (Event t (a, b) -> Event t a -> Event t (These (a, b) a)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t (a, b)
e' (Event t a -> Event t (These (a, b) a))
-> Event t a -> Event t (These (a, b) a)
forall a b. (a -> b) -> a -> b
$ Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d) ((These (a, b) a -> Maybe c) -> Event t c)
-> (These (a, b) a -> Maybe c) -> Event t c
forall a b. (a -> b) -> a -> b
$ \case
       This (a :: a
a, b :: b
b) -> a -> b -> Maybe c
f a
a b
b -- Only the tagging event is firing, so use that
       These (_, b :: b
b) a :: a
a -> a -> b -> Maybe c
f a
a b
b -- Both events are firing, so use the newer value
       That _ -> Maybe c
forall a. Maybe a
Nothing -- The tagging event isn't firing, so don't fire

-- | Factor a @/Dynamic t (Maybe a)/@ into a @/Dynamic t (Maybe (Dynamic t a))/@,
-- such that the outer 'Dynamic' is updated only when the "Maybe"'s constructor
-- chages from 'Nothing' to 'Just' or vice-versa.  Whenever the constructor
-- becomes 'Just', an inner 'Dynamic' will be provided, whose value will track
-- the 'a' inside the 'Just'; when the constructor becomes 'Nothing', the
-- existing inner 'Dynamic' will become constant, and will not change when the
-- outer constructor changes back to 'Nothing'.
maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn :: Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn = (Dynamic t (Either (Dynamic t ()) (Dynamic t a))
 -> Dynamic t (Maybe (Dynamic t a)))
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
-> m (Dynamic t (Maybe (Dynamic t a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (Dynamic t ()) (Dynamic t a) -> Maybe (Dynamic t a))
-> Dynamic t (Either (Dynamic t ()) (Dynamic t a))
-> Dynamic t (Maybe (Dynamic t a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (Dynamic t ()) (Dynamic t a) -> Maybe (Dynamic t a)
forall a a. Either a a -> Maybe a
unpack) (m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
 -> m (Dynamic t (Maybe (Dynamic t a))))
-> (Dynamic t (Maybe a)
    -> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a))))
-> Dynamic t (Maybe a)
-> m (Dynamic t (Maybe (Dynamic t a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t (Either () a)
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
forall k (t :: k) 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)))
eitherDyn (Dynamic t (Either () a)
 -> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a))))
-> (Dynamic t (Maybe a) -> Dynamic t (Either () a))
-> Dynamic t (Maybe a)
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Either () a)
-> Dynamic t (Maybe a) -> Dynamic t (Either () a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Either () a
forall b. Maybe b -> Either () b
pack
  where pack :: Maybe b -> Either () b
pack = \case
          Nothing -> () -> Either () b
forall a b. a -> Either a b
Left ()
          Just a :: b
a -> b -> Either () b
forall a b. b -> Either a b
Right b
a
        unpack :: Either a a -> Maybe a
unpack = \case
          Left _ -> Maybe a
forall a. Maybe a
Nothing
          Right a :: a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | Turns a 'Dynamic t (Either a b)' into a 'Dynamic t (Either (Dynamic t a) (Dynamic t b))' such that
-- the outer 'Dynamic' is updated only when the 'Either' constructor changes (e.g., from 'Left' to 'Right').
eitherDyn :: 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)))
eitherDyn :: Dynamic t (Either a b)
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
eitherDyn = (Dynamic t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))
 -> Dynamic t (Either (Dynamic t a) (Dynamic t b)))
-> m (Dynamic
        t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DSum (EitherTag a b) (Compose (Dynamic t) Identity)
 -> Either (Dynamic t a) (Dynamic t b))
-> Dynamic t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))
-> Dynamic t (Either (Dynamic t a) (Dynamic t b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DSum (EitherTag a b) (Compose (Dynamic t) Identity)
-> Either (Dynamic t a) (Dynamic t b)
unpack) (m (Dynamic
      t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
 -> m (Dynamic t (Either (Dynamic t a) (Dynamic t b))))
-> (Dynamic t (Either a b)
    -> m (Dynamic
            t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))))
-> Dynamic t (Either a b)
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t (DSum (EitherTag a b) Identity)
-> m (Dynamic
        t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
forall k k1 (t :: k) (m :: * -> *) (k :: k1 -> *) (v :: k1 -> *).
(Reflex t, MonadHold t m, GEq k) =>
Dynamic t (DSum k v)
-> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
factorDyn (Dynamic t (DSum (EitherTag a b) Identity)
 -> m (Dynamic
         t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))))
-> (Dynamic t (Either a b)
    -> Dynamic t (DSum (EitherTag a b) Identity))
-> Dynamic t (Either a b)
-> m (Dynamic
        t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a b -> DSum (EitherTag a b) Identity)
-> Dynamic t (Either a b)
-> Dynamic t (DSum (EitherTag a b) Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either a b -> DSum (EitherTag a b) Identity
forall a b. Either a b -> DSum (EitherTag a b) Identity
eitherToDSum
  where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)
        unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity)
-> Either (Dynamic t a) (Dynamic t b)
unpack = \case
          LeftTag :=> Compose a :: Dynamic t (Identity a)
a -> Dynamic t a -> Either (Dynamic t a) (Dynamic t b)
forall a b. a -> Either a b
Left (Dynamic t a -> Either (Dynamic t a) (Dynamic t b))
-> Dynamic t a -> Either (Dynamic t a) (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Identity a) -> Dynamic t a
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Dynamic t a -> Dynamic t b
coerceDynamic Dynamic t (Identity a)
a
          RightTag :=> Compose b :: Dynamic t (Identity a)
b -> Dynamic t b -> Either (Dynamic t a) (Dynamic t b)
forall a b. b -> Either a b
Right (Dynamic t b -> Either (Dynamic t a) (Dynamic t b))
-> Dynamic t b -> Either (Dynamic t a) (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Identity a) -> Dynamic t b
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Dynamic t a -> Dynamic t b
coerceDynamic Dynamic t (Identity a)
b

-- | Factor a 'Dynamic t DSum' into a 'Dynamic' 'DSum' containing nested 'Dynamic' values.
-- The outer 'Dynamic' updates only when the key of the 'DSum' changes, while the update of the inner
-- 'Dynamic' represents updates within the current key.
factorDyn :: forall t m k v. (Reflex t, MonadHold t m, GEq k)
          => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
factorDyn :: Dynamic t (DSum k v)
-> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
factorDyn d :: Dynamic t (DSum k v)
d = PushM t (DSum k (Compose (Dynamic t) v))
-> Event t (DSum k (Compose (Dynamic t) v))
-> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (Behavior t (DSum k v) -> PushM t (DSum k v)
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t (DSum k v) -> Behavior t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (DSum k v)
d) PushM t (DSum k v)
-> (DSum k v -> PushM t (DSum k (Compose (Dynamic t) v)))
-> PushM t (DSum k (Compose (Dynamic t) v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DSum k v -> PushM t (DSum k (Compose (Dynamic t) v))
holdKey) Event t (DSum k (Compose (Dynamic t) v))
update  where
  update :: Event t (DSum k (Compose (Dynamic t) v))
  update :: Event t (DSum k (Compose (Dynamic t) v))
update = ((DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
 -> Event t (DSum k v) -> Event t (DSum k (Compose (Dynamic t) v)))
-> Event t (DSum k v)
-> (DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k (Compose (Dynamic t) v))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k v) -> Event t (DSum k (Compose (Dynamic t) v))
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push (Dynamic t (DSum k v) -> Event t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (DSum k v)
d) ((DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
 -> Event t (DSum k (Compose (Dynamic t) v)))
-> (DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k (Compose (Dynamic t) v))
forall a b. (a -> b) -> a -> b
$ \(newKey :: k a
newKey :=> newVal :: v a
newVal) -> do
     (oldKey :: k a
oldKey :=> _) <- Behavior t (DSum k v) -> PushM t (DSum k v)
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t (DSum k v) -> Behavior t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (DSum k v)
d)
     case k a
newKey k a -> k a -> Maybe (a :~: a)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` k a
oldKey of
      Just Refl -> Maybe (DSum k (Compose (Dynamic t) v))
-> PushM t (Maybe (DSum k (Compose (Dynamic t) v)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DSum k (Compose (Dynamic t) v))
forall a. Maybe a
Nothing
      Nothing -> DSum k (Compose (Dynamic t) v)
-> Maybe (DSum k (Compose (Dynamic t) v))
forall a. a -> Maybe a
Just (DSum k (Compose (Dynamic t) v)
 -> Maybe (DSum k (Compose (Dynamic t) v)))
-> PushM t (DSum k (Compose (Dynamic t) v))
-> PushM t (Maybe (DSum k (Compose (Dynamic t) v)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DSum k v -> PushM t (DSum k (Compose (Dynamic t) v))
holdKey (k a
newKey k a -> v a -> DSum k v
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> v a
newVal)

  holdKey :: DSum k v -> PushM t (DSum k (Compose (Dynamic t) v))
holdKey (k :: k a
k :=> v :: v a
v) = do
    Event t (v a)
inner' <- k a -> Event t (DSum k v) -> PushM t (Event t (v a))
forall k1 k2 (t :: k1) (m :: * -> *) (k3 :: k2 -> *) (v :: k2 -> *)
       (a :: k2).
(Reflex t, MonadFix m, MonadHold t m, GEq k3) =>
k3 a -> Event t (DSum k3 v) -> m (Event t (v a))
filterEventKey k a
k (Dynamic t (DSum k v) -> Event t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (DSum k v)
d)
    Dynamic t (v a)
inner <- v a -> Event t (v a) -> PushM t (Dynamic t (v a))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn v a
v Event t (v a)
inner'
    DSum k (Compose (Dynamic t) v)
-> PushM t (DSum k (Compose (Dynamic t) v))
forall (m :: * -> *) a. Monad m => a -> m a
return (DSum k (Compose (Dynamic t) v)
 -> PushM t (DSum k (Compose (Dynamic t) v)))
-> DSum k (Compose (Dynamic t) v)
-> PushM t (DSum k (Compose (Dynamic t) v))
forall a b. (a -> b) -> a -> b
$ k a
k k a -> Compose (Dynamic t) v a -> DSum k (Compose (Dynamic t) v)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Dynamic t (v a) -> Compose (Dynamic t) v a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Dynamic t (v a)
inner

--------------------------------------------------------------------------------
-- Demux
--------------------------------------------------------------------------------

-- | Represents a time changing value together with an 'EventSelector' that can
-- efficiently detect when the underlying 'Dynamic' has a particular value.
-- This is useful for representing data like the current selection of a long
-- list.
--
-- Semantically,
--
-- > demuxed (demux d) k === fmap (== k) d
--
-- However, when getDemuxed is used multiple times, the complexity is only
-- /O(log(n))/, rather than /O(n)/ for fmap.
data Demux t k = Demux { Demux t k -> Behavior t k
demuxValue :: Behavior t k
                       , Demux t k -> EventSelector t (Const2 k Bool)
demuxSelector :: EventSelector t (Const2 k Bool)
                       }

-- | 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'.
demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
demux :: Dynamic t k -> Demux t k
demux k :: Dynamic t k
k = Behavior t k -> EventSelector t (Const2 k Bool) -> Demux t k
forall k (t :: k) k.
Behavior t k -> EventSelector t (Const2 k Bool) -> Demux t k
Demux (Dynamic t k -> Behavior t k
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t k
k)
                (Event t (DMap (Const2 k Bool) Identity)
-> EventSelector t (Const2 k Bool)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
Event t (DMap k2 Identity) -> EventSelector t k2
fan (Event t (DMap (Const2 k Bool) Identity)
 -> EventSelector t (Const2 k Bool))
-> Event t (DMap (Const2 k Bool) Identity)
-> EventSelector t (Const2 k Bool)
forall a b. (a -> b) -> a -> b
$ (k -> k -> DMap (Const2 k Bool) Identity)
-> Behavior t k
-> Event t k
-> Event t (DMap (Const2 k Bool) Identity)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith (\k0 :: k
k0 k1 :: k
k1 -> if k
k0 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k1
                                                then DMap (Const2 k Bool) Identity
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f
DMap.empty
                                                else [DSum (Const2 k Bool) Identity] -> DMap (Const2 k Bool) Identity
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList [k -> Const2 k Bool Bool
forall x a (b :: x). a -> Const2 a b b
Const2 k
k0 Const2 k Bool Bool
-> Identity Bool -> DSum (Const2 k Bool) Identity
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Bool -> Identity Bool
forall a. a -> Identity a
Identity Bool
False,
                                                                    k -> Const2 k Bool Bool
forall x a (b :: x). a -> Const2 a b b
Const2 k
k1 Const2 k Bool Bool
-> Identity Bool -> DSum (Const2 k Bool) Identity
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Bool -> Identity Bool
forall a. a -> Identity a
Identity Bool
True])
                                  (Dynamic t k -> Behavior t k
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t k
k) (Dynamic t k -> Event t k
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t k
k))

-- | Select a particular output of the 'Demux'; this is equivalent to (but much
-- faster than) mapping over the original 'Dynamic' and checking whether it is
-- equal to the given key.
demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
demuxed :: Demux t k -> k -> Dynamic t Bool
demuxed d :: Demux t k
d k :: k
k =
  let e :: Event t Bool
e = EventSelector t (Const2 k Bool)
-> Const2 k Bool Bool -> Event t Bool
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
select (Demux t k -> EventSelector t (Const2 k Bool)
forall k (t :: k) k. Demux t k -> EventSelector t (Const2 k Bool)
demuxSelector Demux t k
d) (k -> Const2 k Bool Bool
forall x a (b :: x). a -> Const2 a b b
Const2 k
k)
  in PullM t Bool -> Event t Bool -> Dynamic t Bool
forall k (t :: k) a.
Reflex t =>
PullM t a -> Event t a -> Dynamic t a
unsafeBuildDynamic ((k -> Bool) -> PullM t k -> PullM t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k) (PullM t k -> PullM t Bool) -> PullM t k -> PullM t Bool
forall a b. (a -> b) -> a -> b
$ Behavior t k -> PullM t k
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t k -> PullM t k) -> Behavior t k -> PullM t k
forall a b. (a -> b) -> a -> b
$ Demux t k -> Behavior t k
forall k (t :: k) k. Demux t k -> Behavior t k
demuxValue Demux t k
d) Event t Bool
e

--------------------------------------------------------------------------------
-- collectDyn
--------------------------------------------------------------------------------

--TODO: This whole section is badly in need of cleanup

-- | A heterogeneous list whose type and length are fixed statically.  This is
-- reproduced from the 'HList' package due to integration issues, and because
-- very little other functionality from that library is needed.
data HList (l::[*]) where
  HNil  :: HList '[]
  HCons :: e -> HList l -> HList (e ': l)

infixr 2 `HCons`

type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
type instance HRevApp '[] l = l
type instance HRevApp (e ': l) l' = HRevApp l (e ': l')

hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp HNil l :: HList l2
l = HList l2
HList (HRevApp l1 l2)
l
hRevApp (HCons x :: e
x l :: HList l
l) l' :: HList l2
l' = HList l -> HList (e : l2) -> HList (HRevApp l (e : l2))
forall (l1 :: [*]) (l2 :: [*]).
HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp HList l
l (e -> HList l2 -> HList (e : l2)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons e
x HList l2
l')

hReverse :: HList l -> HList (HRevApp l '[])
hReverse :: HList l -> HList (HRevApp l '[])
hReverse l :: HList l
l = HList l -> HList '[] -> HList (HRevApp l '[])
forall (l1 :: [*]) (l2 :: [*]).
HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp HList l
l HList '[]
HNil

hBuild :: (HBuild' '[] r) => r
hBuild :: r
hBuild =  HList '[] -> r
forall (l :: [*]) r. HBuild' l r => HList l -> r
hBuild' HList '[]
HNil

class HBuild' l r where
    hBuild' :: HList l -> r

instance (l' ~ HRevApp l '[])
      => HBuild' l (HList l') where
  hBuild' :: HList l -> HList l'
hBuild' = HList l -> HList l'
forall (l :: [*]). HList l -> HList (HRevApp l '[])
hReverse

instance HBuild' (a ': l) r
      => HBuild' l (a->r) where
  hBuild' :: HList l -> a -> r
hBuild' l :: HList l
l x :: a
x = HList (a : l) -> r
forall (l :: [*]) r. HBuild' l r => HList l -> r
hBuild' (a -> HList l -> HList (a : l)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons a
x HList l
l)

-- | Like 'HList', but with a functor wrapping each element.
data FHList f l where
  FHNil :: FHList f '[]
  FHCons :: f e -> FHList f l -> FHList f (e ': l)

instance GEq (HListPtr l) where
  HHeadPtr geq :: HListPtr l a -> HListPtr l b -> Maybe (a :~: b)
`geq` HHeadPtr = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  HHeadPtr `geq` HTailPtr _ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  HTailPtr _ `geq` HHeadPtr = Maybe (a :~: b)
forall a. Maybe a
Nothing
  HTailPtr a :: HListPtr t a
a `geq` HTailPtr b :: HListPtr t b
b = HListPtr t a
a HListPtr t a -> HListPtr t b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` HListPtr t b
HListPtr t b
b

instance GCompare (HListPtr l) where -- Warning: This ordering can't change, dmapTo*HList will break
  HHeadPtr gcompare :: HListPtr l a -> HListPtr l b -> GOrdering a b
`gcompare` HHeadPtr = GOrdering a b
forall k (a :: k). GOrdering a a
GEQ
  HHeadPtr `gcompare` HTailPtr _ = GOrdering a b
forall k (a :: k) (b :: k). GOrdering a b
GLT
  HTailPtr _ `gcompare` HHeadPtr = GOrdering a b
forall k (a :: k) (b :: k). GOrdering a b
GGT
  HTailPtr a :: HListPtr t a
a `gcompare` HTailPtr b :: HListPtr t b
b = HListPtr t a
a HListPtr t a -> HListPtr t b -> GOrdering a b
forall k (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> GOrdering a b
`gcompare` HListPtr t b
HListPtr t b
b

-- | A typed index into a typed heterogeneous list.
data HListPtr l a where
  HHeadPtr :: HListPtr (h ': t) h
  HTailPtr :: HListPtr t a -> HListPtr (h ': t) a

deriving instance Eq (HListPtr l a)
deriving instance Ord (HListPtr l a)

fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
fhlistToDMap :: FHList f l -> DMap (HListPtr l) f
fhlistToDMap = [DSum (HListPtr l) f] -> DMap (HListPtr l) f
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList ([DSum (HListPtr l) f] -> DMap (HListPtr l) f)
-> (FHList f l -> [DSum (HListPtr l) f])
-> FHList f l
-> DMap (HListPtr l) f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FHList f l -> [DSum (HListPtr l) f]
forall (l' :: [*]). FHList f l' -> [DSum (HListPtr l') f]
go
  where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
        go :: FHList f l' -> [DSum (HListPtr l') f]
go = \case
          FHNil -> []
          FHCons h :: f e
h t :: FHList f l
t -> (HListPtr (e : l) e
forall a (h :: a) (t :: [a]). HListPtr (h : t) h
HHeadPtr HListPtr (e : l) e -> f e -> DSum (HListPtr (e : l)) f
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> f e
h) DSum (HListPtr (e : l)) f
-> [DSum (HListPtr (e : l)) f] -> [DSum (HListPtr (e : l)) f]
forall a. a -> [a] -> [a]
: (DSum (HListPtr l) f -> DSum (HListPtr (e : l)) f)
-> [DSum (HListPtr l) f] -> [DSum (HListPtr (e : l)) f]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: HListPtr l a
p :=> v :: f a
v) -> HListPtr l a -> HListPtr (e : l) a
forall a (t :: [a]) (a :: a) (h :: a).
HListPtr t a -> HListPtr (h : t) a
HTailPtr HListPtr l a
p HListPtr (e : l) a -> f a -> DSum (HListPtr (e : l)) f
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> f a
v) (FHList f l -> [DSum (HListPtr l) f]
forall (l' :: [*]). FHList f l' -> [DSum (HListPtr l') f]
go FHList f l
t)

-- | This class allows 'HList's and 'FHlist's to be built from regular lists;
-- they must be contiguous and sorted.
class RebuildSortedHList l where
  rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
  rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l

instance RebuildSortedHList '[] where
  rebuildSortedFHList :: [DSum (HListPtr '[]) f] -> FHList f '[]
rebuildSortedFHList l :: [DSum (HListPtr '[]) f]
l = case [DSum (HListPtr '[]) f]
l of
    [] -> FHList f '[]
forall a (f :: a -> *). FHList f '[]
FHNil
    _ : _ -> String -> FHList f '[]
forall a. HasCallStack => String -> a
error "rebuildSortedFHList{'[]}: empty list expected"
  rebuildSortedHList :: [DSum (HListPtr '[]) Identity] -> HList '[]
rebuildSortedHList l :: [DSum (HListPtr '[]) Identity]
l = case [DSum (HListPtr '[]) Identity]
l of
    [] -> HList '[]
HNil
    _ : _ -> String -> HList '[]
forall a. HasCallStack => String -> a
error "rebuildSortedHList{'[]}: empty list expected"

instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
  rebuildSortedFHList :: [DSum (HListPtr (h : t)) f] -> FHList f (h : t)
rebuildSortedFHList l :: [DSum (HListPtr (h : t)) f]
l = case [DSum (HListPtr (h : t)) f]
l of
    ((HHeadPtr :=> h :: f a
h) : t :: [DSum (HListPtr (h : t)) f]
t) -> f a -> FHList f t -> FHList f (a : t)
forall a (f :: a -> *) (e :: a) (l :: [a]).
f e -> FHList f l -> FHList f (e : l)
FHCons f a
h (FHList f t -> FHList f (a : t))
-> ([DSum (HListPtr (h : t)) f] -> FHList f t)
-> [DSum (HListPtr (h : t)) f]
-> FHList f (a : t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DSum (HListPtr t) f] -> FHList f t
forall (l :: [*]) (f :: * -> *).
RebuildSortedHList l =>
[DSum (HListPtr l) f] -> FHList f l
rebuildSortedFHList ([DSum (HListPtr t) f] -> FHList f t)
-> ([DSum (HListPtr (h : t)) f] -> [DSum (HListPtr t) f])
-> [DSum (HListPtr (h : t)) f]
-> FHList f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DSum (HListPtr (h : t)) f -> DSum (HListPtr t) f)
-> [DSum (HListPtr (h : t)) f] -> [DSum (HListPtr t) f]
forall a b. (a -> b) -> [a] -> [b]
map (\(HTailPtr p :=> v :: f a
v) -> HListPtr t a
p HListPtr t a -> f a -> DSum (HListPtr t) f
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> f a
v) ([DSum (HListPtr (h : t)) f] -> FHList f (h : t))
-> [DSum (HListPtr (h : t)) f] -> FHList f (h : t)
forall a b. (a -> b) -> a -> b
$ [DSum (HListPtr (h : t)) f]
t
    _ -> String -> FHList f (h : t)
forall a. HasCallStack => String -> a
error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
  rebuildSortedHList :: [DSum (HListPtr (h : t)) Identity] -> HList (h : t)
rebuildSortedHList l :: [DSum (HListPtr (h : t)) Identity]
l = case [DSum (HListPtr (h : t)) Identity]
l of
    ((HHeadPtr :=> Identity h :: a
h) : t :: [DSum (HListPtr (h : t)) Identity]
t) -> a -> HList t -> HList (a : t)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons a
h (HList t -> HList (a : t))
-> ([DSum (HListPtr (h : t)) Identity] -> HList t)
-> [DSum (HListPtr (h : t)) Identity]
-> HList (a : t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DSum (HListPtr t) Identity] -> HList t
forall (l :: [*]).
RebuildSortedHList l =>
[DSum (HListPtr l) Identity] -> HList l
rebuildSortedHList ([DSum (HListPtr t) Identity] -> HList t)
-> ([DSum (HListPtr (h : t)) Identity]
    -> [DSum (HListPtr t) Identity])
-> [DSum (HListPtr (h : t)) Identity]
-> HList t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DSum (HListPtr (h : t)) Identity -> DSum (HListPtr t) Identity)
-> [DSum (HListPtr (h : t)) Identity]
-> [DSum (HListPtr t) Identity]
forall a b. (a -> b) -> [a] -> [b]
map (\(HTailPtr p :=> v :: Identity a
v) -> HListPtr t a
p HListPtr t a -> Identity a -> DSum (HListPtr t) Identity
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Identity a
v) ([DSum (HListPtr (h : t)) Identity] -> HList (h : t))
-> [DSum (HListPtr (h : t)) Identity] -> HList (h : t)
forall a b. (a -> b) -> a -> b
$ [DSum (HListPtr (h : t)) Identity]
t
    _ -> String -> HList (h : t)
forall a. HasCallStack => String -> a
error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"

dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
dmapToHList :: DMap (HListPtr l) Identity -> HList l
dmapToHList = [DSum (HListPtr l) Identity] -> HList l
forall (l :: [*]).
RebuildSortedHList l =>
[DSum (HListPtr l) Identity] -> HList l
rebuildSortedHList ([DSum (HListPtr l) Identity] -> HList l)
-> (DMap (HListPtr l) Identity -> [DSum (HListPtr l) Identity])
-> DMap (HListPtr l) Identity
-> HList l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap (HListPtr l) Identity -> [DSum (HListPtr l) Identity]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList

-- | Collect a hetereogeneous list whose elements are all 'Dynamic's into a
-- single 'Dynamic' whose value represents the current values of all of the
-- input 'Dynamic's.
distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
distributeFHListOverDynPure :: FHList (Dynamic t) l -> Dynamic t (HList l)
distributeFHListOverDynPure l :: FHList (Dynamic t) l
l = (DMap (HListPtr l) Identity -> HList l)
-> Dynamic t (DMap (HListPtr l) Identity) -> Dynamic t (HList l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap (HListPtr l) Identity -> HList l
forall (l :: [*]).
RebuildSortedHList l =>
DMap (HListPtr l) Identity -> HList l
dmapToHList (Dynamic t (DMap (HListPtr l) Identity) -> Dynamic t (HList l))
-> Dynamic t (DMap (HListPtr l) Identity) -> Dynamic t (HList l)
forall a b. (a -> b) -> a -> b
$ DMap (HListPtr l) (Dynamic t)
-> Dynamic t (DMap (HListPtr l) Identity)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
DMap k2 (Dynamic t) -> Dynamic t (DMap k2 Identity)
distributeDMapOverDynPure (DMap (HListPtr l) (Dynamic t)
 -> Dynamic t (DMap (HListPtr l) Identity))
-> DMap (HListPtr l) (Dynamic t)
-> Dynamic t (DMap (HListPtr l) Identity)
forall a b. (a -> b) -> a -> b
$ FHList (Dynamic t) l -> DMap (HListPtr l) (Dynamic t)
forall (f :: * -> *) (l :: [*]). FHList f l -> DMap (HListPtr l) f
fhlistToDMap FHList (Dynamic t) l
l

-- | Indicates that all elements in a type-level list are applications of the
-- same functor.
class AllAreFunctors (f :: a -> *) (l :: [a]) where
  type FunctorList f l :: [*]
  toFHList :: HList (FunctorList f l) -> FHList f l
  fromFHList :: FHList f l -> HList (FunctorList f l)

instance AllAreFunctors f '[] where
  type FunctorList f '[] = '[]
  toFHList :: HList (FunctorList f '[]) -> FHList f '[]
toFHList l :: HList (FunctorList f '[])
l = case HList (FunctorList f '[])
l of
    HNil -> FHList f '[]
forall a (f :: a -> *). FHList f '[]
FHNil
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
    _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
#endif
  fromFHList :: FHList f '[] -> HList (FunctorList f '[])
fromFHList FHNil = HList '[]
HList (FunctorList f '[])
HNil

instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
  type FunctorList f (h ': t) = f h ': FunctorList f t
  toFHList :: HList (FunctorList f (h : t)) -> FHList f (h : t)
toFHList l :: HList (FunctorList f (h : t))
l = case HList (FunctorList f (h : t))
l of
    a :: e
a `HCons` b :: HList l
b -> e
f h
a f h -> FHList f t -> FHList f (h : t)
forall a (f :: a -> *) (e :: a) (l :: [a]).
f e -> FHList f l -> FHList f (e : l)
`FHCons` HList (FunctorList f t) -> FHList f t
forall a (f :: a -> *) (l :: [a]).
AllAreFunctors f l =>
HList (FunctorList f l) -> FHList f l
toFHList HList l
HList (FunctorList f t)
b
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
    _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
#endif
  fromFHList :: FHList f (h : t) -> HList (FunctorList f (h : t))
fromFHList (a :: f e
a `FHCons` b :: FHList f l
b) = f e
a f e -> HList (FunctorList f t) -> HList (f e : FunctorList f t)
forall e (l :: [*]). e -> HList l -> HList (e : l)
`HCons` FHList f l -> HList (FunctorList f l)
forall a (f :: a -> *) (l :: [a]).
AllAreFunctors f l =>
FHList f l -> HList (FunctorList f l)
fromFHList FHList f l
b

-- | Convert a datastructure whose constituent parts are all 'Dynamic's into a
-- single 'Dynamic' whose value represents all the current values of the input's
-- constituent 'Dynamic's.
collectDynPure :: ( RebuildSortedHList (HListElems b)
                  , IsHList a, IsHList b
                  , AllAreFunctors (Dynamic t) (HListElems b)
                  , Reflex t
                  , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
                  ) => a -> Dynamic t b
collectDynPure :: a -> Dynamic t b
collectDynPure ds :: a
ds = (HList (HListElems b) -> b)
-> Dynamic t (HList (HListElems b)) -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HList (HListElems b) -> b
forall a. IsHList a => HList (HListElems a) -> a
fromHList (Dynamic t (HList (HListElems b)) -> Dynamic t b)
-> Dynamic t (HList (HListElems b)) -> Dynamic t b
forall a b. (a -> b) -> a -> b
$ FHList (Dynamic t) (HListElems b)
-> Dynamic t (HList (HListElems b))
forall k (t :: k) (l :: [*]).
(Reflex t, RebuildSortedHList l) =>
FHList (Dynamic t) l -> Dynamic t (HList l)
distributeFHListOverDynPure (FHList (Dynamic t) (HListElems b)
 -> Dynamic t (HList (HListElems b)))
-> FHList (Dynamic t) (HListElems b)
-> Dynamic t (HList (HListElems b))
forall a b. (a -> b) -> a -> b
$ HList (FunctorList (Dynamic t) (HListElems b))
-> FHList (Dynamic t) (HListElems b)
forall a (f :: a -> *) (l :: [a]).
AllAreFunctors f l =>
HList (FunctorList f l) -> FHList f l
toFHList (HList (FunctorList (Dynamic t) (HListElems b))
 -> FHList (Dynamic t) (HListElems b))
-> HList (FunctorList (Dynamic t) (HListElems b))
-> FHList (Dynamic t) (HListElems b)
forall a b. (a -> b) -> a -> b
$ a -> HList (HListElems a)
forall a. IsHList a => a -> HList (HListElems a)
toHList a
ds

-- | Poor man's 'Generic's for product types only.
class IsHList a where
  type HListElems a :: [*]
  toHList :: a -> HList (HListElems a)
  fromHList :: HList (HListElems a) -> a

instance IsHList (a, b) where
  type HListElems (a, b) = [a, b]
  toHList :: (a, b) -> HList (HListElems (a, b))
toHList (a :: a
a, b :: b
b) = a -> b -> HList '[a, b]
forall r. HBuild' '[] r => r
hBuild a
a b
b
  fromHList :: HList (HListElems (a, b)) -> (a, b)
fromHList l :: HList (HListElems (a, b))
l = case HList (HListElems (a, b))
l of
    a :: e
a `HCons` b :: e
b `HCons` HNil -> (a
e
a, b
e
b)
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
    _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
#endif

instance IsHList (a, b, c, d) where
  type HListElems (a, b, c, d) = [a, b, c, d]
  toHList :: (a, b, c, d) -> HList (HListElems (a, b, c, d))
toHList (a :: a
a, b :: b
b, c :: c
c, d :: d
d) = a -> b -> c -> d -> HList '[a, b, c, d]
forall r. HBuild' '[] r => r
hBuild a
a b
b c
c d
d
  fromHList :: HList (HListElems (a, b, c, d)) -> (a, b, c, d)
fromHList l :: HList (HListElems (a, b, c, d))
l = case HList (HListElems (a, b, c, d))
l of
    a :: e
a `HCons` b :: e
b `HCons` c :: e
c `HCons` d :: e
d `HCons` HNil -> (a
e
a, b
e
b, c
e
c, d
e
d)
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
    _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
#endif

instance IsHList (a, b, c, d, e, f) where
  type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
  toHList :: (a, b, c, d, e, f) -> HList (HListElems (a, b, c, d, e, f))
toHList (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f) = a -> b -> c -> d -> e -> f -> HList '[a, b, c, d, e, f]
forall r. HBuild' '[] r => r
hBuild a
a b
b c
c d
d e
e f
f
  fromHList :: HList (HListElems (a, b, c, d, e, f)) -> (a, b, c, d, e, f)
fromHList l :: HList (HListElems (a, b, c, d, e, f))
l = case HList (HListElems (a, b, c, d, e, f))
l of
    a :: e
a `HCons` b :: e
b `HCons` c :: e
c `HCons` d :: e
d `HCons` e :: e
e `HCons` f :: e
f `HCons` HNil -> (a
e
a, b
e
b, c
e
c, d
e
d, e
e
e, f
e
f)
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
    _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
#endif