-- | scsynth server command-line options.
module Sound.Sc3.Server.Options where

import Data.List {- base -}

-- | (short-option, long-option, default-value)
type Sc3_Opt i = (Char,String,i)

-- | Get value from option.
sc3_opt_value :: Sc3_Opt i -> i
sc3_opt_value :: forall i. Sc3_Opt i -> i
sc3_opt_value (Char
_,String
_,i
v) = i
v

-- | Default address string.
sc3_addr_def :: String
sc3_addr_def :: String
sc3_addr_def = String
"127.0.0.1"

-- | Default port number, either a 'u' or a 't' option is required.
sc3_port_def :: Num i => i
sc3_port_def :: forall i. Num i => i
sc3_port_def = i
57110

-- | Protocol is either Udp or Tcp.
data Sc3_Protocol = Sc3_Udp | Sc3_Tcp

-- | Default port option.
sc3_opt_port_def :: Num i => Sc3_Protocol -> Sc3_Opt i
sc3_opt_port_def :: forall i. Num i => Sc3_Protocol -> Sc3_Opt i
sc3_opt_port_def Sc3_Protocol
p =
  case Sc3_Protocol
p of
    Sc3_Protocol
Sc3_Udp -> (Char
'u',String
"udp-port-number",forall i. Num i => i
sc3_port_def)
    Sc3_Protocol
Sc3_Tcp -> (Char
't',String
"tcp-port-number",forall i. Num i => i
sc3_port_def)

-- | SC3 default options.
sc3_opt_def :: Num i => Sc3_Protocol -> [Sc3_Opt i]
sc3_opt_def :: forall i. Num i => Sc3_Protocol -> [Sc3_Opt i]
sc3_opt_def Sc3_Protocol
p =
  forall i. Num i => Sc3_Protocol -> Sc3_Opt i
sc3_opt_port_def Sc3_Protocol
p forall a. a -> [a] -> [a]
:
  [(Char
'a',String
"number-of-audio-bus-channels",i
1024)
  ,(Char
'b',String
"number-of-sample-buffers",i
1024)
  --,('B',"bind-to-address","127.0.0.1")
  ,(Char
'c',String
"number-of-control-bus-channels",i
16384)
  ,(Char
'D',String
"load-synthdefs?",i
1)
  ,(Char
'd',String
"max-number-of-synth-defs",i
1024)
  ,(Char
'i',String
"number-of-input-bus-channels",i
8)
  ,(Char
'l',String
"max-logins",i
64)
  ,(Char
'm',String
"real-time-memory-size",i
8192)
  ,(Char
'n',String
"max-number-of-nodes",i
1024)
  ,(Char
'o',String
"number-of-output-bus-channels",i
8)
  ,(Char
'r',String
"number-of-random-seeds",i
64)
  ,(Char
'R',String
"publish-to-rendezvous?",i
1)
  ,(Char
'S',String
"hardware-sample-rate",i
0)
  ,(Char
'V',String
"verbosity",i
0)
  ,(Char
'w',String
"number-of-wire-buffers",i
64)
  ,(Char
'z',String
"block-size",i
64)
  ,(Char
'Z',String
"hardware-buffer-size",i
0)]

-- | SC3 default options for Udp.
sc3_opt_def_udp :: Num i => [Sc3_Opt i]
sc3_opt_def_udp :: forall i. Num i => [Sc3_Opt i]
sc3_opt_def_udp = forall i. Num i => Sc3_Protocol -> [Sc3_Opt i]
sc3_opt_def Sc3_Protocol
Sc3_Udp

-- | Is option boolean, ie. 0=FALSE and 1=TRUE.
--
-- > filter sc3_opt_bool sc3_opt_def_udp
sc3_opt_bool :: Sc3_Opt i -> Bool
sc3_opt_bool :: forall i. Sc3_Opt i -> Bool
sc3_opt_bool (Char
_,String
s,i
_) = forall a. [a] -> a
last String
s forall a. Eq a => a -> a -> Bool
== Char
'?'

-- | Lookup option given either short or long name.
sc3_opt_get :: [Sc3_Opt i] -> Either Char String -> Maybe i
sc3_opt_get :: forall i. [Sc3_Opt i] -> Either Char String -> Maybe i
sc3_opt_get [Sc3_Opt i]
opt Either Char String
k =
  case Either Char String
k of
    Left Char
c -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i. Sc3_Opt i -> i
sc3_opt_value (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Char
o,String
_,i
_) -> Char
o forall a. Eq a => a -> a -> Bool
== Char
c) [Sc3_Opt i]
opt)
    Right String
s -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i. Sc3_Opt i -> i
sc3_opt_value (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Char
_,String
o,i
_) -> String
o forall a. Eq a => a -> a -> Bool
== String
s) [Sc3_Opt i]
opt)

-- | Set option given either short or long name.
--
-- > sc3_opt_set sc3_opt_def_udp (Left 'w',256)
sc3_opt_set :: [Sc3_Opt i] -> (Either Char String,i) -> [Sc3_Opt i]
sc3_opt_set :: forall i. [Sc3_Opt i] -> (Either Char String, i) -> [Sc3_Opt i]
sc3_opt_set [Sc3_Opt i]
opt (Either Char String
k,i
v) =
  case Either Char String
k of
    Left Char
x -> forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c,String
s,i
y) -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
x then (Char
c,String
s,i
v) else (Char
c,String
s,i
y)) [Sc3_Opt i]
opt
    Right String
x -> forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c,String
s,i
y) -> if String
s forall a. Eq a => a -> a -> Bool
== String
x then (Char
c,String
s,i
v) else (Char
c,String
s,i
y)) [Sc3_Opt i]
opt

-- | Apply set of edits to options.
--
-- > sc3_opt_edit sc3_opt_def_udp [(Left 'w',256),(Left 'm',2 ^ 16)]
sc3_opt_edit :: [Sc3_Opt i] -> [(Either Char String,i)] -> [Sc3_Opt i]
sc3_opt_edit :: forall i. [Sc3_Opt i] -> [(Either Char String, i)] -> [Sc3_Opt i]
sc3_opt_edit [Sc3_Opt i]
opt [(Either Char String, i)]
edt =
  case [(Either Char String, i)]
edt of
    [] -> [Sc3_Opt i]
opt
    (Either Char String, i)
x:[(Either Char String, i)]
rst -> forall i. [Sc3_Opt i] -> [(Either Char String, i)] -> [Sc3_Opt i]
sc3_opt_edit (forall i. [Sc3_Opt i] -> (Either Char String, i) -> [Sc3_Opt i]
sc3_opt_set [Sc3_Opt i]
opt (Either Char String, i)
x) [(Either Char String, i)]
rst

-- | Generate scsynth argument list.
--
-- > unwords (sc3_opt_arg sc3_opt_def_udp)
sc3_opt_arg :: Show i => [Sc3_Opt i] -> [String]
sc3_opt_arg :: forall i. Show i => [Sc3_Opt i] -> [String]
sc3_opt_arg = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Char
c,String
_,i
v) -> [[Char
'-',Char
c],forall a. Show a => a -> String
show i
v])

-- | Generate arguments for 'System.Process.callProcess' or related functions.
--
-- > sc3_opt_cmd sc3_opt_def_udp
sc3_opt_cmd :: Show i => [Sc3_Opt i] -> (FilePath,[String])
sc3_opt_cmd :: forall i. Show i => [Sc3_Opt i] -> (String, [String])
sc3_opt_cmd [Sc3_Opt i]
opt = (String
"scsynth",forall i. Show i => [Sc3_Opt i] -> [String]
sc3_opt_arg [Sc3_Opt i]
opt)