{-# LANGUAGE
     BangPatterns
   , InstanceSigs
   #-}

module Vivid.GlobalState (
     withGlobalSCServerState
   , setClientId
   , setMaxBufferIds
   , waitForSync_io
   , waitForSync_io_noGC
   , startMailbox
   , getMailboxForSyncId
   , connectToSCServer
   , createSCServerConnection
   , closeSCServerConnection
   , getSCServerSocket
   , doScheduledIn
   , doScheduledAt
   , doScheduledNow
   , quitSCServer
   , defineSDFromFile

   -- Not sure we need to export these:
   , getNextAvailables
   , getNextAvailable
   ) where

import Control.Concurrent (ThreadId, forkIO)
import Control.Concurrent.MVar (MVar)
import Control.Concurrent.STM
import Control.Monad.Reader
import Data.ByteString (ByteString)
import Data.Int
import Network.Socket (Socket)

-- We use this only for "the unsafePerformIO hack"
-- (https://wiki.haskell.org/Top_level_mutable_state) so that functions can
-- refer to the state without being passed the state explicitly. This should
-- still be safe:
import System.IO.Unsafe (unsafePerformIO)

import Vivid.Actions (quitSCServerWith)
import Vivid.Actions.Class (VividAction(..))
import Vivid.Actions.IO (defineSDFromFileWith)
import Vivid.Actions.Scheduled
import Vivid.OSC (Timestamp)
import Vivid.SCServer.Connection
import Vivid.SCServer.State
import Vivid.SynthDef.Types (SynthDef)

{-# NOINLINE globalSCServerState #-}
globalSCServerState :: SCServerState
-- See the above note about this use of unsafePerformIO:
globalSCServerState :: SCServerState
globalSCServerState = IO SCServerState -> SCServerState
forall a. IO a -> a
unsafePerformIO IO SCServerState
makeEmptySCServerState

withGlobalSCServerState :: (SCServerState -> x) -> x
withGlobalSCServerState :: (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> x
action =
   -- This line is meant to prevent 'nested STM' errors.
   -- Would like a more systematic look at the causes.:
   let !SCServerState
_ = SCServerState
globalSCServerState

   in SCServerState -> x
action SCServerState
globalSCServerState


setClientId :: Int32 -> IO ()
setClientId :: Int32 -> IO ()
setClientId = (SCServerState -> Int32 -> IO ()) -> Int32 -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> Int32 -> IO ()
setServerClientId

setMaxBufferIds :: Int32 -> IO ()
setMaxBufferIds :: Int32 -> IO ()
setMaxBufferIds = (SCServerState -> Int32 -> IO ()) -> Int32 -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> Int32 -> IO ()
setServerMaxBufferIds

getNextAvailable :: (SCServerState -> TVar [a]) -> IO a
getNextAvailable :: (SCServerState -> TVar [a]) -> IO a
getNextAvailable = (SCServerState -> (SCServerState -> TVar [a]) -> IO a)
-> (SCServerState -> TVar [a]) -> IO a
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> (SCServerState -> TVar [a]) -> IO a
forall a. SCServerState -> (SCServerState -> TVar [a]) -> IO a
getNextAvailable'

getNextAvailables :: Int -> (SCServerState -> TVar [a]) -> IO [a]
getNextAvailables :: Int -> (SCServerState -> TVar [a]) -> IO [a]
getNextAvailables = (SCServerState -> Int -> (SCServerState -> TVar [a]) -> IO [a])
-> Int -> (SCServerState -> TVar [a]) -> IO [a]
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> Int -> (SCServerState -> TVar [a]) -> IO [a]
forall a.
SCServerState -> Int -> (SCServerState -> TVar [a]) -> IO [a]
getNextAvailables'


closeSCServerConnection :: IO ()
closeSCServerConnection :: IO ()
closeSCServerConnection = (SCServerState -> IO ()) -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> IO ()
closeSCServerConnection'

connectToSCServer :: SCConnectConfig -> IO (Socket, ThreadId)
connectToSCServer :: SCConnectConfig -> IO (Socket, ThreadId)
connectToSCServer = (SCServerState -> SCConnectConfig -> IO (Socket, ThreadId))
-> SCConnectConfig -> IO (Socket, ThreadId)
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> SCConnectConfig -> IO (Socket, ThreadId)
connectToSCServer'

waitForSync_io :: SyncId -> IO ()
waitForSync_io :: SyncId -> IO ()
waitForSync_io = (SCServerState -> SyncId -> IO ()) -> SyncId -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> SyncId -> IO ()
waitForSync_io'

waitForSync_io_noGC :: SyncId -> IO ()
waitForSync_io_noGC :: SyncId -> IO ()
waitForSync_io_noGC = (SCServerState -> SyncId -> IO ()) -> SyncId -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> SyncId -> IO ()
waitForSync_io_noGC'

startMailbox :: Socket -> IO ()
startMailbox :: Socket -> IO ()
startMailbox = (SCServerState -> Socket -> IO ()) -> Socket -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> Socket -> IO ()
startMailbox'

getMailboxForSyncId :: SyncId -> IO (MVar ())
getMailboxForSyncId :: SyncId -> IO (MVar ())
getMailboxForSyncId = (SCServerState -> SyncId -> IO (MVar ())) -> SyncId -> IO (MVar ())
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> SyncId -> IO (MVar ())
getMailboxForSyncId'

createSCServerConnection :: SCConnectConfig -> IO (Either String Socket)
createSCServerConnection :: SCConnectConfig -> IO (Either String Socket)
createSCServerConnection = (SCServerState -> SCConnectConfig -> IO (Either String Socket))
-> SCConnectConfig -> IO (Either String Socket)
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> SCConnectConfig -> IO (Either String Socket)
createSCServerConnection'

getSCServerSocket :: IO Socket
getSCServerSocket :: IO Socket
getSCServerSocket = (SCServerState -> IO Socket) -> IO Socket
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> IO Socket
getSCServerSocket'

defineSDFromFile :: SynthDef a -> IO ()
defineSDFromFile :: SynthDef a -> IO ()
defineSDFromFile = (SCServerState -> SynthDef a -> IO ()) -> SynthDef a -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> SynthDef a -> IO ()
forall (a :: [Symbol]). SCServerState -> SynthDef a -> IO ()
defineSDFromFileWith

doScheduledAt :: Timestamp -> Scheduled a -> IO a
doScheduledAt :: Timestamp -> Scheduled a -> IO a
doScheduledAt =
   (SCServerState -> Timestamp -> Scheduled a -> IO a)
-> Timestamp -> Scheduled a -> IO a
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> Timestamp -> Scheduled a -> IO a
forall a. SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith

doScheduledIn :: Double -> Scheduled a -> IO a
doScheduledIn :: Double -> Scheduled a -> IO a
doScheduledIn =
   (SCServerState -> Double -> Scheduled a -> IO a)
-> Double -> Scheduled a -> IO a
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> Double -> Scheduled a -> IO a
forall x. SCServerState -> Double -> Scheduled x -> IO x
doScheduledInWith

doScheduledNow :: Scheduled a -> IO a
doScheduledNow :: Scheduled a -> IO a
doScheduledNow =
   (SCServerState -> Scheduled a -> IO a) -> Scheduled a -> IO a
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> Scheduled a -> IO a
forall x. SCServerState -> Scheduled x -> IO x
doScheduledNowWith

quitSCServer :: IO ()
quitSCServer :: IO ()
quitSCServer = (SCServerState -> IO ()) -> IO ()
forall x. (SCServerState -> x) -> x
withGlobalSCServerState SCServerState -> IO ()
quitSCServerWith

instance VividAction IO where
   callBS :: ByteString -> IO ()
   callBS :: ByteString -> IO ()
callBS ByteString
bs = ReaderT SCServerState IO () -> IO ()
forall x. ReaderT SCServerState IO x -> IO x
globalIO (ReaderT SCServerState IO () -> IO ())
-> ReaderT SCServerState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => ByteString -> m ()
callBS ByteString
bs

   sync :: IO ()
   sync :: IO ()
sync = ReaderT SCServerState IO () -> IO ()
forall x. ReaderT SCServerState IO x -> IO x
globalIO ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => m ()
sync

   waitForSync :: SyncId -> IO ()
   waitForSync :: SyncId -> IO ()
waitForSync SyncId
syncId = ReaderT SCServerState IO () -> IO ()
forall x. ReaderT SCServerState IO x -> IO x
globalIO (ReaderT SCServerState IO () -> IO ())
-> ReaderT SCServerState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SyncId -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => SyncId -> m ()
waitForSync SyncId
syncId

   wait :: Real n => n -> IO ()
   wait :: n -> IO ()
wait n
n = ReaderT SCServerState IO () -> IO ()
forall x. ReaderT SCServerState IO x -> IO x
globalIO (ReaderT SCServerState IO () -> IO ())
-> ReaderT SCServerState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ n -> ReaderT SCServerState IO ()
forall (m :: * -> *) n. (VividAction m, Real n) => n -> m ()
wait n
n

   getTime :: IO Timestamp
   getTime :: IO Timestamp
getTime = ReaderT SCServerState IO Timestamp -> IO Timestamp
forall x. ReaderT SCServerState IO x -> IO x
globalIO ReaderT SCServerState IO Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime

   newBufferId :: IO BufferId
   newBufferId :: IO BufferId
newBufferId = ReaderT SCServerState IO BufferId -> IO BufferId
forall x. ReaderT SCServerState IO x -> IO x
globalIO ReaderT SCServerState IO BufferId
forall (m :: * -> *). VividAction m => m BufferId
newBufferId

   newNodeId :: IO NodeId
   newNodeId :: IO NodeId
newNodeId = ReaderT SCServerState IO NodeId -> IO NodeId
forall x. ReaderT SCServerState IO x -> IO x
globalIO ReaderT SCServerState IO NodeId
forall (m :: * -> *). VividAction m => m NodeId
newNodeId

   newSyncId :: IO SyncId
   newSyncId :: IO SyncId
newSyncId = ReaderT SCServerState IO SyncId -> IO SyncId
forall x. ReaderT SCServerState IO x -> IO x
globalIO ReaderT SCServerState IO SyncId
forall (m :: * -> *). VividAction m => m SyncId
newSyncId

   fork :: IO () -> IO ()
   fork :: IO () -> IO ()
fork = 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

   defineSD :: SynthDef a -> IO ()
   defineSD :: SynthDef a -> IO ()
defineSD SynthDef a
synthDef = ReaderT SCServerState IO () -> IO ()
forall x. ReaderT SCServerState IO x -> IO x
globalIO (ReaderT SCServerState IO () -> IO ())
-> ReaderT SCServerState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SynthDef a -> ReaderT SCServerState IO ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef a
synthDef

globalIO :: (ReaderT SCServerState IO x) -> IO x
globalIO :: ReaderT SCServerState IO x -> IO x
globalIO ReaderT SCServerState IO x
action =
   (SCServerState -> IO x) -> IO x
forall x. (SCServerState -> x) -> x
withGlobalSCServerState (ReaderT SCServerState IO x -> SCServerState -> IO x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT SCServerState IO x
action)