hsc3-process-0.4.0: Sound/SC3/Server/Process/ConfigFile.hs
{-# 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