packages feed

hsc3-server 0.0.0 → 0.1.0

raw patch · 10 files changed

+78/−72 lines, 10 files

Files

Sound/SC3/Server/Allocator.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE-    FlexibleContexts-  , FlexibleInstances-  , MultiParamTypeClasses #-}+    DeriveDataTypeable+  , FlexibleContexts+  , TypeFamilies #-}  module Sound.SC3.Server.Allocator     ( AllocFailure(..)@@ -26,11 +25,12 @@  instance Exception AllocFailure -class IdAllocator i a where-    alloc :: Failure AllocFailure m => a -> m (i, a)-    free  :: Failure AllocFailure m => i -> a -> m a+class IdAllocator a where+    type Id a+    alloc :: Failure AllocFailure m => a -> m (Id a, a)+    free  :: Failure AllocFailure m => Id a -> a -> m a     -    allocMany :: Failure AllocFailure m => Int -> a -> m ([i], a)+    allocMany :: Failure AllocFailure m => Int -> a -> m ([Id a], a)     allocMany n = State.runStateT (replicateM n (modifyM alloc))         where             modifyM f = do@@ -38,6 +38,6 @@                 State.put $! s'                 return a -class IdAllocator i a => RangeAllocator i a where-    allocRange :: Failure AllocFailure m => Int -> a -> m (Range i, a)-    freeRange  :: Failure AllocFailure m => Range i -> a -> m a+class IdAllocator a => RangeAllocator a where+    allocRange :: Failure AllocFailure m => Int -> a -> m (Range (Id a), a)+    freeRange  :: Failure AllocFailure m => Range (Id a) -> a -> m a
Sound/SC3/Server/Allocator/SetAllocator.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE BangPatterns            , FlexibleContexts-           , FlexibleInstances-           , MultiParamTypeClasses #-}+           , TypeFamilies #-} module Sound.SC3.Server.Allocator.SetAllocator (     SetAllocator   , cons@@ -49,6 +48,7 @@                                | otherwise = failure InvalidId     where u' = Set.delete (fromIntegral i) u -instance (Integral i) => IdAllocator i (SetAllocator i) where+instance (Integral i) => IdAllocator (SetAllocator i) where+    type Id (SetAllocator i) = i     alloc = sa_alloc     free  = sa_free
Sound/SC3/Server/Allocator/SimpleAllocator.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE FlexibleContexts-           , FlexibleInstances-           , MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} module Sound.SC3.Server.Allocator.SimpleAllocator (     SimpleAllocator   , cons@@ -23,6 +21,7 @@ sa_free :: (Monad m) => i -> SimpleAllocator i -> m (SimpleAllocator i) sa_free _ sa = return sa -instance (Integral i) => IdAllocator i (SimpleAllocator i) where+instance (Integral i) => IdAllocator (SimpleAllocator i) where+    type Id (SimpleAllocator i) = i     alloc = sa_alloc     free  = sa_free
Sound/SC3/Server/Connection.hs view
@@ -21,7 +21,7 @@  import           Sound.SC3 (notify) import           Sound.SC3.Server.Notification (done, synced)-import           Sound.SC3.Server.State (State)+import           Sound.SC3.Server.State (State, SyncId) import qualified Sound.SC3.Server.State as State import qualified Sound.SC3.Server.State.Concurrent as IOState @@ -100,12 +100,12 @@         hasAddress _                = Nothing  -- | Append a @\/sync@ message to an OSC packet.-appendSync :: OSC -> Int -> OSC+appendSync :: OSC -> SyncId -> OSC appendSync p i =     case p of         m@(Message _ _) -> Bundle immediately [m, s]         (Bundle t xs)   -> Bundle t (xs ++ [s])-    where s = Message "/sync" [Int i]+    where s = Message "/sync" [Int (fromIntegral i)]  sync :: OSC -> Connection -> IO () sync osc c = do
Sound/SC3/Server/Monad.hs view
@@ -35,7 +35,7 @@ import           Control.Monad.Trans (MonadIO, MonadTrans, liftIO) import           Data.Accessor import           Sound.SC3 (Rate(..))-import           Sound.SC3.Server.Allocator (IdAllocator, RangeAllocator, Range)+import           Sound.SC3.Server.Allocator (Id, IdAllocator, RangeAllocator, Range) import           Sound.SC3.Server.Connection (Connection) import qualified Sound.SC3.Server.Connection as C -- import           Sound.SC3.Server.Process.Options (ServerOptions, numberOfInputBusChannels, numberOfOutputBusChannels)@@ -80,19 +80,19 @@ busId r  = error ("No bus allocator for rate " ++ show r)  -alloc :: (IdAllocator i a, MonadIO m) => Allocator a -> ServerT m i+alloc :: (IdAllocator a, MonadIO m) => Allocator a -> ServerT m (Id a) alloc a = asks C.state >>= liftIO . IOState.alloc a -allocMany :: (IdAllocator i a, MonadIO m) => Allocator a -> Int -> ServerT m [i]+allocMany :: (IdAllocator a, MonadIO m) => Allocator a -> Int -> ServerT m [Id a] allocMany a n = asks C.state >>= liftIO . flip (IOState.allocMany a) n -free :: (IdAllocator i a, MonadIO m) => Allocator a -> i -> ServerT m ()+free :: (IdAllocator a, MonadIO m) => Allocator a -> Id a -> ServerT m () free a i = asks C.state >>= liftIO . flip (IOState.free a) i -allocRange :: (RangeAllocator i a, MonadIO m) => Allocator a -> Int -> ServerT m (Range i)+allocRange :: (RangeAllocator a, MonadIO m) => Allocator a -> Int -> ServerT m (Range (Id a)) allocRange a n = asks C.state >>= liftIO . flip (IOState.allocRange a) n -freeRange :: (RangeAllocator i a, MonadIO m) => Allocator a -> Range i -> ServerT m ()+freeRange :: (RangeAllocator a, MonadIO m) => Allocator a -> Range (Id a) -> ServerT m () freeRange a r = asks C.state >>= liftIO . flip (IOState.freeRange a) r  fork :: (MonadIO m) => ServerT IO () -> ServerT m ThreadId
Sound/SC3/Server/Notification.hs view
@@ -9,7 +9,7 @@   , n_go , n_end , n_off , n_on , n_move , n_info ) where -import Sound.SC3.Server.State (NodeId)+import Sound.SC3.Server.State (NodeId, SyncId) import Sound.OpenSoundControl (OSC(..), Datum(..))  data Status = Status {@@ -33,9 +33,9 @@ tr n Nothing  (Message "/tr" [Int n', Int _, Float r])  | fromIntegral n == n' = Just r tr _ _        _                                         = Nothing -synced :: Int -> OSC -> Maybe Int-synced i (Message "/synced" [Int j]) | j == i = Just i-synced _ _                                    = Nothing+synced :: SyncId -> OSC -> Maybe SyncId+synced i (Message "/synced" [Int j]) | fromIntegral j == i = Just i+synced _ _                                                 = Nothing  normalize :: String -> String normalize ('/':s) = s
Sound/SC3/Server/Process/Monad.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-} module Sound.SC3.Server.Process.Monad (     withSynth   , withInternal
Sound/SC3/Server/State.hs view
@@ -1,22 +1,23 @@ {-# LANGUAGE     CPP   , ExistentialQuantification-  , FlexibleContexts+  , GADTs   , GeneralizedNewtypeDeriving-  , MultiParamTypeClasses #-}+  , TypeFamilies #-}  #include "Accessor.h"  module Sound.SC3.Server.State (     State   , options-  , IntAllocator+  , SyncId+  , SyncIdAllocator+  , NodeId   , NodeIdAllocator-  , BusIdAllocator+  , BufferId   , BufferIdAllocator-  , NodeId   , BusId-  , BufferId+  , BusIdAllocator   , syncId   , nodeId   , bufferId@@ -34,7 +35,7 @@ import           Control.DeepSeq (NFData(..)) import           Control.Monad (liftM) import           Data.Accessor-import           Sound.SC3.Server.Allocator (IdAllocator)+import           Sound.SC3.Server.Allocator (IdAllocator(..)) import qualified Sound.SC3.Server.Allocator as Alloc import           Sound.SC3.Server.Allocator.SetAllocator (SetAllocator) import qualified Sound.SC3.Server.Allocator.SetAllocator as SetAlloc@@ -42,49 +43,56 @@ import qualified Sound.SC3.Server.Allocator.SimpleAllocator as SAlloc import           Sound.SC3.Server.Options (ServerOptions(..)) --- Hide the actual allocator-data IntAllocator = forall a . (IdAllocator Int a, NFData a) => IntAllocator !a+allocM f = liftM (second f) . Alloc.alloc+freeM f i = liftM f . Alloc.free i -instance IdAllocator Int IntAllocator where-    alloc  (IntAllocator a) = liftM (second IntAllocator) $ Alloc.alloc a-    free i (IntAllocator a) = liftM         IntAllocator  $ Alloc.free i a+newtype SyncId = SyncId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)+data SyncIdAllocator = forall a . (IdAllocator a, NFData a, Id a ~ SyncId) => SyncIdAllocator !a -instance NFData IntAllocator where-    rnf (IntAllocator a) = rnf a `seq` ()+instance IdAllocator SyncIdAllocator where+    type Id SyncIdAllocator = SyncId+    alloc  (SyncIdAllocator a) = allocM SyncIdAllocator a+    free i (SyncIdAllocator a) = freeM SyncIdAllocator i a -newtype NodeId       = NodeId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)-data NodeIdAllocator = forall a . (IdAllocator NodeId a, NFData a) => NodeIdAllocator !a+instance NFData SyncIdAllocator where+    rnf (SyncIdAllocator a) = rnf a `seq` () -instance IdAllocator NodeId NodeIdAllocator where-    alloc  (NodeIdAllocator a) = liftM (second NodeIdAllocator) $ Alloc.alloc a-    free i (NodeIdAllocator a) = liftM         NodeIdAllocator  $ Alloc.free i a+newtype NodeId = NodeId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)+data NodeIdAllocator = forall a . (IdAllocator a, NFData a, Id a ~ NodeId) => NodeIdAllocator !a +instance IdAllocator NodeIdAllocator where+    type Id NodeIdAllocator = NodeId+    alloc  (NodeIdAllocator a) = allocM NodeIdAllocator a+    free i (NodeIdAllocator a) = freeM NodeIdAllocator i a+ instance NFData NodeIdAllocator where     rnf (NodeIdAllocator a) = rnf a `seq` () -newtype BufferId       = BufferId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)-data BufferIdAllocator = forall a . (IdAllocator BufferId a, NFData a) => BufferIdAllocator !a+newtype BufferId = BufferId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)+data BufferIdAllocator = forall a . (IdAllocator a, NFData a, Id a ~ BufferId) => BufferIdAllocator !a -instance IdAllocator BufferId BufferIdAllocator where-    alloc  (BufferIdAllocator a) = liftM (second BufferIdAllocator) $ Alloc.alloc a-    free i (BufferIdAllocator a) = liftM         BufferIdAllocator  $ Alloc.free i a+instance IdAllocator BufferIdAllocator where+    type Id BufferIdAllocator = BufferId+    alloc  (BufferIdAllocator a) = allocM BufferIdAllocator a+    free i (BufferIdAllocator a) = freeM BufferIdAllocator i a  instance NFData BufferIdAllocator where     rnf (BufferIdAllocator a) = rnf a `seq` () -newtype BusId       = BusId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)-data BusIdAllocator = forall a . (IdAllocator BusId a, NFData a) => BusIdAllocator !a+newtype BusId = BusId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)+data BusIdAllocator = forall a . (IdAllocator a, NFData a, Id a ~ BusId) => BusIdAllocator !a -instance IdAllocator BusId BusIdAllocator where-    alloc  (BusIdAllocator a) = liftM (second BusIdAllocator) $ Alloc.alloc a-    free i (BusIdAllocator a) = liftM         BusIdAllocator  $ Alloc.free i a+instance IdAllocator BusIdAllocator where+    type Id BusIdAllocator = BusId+    alloc  (BusIdAllocator a) = allocM BusIdAllocator a+    free i (BusIdAllocator a) = freeM BusIdAllocator i a  instance NFData BusIdAllocator where     rnf (BusIdAllocator a) = rnf a `seq` ()  data State = State {     _options      :: !ServerOptions-  , _syncId       :: !IntAllocator+  , _syncId       :: !SyncIdAllocator   , _nodeId       :: !NodeIdAllocator   , _bufferId     :: !BufferIdAllocator   , _controlBusId :: !BusIdAllocator@@ -101,7 +109,7 @@         rnf x6 `seq` ()  ACCESSOR(options,      _options,      State, ServerOptions)-ACCESSOR(syncId,       _syncId,       State, IntAllocator)+ACCESSOR(syncId,       _syncId,       State, SyncIdAllocator) ACCESSOR(nodeId,       _nodeId,       State, NodeIdAllocator) ACCESSOR(bufferId,     _bufferId,     State, BufferIdAllocator) ACCESSOR(controlBusId, _controlBusId, State, BusIdAllocator)@@ -121,8 +129,8 @@       , _audioBusId   = aid     }     where-        sid = IntAllocator-                (SAlloc.cons :: SimpleAllocator Int)+        sid = SyncIdAllocator+                (SAlloc.cons :: SimpleAllocator SyncId)         nid = NodeIdAllocator                 (SetAlloc.cons $ Alloc.range 1000 (1000 + fromIntegral (maxNumberOfNodes os)) :: SetAllocator NodeId)         bid = BufferIdAllocator
Sound/SC3/Server/State/Concurrent.hs view
@@ -14,7 +14,7 @@ -- import           Control.Concurrent.MVar (MVar, newMVar) import           Control.Concurrent.MVar.Strict (MVar, modifyMVar, modifyMVar_, newMVar) import           Data.Accessor-import           Sound.SC3.Server.Allocator (AllocFailure, IdAllocator, RangeAllocator, Range)+import           Sound.SC3.Server.Allocator (AllocFailure, IdAllocator, Id, RangeAllocator, Range) import qualified Sound.SC3.Server.Allocator as Alloc import           Sound.SC3.Server.State (State) import qualified Sound.SC3.Server.State as State@@ -31,22 +31,22 @@ swap :: (a, b) -> (b, a) swap (a, b) = (b, a) -alloc :: (IdAllocator i a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> IO i+alloc :: (IdAllocator a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> IO (Id a) alloc f ios = modifyMVar ios (\s -> fmap (swap . second (flip (setVal f) s)) . Alloc.alloc . getVal f $ s) -allocMany :: (IdAllocator i a, Failure AllocFailure IO)  => (Accessor State a) -> MVar State -> Int -> IO [i]+allocMany :: (IdAllocator a, Failure AllocFailure IO)  => (Accessor State a) -> MVar State -> Int -> IO [Id a] allocMany f m n = modifyMVar m (\s -> fmap (swap . second (flip (setVal f) s)) . Alloc.allocMany n . getVal f $ s) -free :: IdAllocator i a => (Accessor State a) -> IOState -> i -> IO ()+free :: IdAllocator a => (Accessor State a) -> IOState -> Id a -> IO () free f ios i = modifyMVar_ ios $ \s -> do     let a  = s ^. f     a' <- Alloc.free i a     return $ f ^= a' $ s -allocRange :: (RangeAllocator i a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> Int -> IO (Range i)+allocRange :: (RangeAllocator a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> Int -> IO (Range (Id a)) allocRange f ios n = modifyMVar ios (\s -> fmap (swap . second (flip (setVal f) s)) . Alloc.allocRange n . getVal f $ s) -freeRange :: (RangeAllocator i a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> Range i -> IO ()+freeRange :: (RangeAllocator a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> Range (Id a) -> IO () freeRange f ios r = modifyMVar_ ios $ \s -> do     let a  = s ^. f     a' <- Alloc.freeRange r a
hsc3-server.cabal view
@@ -1,5 +1,5 @@ Name:               hsc3-server-Version:            0.0.0+Version:            0.1.0 Synopsis:           SuperCollider server resource management and synchronization. Description:        This library provides abstractions for managing SuperCollider server resources like node, buffer and bus ids and synchronization primitives. License:            GPL