State.hs

{-# LANGUAGE
    ExistentialQuantification
  , GADTs
  , GeneralizedNewtypeDeriving
  , TypeFamilies #-}

-- | Data type for holding server state.
--
-- The server state consists mainly of the allocators needed for different types of resources, such as nodes, buffers and buses.
module Sound.SC3.Server.State (
    SyncId
  , SyncIdAllocator
  , syncIdAllocator
  , NodeId
  , NodeIdAllocator
  , nodeIdAllocator
  , BufferId
  , BufferIdAllocator
  , bufferIdAllocator
  , BusId
  , BusIdAllocator
  , controlBusIdAllocator
  , audioBusIdAllocator
  , Allocators
  , mkAllocators
) where

import           Control.DeepSeq (NFData(..))
import           Data.Int (Int32)
import           Sound.SC3.Server.Allocator (IdAllocator(..), RangeAllocator(..))
import qualified Sound.SC3.Server.Allocator as Alloc
import qualified Sound.SC3.Server.Allocator.BlockAllocator.FirstFit as FirstFitAllocator
import qualified Sound.SC3.Server.Allocator.SetAllocator as SetAllocator
import qualified Sound.SC3.Server.Allocator.SimpleAllocator as SimpleAllocator
import qualified Sound.SC3.Server.Allocator.Wrapped as Wrapped
import           Sound.SC3.Server.Process.Options (ServerOptions(..))

-- | Synchronisation barrier id.
newtype SyncId = SyncId Int32 deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)

-- | Synchronisation barrier id allocator.
data SyncIdAllocator = forall a . (IdAllocator a, NFData a, Id a ~ SyncId) => SyncIdAllocator !a

instance IdAllocator SyncIdAllocator where
    type Id SyncIdAllocator = SyncId
    alloc  (SyncIdAllocator a) = Wrapped.alloc SyncIdAllocator a
    free i (SyncIdAllocator a) = Wrapped.free SyncIdAllocator i a
    statistics (SyncIdAllocator a) = Wrapped.statistics a

instance NFData SyncIdAllocator where
    rnf (SyncIdAllocator a) = rnf a `seq` ()

-- | Node id.
newtype NodeId = NodeId Int32 deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)

-- | Node id allocator.
data NodeIdAllocator = forall a . (IdAllocator a, NFData a, Id a ~ NodeId) => NodeIdAllocator !a

instance IdAllocator NodeIdAllocator where
    type Id NodeIdAllocator = NodeId
    alloc  (NodeIdAllocator a) = Wrapped.alloc NodeIdAllocator a
    free i (NodeIdAllocator a) = Wrapped.free NodeIdAllocator i a
    statistics (NodeIdAllocator a) = Wrapped.statistics a

instance NFData NodeIdAllocator where
    rnf (NodeIdAllocator a) = rnf a `seq` ()

-- | Buffer id.
newtype BufferId = BufferId Int32 deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)

-- | Buffer id allocator.
data BufferIdAllocator = forall a . (RangeAllocator a, NFData a, Id a ~ BufferId) => BufferIdAllocator !a

instance IdAllocator BufferIdAllocator where
    type Id BufferIdAllocator = BufferId
    alloc  (BufferIdAllocator a) = Wrapped.alloc BufferIdAllocator a
    free i (BufferIdAllocator a) = Wrapped.free BufferIdAllocator i a
    statistics (BufferIdAllocator a) = Wrapped.statistics a

instance RangeAllocator BufferIdAllocator where
    allocRange n (BufferIdAllocator a) = Wrapped.allocRange BufferIdAllocator n a
    freeRange r (BufferIdAllocator a) = Wrapped.freeRange BufferIdAllocator r a

instance NFData BufferIdAllocator where
    rnf (BufferIdAllocator a) = rnf a `seq` ()

-- | Bus id.
newtype BusId = BusId Int32 deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)

-- | Bus id allocator.
data BusIdAllocator = forall a . (RangeAllocator a, NFData a, Id a ~ BusId) => BusIdAllocator !a

instance IdAllocator BusIdAllocator where
    type Id BusIdAllocator = BusId
    alloc  (BusIdAllocator a) = Wrapped.alloc BusIdAllocator a
    free i (BusIdAllocator a) = Wrapped.free BusIdAllocator i a
    statistics (BusIdAllocator a) = Wrapped.statistics a

instance RangeAllocator BusIdAllocator where
    allocRange n (BusIdAllocator a) = Wrapped.allocRange BusIdAllocator n a
    freeRange r (BusIdAllocator a) = Wrapped.freeRange BusIdAllocator r a

instance NFData BusIdAllocator where
    rnf (BusIdAllocator a) = rnf a `seq` ()

-- | Server allocators.
data Allocators = Allocators {
    syncIdAllocator       :: !SyncIdAllocator
  , nodeIdAllocator       :: !NodeIdAllocator
  , bufferIdAllocator     :: !BufferIdAllocator
  , controlBusIdAllocator :: !BusIdAllocator
  , audioBusIdAllocator   :: !BusIdAllocator
  }

-- | Create a new state with default allocators.
mkAllocators :: ServerOptions -> Allocators
mkAllocators os =
    Allocators {
        syncIdAllocator       = sid
      , nodeIdAllocator       = nid
      , bufferIdAllocator     = bid
      , controlBusIdAllocator = cid
      , audioBusIdAllocator   = aid
    }
    where
        sid = SyncIdAllocator (SimpleAllocator.cons (Alloc.range 0 (maxBound :: SyncId)))
        nid = NodeIdAllocator (SetAllocator.cons (Alloc.range 1000 (1000 + fromIntegral (maxNumberOfNodes os))))
        bid = BufferIdAllocator (FirstFitAllocator.bestFit
                                 FirstFitAllocator.LazyCoalescing
                                 (Alloc.range 0 (fromIntegral (numberOfSampleBuffers os))))
        cid = BusIdAllocator (FirstFitAllocator.bestFit
                              FirstFitAllocator.LazyCoalescing
                              (Alloc.range 0 (fromIntegral (numberOfControlBusChannels os))))
        aid = BusIdAllocator (FirstFitAllocator.bestFit
                              FirstFitAllocator.LazyCoalescing
                              (Alloc.range
                                (fromIntegral numHardwareChannels)
                                (fromIntegral (numHardwareChannels + numberOfAudioBusChannels os))))
        numHardwareChannels = numberOfInputBusChannels os
                            + numberOfOutputBusChannels os