{-|
Module      : EventAndQList
Description : Turning qlist into timed event lists and back
Copyright   : (c) Simon Archipoff, David Janin, 2016
License     : see the LICENSE file in the distribution
Maintainer  : janin@labri.fr
Stability   : experimental

-}

{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}

{-# LANGUAGE TupleSections,
             FlexibleContexts #-}

module Runtime.EventAndQList where

import Tile.Tile
import Tile.QList
import Tile.Atom
import Reactive.Input
    
import Duration.Lattice
import Reactive.Event


import Data.List -- (sortOn,groupBy)

import Reactive.RTile
import Reactive.QState
import Reactive.TimeStamp
import Reactive.Duration

import Data.Function (on)

import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Writer.Lazy
import Control.Monad.Trans (lift)

import Debug.Trace



-- | Transforms a timed event list into a list of timed events
eventsToDelayedEvents
  :: (Ord d, Num d, Ord v, Ord iv) =>
     [(RDuration d iv, Event v)] -> [DelayedEvents d v]
eventsToDelayedEvents evts =
  let evtsg = groupBy ((==)`on`fst) evts -- pack by events at same timestamp
      f l = DelayedEvents (TimeStamp $ toConstDur . fst $ head l) (map snd l)
  in map f evtsg

-- | Transforms  a list of timed events into a timed event list
delayEventsToEvents
  :: (Ord d, Num d, Ord v, Ord iv) =>
     [DelayedEvents d v] -> [(RDuration d iv, Event v)]
delayEventsToEvents lb = 
   sortOn fst $ lb >>= \(DelayedEvents d le) -> map (durationFromConst $ getTimeStamp d,) le




-- | Loops qState (testing purposes)  
loopQState :: (Num d, Ord d, Ord iv, Ord v,POrd v, Show d, Show v, Show iv) =>
     DelayedEvents d iv
     -> StateT
          (QState d iv v , WakeUpOrder d)
          (Writer [DelayedEvents d v])
          ()
loopQState b =
  do (state,wakeuporder) <- get
     let wake = case wakeuporder of
           NoWakeUp -> Nothing
           WakeUp tswakeup -> Just tswakeup
                              -- Just converts wakeuporder into time stamp
     let (stateupdated,out, newWakuporder) =  updateStateOnEvent state b wake 
     lift $ tell (reverse out)
     put $  (stateupdated, newWakuporder)

-- | Runs a function over qlist through events exchanges (testing purposes)  
runFunOnQList  :: (Num d, Ord iv, Ord v, Ord d, POrd iv,POrd v, Show d, Show iv, Show v) =>
     (RTile d iv iv -> RTile d iv v) -> RQList d iv iv -> RQList d iv v
runFunOnQList f q =
   let bds =  (eventsToDelayedEvents $ qListToEvents q) 
       out = runFunOnBundles f bds
   in eventsToQList $ delayEventsToEvents out

runFunOnBundles
  :: (Num d, Ord v, Ord d, Ord iv, Show iv, Show d, Show v,
      POrd v) =>
     (Tile (RDuration d iv) iv iv -> Tile (RDuration d iv) iv v)
     -> [DelayedEvents d iv] -> [DelayedEvents d v]
runFunOnBundles f bsd =
  let s = initQState f
      bds' = bsd++ [DelayedEvents (TimeStamp $ fromInteger 1000000) []]
      m = mapM loopQState bds'
  in  execWriter $ runStateT m (s, NoWakeUp)



-- | Runs a function over tiles through events exchanges (testing purposes)  
runFunOnTile   :: (Num d, Ord iv, Ord v, Ord d, POrd iv,POrd v, Show d, Show iv, Show v) =>
                  (RTile d iv iv -> RTile d iv v) -> RTile d iv iv -> RTile d iv v
runFunOnTile f = fromQList . (runFunOnQList f) . toQList
               

-- * For test purpose

t1 :: RTile Integer Char Char
t1 = Tile 0 0 (QList [Atom 5 'q'] (DQ 0 QEnd))

ft1 :: Duration Integer (ID Char) -> RTile Integer Char Char
ft1 d = Tile 0 0 (QList [Atom d 'q'] (DQ 0 QEnd))

fun ::  RTile Integer Char Char -> RTile Integer Char Char
fun = (\t ->  headT t + 1 + headT t)