content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE LambdaCase #-}
  
  {-# LANGUAGE NoIncoherentInstances #-}
  {-# LANGUAGE NoMonomorphismRestriction #-}
  {-# LANGUAGE NoUndecidableInstances #-}
  
  module Vivid.SCServer.State (
       BufferId(..)
     , NodeId(..)
     , SyncId(..)
  
     , scServerState
     , SCServerState(..)
  
     , setClientId
     , setMaxBufferIds
  
     , getNextAvailable
     , numberOfSyncIdsToDrop
     ) where
  
  import Vivid.OSC (OSC)
  import Vivid.SC.Server.Types
  import Vivid.SynthDef.Types
  
  import Network.Socket (Socket)
  
  import Control.Concurrent (ThreadId)
  import Control.Concurrent.MVar
  import Control.Concurrent.STM -- (readTVar, atomically, writeTVar, newTVar, TVar, TMVar)
  import Control.Monad (when)
  import Data.Bits
  import Data.Int (Int32)
  -- import Data.IORef
  import qualified Data.Map as Map
  import Data.Map (Map)
  import qualified Data.Set as Set
  import Data.Set (Set)
  import Prelude
  
  -- 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)
  
  {-# NOINLINE scServerState #-}
  scServerState :: SCServerState
  -- Currently you can only be connected to one SC server at a time. Future
  --   versions plan to remove this.
  -- See the above note about this use of unsafePerformIO:
  scServerState = unsafePerformIO makeEmptySCServerState
  
  data SCServerState
     = SCServerState
     -- We use 'IORef Maybe's instead of MVars so we can use weak pointer
     --   finalizers with older versions of GHC:
    { _scServerState_socketConnectStarted :: TVar Bool
    , _scServerState_socket :: !(TMVar Socket) -- !(TVar (Maybe Socket))
    , _scServerState_listener :: !(TMVar ThreadId) -- !(TVar (Maybe ThreadId))
  
    , _scServerState_availableBufferIds :: !(TVar [BufferId])
    , _scServerState_maxBufIds :: !(TVar Int32)
    , _scServerState_availableNodeIds :: !(TVar [NodeId])
    , _scServerState_availableSyncIds :: !(TVar [SyncId])
    , _scServerState_syncIdMailboxes :: !(TVar (Map SyncId (MVar ())))
    , _scServerState_serverMessageFunction :: !(TVar (OSC -> IO ()))
    , _scServerState_definedSDs :: !(TVar (Set (SDName, Int))) -- Int is the hash
    }
  
  setClientId :: Int32 -> IO ()
  setClientId clientId = do
     when (clientId < 0 || clientId > 31) $
        error "client id must be betw 0 and 31"
     atomically $ writeTVar (_scServerState_availableNodeIds scServerState) $
        -- The client id is the first 5 bits of a positive int:
        -- Note the incrementing gets weird once we hit the (.&.) -- should
        -- fix if anyone plans to use more than 33 million nodes
        (flip map) [1000..] $ \nodeNum -> NodeId $
           ((clientId `shiftL` ((finiteBitSize nodeNum-5)-1)) .|.) $
              ((maxBound `shiftR` 5) .&. nodeNum)
  
  numberOfSyncIdsToDrop :: Int
  numberOfSyncIdsToDrop = 10000
  
  makeEmptySCServerState :: IO SCServerState
  -- We don't do this with 'atomically' because you can't put 'atomically' in
  --   'unsafePerformIO' (or, apparently you can with the "!_ =" hack I was
  --   doing, but let's do the recommended way):
  makeEmptySCServerState = do -- atomically $ do
     sockConnectStarted <- newTVarIO False
     sockIORef <- newEmptyTMVarIO -- newTVar Nothing -- newIORef Nothing
     listenerIORef <- newEmptyTMVarIO -- newTVar Nothing -- newIORef Nothing
  
     availBufIds <- newTVarIO $ drop 512 $ map BufferId [0..]
     -- these'll be allocated when we connect (and get a clientId):
     availNodeIds <- newTVarIO $ map (NodeId . ((1 `shiftL` 26) .|.)) [1000..]
     maxBufIds <- newTVarIO 1024
     syncIds <- newTVarIO $ drop numberOfSyncIdsToDrop $ map SyncId [0..]
     syncMailboxes <- newTVarIO $ Map.empty
     serverMessageFunction <- newTVarIO $ \_ -> return ()
     definedSDs <- newTVarIO $ Set.empty
  
     return $ SCServerState
            { _scServerState_socketConnectStarted = sockConnectStarted
            , _scServerState_socket = sockIORef
            , _scServerState_listener = listenerIORef
            , _scServerState_availableBufferIds = availBufIds
            , _scServerState_maxBufIds = maxBufIds
            , _scServerState_availableNodeIds = availNodeIds
            , _scServerState_availableSyncIds = syncIds
            , _scServerState_syncIdMailboxes = syncMailboxes
            , _scServerState_serverMessageFunction = serverMessageFunction
            , _scServerState_definedSDs = definedSDs
            }
  
  -- | If you've started the SC server with a non-default number of buffer ids,
  --   (e.g. with the \"-b\" argument), you can reflect that here
  -- 
  --   Note that the buffer ids start at 512, to not clash with any that
  --   another client (e.g. sclang) has allocated
  setMaxBufferIds :: Int32 -> IO ()
  setMaxBufferIds newMax = atomically $
     writeTVar (_scServerState_maxBufIds scServerState) newMax
  
  getNextAvailable :: (SCServerState -> TVar [a]) -> IO a
  getNextAvailable getter =
     getNextAvailables 1 getter >>= \case
        [x] -> return x
        _ -> error "i don't even - 938"
  
  getNextAvailables :: Int -> (SCServerState -> TVar [a]) -> IO [a]
  getNextAvailables numToGet getter = do
     let !_ = scServerState
     atomically $ do
        let avail = getter scServerState
        (ns, rest) <- splitAt numToGet <$> readTVar avail
        writeTVar avail rest
        return ns
  