{-# LANGUAGE Arrows #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module LiveCoding.Cell.Util where

-- base
import Control.Arrow
import Control.Monad (join, guard)
import Control.Monad.IO.Class
import Data.Data (Data)
import Data.Foldable (toList)
import Data.Functor (void)
import Data.Maybe

-- containers
import Data.Sequence hiding (take)
import qualified Data.Sequence as Sequence

-- time
import Data.Time.Clock

-- essence-of-live-coding
import LiveCoding.Cell
import LiveCoding.Cell.Feedback
import LiveCoding.Cell.Resample (resampleMaybe)
import LiveCoding.Cell.Util.Internal

-- * State accumulation

-- | Sum all past inputs, starting by the given number
sumFrom :: Monad m => Integer -> Cell m Integer Integer
sumFrom :: Integer -> Cell m Integer Integer
sumFrom Integer
n0 = Integer
-> Cell m (Integer, Integer) (Integer, Integer)
-> Cell m Integer Integer
forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback Integer
n0 (Cell m (Integer, Integer) (Integer, Integer)
 -> Cell m Integer Integer)
-> Cell m (Integer, Integer) (Integer, Integer)
-> Cell m Integer Integer
forall a b. (a -> b) -> a -> b
$ proc (Integer
n, Integer
acc) -> Cell m (Integer, Integer) (Integer, Integer)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (Integer
acc, Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n)

-- | Count the number of ticks, starting at 0
count :: Monad m => Cell m a Integer
count :: Cell m a Integer
count = (a -> Integer) -> Cell m a Integer
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Integer -> a -> Integer
forall a b. a -> b -> a
const Integer
1) Cell m a Integer -> Cell m Integer Integer -> Cell m a Integer
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Cell m Integer Integer
forall (m :: * -> *) a. (Monad m, Num a, Data a) => Cell m a a
sumC

-- | Accumulate all incoming data,
--   using the given fold function and start value.
--   For example, if @'foldC' f b@ receives inputs @a0@, @a1@,...
--   it will output @b@, @f a0 b@, @f a1 $ f a0 b@, and so on.
foldC :: (Data b, Monad m) => (a -> b -> b) -> b -> Cell m a b
foldC :: (a -> b -> b) -> b -> Cell m a b
foldC a -> b -> b
step b
cellState = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell { b
b -> a -> m (b, b)
forall (m :: * -> *). Monad m => b -> a -> m (b, b)
cellStep :: b -> a -> m (b, b)
cellState :: b
cellStep :: forall (m :: * -> *). Monad m => b -> a -> m (b, b)
cellState :: b
.. }
  where
    cellStep :: b -> a -> m (b, b)
cellStep b
b a
a = let b' :: b
b' = a -> b -> b
step a
a b
b in (b, b) -> m (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, b
b')

-- | Like 'foldC', but does not delay the output.
foldC' :: (Data b, Monad m) => (a -> b -> b) -> b -> Cell m a b
foldC' :: (a -> b -> b) -> b -> Cell m a b
foldC' a -> b -> b
step b
cellState = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell { b
b -> a -> m (b, b)
forall (m :: * -> *). Monad m => b -> a -> m (b, b)
cellStep :: forall (m :: * -> *). Monad m => b -> a -> m (b, b)
cellState :: b
cellStep :: b -> a -> m (b, b)
cellState :: b
.. }
  where
    cellStep :: b -> a -> m (b, b)
cellStep b
b a
a = let b' :: b
b' = a -> b -> b
step a
a b
b in (b, b) -> m (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b', b
b')

-- | Initialise with a value 'a'.
--   If the input is 'Nothing', @'hold' a@ will output the stored indefinitely.
--   A new value can be stored by inputting @'Just' a@.
hold :: (Data a, Monad m) => a -> Cell m (Maybe a) a
hold :: a -> Cell m (Maybe a) a
hold a
a = a -> Cell m (Maybe a, a) (a, a) -> Cell m (Maybe a) a
forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback a
a (Cell m (Maybe a, a) (a, a) -> Cell m (Maybe a) a)
-> Cell m (Maybe a, a) (a, a) -> Cell m (Maybe a) a
forall a b. (a -> b) -> a -> b
$ proc (Maybe a
ma, a
aOld) -> do
  let aNew :: a
aNew = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
aOld Maybe a
ma
  Cell m (a, a) (a, a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
aNew, a
aNew)

-- | Outputs @'Just' a@ whenever the the value a changes and 'Nothing' otherwise.
--  The first output is always 'Nothing'. The following holds:
--
--  @
--    delay a >>> changes >>> hold a == delay a
--  @
changes
  :: (Data a, Eq a, Monad m) 
  => Cell m a (Maybe a)
changes :: Cell m a (Maybe a)
changes = proc a
a -> do
  Maybe a
aLast <- Maybe a -> Cell m (Maybe a) (Maybe a)
forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay Maybe a
forall a. Maybe a
Nothing -< a -> Maybe a
forall a. a -> Maybe a
Just a
a
  Cell m (Maybe a) (Maybe a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< do
      a
aLast' <- Maybe a
aLast
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
aLast'
      a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Like 'hold', but returns 'Nothing' until it is initialised by a @'Just' a@ value.
holdJust
  :: (Monad m, Data a)
  => Cell m (Maybe a) (Maybe a)
holdJust :: Cell m (Maybe a) (Maybe a)
holdJust = Maybe a
-> Cell m (Maybe a, Maybe a) (Maybe a, Maybe a)
-> Cell m (Maybe a) (Maybe a)
forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback Maybe a
forall a. Maybe a
Nothing (Cell m (Maybe a, Maybe a) (Maybe a, Maybe a)
 -> Cell m (Maybe a) (Maybe a))
-> Cell m (Maybe a, Maybe a) (Maybe a, Maybe a)
-> Cell m (Maybe a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ ((Maybe a, Maybe a) -> (Maybe a, Maybe a))
-> Cell m (Maybe a, Maybe a) (Maybe a, Maybe a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Maybe a, Maybe a) -> (Maybe a, Maybe a)
forall a. (Maybe a, Maybe a) -> (Maybe a, Maybe a)
keep
  where
    keep :: (Maybe a, Maybe a) -> (Maybe a, Maybe a)
keep (Maybe a
Nothing, Maybe a
Nothing) = (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
    keep (Maybe a
_, Just a
a) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
    keep (Just a
a, Maybe a
Nothing) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- | Hold the first value and output it indefinitely.
holdFirst :: (Data a, Monad m) => Cell m a a
holdFirst :: Cell m a a
holdFirst = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell { Maybe a
Maybe a -> a -> m (a, Maybe a)
forall a. Maybe a
forall (m :: * -> *) a. Monad m => Maybe a -> a -> m (a, Maybe a)
cellStep :: forall (m :: * -> *) a. Monad m => Maybe a -> a -> m (a, Maybe a)
cellState :: forall a. Maybe a
cellStep :: Maybe a -> a -> m (a, Maybe a)
cellState :: Maybe a
.. }
  where
    cellState :: Maybe a
cellState = Maybe a
forall a. Maybe a
Nothing
    cellStep :: Maybe a -> a -> m (a, Maybe a)
cellStep Maybe a
Nothing a
x = (a, Maybe a) -> m (a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    cellStep (Just a
s) a
_ = (a, Maybe a) -> m (a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
s, a -> Maybe a
forall a. a -> Maybe a
Just a
s)

-- | @boundedFIFO n@ keeps the first @n@ present values.
boundedFIFO :: (Data a, Monad m) => Int -> Cell m (Maybe a) (Seq a)
boundedFIFO :: Int -> Cell m (Maybe a) (Seq a)
boundedFIFO Int
n = (Maybe a -> Seq a -> Seq a) -> Seq a -> Cell m (Maybe a) (Seq a)
forall b (m :: * -> *) a.
(Data b, Monad m) =>
(a -> b -> b) -> b -> Cell m a b
foldC' Maybe a -> Seq a -> Seq a
forall a. Maybe a -> Seq a -> Seq a
step Seq a
forall a. Seq a
empty
  where
    step :: Maybe a -> Seq a -> Seq a
step Maybe a
Nothing  Seq a
as = Seq a
as
    step (Just a
a) Seq a
as = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Sequence.take Int
n (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
as

-- | Buffers and returns the elements in First-In-First-Out order,
--   returning 'Nothing' whenever the buffer is empty.
fifo :: (Monad m, Data a) => Cell m (Seq a) (Maybe a)
fifo :: Cell m (Seq a) (Maybe a)
fifo = Seq a
-> Cell m (Seq a, Seq a) (Maybe a, Seq a)
-> Cell m (Seq a) (Maybe a)
forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback Seq a
forall a. Seq a
empty (Cell m (Seq a, Seq a) (Maybe a, Seq a)
 -> Cell m (Seq a) (Maybe a))
-> Cell m (Seq a, Seq a) (Maybe a, Seq a)
-> Cell m (Seq a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ proc (Seq a
as, Seq a
accum) -> do
  let accum' :: Seq a
accum' = Seq a
accum Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
as
  Cell m (Maybe a, Seq a) (Maybe a, Seq a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< case Seq a
accum' of
    Seq a
Empty    -> (Maybe a
forall a. Maybe a
Nothing, Seq a
forall a. Seq a
empty)
    a
a :<| Seq a
as -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a , Seq a
as)

-- | Like 'fifo', but accepts lists as input.
--   Each step is O(n) in the length of the list.
fifoList :: (Monad m, Data a) => Cell m [a] (Maybe a)
fifoList :: Cell m [a] (Maybe a)
fifoList = ([a] -> Seq a) -> Cell m [a] (Seq a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [a] -> Seq a
forall a. [a] -> Seq a
fromList Cell m [a] (Seq a)
-> Cell m (Seq a) (Maybe a) -> Cell m [a] (Maybe a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Cell m (Seq a) (Maybe a)
forall (m :: * -> *) a.
(Monad m, Data a) =>
Cell m (Seq a) (Maybe a)
fifo

-- | Like 'fifoList', but generalised to any 'Foldable'.
fifoFoldable :: (Monad m, Data a, Foldable f) => Cell m (f a) (Maybe a)
fifoFoldable :: Cell m (f a) (Maybe a)
fifoFoldable = (f a -> [a]) -> Cell m (f a) [a]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Cell m (f a) [a] -> Cell m [a] (Maybe a) -> Cell m (f a) (Maybe a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Cell m [a] (Maybe a)
forall (m :: * -> *) a. (Monad m, Data a) => Cell m [a] (Maybe a)
fifoList

-- | Returns 'True' iff the current input value is 'True' and the last input value was 'False'.
edge :: Monad m => Cell m Bool Bool
edge :: Cell m Bool Bool
edge = proc Bool
b -> do
  Bool
bLast <- Bool -> Cell m Bool Bool
forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay Bool
False -< Bool
b
  Cell m Bool Bool
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Bool
b Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
bLast

-- * Debugging utilities

-- | Print the current UTC time, prepended with the first 8 characters of the given message.
printTime :: MonadIO m => String -> m ()
printTime :: String -> m ()
printTime String
msg = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> (UTCTime -> String) -> UTCTime -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
8 String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (UTCTime -> String) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show (UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime

-- | Like 'printTime', but as a cell.
printTimeC :: MonadIO m => String -> Cell m () ()
printTimeC :: String -> Cell m () ()
printTimeC String
msg = m () -> Cell m () ()
forall (m :: * -> *) b a. m b -> Cell m a b
constM (m () -> Cell m () ()) -> m () -> Cell m () ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
printTime String
msg

-- * Buffers

-- | A command to send to 'buffer'.
data BufferCommand a
  = Push a
  -- ^ Add an 'a' to the buffer.
  | Pop
  -- ^ Remove the oldest element from the buffer.

-- | Pushes @'Just' a@ and does nothing on 'Nothing'.
maybePush :: Maybe a -> [BufferCommand a]
maybePush :: Maybe a -> [BufferCommand a]
maybePush = (a -> BufferCommand a
forall a. a -> BufferCommand a
Push (a -> BufferCommand a) -> [a] -> [BufferCommand a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([a] -> [BufferCommand a])
-> (Maybe a -> [a]) -> Maybe a -> [BufferCommand a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList

-- | Pops on @'Just' a@ and does nothing on 'Nothing'.
maybePop :: Maybe a -> [BufferCommand b]
maybePop :: Maybe a -> [BufferCommand b]
maybePop = (BufferCommand b -> a -> BufferCommand b
forall a b. a -> b -> a
const BufferCommand b
forall a. BufferCommand a
Pop (a -> BufferCommand b) -> [a] -> [BufferCommand b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([a] -> [BufferCommand b])
-> (Maybe a -> [a]) -> Maybe a -> [BufferCommand b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList

{- | Single-consumer, multi-producer buffer.

The output value is the oldest value in the buffer,
if it exists.

* Add elements by inputting @'Push' a@.
* Remove elements by inputting 'Pop'.
-}
buffer :: (Monad m, Data a) => Cell m [BufferCommand a] (Maybe a)
buffer :: Cell m [BufferCommand a] (Maybe a)
buffer = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell { Seq a
Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
forall a. Seq a
forall (m :: * -> *) a.
Monad m =>
Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellStep :: forall (m :: * -> *) a.
Monad m =>
Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellState :: forall a. Seq a
cellStep :: Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellState :: Seq a
.. }
  where
    cellState :: Seq a
cellState = Seq a
forall a. Seq a
empty
    cellStep :: Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellStep Seq a
as [BufferCommand a]
commands = (Maybe a, Seq a) -> m (Maybe a, Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> Maybe a
forall a. Seq a -> Maybe a
currentHead Seq a
as, Seq a -> [BufferCommand a] -> Seq a
forall a. Seq a -> [BufferCommand a] -> Seq a
nextBuffer Seq a
as [BufferCommand a]
commands)
    currentHead :: Seq a -> Maybe a
currentHead Seq a
as = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
as of
      ViewL a
EmptyL   -> Maybe a
forall a. Maybe a
Nothing
      a
a :< Seq a
as' -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    nextBuffer :: Seq a -> [BufferCommand a] -> Seq a
nextBuffer Seq a
as [] = Seq a
as
    nextBuffer Seq a
as (Push a
a : [BufferCommand a]
commands) = Seq a -> [BufferCommand a] -> Seq a
nextBuffer (Seq a
as Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a) [BufferCommand a]
commands
    nextBuffer Seq a
as (BufferCommand a
Pop : [BufferCommand a]
commands) = Seq a -> [BufferCommand a] -> Seq a
nextBuffer (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Sequence.drop Int
1 Seq a
as) [BufferCommand a]
commands

{- | Equip a 'Cell' with a 'buffer'.

* Whenever @'Just' a@ value enters @buffered cell@,
  it is added to the buffer.
* Whenever @cell@ emits @'Just' b@,
  the oldest value is dropped from the buffer.
* @cell@ is always fed with 'Just' the oldest value from the buffer,
  except when the buffer is empty, then it is fed 'Nothing'.

This construction guarantees that @cell@ produces exactly one output for every input value.
-}
buffered
  :: (Monad m, Data a)
  => Cell m (Maybe a) (Maybe b)
  -> Cell m (Maybe a) (Maybe b)
buffered :: Cell m (Maybe a) (Maybe b) -> Cell m (Maybe a) (Maybe b)
buffered Cell m (Maybe a) (Maybe b)
cell = Maybe ()
-> Cell m (Maybe a, Maybe ()) (Maybe b, Maybe ())
-> Cell m (Maybe a) (Maybe b)
forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback Maybe ()
forall a. Maybe a
Nothing (Cell m (Maybe a, Maybe ()) (Maybe b, Maybe ())
 -> Cell m (Maybe a) (Maybe b))
-> Cell m (Maybe a, Maybe ()) (Maybe b, Maybe ())
-> Cell m (Maybe a) (Maybe b)
forall a b. (a -> b) -> a -> b
$ proc (Maybe a
aMaybe, Maybe ()
ticked) -> do
  Maybe a
aMaybe' <- Cell m [BufferCommand a] (Maybe a)
forall (m :: * -> *) a.
(Monad m, Data a) =>
Cell m [BufferCommand a] (Maybe a)
buffer -< Maybe () -> [BufferCommand a]
forall a b. Maybe a -> [BufferCommand b]
maybePop Maybe ()
ticked [BufferCommand a] -> [BufferCommand a] -> [BufferCommand a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [BufferCommand a]
forall a. Maybe a -> [BufferCommand a]
maybePush Maybe a
aMaybe
  Maybe b
bMaybe' <- Cell m (Maybe a) (Maybe b)
cell   -< Maybe a
aMaybe'
  Cell m (Maybe b, Maybe ()) (Maybe b, Maybe ())
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA           -< (Maybe b
bMaybe', Maybe b -> Maybe ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Maybe b
bMaybe')

-- * Detecting change

{- | Perform an action whenever the parameter @p@ changes, and the code is reloaded.

Note that this does not trigger any actions when adding, or removing an 'onChange' cell.
For this functionality, see "LiveCoding.Handle".
Also, when moving such a cell, the action may not be triggered reliably.
-}
onChange
  :: (Monad m, Data p, Eq p)
  => p -- ^ This parameter has to change during live coding to trigger an action
  -> (p -> p -> a -> m b) -- ^ This action gets passed the old parameter and the new parameter
  -> Cell m a (Maybe b)
onChange :: p -> (p -> p -> a -> m b) -> Cell m a (Maybe b)
onChange p
p p -> p -> a -> m b
action = proc a
a -> do
  p
pCurrent <- (() -> p) -> Cell m () p
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((() -> p) -> Cell m () p) -> (() -> p) -> Cell m () p
forall a b. (a -> b) -> a -> b
$ p -> () -> p
forall a b. a -> b -> a
const p
p -< ()
  p
pPrevious <- p -> Cell m p p
forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay p
p -< p
pCurrent
  ((p, p, a) -> m (Maybe b)) -> Cell m (p, p, a) (Maybe b)
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM (((p, p, a) -> m (Maybe b)) -> Cell m (p, p, a) (Maybe b))
-> ((p, p, a) -> m (Maybe b)) -> Cell m (p, p, a) (Maybe b)
forall a b. (a -> b) -> a -> b
$ (p -> p -> a -> m b) -> (p, p, a) -> m (Maybe b)
forall p (m :: * -> *) a b.
(Eq p, Monad m) =>
(p -> p -> a -> m b) -> (p, p, a) -> m (Maybe b)
whenDifferent p -> p -> a -> m b
action -< (p
pCurrent, p
pPrevious, a
a)

-- | Like 'onChange'', but with a dynamic input.
onChange'
  :: (Monad m, Data p, Eq p)
  => (p -> p -> a -> m b) -- ^ This action gets passed the old parameter and the new parameter
  -> Cell m (p, a) (Maybe b)
onChange' :: (p -> p -> a -> m b) -> Cell m (p, a) (Maybe b)
onChange' p -> p -> a -> m b
action = proc (p
pCurrent, a
a) -> do
  Maybe p
pPrevious <- Maybe p -> Cell m (Maybe p) (Maybe p)
forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay Maybe p
forall a. Maybe a
Nothing -< p -> Maybe p
forall a. a -> Maybe a
Just p
pCurrent
  Maybe (Maybe b)
bMaybeMaybe <- Cell m (p, p, a) (Maybe b)
-> Cell m (Maybe (p, p, a)) (Maybe (Maybe b))
forall (m :: * -> *) a b.
Monad m =>
Cell m a b -> Cell m (Maybe a) (Maybe b)
resampleMaybe (Cell m (p, p, a) (Maybe b)
 -> Cell m (Maybe (p, p, a)) (Maybe (Maybe b)))
-> Cell m (p, p, a) (Maybe b)
-> Cell m (Maybe (p, p, a)) (Maybe (Maybe b))
forall a b. (a -> b) -> a -> b
$ ((p, p, a) -> m (Maybe b)) -> Cell m (p, p, a) (Maybe b)
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM (((p, p, a) -> m (Maybe b)) -> Cell m (p, p, a) (Maybe b))
-> ((p, p, a) -> m (Maybe b)) -> Cell m (p, p, a) (Maybe b)
forall a b. (a -> b) -> a -> b
$ (p -> p -> a -> m b) -> (p, p, a) -> m (Maybe b)
forall p (m :: * -> *) a b.
(Eq p, Monad m) =>
(p -> p -> a -> m b) -> (p, p, a) -> m (Maybe b)
whenDifferent p -> p -> a -> m b
action -< ( , p
pCurrent, a
a) (p -> (p, p, a)) -> Maybe p -> Maybe (p, p, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe p
pPrevious
  Cell m (Maybe b) (Maybe b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe (Maybe b) -> Maybe b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe b)
bMaybeMaybe