{-# LANGUAGE TypeOperators #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.FRPNow.Time
-- Copyright   :  (c) Atze van der Ploeg 2015
-- License     :  BSD-style
-- Maintainer  :  atzeus@gmail.org
-- Stability   :  provisional
-- Portability :  portable
-- 
-- Various utility functions for FRPNow related to the passing of time.
-- All take a "clock" as an argument, i.e. a behavior that
-- gives the seconds since the program started.
--
-- The clock itself is created by a function specialized to the
-- GUI library you are using FRP with such as 'Control.FRPNow.GTK.getClock'

module Control.FRPNow.Time(localTime,timeFrac, lastInputs, bufferBehavior,delayBy, delayByN) where

import Control.FRPNow.Core
import Control.FRPNow.Lib
import Control.FRPNow.EvStream
import Data.Sequence
import Control.Applicative hiding (empty)
import Data.Foldable
import Debug.Trace




-- | When sampled at time t, gives the time since time t
localTime :: (Floating time, Ord time) =>  Behavior time -> Behavior (Behavior time)
localTime t = do n <- t
                 return ((\x -> x - n) <$> t)

-- | Gives a behavior that linearly increases from 0 to 1 in the specified duration
timeFrac :: (Floating time, Ord time) =>   Behavior time -> time -> Behavior (Behavior time)
timeFrac t d = do t' <- localTime t
                  e <- when $ (>= d) <$> t'
                  let frac = (\x -> min 1.0 (x / d)) <$> t'
                  return (frac `switch` (pure 1.0 <$ e))


-- | Tag the events in a stream with their time
tagTime :: (Floating time, Ord time) => Behavior time  -> EvStream a -> EvStream (time,a)
tagTime c s = ((,) <$> c) <@@> s

-- | Gives a behavior containing the values of the events in the stream that occured in the last n seconds
lastInputs :: (Floating time, Ord time) => 
    Behavior time -- ^ The "clock" behavior, the behavior monotonically increases with time
    -> time -- ^ The duration of the history to be kept
    -> EvStream a -- ^ The input stream
    -> Behavior (Behavior [a])
lastInputs clock dur s = do s' <- bufferStream clock dur s
                            bs <- fromChanges [] s'
                            let dropIt cur s = dropWhile (\(t,_) -> t + dur < cur) s
                            return $ (fmap snd) <$> (dropIt <$> clock <*> bs)

bufferStream :: (Floating time, Ord time)  => Behavior time  -> time -> EvStream a ->  Behavior (EvStream [(time,a)])
bufferStream clock dur s = do s' <- scanlEv addDrop empty $ tagTime clock s
                              return $  toList <$> s' where
  addDrop ss s@(last,v) = dropWhileL (\(tn,_) -> tn + dur < last) (ss |> s)


data TimeTag t a = TimeTag t a

instance Eq t => Eq (TimeTag t a) where
  (TimeTag t1 _) == (TimeTag t2 _) = t1 == t2



-- | Gives a behavior containing the values of the behavior during the last n seconds, with time stamps
bufferBehavior :: (Floating time, Ord time)  =>
      Behavior time   -- ^ The "clock" behavior, the behavior monotonically increases with time
      -> time -- ^ The duration of the history to be kept
      -> Behavior a  -- ^ The input behavior
      ->  Behavior (Behavior [(time,a)])
bufferBehavior clock dur b = fmap toList <$> foldB update empty (TimeTag <$> clock <*> b)
     where update l (TimeTag now x) = trimList (l |> (now,x)) (now - dur)
           trimList l after = loop l where
             loop l = 
               case viewl l of
                EmptyL -> empty
                (t1,v1) :< tail1 
                   | after <= t1 -> l 
                   | otherwise   -> 
                     case viewl tail1 of
                      (t2,v2) :< tail2 
                          | t2 <= after -> loop tail2
                          | otherwise   -> l


-- | Give a version of the behavior delayed by n seconds
delayBy ::  (Floating time, Ord time)  =>
       Behavior time  -- ^ The "clock" behavior, the behavior monotonically increases with time
       -> time  -- ^ The duration of the delay
       -> Behavior a -- ^ The input behavior
       -> Behavior (Behavior a)
delayBy time d b = fmap (snd . head) <$> bufferBehavior time d b


-- | Give n delayed versions of the behavior, each with the given duration in delay between them. 
delayByN :: (Floating time, Ord time)  => 
         Behavior time  -- ^ The "clock" behavior, the behavior monotonically increases with time
         -> time  -- ^ The duration _between_ delayed versions
         -> Integer -- ^ The number of delayed versions 
         -> Behavior a  -- ^ The input behavior
         -> Behavior (Behavior [a])
delayByN clock dur n b =
  let durN = (fromIntegral n) * dur
  in do samples <- bufferBehavior clock durN b
        return $ interpolateFromList <$> clock <*> samples where
  interpolateFromList now l= loop (n - 1) l where
        loop n l = 
           if n < 0 then []
           else let sampleTime = now - (fromIntegral n * dur)
                in case l of
                   [] -> []
                   [(_,v)] -> v : loop (n-1) l
                   ((t1,v1) : (t2,v2) : rest)
                    | sampleTime >= t2 -> loop n ((t2,v2) : rest)
                    | otherwise -> v1 : loop (n-1) l