-- | 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 host name string.
sc3_host_name_def :: String
sc3_host_name_def :: String
sc3_host_name_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

sc3_protocol_def :: Sc3_Protocol
sc3_protocol_def :: Sc3_Protocol
sc3_protocol_def = Sc3_Protocol
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", i
forall i. Num i => i
sc3_port_def)
    Sc3_Protocol
Sc3_Tcp -> (Char
't', String
"tcp-port-number", i
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 =
  Sc3_Protocol -> Sc3_Opt i
forall i. Num i => Sc3_Protocol -> Sc3_Opt i
sc3_opt_port_def Sc3_Protocol
p
    Sc3_Opt i -> [Sc3_Opt i] -> [Sc3_Opt i]
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 = Sc3_Protocol -> [Sc3_Opt i]
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
[('D',"load-synthdefs?",1),('R',"publish-to-rendezvous?",1)]
-}
sc3_opt_bool :: Sc3_Opt i -> Bool
sc3_opt_bool :: forall i. Sc3_Opt i -> Bool
sc3_opt_bool (Char
_, String
s, i
_) = String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
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 -> (Sc3_Opt i -> i) -> Maybe (Sc3_Opt i) -> Maybe i
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sc3_Opt i -> i
forall i. Sc3_Opt i -> i
sc3_opt_value ((Sc3_Opt i -> Bool) -> [Sc3_Opt i] -> Maybe (Sc3_Opt i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Char
o, String
_, i
_) -> Char
o Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) [Sc3_Opt i]
opt)
    Right String
s -> (Sc3_Opt i -> i) -> Maybe (Sc3_Opt i) -> Maybe i
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sc3_Opt i -> i
forall i. Sc3_Opt i -> i
sc3_opt_value ((Sc3_Opt i -> Bool) -> [Sc3_Opt i] -> Maybe (Sc3_Opt i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Char
_, String
o, i
_) -> String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) [Sc3_Opt i]
opt)

{- | Set option given either short or long name.

>>> sc3_opt_get (sc3_opt_set sc3_opt_def_udp (Left 'w',256)) (Right "number-of-wire-buffers")
Just 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 -> (Sc3_Opt i -> Sc3_Opt i) -> [Sc3_Opt i] -> [Sc3_Opt i]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c, String
s, i
y) -> if Char
c Char -> Char -> Bool
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 -> (Sc3_Opt i -> Sc3_Opt i) -> [Sc3_Opt i] -> [Sc3_Opt i]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c, String
s, i
y) -> if String
s String -> String -> Bool
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.

>>> unwords (sc3_opt_arg (sc3_opt_edit sc3_opt_def_udp [(Left 'w',256),(Left 'm',2 ^ 16)]))
"-u 57110 -a 1024 -b 1024 -c 16384 -D 1 -d 1024 -i 8 -l 64 -m 65536 -n 1024 -o 8 -r 64 -R 1 -S 0 -V 0 -w 256 -z 64 -Z 0"
-}
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 -> [Sc3_Opt i] -> [(Either Char String, i)] -> [Sc3_Opt i]
forall i. [Sc3_Opt i] -> [(Either Char String, i)] -> [Sc3_Opt i]
sc3_opt_edit ([Sc3_Opt i] -> (Either Char String, i) -> [Sc3_Opt i]
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)
"-u 57110 -a 1024 -b 1024 -c 16384 -D 1 -d 1024 -i 8 -l 64 -m 8192 -n 1024 -o 8 -r 64 -R 1 -S 0 -V 0 -w 64 -z 64 -Z 0"
-}
sc3_opt_arg :: Show i => [Sc3_Opt i] -> [String]
sc3_opt_arg :: forall i. Show i => [Sc3_Opt i] -> [String]
sc3_opt_arg = (Sc3_Opt i -> [String]) -> [Sc3_Opt i] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Char
c, String
_, i
v) -> [[Char
'-', Char
c], i -> String
forall a. Show a => a -> String
show i
v])

{- | Generate arguments for 'System.Process.callProcess' or related functions.

>>> let o = sc3_opt_def_udp in sc3_opt_cmd o == ("scsynth", sc3_opt_arg o)
True
-}
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", [Sc3_Opt i] -> [String]
forall i. Show i => [Sc3_Opt i] -> [String]
sc3_opt_arg [Sc3_Opt i]
opt)