hsc3-process 0.3.1 → 0.4.0

raw patch · 7 files changed

+603/−333 lines, 7 filesdep +bindings-sc3dep +bytestringdep +data-accessor-mtldep −transformersdep ~hoscdep ~hsc3PVP ok

version bump matches the API change (PVP)

Dependencies added: bindings-sc3, bytestring, data-accessor-mtl, regex-compat

Dependencies removed: transformers

Dependency ranges changed: hosc, hsc3

API changes (from Hackage documentation)

Files

• Sound/SC3/Server/Internal.hs +173/−0
• Sound/SC3/Server/Options.hs +205/−0
• Sound/SC3/Server/Process.hs +45/−37
• Sound/SC3/Server/Process/CommandLine.hs +2/−2
• Sound/SC3/Server/Process/ConfigFile.hs +146/−122
• Sound/SC3/Server/Process/Options.hs +0/−144
• hsc3-process.cabal +32/−28

@@ -0,0 +1,173 @@+module Sound.SC3.Server.Internal (+    InternalTransport+  , withInternal+) where++import           Bindings.Sound.SC3+import           Control.Concurrent.Chan+import           Control.Exception (bracket)+import           Control.Monad+import           Control.Monad.State+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.List as L+import           Foreign.C+import           Foreign.ForeignPtr+import           Foreign.Marshal+import           Foreign.Ptr+import           Foreign.Storable+import           Foreign.StablePtr+import           Sound.OpenSoundControl as OSC+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+  }++withInternal ::+    ServerOptions+ -> RTOptions+ -> OutputHandler+ -> (InternalTransport -> IO a)+ -> IO a+withInternal serverOptions rtOptions handler =+    bracket (withWorldOptions (newIT handler) serverOptions rtOptions)+            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+    c <- newChan+    f <- mk'ReplyFunc it_replyFunc+    p <- newStablePtr c+    return $ InternalTransport w c f p pf++it_replyFunc :: Ptr C'ReplyAddress -> Ptr CChar -> CInt -> IO ()+it_replyFunc replyAddress cbuf csize = do+    -- putStrLn $ "it_replyFunc: " ++ show (replyAddress, cbuf, csize)+    buf <- BS.packCStringLen (cbuf, fromIntegral csize)+    ptr <- liftM castPtrToStablePtr (c'ReplyAddress_ReplyData replyAddress)+    chan <- deRefStablePtr ptr+    let osc = decodeOSC (BL.fromChunks [buf])+    -- putStrLn $ "it_replyFunc: " ++ show osc+    writeChan chan osc++copyChunks :: Ptr CChar -> [BS.ByteString] -> IO ()+copyChunks dst = foldM_ f 0+    where+        f i b = do+            let (fp, o, n) = BS.toForeignPtr b+            -- putStrLn $ "copyChunks " ++ show (i, o, n)+            withForeignPtr fp $ \src ->+                copyBytes (dst `plusPtr` i)+                          (src `plusPtr` o)+                          n+            return (i + n)++copyByteString :: Ptr CChar -> BL.ByteString -> IO ()+copyByteString dst = copyChunks dst . BL.toChunks++sendIT :: InternalTransport -> OSC -> IO ()+sendIT t osc = do+    let buf = 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 ()++recvIT :: InternalTransport -> IO OSC+recvIT = readChan . recvChan++closeIT :: InternalTransport -> IO ()+closeIT t = do+    sendIT t SC.quit+    c'World_WaitForQuit (world t)+    freeHaskellFunPtr (replyFunc t)+    freeStablePtr (replyFuncData t)+    freeHaskellFunPtr (printFunc t)++withWorldOptions :: (Ptr C'WorldOptions -> IO a) -> ServerOptions -> RTOptions -> IO a+withWorldOptions f so ro = do+    (fs, cs) <- flip execStateT ([], []) $ do+        -- c'WorldOptions'mPassword :: CString+        setOpt (\x -> x { c'WorldOptions'mNumBuffers = int (numberOfSampleBuffers so) })+        setOpt (\x -> x { c'WorldOptions'mMaxLogins  = int (maxNumberOfLogins ro) })+        setOpt (\x -> x { c'WorldOptions'mMaxNodes   = int (maxNumberOfNodes so) })+        setOpt (\x -> x { c'WorldOptions'mMaxGraphDefs = int (maxNumberOfSynthDefs so) })+        setOpt (\x -> x { c'WorldOptions'mMaxWireBufs = int (numberOfWireBuffers so) })+        setOpt (\x -> x { c'WorldOptions'mNumAudioBusChannels = int (numberOfAudioBusChannels so) })+        setOpt (\x -> x { c'WorldOptions'mNumInputBusChannels = int (numberOfInputBusChannels so) })+        setOpt (\x -> x { c'WorldOptions'mNumOutputBusChannels = int (numberOfOutputBusChannels so) })+        setOpt (\x -> x { c'WorldOptions'mNumControlBusChannels = int (numberOfControlBusChannels so) })+        setOpt (\x -> x { c'WorldOptions'mBufLength = int (blockSize so) })+        setOpt (\x -> x { c'WorldOptions'mRealTimeMemorySize = int (realtimeMemorySize so) })+        -- TODO: Make shared controls accessible+        setOpt (\x -> x { c'WorldOptions'mNumSharedControls = 0 })+        setOpt (\x -> x { c'WorldOptions'mSharedControls = nullPtr })+        -- TODO+        -- tell (\x -> x { c'WorldOptions'mRealTime })+        -- TODO+        -- tell (\x -> x { c'WorldOptions'mMemoryLocking :: CInt+        -- tell (\x -> x { c'WorldOptions'mNonRealTimeCmdFilename :: CString+        -- tell (\x -> x { c'WorldOptions'mNonRealTimeInputFilename :: CString+        -- tell (\x -> x { c'WorldOptions'mNonRealTimeOutputFilename :: CString+        -- tell (\x -> x { c'WorldOptions'mNonRealTimeOutputHeaderFormat :: CString+        -- tell (\x -> x { c'WorldOptions'mNonRealTimeOutputSampleFormat :: CString+        setOpt (\x -> x { c'WorldOptions'mPreferredSampleRate = int (hardwareSampleRate ro) })+        setOpt (\x -> x { c'WorldOptions'mNumRGens = int (numberOfRandomSeeds so) })+        setOpt (\x -> x { c'WorldOptions'mPreferredHardwareBufferFrameSize = int (hardwareBufferSize ro) })+        setOpt (\x -> x { c'WorldOptions'mLoadGraphDefs = bool (loadSynthDefs so) })+        -- tell (\x -> x { c'WorldOptions'mInputStreamsEnabled :: CString+        -- tell (\x -> x { c'WorldOptions'mOutputStreamsEnabled :: CString+        -- TODO: Make input and output device configurable separately+        case hardwareDeviceName ro of+            Nothing -> return ()+            Just name -> do+                setOptS (\x s -> x { c'WorldOptions'mInDeviceName = s }) name+                setOptS (\x s -> x { c'WorldOptions'mOutDeviceName = s }) name+        setOpt (\x -> x { c'WorldOptions'mVerbosity = int (fromEnum (verbosity so)) })+        setOpt (\x -> x { c'WorldOptions'mRendezvous = bool (useZeroconf ro) })+        maybe (return ()) (setOptS (\x s -> x { c'WorldOptions'mUGensPluginPath = s }) . path) (ugenPluginPath so)+        maybe (return ()) (setOptS (\x s -> x { c'WorldOptions'mRestrictedPath = s })) (restrictedPath so)+    opts <- liftM (flip (foldl (flip ($))) fs) (c'kDefaultWorldOptions >>= peek)+    a <- alloca $ \ptr -> do+        ptr `poke` opts+        f ptr+    mapM_ free cs+    return a+    where+        int :: (Integral a, Num b) => a -> b+        int = fromIntegral+        bool :: Num a => Bool -> a+        bool b = int (if b then 1 else 0)+        path :: [String] -> String+        path = L.intercalate ":"+        setOpt f = do+            (fs, cs) <- get+            put (f:fs, cs)+        setOptS f s = do+            ptr <- liftIO (newCString s)+            (fs, cs) <- get+            put (flip f ptr:fs, ptr:cs)+            +instance OSC.Transport InternalTransport where+    send  = sendIT+    recv  = recvIT+    close = closeIT

@@ -0,0 +1,205 @@+{-# LANGUAGE TemplateHaskell #-}+module Sound.SC3.Server.Options (+    Verbosity(..)+  , ServerOptions(..)+  , defaultServerOptions+  , _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+  , NRTOptions(..)+  , defaultNRTOptions+  , _commandFilePath+  , _inputFilePath+  , _outputFilePath+  , _outputSampleRate+  , _outputHeaderFormat+  , _outputSampleFormat+) where++import           Control.Monad.Error+import qualified Data.ConfigFile as CF+import           Sound.SC3.Server.Process.Accessor (deriveAccessors)++-- | Used with the 'verbosity' field in 'ServerOptions'.+data Verbosity =+    Silent+  | Quiet+  | Normal+  | Verbose+  | VeryVerbose+  | ExtremelyVerbose+  deriving (Eq, Read, Show)++instance Enum Verbosity where+    fromEnum Silent           = -2+    fromEnum Quiet            = -1+    fromEnum Normal           = 0+    fromEnum Verbose          = 1+    fromEnum VeryVerbose      = 2+    fromEnum ExtremelyVerbose = 3+    toEnum (-2)               = Silent+    toEnum (-1)               = Quiet+    toEnum 0                  = Normal+    toEnum 1                  = Verbose+    toEnum 2                  = VeryVerbose+    toEnum 3                  = ExtremelyVerbose+    toEnum _                  = error "Verbosity (toEnum): bad argument"++instance CF.Get_C Verbosity where+    get parser section option = do+        s <- CF.get parser section option+        case s of+            "Silent"           -> return Silent+            "Quiet"            -> return Quiet+            "Normal"           -> return Normal+            "Verbose"          -> return Verbose+            "VeryVerbose"      -> return VeryVerbose+            "ExtremelyVerbose" -> return ExtremelyVerbose+            _ -> throwError $ (CF.ParseError $ "Invalid Verbosity value: " ++ s, "")++-- ====================================================================+-- * Server options++-- | Specify general server options used both in realtime and non-realtime+-- mode.+data ServerOptions = ServerOptions {+    serverProgram               :: FilePath          -- ^ Path to the @scsynth@ program+  , numberOfControlBusChannels  :: Int               -- ^ Number of allocated control bus channels+  , numberOfAudioBusChannels    :: Int               -- ^ Number of allocated audio bus channels+  , numberOfInputBusChannels    :: Int               -- ^ Number of physical input channels+  , numberOfOutputBusChannels   :: Int               -- ^ Number of physical output channels+  , blockSize                   :: Int               -- ^ Synthesis block size+  , numberOfSampleBuffers       :: Int               -- ^ Number of allocated sample buffers+  , maxNumberOfNodes            :: Int               -- ^ Maximum number of synthesis nodes+  , maxNumberOfSynthDefs        :: Int               -- ^ Maximum number of synth definitions+  , realtimeMemorySize          :: Int               -- ^ Realtime memory size in bytes+  , numberOfWireBuffers         :: Int               -- ^ Number of unit generator connection buffers+  , numberOfRandomSeeds         :: Int               -- ^ Number of random number generator seeds+  , loadSynthDefs               :: Bool              -- ^ If 'True', load synth definitions from /synthdefs/ directory on startup+  , verbosity                   :: Verbosity         -- ^ 'Verbosity' level+  , ugenPluginPath				:: Maybe [FilePath]  -- ^ List of UGen plugin search paths+  , restrictedPath              :: Maybe FilePath    -- ^ Sandbox path to restrict OSC command filesystem access+} deriving (Eq, Show)++-- | Default server options.+defaultServerOptions :: ServerOptions+defaultServerOptions = ServerOptions {+    serverProgram              = "scsynth"+  , numberOfControlBusChannels = 4096+  , numberOfAudioBusChannels   = 128+  , numberOfInputBusChannels   = 8+  , numberOfOutputBusChannels  = 8+  , blockSize                  = 64+  , numberOfSampleBuffers      = 1024+  , maxNumberOfNodes           = 1024+  , maxNumberOfSynthDefs       = 1024+  , realtimeMemorySize         = 8192+  , numberOfWireBuffers        = 64+  , numberOfRandomSeeds        = 64+  , loadSynthDefs              = True+  , verbosity                  = Normal+  , ugenPluginPath             = Nothing+  , restrictedPath             = Nothing+}++$(deriveAccessors ''ServerOptions)++-- ====================================================================+-- * Realtime options++-- | Realtime server options, parameterized by the OpenSoundControl+-- 'Transport' to be used.+data RTOptions = RTOptions {+    -- Network control+    udpPortNumber           :: Int             -- ^ UDP port number (one of 'udpPortNumber' and 'tcpPortNumber' must be non-zero)+  , tcpPortNumber           :: Int             -- ^ TCP port number (one of 'udpPortNumber' and 'tcpPortNumber' must be non-zero)+  , useZeroconf             :: Bool            -- ^ If 'True', publish scsynth service through Zeroconf+  , maxNumberOfLogins       :: Int             -- ^ Max number of supported logins if 'sessionPassword' is set+  , sessionPassword         :: Maybe String    -- ^ Session password+  -- Audio device control+  , hardwareDeviceName      :: Maybe String    -- ^ Hardware device name (JACK client:server name on Linux)+  , hardwareBufferSize      :: Int             -- ^ Hardware buffer size (no effect with JACK)+  , hardwareSampleRate      :: Int             -- ^ Hardware buffer size (no effect with JACK)+  , inputStreamsEnabled     :: Maybe Int       -- ^ Enabled input streams (CoreAudio only)+  , outputStreamsEnabled    :: Maybe Int       -- ^ Enabled output streams (CoreAudio only)+} deriving (Eq, Show)++-- | Default realtime server options.+defaultRTOptions :: RTOptions+defaultRTOptions = RTOptions {+    -- Network control+    udpPortNumber           = 0,+    tcpPortNumber           = 0,+    useZeroconf             = False,+    maxNumberOfLogins       = 16,+    sessionPassword         = Nothing,+    -- Audio device control+    hardwareDeviceName      = Nothing,+    hardwareBufferSize      = 0,+    hardwareSampleRate      = 0,+    inputStreamsEnabled     = Nothing,+    outputStreamsEnabled    = Nothing+}++$(deriveAccessors ''RTOptions)++-- | Default realtime server options (UDP transport).+defaultRTOptionsUDP :: RTOptions+defaultRTOptionsUDP =  defaultRTOptions { udpPortNumber = 57110 }++-- | Default realtime server options (TCP transport).+defaultRTOptionsTCP :: RTOptions+defaultRTOptionsTCP = defaultRTOptions { tcpPortNumber = 57110 }++-- ====================================================================+-- * Non-Realtime options++-- | Non-realtime server options.+data NRTOptions = NRTOptions {+    commandFilePath    :: Maybe FilePath,  -- ^ Path to OSC command file ('Nothing' for stdin)+    inputFilePath      :: Maybe FilePath,  -- ^ Path to input sound file ('Nothing' for no audio input)+    outputFilePath     :: FilePath,        -- ^ Path to output sound file+    outputSampleRate   :: Int,             -- ^ Output sound file sample rate+    outputHeaderFormat :: String,          -- ^ Output sound file header format+    outputSampleFormat :: String           -- ^ Output sound file sample format+} deriving (Eq, Show)++-- | Default non-realtime server options.+defaultNRTOptions :: NRTOptions+defaultNRTOptions = NRTOptions {+    commandFilePath         = Nothing,+    inputFilePath           = Nothing,+    outputFilePath          = "output.wav",+    outputSampleRate        = 44100,+    outputHeaderFormat      = "wav",+    outputSampleFormat      = "int16"+}++$(deriveAccessors ''NRTOptions)

@@ -2,46 +2,43 @@ -- | This module includes utilities for spawning an external scsynth process, -- either for realtime or non-realtime execution. module Sound.SC3.Server.Process (-    module Sound.SC3.Server.Process.Options,-    OpenTransport(..),-    OutputHandler(..),-    defaultOutputHandler,-    withSynth,-    withNRT+    module Sound.SC3.Server.Options+  , OutputHandler(..)+  , defaultOutputHandler+  , withTransport+  , withSynth+  , openTCP+  , openUDP+  , withNRT ) where -import Sound.OpenSoundControl               (Transport, TCP, UDP, openTCP, openUDP, send)-import Control.Concurrent-import Control.Concurrent.MVar-import Control.Exception-import Control.Monad                        (unless)-import Prelude hiding                       (catch)-import Data.List                            (isPrefixOf)--import Sound.SC3                            (quit)-import Sound.SC3.Server.Process.Accessor    (deriveAccessors)-import Sound.SC3.Server.Process.Options-import Sound.SC3.Server.Process.CommandLine--import System.Exit                          (ExitCode(..))-import System.IO                            (Handle, hGetLine, hIsEOF, hPutStrLn, stderr, stdout)-import System.Process                       (ProcessHandle, runInteractiveProcess, waitForProcess)+import           Control.Concurrent+import           Control.Exception+import           Control.Monad (unless)+import           Prelude hiding (catch)+import           Data.List (isPrefixOf)+import           Sound.OpenSoundControl (Transport, TCP, UDP)+import qualified Sound.OpenSoundControl as OSC+import           Sound.SC3 (quit)+import           Sound.SC3.Server.Options+import           Sound.SC3.Server.Process.CommandLine+import           System.Exit (ExitCode(..))+import           System.IO (Handle, hGetLine, hIsEOF, hPutStrLn, stderr, stdout)+import           System.Process (runInteractiveProcess, waitForProcess) --- | Helper class for polymorphic opening of network connections.-class OpenTransport t where-    -- | Open a transport to scsynth based on the given RTOptions and a hostname.-    openTransport :: RTOptions -> String -> IO t+localhost :: String+localhost = "127.0.0.1"  -- | Check wether a network port is within the valid range (0, 65535] checkPort :: String -> Int -> Int checkPort tag p | p <= 0 || p > 65535 = error ("Invalid " ++ tag ++ " port " ++ show p) checkPort _ p                         = p -instance OpenTransport (UDP) where-    openTransport options server = openUDP server (checkPort "UDP" $ udpPortNumber options)+openTCP :: ServerOptions -> RTOptions -> IO TCP+openTCP _ rtOptions = OSC.openTCP localhost (checkPort "TCP" $ tcpPortNumber rtOptions) -instance OpenTransport (TCP) where-    openTransport options server = openTCP server (checkPort "TCP" $ tcpPortNumber options)+openUDP :: ServerOptions -> RTOptions -> IO UDP+openUDP _ rtOptions = OSC.openUDP localhost (checkPort "UDP" $ udpPortNumber rtOptions)  -- ==================================================================== -- * Output handler@@ -68,6 +65,16 @@ -- ==================================================================== -- * Realtime scsynth execution +withTransport :: (Transport t) =>+    (ServerOptions -> RTOptions -> IO t)+ -> ServerOptions+ -> RTOptions+ -> (t -> IO a)+ -> IO a+withTransport openTransport serverOptions rtOptions =+    bracket (openTransport serverOptions rtOptions)+            OSC.close+ -- | Execute a realtime instance of @scsynth@ with 'Transport' t. -- -- The spawned @scsynth@ is sent a @\/quit@ message after the supplied action@@ -75,13 +82,14 @@ -- -- /NOTE/: When compiling executables with GHC, the @-threaded@ option should -- be passed, otherwise the I\/O handlers will not work correctly.-withSynth :: (Transport t, OpenTransport t) =>-    ServerOptions+withSynth :: (Transport t) =>+    (ServerOptions -> RTOptions -> IO t)+ -> ServerOptions  -> RTOptions  -> OutputHandler  -> (t -> IO a)  -> IO a-withSynth serverOptions rtOptions handler action = do+withSynth openTransport serverOptions rtOptions handler action = do         (_, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing         forkIO $ putStderr hErr         result <- newEmptyMVar@@ -103,16 +111,16 @@             case l of                 Left (ex :: IOException) -> returnExc (toException ex)                 Right l ->-                    if "SuperCollider 3 server ready." `isPrefixOf` l+                    if "SuperCollider 3 server ready" `isPrefixOf` l                         then do                             e <- try (onPutString handler l)                             case e of                                 Left (ex :: IOException) -> returnExc (toException ex)                                 _                        -> do                                     forkIO $ putStdout h-                                    fd <- openTransport rtOptions "127.0.0.1"-                                    a <- try (action fd)-                                    send fd quit+                                    fd <- openTransport serverOptions rtOptions+                                    a <- try (action fd >>= evaluate)+                                    OSC.send fd quit                                     case a of                                         Left (ex :: SomeException) -> returnExc (toException ex)                                         Right a -> returnRes a

@@ -8,7 +8,7 @@ import Data.Accessor import Data.List (intercalate) import Data.Maybe (fromMaybe)-import Sound.SC3.Server.Process.Options+import Sound.SC3.Server.Options  -- ==================================================================== -- scsynth commandline options@@ -34,7 +34,7 @@     showOption (Just a) = showOption a  instance Option (Verbosity) where-    showOption = showOption . ((-)2) . fromEnum+    showOption = showOption . fromEnum  instance Option [FilePath] where     showOption = intercalate ":"

@@ -1,145 +1,169 @@ {-# LANGUAGE FlexibleContexts #-} -- | Read server options from configuraton file. module Sound.SC3.Server.Process.ConfigFile (-    fromAssocs,-    toAssocs+    getOptions+  , setOptions ) where-    -import Control.Monad.Error              (MonadError)-import Control.Monad.Trans.State        (StateT, evalStateT, execStateT)-import Data.Accessor-import Sound.OpenSoundControl           (TCP, UDP)-import Sound.SC3.Server.Process.Options-import Data.ConfigFile                  (CPError, OptionSpec)-import Data.Map                         (Map)-import qualified Data.Map               as Map -readMaybe :: (Read a) => String -> Maybe a-readMaybe s = case reads s of-             [(a, "")] -> return a-             _         -> fail ("Could not read " ++ (show s))+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 --- TODO: Add parse error handling-set :: (Read b, Monad m) => Map OptionSpec String -> OptionSpec -> Accessor a b -> StateT a m ()-set opts name accessor = do-    case Map.lookup name opts of-        Nothing  -> return ()-        Just str -> case readMaybe str of-                        Nothing    -> return ()-                        Just value -> putA accessor value+newtype MaybeConfig a = MaybeConfig { maybeConfig :: Maybe a } -get :: (Show b, Monad m) => OptionSpec -> Accessor a b -> StateT a m (OptionSpec, String)-get name accessor = do-    value <- getA accessor-    return (name, show value)+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 :: (Monad m) => Map OptionSpec String -> m ServerOptions-getServerOptions m = flip execStateT defaultServerOptions $ do-    set m "serverProgram"              _serverProgram-    set m "numberOfControlBusChannels" _numberOfControlBusChannels-    set m "numberOfAudioBusChannels"   _numberOfAudioBusChannels-    set m "numberOfInputBusChannels"   _numberOfInputBusChannels-    set m "numberOfOutputBusChannels"  _numberOfOutputBusChannels-    set m "blockSize"                  _blockSize-    set m "numberOfSampleBuffers"      _numberOfSampleBuffers-    set m "maxNumberOfNodes"           _maxNumberOfNodes-    set m "maxNumberOfSynthDefs"       _maxNumberOfSynthDefs-    set m "realtimeMemorySize"         _realtimeMemorySize-    set m "numberOfWireBuffers"        _numberOfWireBuffers-    set m "numberOfRandomSeeds"        _numberOfRandomSeeds-    set m "loadSynthDefs"              _loadSynthDefs-    set m "verbosity"                  _verbosity+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 :: (Monad m) => Map OptionSpec String -> m RTOptions-getRTOptions m = flip execStateT defaultRTOptions $ do-    set m "udpPortNumber"              _udpPortNumber-    set m "tcpPortNumber"              _tcpPortNumber-    set m "useZeroconf"                _useZeroconf-    set m "maxNumberOfLogins"          _maxNumberOfLogins-    set m "sessionPassword"            _sessionPassword-    set m "hardwareDeviceName"         _hardwareDeviceName-    set m "hardwareBufferSize"         _hardwareBufferSize-    set m "hardwareSampleRate"         _hardwareSampleRate-    set m "inputStreamsEnabled"        _inputStreamsEnabled-    set m "outputStreamsEnabled"       _outputStreamsEnabled+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 :: Monad m => Map OptionSpec String -> m NRTOptions-getNRTOptions m = flip execStateT defaultNRTOptions $ do-    set m "commandFilePath"            _commandFilePath-    set m "inputFilePath"              _inputFilePath-    set m "outputFilePath"             _outputFilePath-    set m "outputSampleRate"           _outputSampleRate-    set m "outputHeaderFormat"         _outputHeaderFormat-    set m "outputSampleFormat"         _outputSampleFormat+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 an--- association list.------ TODO: Add error handling.-fromAssocs :: MonadError CPError m => [(OptionSpec, String)] -> m (ServerOptions, RTOptions, NRTOptions)-fromAssocs opts = do-    srvo <- getServerOptions m-    rto  <- getRTOptions m-    nrto <- getNRTOptions m-    return (srvo, rto, nrto)-    where m = Map.fromList opts+-- | 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) --- | Convert 'ServerOptions' to association list.-assocsServerOptions :: Monad m => ServerOptions -> m [(OptionSpec, String)]-assocsServerOptions options = flip evalStateT options $ sequence [-      get "serverProgram"              _serverProgram-    , get "numberOfControlBusChannels" _numberOfControlBusChannels-    , get "numberOfAudioBusChannels"   _numberOfAudioBusChannels-    , get "numberOfInputBusChannels"   _numberOfInputBusChannels-    , get "numberOfOutputBusChannels"  _numberOfOutputBusChannels-    , get "blockSize"                  _blockSize-    , get "numberOfSampleBuffers"      _numberOfSampleBuffers-    , get "maxNumberOfNodes"           _maxNumberOfNodes-    , get "maxNumberOfSynthDefs"       _maxNumberOfSynthDefs-    , get "realtimeMemorySize"         _realtimeMemorySize-    , get "numberOfWireBuffers"        _numberOfWireBuffers-    , get "numberOfRandomSeeds"        _numberOfRandomSeeds-    , get "loadSynthDefs"              _loadSynthDefs-    , get "verbosity"                  _verbosity-    ]+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') --- | Convert 'RTOptions' to association list.-assocsRTOptions :: Monad m => RTOptions -> m [(OptionSpec, String)]-assocsRTOptions options = flip evalStateT options $ sequence [-      get "udpPortNumber"              _udpPortNumber-    , get "tcpPortNumber"              _tcpPortNumber-    , get "useZeroconf"                _useZeroconf-    , get "maxNumberOfLogins"          _maxNumberOfLogins-    , get "sessionPassword"            _sessionPassword-    , get "hardwareDeviceName"         _hardwareDeviceName-    , get "hardwareBufferSize"         _hardwareBufferSize-    , get "hardwareSampleRate"         _hardwareSampleRate-    , get "inputStreamsEnabled"        _inputStreamsEnabled-    , get "outputStreamsEnabled"       _outputStreamsEnabled-    ]+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 'NRTOptions' to association list.-assocsNRTOptions :: Monad m => NRTOptions -> m [(OptionSpec, String)]-assocsNRTOptions options = flip evalStateT options $ sequence [-      get "commandFilePath"            _commandFilePath-    , get "inputFilePath"              _inputFilePath-    , get "outputFilePath"             _outputFilePath-    , get "outputSampleRate"           _outputSampleRate-    , get "outputHeaderFormat"         _outputHeaderFormat-    , get "outputSampleFormat"         _outputSampleFormat-    ]+-- -- | 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.-toAssocs :: Monad m => ServerOptions -> Maybe RTOptions -> Maybe NRTOptions -> m [(OptionSpec, String)]-toAssocs serverOptions rtOptions nrtOptions = do-    srvo <- assocsServerOptions serverOptions-    rto  <- maybe (return []) assocsRTOptions rtOptions-    nrto <- maybe (return []) assocsNRTOptions nrtOptions-    return $ srvo++rto++nrto+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,144 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module Sound.SC3.Server.Process.Options where--import Data.Accessor                        (Accessor)-import Sound.SC3.Server.Process.Accessor    (deriveAccessors)---- | Used with the 'verbosity' field in 'ServerOptions'.-data Verbosity =-    Silent-  | Quiet-  | Normal-  | Verbose-  | VeryVerbose-  | ExtremelyVerbose-  deriving (Enum, Eq, Read, Show)---- ====================================================================--- * Server options---- | Specify general server options used both in realtime and non-realtime--- mode.-data ServerOptions = ServerOptions {-    serverProgram               :: FilePath          -- ^ Path to the @scsynth@ program-  , numberOfControlBusChannels  :: Int               -- ^ Number of allocated control bus channels-  , numberOfAudioBusChannels    :: Int               -- ^ Number of allocated audio bus channels-  , numberOfInputBusChannels    :: Int               -- ^ Number of physical input channels-  , numberOfOutputBusChannels   :: Int               -- ^ Number of physical output channels-  , blockSize                   :: Int               -- ^ Synthesis block size-  , numberOfSampleBuffers       :: Int               -- ^ Number of allocated sample buffers-  , maxNumberOfNodes            :: Int               -- ^ Maximum number of synthesis nodes-  , maxNumberOfSynthDefs        :: Int               -- ^ Maximum number of synth definitions-  , realtimeMemorySize          :: Int               -- ^ Realtime memory size in bytes-  , numberOfWireBuffers         :: Int               -- ^ Number of unit generator connection buffers-  , numberOfRandomSeeds         :: Int               -- ^ Number of random number generator seeds-  , loadSynthDefs               :: Bool              -- ^ If 'True', load synth definitions from /synthdefs/ directory on startup-  , verbosity                   :: Verbosity         -- ^ 'Verbosity' level-  , ugenPluginPath				:: Maybe [FilePath]  -- ^ List of UGen plugin search paths-  , restrictedPath              :: Maybe FilePath    -- ^ Sandbox path to restrict OSC command filesystem access-} deriving (Eq, Show)---- | Default server options.-defaultServerOptions :: ServerOptions-defaultServerOptions = ServerOptions {-    serverProgram              = "scsynth"-  , numberOfControlBusChannels = 4096-  , numberOfAudioBusChannels   = 128-  , numberOfInputBusChannels   = 8-  , numberOfOutputBusChannels  = 8-  , blockSize                  = 64-  , numberOfSampleBuffers      = 1024-  , maxNumberOfNodes           = 1024-  , maxNumberOfSynthDefs       = 1024-  , realtimeMemorySize         = 8192-  , numberOfWireBuffers        = 64-  , numberOfRandomSeeds        = 64-  , loadSynthDefs              = True-  , verbosity                  = Normal-  , ugenPluginPath             = Nothing-  , restrictedPath             = Nothing-}--$(deriveAccessors ''ServerOptions)--{-# DEPRECATED realTimeMemorySize "Use `realtimeMemorySize' instead" #-}-realTimeMemorySize :: ServerOptions -> Int-realTimeMemorySize = realtimeMemorySize--{-# DEPRECATED _realTimeMemorySize "Use `_realtimeMemorySize' instead" #-}-_realTimeMemorySize :: Accessor ServerOptions Int-_realTimeMemorySize = _realtimeMemorySize---- ====================================================================--- * Realtime options---- | Realtime server options, parameterized by the OpenSoundControl--- 'Transport' to be used.-data RTOptions = RTOptions {-    -- Network control-    udpPortNumber           :: Int,             -- ^ UDP port number (one of 'udpPortNumber' and 'tcpPortNumber' must be non-zero)-    tcpPortNumber           :: Int,             -- ^ TCP port number (one of 'udpPortNumber' and 'tcpPortNumber' must be non-zero)-    useZeroconf             :: Bool,            -- ^ If 'True', publish scsynth service through Zeroconf-    maxNumberOfLogins       :: Int,             -- ^ Max number of supported logins if 'sessionPassword' is set-    sessionPassword         :: Maybe String,    -- ^ Session password-    -- Audio device control-    hardwareDeviceName      :: Maybe String,    -- ^ Hardware device name (JACK client:server name on Linux)-    hardwareBufferSize      :: Int,             -- ^ Hardware buffer size (no effect with JACK)-    hardwareSampleRate      :: Int,             -- ^ Hardware buffer size (no effect with JACK)-    inputStreamsEnabled     :: Maybe Int,       -- ^ Enabled input streams (CoreAudio only)-    outputStreamsEnabled    :: Maybe Int        -- ^ Enabled output streams (CoreAudio only)-} deriving (Eq, Show)---- | Default realtime server options.-defaultRTOptions :: RTOptions-defaultRTOptions = RTOptions {-    -- Network control-    udpPortNumber           = 0,-    tcpPortNumber           = 0,-    useZeroconf             = False,-    maxNumberOfLogins       = 16,-    sessionPassword         = Nothing,-    -- Audio device control-    hardwareDeviceName      = Nothing,-    hardwareBufferSize      = 0,-    hardwareSampleRate      = 0,-    inputStreamsEnabled     = Nothing,-    outputStreamsEnabled    = Nothing-}--$(deriveAccessors ''RTOptions)---- | Default realtime server options (UDP transport).-defaultRTOptionsUDP :: RTOptions-defaultRTOptionsUDP =  defaultRTOptions { udpPortNumber = 57110 }---- | Default realtime server options (TCP transport).-defaultRTOptionsTCP :: RTOptions-defaultRTOptionsTCP = defaultRTOptions { tcpPortNumber = 57110 }---- ====================================================================--- * Non-Realtime options---- | Non-realtime server options.-data NRTOptions = NRTOptions {-    commandFilePath    :: Maybe FilePath,  -- ^ Path to OSC command file ('Nothing' for stdin)-    inputFilePath      :: Maybe FilePath,  -- ^ Path to input sound file ('Nothing' for no audio input)-    outputFilePath     :: FilePath,        -- ^ Path to output sound file-    outputSampleRate   :: Int,             -- ^ Output sound file sample rate-    outputHeaderFormat :: String,          -- ^ Output sound file header format-    outputSampleFormat :: String           -- ^ Output sound file sample format-} deriving (Eq, Show)---- | Default non-realtime server options.-defaultNRTOptions :: NRTOptions-defaultNRTOptions = NRTOptions {-    commandFilePath         = Nothing,-    inputFilePath           = Nothing,-    outputFilePath          = "output.wav",-    outputSampleRate        = 44100,-    outputHeaderFormat      = "wav",-    outputSampleFormat      = "int16"-}--$(deriveAccessors ''NRTOptions)-

@@ -1,44 +1,48 @@-name:               hsc3-process-version:            0.3.1-synopsis:           Create and control scsynth processes-description:        Create and control scsynth processes.-license:            GPL-license-file:       LICENSE-category:           Sound-copyright:          Copyright (c) Stefan Kersten 2008-2009-author:             Stefan Kersten-maintainer:         Stefan Kersten-stability:          provisional-homepage:           http://code.haskell.org/~StefanKersten/code/hsc3-process-tested-with:        GHC == 6.10.1-build-type:         Simple-cabal-version:      >= 1.6+Name:               hsc3-process+Version:            0.4.0+Synopsis:           Create and control scsynth processes+Description:        Create and control scsynth processes.+License:            GPL+License-File:       LICENSE+Category:           Sound+Copyright:          Copyright (c) Stefan Kersten 2008-2010+Author:             Stefan Kersten+Maintainer:         Stefan Kersten+Stability:          experimental+Homepage:           http://space.k-hornz.de/software/hsc3-process+Tested-With:        GHC == 6.10.1, GHC == 6.12.3+Build-Type:         Simple+Cabal-Version:      >= 1.6 -extra-source-files: examples/config.hs+Extra-Source-Files: examples/config.hs                     examples/scsynth.cfg                     examples/sine.hs -library-  exposed-modules:  Sound.SC3.Server.Process+Library+  Exposed-Modules:  Sound.SC3.Server.Internal+                    Sound.SC3.Server.Options+                    Sound.SC3.Server.Process                     Sound.SC3.Server.Process.CommandLine                     Sound.SC3.Server.Process.ConfigFile-                    Sound.SC3.Server.Process.Options-  other-modules:    Sound.SC3.Server.Process.Accessor+  Other-Modules:    Sound.SC3.Server.Process.Accessor -  build-depends:    base >= 3 && < 5+  Build-Depends:    base >= 3 && < 5+                  , bindings-sc3+                  , bytestring >= 0.8 && < 0.10                   , ConfigFile >= 1                   , containers >= 0.2                   , data-accessor >= 0.2                   , data-accessor-template >= 0.2-                  , hosc >= 0.7-                  , hsc3 >= 0.7+                  , data-accessor-mtl >= 0.2+                  , hosc >= 0.7 && < 0.9+                  , hsc3 >= 0.7 && < 0.9                   , mtl >= 1.1                   , process >= 1.0+                  , regex-compat >= 0.9                   , template-haskell >= 2-                  , transformers -  ghc-options:      -Wall+  Ghc-Options:      -W  -source-repository head-  type:             darcs-  location:         http://code.haskell.org/~StefanKersten/code/hsc3-process/+Source-Repository head+  Type:             git+  Location:         git://github.com/kaoskorobase/hsc3-process.git