-- | This is for timing of actions that's more precise than IO
-- 
--   It tells the server when to perform the actions, so musical timing won't
--   be affected by e.g. network latency or the time it took to compute a value
-- 
--   If you're running vivid on a different computer than the SC synth, make
--   sure the clocks agree

-- {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE
     FlexibleInstances
   , InstanceSigs
   , KindSignatures
   , TypeSynonymInstances
   #-}
-- {-# LANGUAGE ViewPatterns #-}

{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}

module Vivid.Actions.Scheduled (
     Scheduled

   , doScheduledInWith

   , doScheduledAtWith

   , doScheduledNowWith
   ) where

import Vivid.Actions.Class
import Vivid.Actions.IO () -- Just until we remove MonadIO
import Vivid.OSC
import Vivid.SCServer
import Vivid.SynthDef (SynthDef)

import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, mapReaderT)
import Control.Monad.State (evalStateT, put, get, modify, StateT)
import Data.ByteString (ByteString)
import Prelude

type Scheduled = ReaderT SCServerState (StateT Timestamp IO)


instance VividAction Scheduled where
   callOSC :: OSC -> Scheduled ()
   callOSC :: OSC -> Scheduled ()
callOSC OSC
message = do
      Timestamp
now <- Scheduled Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime
      (IO () -> StateT Timestamp IO ())
-> ReaderT SCServerState IO () -> Scheduled ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO () -> StateT Timestamp IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO () -> Scheduled ())
-> (OSCBundle -> ReaderT SCServerState IO ())
-> OSCBundle
-> Scheduled ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => ByteString -> m ()
callBS (ByteString -> ReaderT SCServerState IO ())
-> (OSCBundle -> ByteString)
-> OSCBundle
-> ReaderT SCServerState IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSCBundle -> ByteString
encodeOSCBundle (OSCBundle -> Scheduled ()) -> OSCBundle -> Scheduled ()
forall a b. (a -> b) -> a -> b
$ Timestamp -> [Either ByteString OSC] -> OSCBundle
OSCBundle Timestamp
now [OSC -> Either ByteString OSC
forall a b. b -> Either a b
Right OSC
message]

   callBS :: ByteString -> Scheduled ()
   callBS :: ByteString -> Scheduled ()
callBS ByteString
message = do
      Timestamp
now <- Scheduled Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime
      (IO () -> StateT Timestamp IO ())
-> ReaderT SCServerState IO () -> Scheduled ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO () -> StateT Timestamp IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO () -> Scheduled ())
-> (OSCBundle -> ReaderT SCServerState IO ())
-> OSCBundle
-> Scheduled ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => ByteString -> m ()
callBS (ByteString -> ReaderT SCServerState IO ())
-> (OSCBundle -> ByteString)
-> OSCBundle
-> ReaderT SCServerState IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSCBundle -> ByteString
encodeOSCBundle (OSCBundle -> Scheduled ()) -> OSCBundle -> Scheduled ()
forall a b. (a -> b) -> a -> b
$ Timestamp -> [Either ByteString OSC] -> OSCBundle
OSCBundle Timestamp
now [ByteString -> Either ByteString OSC
forall a b. a -> Either a b
Left ByteString
message]

   sync :: Scheduled ()
   sync :: Scheduled ()
sync = () -> Scheduled ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- always right?

   waitForSync :: SyncId -> Scheduled ()
   waitForSync :: SyncId -> Scheduled ()
waitForSync SyncId
_ = () -> Scheduled ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- always right?

   wait :: Real n => n -> Scheduled ()
   wait :: n -> Scheduled ()
wait n
t = (Timestamp -> Timestamp) -> Scheduled ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Timestamp -> Double -> Timestamp
`addSecs` n -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
t)

   getTime :: Scheduled Timestamp
   getTime :: Scheduled Timestamp
getTime = Scheduled Timestamp
forall s (m :: * -> *). MonadState s m => m s
get

   newBufferId :: Scheduled BufferId
   newBufferId :: Scheduled BufferId
newBufferId = (IO BufferId -> StateT Timestamp IO BufferId)
-> ReaderT SCServerState IO BufferId -> Scheduled BufferId
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO BufferId -> StateT Timestamp IO BufferId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO BufferId
forall (m :: * -> *). VividAction m => m BufferId
newBufferId :: ReaderT SCServerState IO BufferId)

   newNodeId :: Scheduled NodeId
   newNodeId :: Scheduled NodeId
newNodeId = (IO NodeId -> StateT Timestamp IO NodeId)
-> ReaderT SCServerState IO NodeId -> Scheduled NodeId
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO NodeId -> StateT Timestamp IO NodeId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO NodeId
forall (m :: * -> *). VividAction m => m NodeId
newNodeId :: ReaderT SCServerState IO NodeId)

   newSyncId :: Scheduled SyncId
   newSyncId :: Scheduled SyncId
newSyncId = (IO SyncId -> StateT Timestamp IO SyncId)
-> ReaderT SCServerState IO SyncId -> Scheduled SyncId
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO SyncId -> StateT Timestamp IO SyncId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO SyncId
forall (m :: * -> *). VividAction m => m SyncId
newSyncId :: ReaderT SCServerState IO SyncId)

   fork :: Scheduled () -> Scheduled ()
   fork :: Scheduled () -> Scheduled ()
fork Scheduled ()
action = do
      Timestamp
timeOfFork <- Scheduled Timestamp
forall s (m :: * -> *). MonadState s m => m s
get
      Scheduled ()
action
      Timestamp -> Scheduled ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Timestamp
timeOfFork

   defineSD :: SynthDef a -> Scheduled ()
   defineSD :: SynthDef a -> Scheduled ()
defineSD = (IO () -> StateT Timestamp IO ())
-> ReaderT SCServerState IO () -> Scheduled ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (IO () -> StateT Timestamp IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT Timestamp IO ())
-> (IO () -> IO ()) -> IO () -> StateT Timestamp IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO) (ReaderT SCServerState IO () -> Scheduled ())
-> (SynthDef a -> ReaderT SCServerState IO ())
-> SynthDef a
-> Scheduled ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynthDef a -> ReaderT SCServerState IO ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD

-- | Schedule an action to happen at the given time
doScheduledAtWith :: SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith :: SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith SCServerState
serverState Timestamp
startTime Scheduled a
action =
   let stateAction :: StateT Timestamp IO a
stateAction = Scheduled a -> SCServerState -> StateT Timestamp IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Scheduled a
action SCServerState
serverState
   in StateT Timestamp IO a -> Timestamp -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT Timestamp IO a
stateAction Timestamp
startTime

-- | Schedule an action to happen n seconds from now
doScheduledInWith :: SCServerState -> Double -> Scheduled x -> IO x
doScheduledInWith :: SCServerState -> Double -> Scheduled x -> IO x
doScheduledInWith SCServerState
serverState Double
numSecs Scheduled x
action = do
   Timestamp
now <- ReaderT SCServerState IO Timestamp -> SCServerState -> IO Timestamp
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT SCServerState IO Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime :: ReaderT SCServerState IO Timestamp) SCServerState
serverState -- Not that the server state matters here
   SCServerState -> Timestamp -> Scheduled x -> IO x
forall a. SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith SCServerState
serverState (Timestamp -> Double -> Timestamp
addSecs Timestamp
now Double
numSecs) Scheduled x
action

-- | Schedule an action to happen right now. Because of server latency this
--   could arrive late, so you might want to do something like
--   @doScheduledIn 0.01@ instead:
doScheduledNowWith :: SCServerState -> Scheduled x -> IO x
doScheduledNowWith :: SCServerState -> Scheduled x -> IO x
doScheduledNowWith SCServerState
serverState Scheduled x
action = do
   Timestamp
now <- ReaderT SCServerState IO Timestamp -> SCServerState -> IO Timestamp
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT SCServerState IO Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime :: ReaderT SCServerState IO Timestamp) SCServerState
serverState -- Not that the server state matters here
   SCServerState -> Timestamp -> Scheduled x -> IO x
forall a. SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith SCServerState
serverState Timestamp
now Scheduled x
action