{-# LANGUAGE LambdaCase #-}
-- |
--   Module:     Control.Varying.Event
--   Copyright:  (c) 2015 Schell Scivally
--   License:    MIT
--   Maintainer: Schell Scivally <schell@takt.com>
--
--  An event stream is simply a stream of @Maybe a@. This kind of stream is
--  considered to be only defined at those occurances of @Just a@. Events
--  describe things that happen at a specific time, place or any collection of
--  inputs.
--
--  For example, you can think of the event stream
--  @'VarT' 'IO' 'Double' ('Event' ())@ as an occurrence of @()@ at a specific
--  value of 'Double'. It is possible that this 'Double' is time, or it could be
--  the number of ice cream sandwiches eaten by a particular cat.
--
--  In `varying` we use event streams to dynamically update the network while it
--  is running.  For more info on switching and sequencing streams with events
--  please check out 'Control.Varying.Spline', which lets you chain together
--  sequences of values and events using a familiar do-notation.

module Control.Varying.Event
  ( -- * Event constructors (synonyms of Maybe)
    Event
  , event
  , noevent
    -- * Generating events from value streams
  , use
  , onTrue
  , onUnique
  , onWhen
    -- * Folding and gathering event streams
  , foldStream
  , startingWith, startWith
    -- * Combining multiple event streams
  , bothE
  , anyE
    -- * List-like operations on event streams
  , filterE
  , takeE
  , dropE
    -- * Primitive event streams
  , once
  , always
  , never
  , before
  , after
    -- * Switching
  , switch
    -- * Bubbling
  , onlyWhen
  , onlyWhenE
  ) where

import           Control.Applicative
import           Control.Monad
import           Control.Varying.Core
import           Data.Foldable        (foldl')
import           Prelude              hiding (until)

type Event = Maybe

-- | A synonym for the @Maybe@ constructor @Just@.
event :: a -> Event a
event = Just

-- | A synonym for the @Maybe@ constructor @Nothing@.
noevent :: Event a
noevent = Nothing
--------------------------------------------------------------------------------
-- Generating events from values
--------------------------------------------------------------------------------
-- |
-- @
-- 'use' :: 'Monad' m => b -> 'VarT' m a ('Event' x) -> 'VarT' m a ('Event' b)
-- @
--
-- Populates a varying Event with a value. This is meant to be used with
-- the various @on...@ event triggers. For example,
-- @
-- 'use' 1 'onTrue'
-- @
-- produces values of @'Event' 1@ when the input value is 'True'.
use :: (Functor f, Functor e) => a -> f (e b) -> f (e a)
use a v = (a <$) <$> v

-- | Triggers an @'Event' ()@ when the input value is 'True'.
--
-- @
-- 'use' b 'onTrue' :: 'Monad' m => 'VarT' m 'Bool' ('Event' b)
-- @
onTrue :: Monad m => VarT m Bool (Event ())
onTrue = var $ \b -> if b then Just () else Nothing

-- | Triggers an @'Event' a@ when the input is distinct from the previous
-- input.
--
-- @
-- 'use' b 'onUnique' :: ('Eq' x, 'Monad' m) => 'VarT' m x ('Event' b)
-- @
onUnique :: (Monad m, Eq a) => VarT m a (Event a)
onUnique = VarT $ \a -> return (Just a, trigger a)
    where trigger a' = VarT $ \a'' -> let e = if a' == a''
                                             then Nothing
                                             else Just a''
                                   in return (e, trigger a'')

-- | Triggers an @'Event' a@ when the condition is met.
onWhen :: Applicative m => (a -> Bool) -> VarT m a (Event a)
onWhen f = var $ \a -> if f a then Just a else Nothing
--------------------------------------------------------------------------------
-- Collecting
--------------------------------------------------------------------------------
-- | Like a left fold over all the stream's produced values.
foldStream :: Monad m => (a -> t -> a) -> a -> VarT m (Event t) a
foldStream f acc = VarT $ \e ->
    case e of
      Just  a -> let acc' = f acc a
                 in return (acc', foldStream f acc')
      Nothing -> return (acc, foldStream f acc)


-- | Produces the given value until the input events produce a value, then
-- produce that value until a new input event produces. This always holds
-- the last produced value, starting with the given value.
--
-- @
-- time '>>>' 'Control.Varying.Time.after' 3 '>>>' 'startingWith' 0
-- @
--
-- >>> :{
-- let v = onWhen (== 3) >>> startingWith 0
-- in testVarOver v [0, 1, 2, 3, 4]
-- >>> :}
-- 0
-- 0
-- 0
-- 3
-- 3
startWith, startingWith
  :: Monad m
  => a
  -> VarT m (Event a) a
startWith    = foldStream (\_ a -> a)
startingWith = startWith

-- | Stream through some number of successful 'Event's and then inhibit
-- forever.
takeE :: Monad m
      => Int -> VarT m a (Event b) -> VarT m a (Event b)
takeE 0 _ = never
takeE n ve = VarT $ \a -> do
    (eb, ve') <- runVarT ve a
    case eb of
        Nothing -> return (Nothing, takeE n ve')
        Just  b -> return (Just b, takeE (n-1) ve')

-- | Inhibit the first n occurences of an 'Event'.
dropE :: Monad m
      => Int -> VarT m a (Event b) -> VarT m a (Event b)
dropE 0 ve = ve
dropE n ve = VarT $ \a -> do
    (eb, ve') <- runVarT ve a
    case eb of
        Nothing -> return (Nothing, dropE n ve')
        Just  _ -> return (Nothing, dropE (n-1) ve')

-- | Inhibit all 'Event's that don't pass the predicate.
filterE :: Monad m
        => (b -> Bool) -> VarT m a (Event b) -> VarT m a (Event b)
filterE p v = (join . (check <$>)) <$> v
  where check b = if p b then Just b else Nothing
--------------------------------------------------------------------------------
-- Using multiple streams
--------------------------------------------------------------------------------
-- | Combine two 'Event' streams. Produces an event only when both streams proc
-- at the same time.
bothE :: Monad m
       => (a -> b -> c) -> VarT m a (Event a) -> VarT m a (Event b)
       -> VarT m a (Event c)
bothE f va vb = (\ea eb -> f <$> ea <*> eb) <$> va <*> vb

-- | Combine two 'Event' streams and produce an 'Event' any time either stream
-- produces. In the case that both streams produce, this produces the 'Event'
-- of the leftmost stream.
anyE :: Monad m => [VarT m a (Event b)] -> VarT m a (Event b)
anyE [] = never
anyE vs = VarT $ \a -> do
  outs <- mapM (`runVarT` a) vs
  let f (eb, vs1) (eb1, v) = (msum [eb, eb1], vs1 ++ [v])
  return (anyE <$> foldl' f (Nothing, []) outs)
--------------------------------------------------------------------------------
-- Primitive event streams
--------------------------------------------------------------------------------
-- | Produce the given event value once and then inhibit forever.
once :: Monad m => b -> VarT m a (Event b)
once b = VarT $ \_ -> return (Just b, never)

-- | Never produces any 'Event' values.
--
-- @
-- 'never' = 'pure' 'Nothing'
-- @
never :: Monad m => VarT m b (Event c)
never = pure Nothing

-- | Produces 'Event's with the initial value forever.
--
-- @
-- 'always' e = 'pure' ('Event' e)
-- @
always :: Monad m => b -> VarT m a (Event b)
always = pure . Just

-- | Emits events before accumulating t of input dt.
-- Note that as soon as we have accumulated >= t we stop emitting events
-- and therefore an event will never be emitted exactly at time == t.
before :: (Monad m, Num t, Ord t) => t -> VarT m t (Event t)
before t = accumulate (+) 0 >>> onWhen (< t)

-- | Emits events after t input has been accumulated.
-- Note that event emission is not guaranteed to begin exactly at t,
-- since it depends on the input.
after :: (Monad m, Num t, Ord t) => t -> VarT m t (Event t)
after t = accumulate (+) 0 >>> onWhen (>= t)

--------------------------------------------------------------------------------
-- Switching
--------------------------------------------------------------------------------
-- | Higher-order switching.
-- Use an event stream of value streams and produces event values of the latest
-- produced value stream. Switches to a new value stream each time one is
-- produced. The currently used value stream maintains local state until the
-- outer event stream produces a new value stream.
--
-- In this example we're sequencing the value streams we'd like to use and then
-- switching them when the outer event stream fires.
--
-- >>> import Control.Varying.Spline
-- >>> :{
-- let v :: VarT IO () (Event Int)
--     v = switch $ flip outputStream Nothing $ do
--           step $ Just $ 1 >>> accumulate (+) 0
--           step Nothing
--           step Nothing
--           step $ Just 5
--           step Nothing
-- in testVarOver v [(), (), (), (), ()] -- testing over five frames
-- >>> :}
-- Just 1
-- Just 2
-- Just 3
-- Just 5
-- Just 5
switch
  :: Monad m
  => VarT m a (Event (VarT m a b))
  -> VarT m a (Event b)
switch = switchGo $ pure Nothing
  where switchGo vInner v = VarT $ \a -> runVarT v a >>= \case
          (Nothing, vOuter) -> do
            (mayB, vInner1) <- runVarT vInner a
            return (mayB, switchGo vInner1 vOuter)
          (Just vInner2, vOuter) -> do
            (mayB, vInner3) <- runVarT (Just <$> vInner2) a
            return (mayB, switchGo vInner3 vOuter)

--------------------------------------------------------------------------------
-- Bubbling
--------------------------------------------------------------------------------
-- | Produce events of a stream @v@ only when an event stream @h@ produces an
-- event.
-- @v@ and @h@ maintain state while cold.
onlyWhenE :: Monad m
          => VarT m a b -- ^ @v@ - The value stream
          -> VarT m a (Event c) -- ^ @h@ - The event stream
          -> VarT m a (Event b)
onlyWhenE v hot = VarT $ \a -> do
    (e, hot') <- runVarT hot a
    case e of
      Just _ -> do (b, v') <- runVarT v a
                   return (Just b, onlyWhenE v' hot')
      _      ->  return (Nothing, onlyWhenE v hot')

-- | Produce 'Event's of a value stream @v@ only when its input value passes a
-- predicate @f@.
-- @v@ maintains state while cold.
onlyWhen :: Monad m
         => VarT m a b -- ^ @v@ - The value stream
         -> (a -> Bool) -- ^ @f@ - The predicate to run on @v@'s input values.
         -> VarT m a (Event b)
onlyWhen v f = v `onlyWhenE` hot
    where hot = var id >>> onWhen f