hsc3-process 0.4.0 → 0.5.0

raw patch · 5 files changed

+83/−249 lines, 5 filesdep +data-accessor-transformersdep −data-accessor-mtldep −data-accessor-templatedep ~hoscdep ~hsc3dep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: data-accessor-transformers

Dependencies removed: data-accessor-mtl, data-accessor-template

Dependency ranges changed: hosc, hsc3, mtl

API changes (from Hackage documentation)

Files

• Sound/SC3/Server/Internal.hs +38/−25
• Sound/SC3/Server/Options.hs +36/−36
• Sound/SC3/Server/Process/Accessor.hs +0/−10
• Sound/SC3/Server/Process/ConfigFile.hs +0/−169
• hsc3-process.cabal +9/−9

@@ -5,6 +5,7 @@  import           Bindings.Sound.SC3 import           Control.Concurrent.Chan+import           Control.Concurrent.MVar import           Control.Exception (bracket) import           Control.Monad import           Control.Monad.State@@ -18,17 +19,19 @@ import           Foreign.Ptr import           Foreign.Storable import           Foreign.StablePtr-import           Sound.OpenSoundControl as OSC+import           Sound.OpenSoundControl (OSC)+import qualified Sound.OpenSoundControl as OSC+-- import qualified Sound.OpenSoundControl.Binary as BOSC import qualified Sound.SC3 as SC import           Sound.SC3.Server.Options import           Sound.SC3.Server.Process (OutputHandler(..))  data InternalTransport = InternalTransport {-    world         :: Ptr C'World-  , recvChan      :: Chan OSC-  , replyFunc     :: C'ReplyFunc-  , replyFuncData :: StablePtr (Chan OSC)-  , printFunc     :: C'HaskellPrintFunc+    world         :: MVar (Ptr C'World)     -- ^The World pointer, wrapped in an MVar.+  , recvChan      :: Chan OSC               -- ^The channel messages received from the library are written to.+  , replyFunc     :: C'ReplyFunc            -- ^Reply callback function pointer.+  , replyFuncData :: StablePtr (Chan OSC)   -- ^Data for the reply callback (a pointer to the receive channel).+  , printFunc     :: C'HaskellPrintFunc     -- ^Print callback function pointer.   }  withInternal ::@@ -39,13 +42,13 @@  -> IO a withInternal serverOptions rtOptions handler =     bracket (withWorldOptions (newIT handler) serverOptions rtOptions)-            close+            OSC.close  newIT :: OutputHandler -> Ptr C'WorldOptions -> IO InternalTransport newIT handler options = do     pf <- mk'HaskellPrintFunc (\cs -> mapM_ (onPutString handler) . lines =<< peekCString cs)     c'SetHaskellPrintFunc pf-    w <- c'World_New options+    w <- newMVar =<< c'World_New options     c <- newChan     f <- mk'ReplyFunc it_replyFunc     p <- newStablePtr c@@ -57,7 +60,7 @@     buf <- BS.packCStringLen (cbuf, fromIntegral csize)     ptr <- liftM castPtrToStablePtr (c'ReplyAddress_ReplyData replyAddress)     chan <- deRefStablePtr ptr-    let osc = decodeOSC (BL.fromChunks [buf])+    let osc = OSC.decodeOSC (BL.fromChunks [buf])     -- putStrLn $ "it_replyFunc: " ++ show osc     writeChan chan osc @@ -77,20 +80,27 @@ copyByteString dst = copyChunks dst . BL.toChunks  sendIT :: InternalTransport -> OSC -> IO ()-sendIT t osc = do-    let buf = encodeOSC osc+sendIT t osc = withMVar (world t) $ \w -> do+    let buf = OSC.encodeOSC osc+        -- buf1 = OSC.encodeOSC osc         n = BL.length buf     -- putStrLn $ "sendIT: " ++ show n ++ " (" ++ show osc ++ ")"-    _ <- allocaArray (fromIntegral n) $ \cbuf -> do-        copyByteString cbuf buf-        c'World_SendPacketWithContext-            (world t)-            (fromIntegral n)-            cbuf-            (replyFunc t)-            (castStablePtrToPtr (replyFuncData t))-    -- putStrLn $ "sendIT: " ++ show b-    return ()+    -- when (buf /= buf1) $ do+    --     putStrLn $ "================\n"+    --             ++ show (BS.pack.BL.unpack$buf1)+    --             ++ "\n--------------\n"+    --             ++ show (BS.pack.BL.unpack$buf)+    when (w /= nullPtr) $ do+        -- TODO: Check return value and throw exception+        _ <- allocaArray (fromIntegral n) $ \cbuf -> do+            copyByteString cbuf buf+            c'World_SendPacketWithContext+                w+                (fromIntegral n)+                cbuf+                (replyFunc t)+                (castStablePtrToPtr (replyFuncData t))+        return ()  recvIT :: InternalTransport -> IO OSC recvIT = readChan . recvChan@@ -98,10 +108,13 @@ closeIT :: InternalTransport -> IO () closeIT t = do     sendIT t SC.quit-    c'World_WaitForQuit (world t)-    freeHaskellFunPtr (replyFunc t)-    freeStablePtr (replyFuncData t)-    freeHaskellFunPtr (printFunc t)+    modifyMVar_ (world t) $ \w -> do+        when (w /= nullPtr) $ do+            c'World_WaitForQuit w+            freeHaskellFunPtr (replyFunc t)+            freeStablePtr (replyFuncData t)+            freeHaskellFunPtr (printFunc t)+        return nullPtr  withWorldOptions :: (Ptr C'WorldOptions -> IO a) -> ServerOptions -> RTOptions -> IO a withWorldOptions f so ro = do

@@ -3,49 +3,49 @@     Verbosity(..)   , ServerOptions(..)   , defaultServerOptions-  , _serverProgram-  , _numberOfControlBusChannels-  , _numberOfAudioBusChannels-  , _numberOfInputBusChannels-  , _numberOfOutputBusChannels-  , _blockSize-  , _numberOfSampleBuffers-  , _maxNumberOfNodes-  , _maxNumberOfSynthDefs-  , _realtimeMemorySize-  , _numberOfWireBuffers-  , _numberOfRandomSeeds-  , _loadSynthDefs-  , _verbosity-  , _ugenPluginPath-  , _restrictedPath+  -- , _serverProgram+  -- , _numberOfControlBusChannels+  -- , _numberOfAudioBusChannels+  -- , _numberOfInputBusChannels+  -- , _numberOfOutputBusChannels+  -- , _blockSize+  -- , _numberOfSampleBuffers+  -- , _maxNumberOfNodes+  -- , _maxNumberOfSynthDefs+  -- , _realtimeMemorySize+  -- , _numberOfWireBuffers+  -- , _numberOfRandomSeeds+  -- , _loadSynthDefs+  -- , _verbosity+  -- , _ugenPluginPath+  -- , _restrictedPath   , RTOptions(..)   , defaultRTOptions   , defaultRTOptionsUDP   , defaultRTOptionsTCP-  , _udpPortNumber-  , _tcpPortNumber-  , _useZeroconf-  , _maxNumberOfLogins-  , _sessionPassword-  , _hardwareDeviceName-  , _hardwareBufferSize-  , _hardwareSampleRate-  , _inputStreamsEnabled-  , _outputStreamsEnabled+  -- , _udpPortNumber+  -- , _tcpPortNumber+  -- , _useZeroconf+  -- , _maxNumberOfLogins+  -- , _sessionPassword+  -- , _hardwareDeviceName+  -- , _hardwareBufferSize+  -- , _hardwareSampleRate+  -- , _inputStreamsEnabled+  -- , _outputStreamsEnabled   , NRTOptions(..)   , defaultNRTOptions-  , _commandFilePath-  , _inputFilePath-  , _outputFilePath-  , _outputSampleRate-  , _outputHeaderFormat-  , _outputSampleFormat+  -- , _commandFilePath+  -- , _inputFilePath+  -- , _outputFilePath+  -- , _outputSampleRate+  -- , _outputHeaderFormat+  -- , _outputSampleFormat ) where  import           Control.Monad.Error import qualified Data.ConfigFile as CF-import           Sound.SC3.Server.Process.Accessor (deriveAccessors)+-- import           Sound.SC3.Server.Process.Accessor (deriveAccessors)  -- | Used with the 'verbosity' field in 'ServerOptions'. data Verbosity =@@ -129,7 +129,7 @@   , restrictedPath             = Nothing } -$(deriveAccessors ''ServerOptions)+-- $(deriveAccessors ''ServerOptions)  -- ==================================================================== -- * Realtime options@@ -168,7 +168,7 @@     outputStreamsEnabled    = Nothing } -$(deriveAccessors ''RTOptions)+-- $(deriveAccessors ''RTOptions)  -- | Default realtime server options (UDP transport). defaultRTOptionsUDP :: RTOptions@@ -202,4 +202,4 @@     outputSampleFormat      = "int16" } -$(deriveAccessors ''NRTOptions)+-- $(deriveAccessors ''NRTOptions)

@@ -1,10 +0,0 @@-module Sound.SC3.Server.Process.Accessor (-    deriveAccessors-) where--import qualified Data.Accessor.Template as Accessor-import Language.Haskell.TH              (Dec, Name, Q)---- | Derive accessors with a leading @_@.-deriveAccessors :: Name -> Q [Dec]-deriveAccessors = flip Accessor.nameDeriveAccessors (Just . ("_"++))

@@ -1,169 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- | Read server options from configuraton file.-module Sound.SC3.Server.Process.ConfigFile (-    getOptions-  , setOptions-) where--import           Control.Monad-import           Control.Monad.Error-import           Control.Monad.State (StateT)-import qualified Control.Monad.State as State-import           Data.Accessor-import qualified Data.Accessor.Monad.MTL.State as A-import qualified Data.List as L-import           Sound.SC3.Server.Options-import           Data.ConfigFile-import           Text.Regex--newtype MaybeConfig a = MaybeConfig { maybeConfig :: Maybe a }--instance Show a => Show (MaybeConfig a) where-    show = maybe "" show . maybeConfig--instance Get_C a => Get_C (MaybeConfig a) where-    get parser section option = liftM (MaybeConfig . Just) (get parser section option)--data FilePathList = FilePathList { filePathList :: [FilePath] }--instance Show FilePathList where-    show = L.intercalate ":" . filePathList--instance Get_C FilePathList where-    get parser section option = liftM (FilePathList . splitRegex r) (get parser section option)-        where r = mkRegex ":"--getField :: (MonadError CPError m, Get_C b) => ConfigParser -> SectionSpec -> OptionSpec -> Accessor a b -> StateT a m ()-getField parser section option accessor = do-    case get parser section option of-        Left _  -> return ()-        Right x -> A.set accessor x--getField_ :: (MonadError CPError m, Get_C c) => ConfigParser -> SectionSpec -> (c -> b) -> OptionSpec -> Accessor a b -> StateT a m ()-getField_ parser section wrapper option accessor = do-    case get parser section option of-        Left _ -> return ()-        Right x -> A.set accessor (wrapper x)---- | Get 'ServerOptions' from an option 'Map'.--- Uninitialized fields are taken from 'defaultServerOptions'.-getServerOptions :: (MonadError CPError m) => ConfigParser -> SectionSpec -> m ServerOptions-getServerOptions parser section = flip State.execStateT defaultServerOptions $ do-    getField parser section                        "serverProgram"              _serverProgram-    getField parser section                        "numberOfControlBusChannels" _numberOfControlBusChannels-    getField parser section                        "numberOfAudioBusChannels"   _numberOfAudioBusChannels-    getField parser section                        "numberOfInputBusChannels"   _numberOfInputBusChannels-    getField parser section                        "numberOfOutputBusChannels"  _numberOfOutputBusChannels-    getField parser section                        "blockSize"                  _blockSize-    getField parser section                        "numberOfSampleBuffers"      _numberOfSampleBuffers-    getField parser section                        "maxNumberOfNodes"           _maxNumberOfNodes-    getField parser section                        "maxNumberOfSynthDefs"       _maxNumberOfSynthDefs-    getField parser section                        "realtimeMemorySize"         _realtimeMemorySize-    getField parser section                        "numberOfWireBuffers"        _numberOfWireBuffers-    getField parser section                        "numberOfRandomSeeds"        _numberOfRandomSeeds-    getField parser section                        "loadSynthDefs"              _loadSynthDefs-    getField parser section                        "verbosity"                  _verbosity-    getField_ parser section (Just . filePathList) "ugenPluginPath"             _ugenPluginPath-    getField_ parser section maybeConfig           "restrictedPath"             _restrictedPath---- | Get 'RTOptions' from an option 'Map'.--- Uninitialized fields are taken from 'defaultRTOptions'.-getRTOptions :: (MonadError CPError m) => ConfigParser -> SectionSpec -> m RTOptions-getRTOptions parser section = flip State.execStateT defaultRTOptions $ do-    getField parser section              "udpPortNumber"        _udpPortNumber-    getField parser section              "tcpPortNumber"        _tcpPortNumber-    getField parser section              "useZeroconf"          _useZeroconf-    getField parser section              "maxNumberOfLogins"    _maxNumberOfLogins-    getField_ parser section maybeConfig "sessionPassword"      _sessionPassword-    getField_ parser section maybeConfig "hardwareDeviceName"   _hardwareDeviceName-    getField parser section              "hardwareBufferSize"   _hardwareBufferSize-    getField parser section              "hardwareSampleRate"   _hardwareSampleRate-    getField_ parser section maybeConfig "inputStreamsEnabled"  _inputStreamsEnabled-    getField_ parser section maybeConfig "outputStreamsEnabled" _outputStreamsEnabled---- | Get 'NRTOptions' from an option 'Map'.--- Uninitialized fields are taken from 'defaultNRTOptions'.-getNRTOptions :: MonadError CPError m => ConfigParser -> SectionSpec -> m NRTOptions-getNRTOptions parser section = flip State.execStateT defaultNRTOptions $ do-    getField_ parser section maybeConfig "commandFilePath"    _commandFilePath-    getField_ parser section maybeConfig "inputFilePath"      _inputFilePath-    getField parser section              "outputFilePath"     _outputFilePath-    getField parser section              "outputSampleRate"   _outputSampleRate-    getField parser section              "outputHeaderFormat" _outputHeaderFormat-    getField parser section              "outputSampleFormat" _outputSampleFormat---- | Read server options, realtime options and non-relatime options from a 'ConfigParser'.-getOptions :: MonadError CPError m => ConfigParser -> SectionSpec -> m (ServerOptions, RTOptions, NRTOptions)-getOptions parser section = do-    so <- getServerOptions parser section-    ro <- getRTOptions parser section-    no <- getNRTOptions parser section-    return (so, ro, no)--setField :: (Show b, MonadError CPError m) => SectionSpec -> OptionSpec -> Accessor a b -> StateT (a, ConfigParser) m ()-setField section option accessor = do-    (options, parser) <- State.get-    let value = getVal accessor options-    parser' <- lift (setshow parser section option value)-    State.put (options, parser')--setField_ :: (Show c, MonadError CPError m) => (b -> c) -> SectionSpec -> OptionSpec -> Accessor a b -> StateT (a, ConfigParser) m ()-setField_ wrapper section option accessor = do-    (options, parser) <- State.get-    let value = getVal accessor options-    parser' <- lift (setshow parser section option (wrapper value))-    State.put (options, parser')---- -- | Convert 'ServerOptions' to association list.-setServerOptions :: MonadError CPError m => ServerOptions -> ConfigParser -> SectionSpec -> m ConfigParser-setServerOptions options parser section = liftM snd $ flip State.execStateT (options, parser) $ do-    setField                                    section "serverProgram"              _serverProgram-    setField                                    section "numberOfControlBusChannels" _numberOfControlBusChannels-    setField                                    section "numberOfAudioBusChannels"   _numberOfAudioBusChannels-    setField                                    section "numberOfInputBusChannels"   _numberOfInputBusChannels-    setField                                    section "numberOfOutputBusChannels"  _numberOfOutputBusChannels-    setField                                    section "blockSize"                  _blockSize-    setField                                    section "numberOfSampleBuffers"      _numberOfSampleBuffers-    setField                                    section "maxNumberOfNodes"           _maxNumberOfNodes-    setField                                    section "maxNumberOfSynthDefs"       _maxNumberOfSynthDefs-    setField                                    section "realtimeMemorySize"         _realtimeMemorySize-    setField                                    section "numberOfWireBuffers"        _numberOfWireBuffers-    setField                                    section "numberOfRandomSeeds"        _numberOfRandomSeeds-    setField                                    section "loadSynthDefs"              _loadSynthDefs-    setField                                    section "verbosity"                  _verbosity-    setField_ (MaybeConfig . fmap FilePathList) section "ugenPluginPath"             _ugenPluginPath-    setField_ MaybeConfig                       section "restrictedPath"            _restrictedPath---- -- | Convert 'RTOptions' to association list.-setRTOptions :: MonadError CPError m => RTOptions -> ConfigParser -> SectionSpec -> m ConfigParser-setRTOptions options parser section = liftM snd $ flip State.execStateT (options, parser) $ do-    setField              section "udpPortNumber"        _udpPortNumber-    setField              section "tcpPortNumber"        _tcpPortNumber-    setField              section "useZeroconf"          _useZeroconf-    setField              section "maxNumberOfLogins"    _maxNumberOfLogins-    setField_ MaybeConfig section "sessionPassword"      _sessionPassword-    setField_ MaybeConfig section "hardwareDeviceName"   _hardwareDeviceName-    setField              section "hardwareBufferSize"   _hardwareBufferSize-    setField              section "hardwareSampleRate"   _hardwareSampleRate-    setField_ MaybeConfig section "inputStreamsEnabled"  _inputStreamsEnabled-    setField_ MaybeConfig section "outputStreamsEnabled" _outputStreamsEnabled---- -- | Convert 'NRTOptions' to association list.-setNRTOptions :: MonadError CPError m => NRTOptions -> ConfigParser -> SectionSpec -> m ConfigParser-setNRTOptions options parser section = liftM snd $ flip State.execStateT (options, parser) $ do-    setField_ MaybeConfig section "commandFilePath"    _commandFilePath-    setField_ MaybeConfig section "inputFilePath"      _inputFilePath-    setField              section "outputFilePath"     _outputFilePath-    setField              section "outputSampleRate"   _outputSampleRate-    setField              section "outputHeaderFormat" _outputHeaderFormat-    setField              section "outputSampleFormat" _outputSampleFormat----- | Convert server options and optionally realtime options and non-realtime--- options to an association list.-setOptions :: MonadError CPError m => ConfigParser -> SectionSpec -> (ServerOptions, RTOptions, NRTOptions) -> m ConfigParser-setOptions p0 section (so, ro, no) = do-    p1 <- setServerOptions so p0 section-    p2 <- setRTOptions     ro p1 section-    p3 <- setNRTOptions    no p2 section-    return p3

@@ -1,5 +1,5 @@ Name:               hsc3-process-Version:            0.4.0+Version:            0.5.0 Synopsis:           Create and control scsynth processes Description:        Create and control scsynth processes. License:            GPL@@ -10,7 +10,7 @@ Maintainer:         Stefan Kersten Stability:          experimental Homepage:           http://space.k-hornz.de/software/hsc3-process-Tested-With:        GHC == 6.10.1, GHC == 6.12.3+Tested-With:        GHC == 6.10.1, GHC == 6.12.3, GHC == 7.0.1 Build-Type:         Simple Cabal-Version:      >= 1.6 @@ -23,8 +23,8 @@                     Sound.SC3.Server.Options                     Sound.SC3.Server.Process                     Sound.SC3.Server.Process.CommandLine-                    Sound.SC3.Server.Process.ConfigFile-  Other-Modules:    Sound.SC3.Server.Process.Accessor+                    -- Sound.SC3.Server.Process.ConfigFile+  -- Other-Modules:    Sound.SC3.Server.Process.Accessor    Build-Depends:    base >= 3 && < 5                   , bindings-sc3@@ -32,11 +32,11 @@                   , ConfigFile >= 1                   , containers >= 0.2                   , data-accessor >= 0.2-                  , data-accessor-template >= 0.2-                  , data-accessor-mtl >= 0.2-                  , hosc >= 0.7 && < 0.9-                  , hsc3 >= 0.7 && < 0.9-                  , mtl >= 1.1+                  -- , data-accessor-template >= 0.2+                  , data-accessor-transformers >= 0.2+                  , hosc >= 0.7 && < 0.10+                  , hsc3 >= 0.7 && < 0.10+                  , mtl >= 2                   , process >= 1.0                   , regex-compat >= 0.9                   , template-haskell >= 2