{- | Request and display status information from the synthesis server.

\/status messages receive \/status.reply messages.

\/g_queryTree messages recieve \/g_queryTree.reply messages.
-}
module Sound.Sc3.Server.Status where

import Data.List {- base -}
import Data.Maybe {- base -}
import Text.Printf {- base -}

import qualified Data.ByteString.Char8 as C {- bytestring -}
import qualified Data.Tree as T {- containers -}
import qualified Safe {- safe -}

import Sound.Osc.Datum {- hosc -}
import Sound.Osc.Text {- hosc -}

import Sound.Sc3.Server.Command.Plain

-- * Status

-- | Get /n/th field of /status.reply message as 'Floating'.
extractStatusField :: Floating n => Int -> [Datum] -> n
extractStatusField :: forall n. Floating n => Int -> [Datum] -> n
extractStatusField Int
n =
  n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe (String -> n
forall a. HasCallStack => String -> a
error String
"extractStatusField")
    (Maybe n -> n) -> ([Datum] -> Maybe n) -> [Datum] -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> Maybe n
forall n. Floating n => Datum -> Maybe n
datum_floating
    (Datum -> Maybe n) -> ([Datum] -> Datum) -> [Datum] -> Maybe n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Datum] -> Int -> Datum) -> Int -> [Datum] -> Datum
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> [Datum] -> Int -> Datum
forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote String
"extractStatusField") Int
n

-- | Names of /status.reply fields sent in reply to /status request.
statusFields :: [String]
statusFields :: [String]
statusFields =
  [ String
"Unused                      "
  , String
"# Ugens                     "
  , String
"# Synths                    "
  , String
"# Groups                    "
  , String
"# Synthdefs                 "
  , String
"% CPU (Average)             "
  , String
"% CPU (Peak)                "
  , String
"Sample Rate (Nominal)       "
  , String
"Sample Rate (Actual)        "
  ]

-- | Status pretty printer.
statusFormat :: [Datum] -> [String]
statusFormat :: [Datum] -> [String]
statusFormat [Datum]
d =
  let s :: String
s = String
"***** SuperCollider Server Status *****"
      t :: [a] -> [a]
t = String -> [a] -> [a]
forall a. HasCallStack => String -> [a] -> [a]
Safe.tailNote String
"statusFormat"
  in String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a. [a] -> [a] -> [a]
(++) ([String] -> [String]
forall {a}. [a] -> [a]
t [String]
statusFields) ((Datum -> String) -> [Datum] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FpPrecision -> Datum -> String
showDatum (Int -> FpPrecision
forall a. a -> Maybe a
Just Int
5)) ([Datum] -> [Datum]
forall {a}. [a] -> [a]
t [Datum]
d))

-- | Concise pretty printer, one line, omits Peak-Cpu and Nominal-Sr.
status_format_concise :: [Datum] -> String
status_format_concise :: [Datum] -> String
status_format_concise [Datum]
d =
  case [Datum]
d of
    [Int32 Int32
_, Int32 Int32
ugn, Int32 Int32
grp, Int32 Int32
syn, Int32 Int32
ins, Float Float
cpu1, Float Float
_cpu2, Double Double
_sr1, Double Double
sr2] ->
      String
-> Int32 -> Int32 -> Int32 -> Int32 -> Float -> Double -> String
forall r. PrintfType r => String -> r
printf
        String
"UGN=%-5d GRP=%-5d SYN=%-5d INS=%-5d CPU=%-5.1f SR=%-7.1f"
        Int32
ugn
        Int32
grp
        Int32
syn
        Int32
ins
        Float
cpu1
        Double
sr2
    [Datum]
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"status_format_concise?"

-- * Query Group

-- | Name or index and value or bus mapping.
type Query_Ctl = (Either String Int, Either Double Int)

-- | Nodes are either groups of synths.
data Query_Node
  = Query_Group Group_Id [Query_Node]
  | Query_Synth Synth_Id String (Maybe [Query_Ctl])
  deriving (Query_Node -> Query_Node -> Bool
(Query_Node -> Query_Node -> Bool)
-> (Query_Node -> Query_Node -> Bool) -> Eq Query_Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query_Node -> Query_Node -> Bool
== :: Query_Node -> Query_Node -> Bool
$c/= :: Query_Node -> Query_Node -> Bool
/= :: Query_Node -> Query_Node -> Bool
Eq, Int -> Query_Node -> String -> String
[Query_Node] -> String -> String
Query_Node -> String
(Int -> Query_Node -> String -> String)
-> (Query_Node -> String)
-> ([Query_Node] -> String -> String)
-> Show Query_Node
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Query_Node -> String -> String
showsPrec :: Int -> Query_Node -> String -> String
$cshow :: Query_Node -> String
show :: Query_Node -> String
$cshowList :: [Query_Node] -> String -> String
showList :: [Query_Node] -> String -> String
Show)

-- | Pretty-print 'Query_Ctl'
query_ctl_pp :: Query_Ctl -> String
query_ctl_pp :: Query_Ctl -> String
query_ctl_pp (Either String Int
p, Either Double Int
q) = (String -> String)
-> (Int -> String) -> Either String Int -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id Int -> String
forall a. Show a => a -> String
show Either String Int
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Double -> String)
-> (Int -> String) -> Either Double Int -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Double -> String
forall a. Show a => a -> String
show Int -> String
forall a. Show a => a -> String
show Either Double Int
q

-- | Pretty-print 'Query_Node'
query_node_pp :: Query_Node -> String
query_node_pp :: Query_Node -> String
query_node_pp Query_Node
n =
  case Query_Node
n of
    Query_Group Int
k [Query_Node]
_ -> Int -> String
forall a. Show a => a -> String
show Int
k
    Query_Synth Int
k String
nm Maybe [Query_Ctl]
c ->
      let c' :: String
c' = [String] -> String
unwords ([String]
-> ([Query_Ctl] -> [String]) -> Maybe [Query_Ctl] -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Query_Ctl -> String) -> [Query_Ctl] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Query_Ctl -> String
query_ctl_pp) Maybe [Query_Ctl]
c)
      in (Int, String, String) -> String
forall a. Show a => a -> String
show (Int
k, String
nm, String
c')

{- | Control (parameter) data may be given as names or indices and as
values or bus mappings.

> queryTree_ctl (string "freq",float 440) == (Left "freq",Left 440.0)
> queryTree_ctl (int32 1,string "c0") == (Right 1,Right 0)
-}
queryTree_ctl :: (Datum, Datum) -> Query_Ctl
queryTree_ctl :: (Datum, Datum) -> Query_Ctl
queryTree_ctl (Datum
p, Datum
q) =
  let err :: b -> c -> a
err b
msg c
val = String -> a
forall a. HasCallStack => String -> a
error ((String, b, c) -> String
forall a. Show a => a -> String
show (String
"queryTree_ctl", b
msg, c
val))
      f :: Datum -> Either String b
f Datum
d = case Datum
d of
        AsciiString Ascii
nm -> String -> Either String b
forall a b. a -> Either a b
Left (Ascii -> String
C.unpack Ascii
nm)
        Int32 Int32
ix -> b -> Either String b
forall a b. b -> Either a b
Right (Int32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ix)
        Datum
_ -> String -> Datum -> Either String b
forall {b} {c} {a}. (Show b, Show c) => b -> c -> a
err String
"string/int32" Datum
d
      g :: Datum -> Either a b
g Datum
d = case Datum
d of
        Float Float
k -> a -> Either a b
forall a b. a -> Either a b
Left (Float -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
k)
        AsciiString Ascii
b -> case Ascii -> String
C.unpack Ascii
b of
          Char
'c' : String
n -> b -> Either a b
forall a b. b -> Either a b
Right (String -> b
forall a. Read a => String -> a
read String
n)
          String
_ -> String -> Datum -> Either a b
forall {b} {c} {a}. (Show b, Show c) => b -> c -> a
err String
"c:_" Datum
d
        Datum
_ -> String -> Datum -> Either a b
forall {b} {c} {a}. (Show b, Show c) => b -> c -> a
err String
"float/string" Datum
d
  in (Datum -> Either String Int
forall {b}. Num b => Datum -> Either String b
f Datum
p, Datum -> Either Double Int
forall {a} {b}. (Fractional a, Read b) => Datum -> Either a b
g Datum
q)

{- | If /rc/ is 'True' then 'Query_Ctl' data is expected (ie. flag was set at @\/g_queryTree@).
/k/ is the synth-id, and /nm/ the name.

> let d = [int32 1,string "freq",float 440]
> in queryTree_synth True 1000 "saw" d
-}
queryTree_synth :: Bool -> Synth_Id -> String -> [Datum] -> (Query_Node, [Datum])
queryTree_synth :: Bool -> Int -> String -> [Datum] -> (Query_Node, [Datum])
queryTree_synth Bool
rc Int
k String
nm [Datum]
d =
  let pairs :: [b] -> [(b, b)]
pairs [b]
l = case [b]
l of
        b
e0 : b
e1 : [b]
l' -> (b
e0, b
e1) (b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
: [b] -> [(b, b)]
pairs [b]
l'
        [b]
_ -> []
      f :: [Datum] -> ([Query_Ctl], [Datum])
f [Datum]
r = case [Datum]
r of
        Int32 Int32
n : [Datum]
r' ->
          let ([Datum]
p, [Datum]
r'') = Int32 -> [Datum] -> ([Datum], [Datum])
forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt (Int32
n Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
2) [Datum]
r'
          in (((Datum, Datum) -> Query_Ctl) -> [(Datum, Datum)] -> [Query_Ctl]
forall a b. (a -> b) -> [a] -> [b]
map (Datum, Datum) -> Query_Ctl
queryTree_ctl ([Datum] -> [(Datum, Datum)]
forall {b}. [b] -> [(b, b)]
pairs [Datum]
p), [Datum]
r'')
        [Datum]
_ -> String -> ([Query_Ctl], [Datum])
forall a. HasCallStack => String -> a
error String
"queryTree_synth"
  in if Bool
rc
      then
        let ([Query_Ctl]
p, [Datum]
d') = [Datum] -> ([Query_Ctl], [Datum])
f [Datum]
d
        in (Int -> String -> Maybe [Query_Ctl] -> Query_Node
Query_Synth Int
k String
nm ([Query_Ctl] -> Maybe [Query_Ctl]
forall a. a -> Maybe a
Just [Query_Ctl]
p), [Datum]
d')
      else (Int -> String -> Maybe [Query_Ctl] -> Query_Node
Query_Synth Int
k String
nm Maybe [Query_Ctl]
forall a. Maybe a
Nothing, [Datum]
d)

-- | Generate 'Query_Node' for indicated 'Group_Id'.
queryTree_group :: Bool -> Group_Id -> Int -> [Datum] -> (Query_Node, [Datum])
queryTree_group :: Bool -> Int -> Int -> [Datum] -> (Query_Node, [Datum])
queryTree_group Bool
rc Int
gid Int
nc =
  let recur :: t -> [Query_Node] -> [Datum] -> (Query_Node, [Datum])
recur t
n [Query_Node]
r [Datum]
d =
        if t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
          then (Int -> [Query_Node] -> Query_Node
Query_Group Int
gid ([Query_Node] -> [Query_Node]
forall {a}. [a] -> [a]
reverse [Query_Node]
r), [Datum]
d)
          else
            let (Query_Node
c, [Datum]
d') = Bool -> [Datum] -> (Query_Node, [Datum])
queryTree_child Bool
rc [Datum]
d
            in t -> [Query_Node] -> [Datum] -> (Query_Node, [Datum])
recur (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Query_Node
c Query_Node -> [Query_Node] -> [Query_Node]
forall a. a -> [a] -> [a]
: [Query_Node]
r) [Datum]
d'
  in Int -> [Query_Node] -> [Datum] -> (Query_Node, [Datum])
forall {t}.
(Eq t, Num t) =>
t -> [Query_Node] -> [Datum] -> (Query_Node, [Datum])
recur Int
nc []

-- | Either 'queryTree_synth' or 'queryTree_group'.
queryTree_child :: Bool -> [Datum] -> (Query_Node, [Datum])
queryTree_child :: Bool -> [Datum] -> (Query_Node, [Datum])
queryTree_child Bool
rc [Datum]
d =
  case [Datum]
d of
    Int32 Int32
nid : Int32 (-1) : AsciiString Ascii
nm : [Datum]
d' ->
      Bool -> Int -> String -> [Datum] -> (Query_Node, [Datum])
queryTree_synth Bool
rc (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nid) (Ascii -> String
C.unpack Ascii
nm) [Datum]
d'
    Int32 Int32
gid : Int32 Int32
nc : [Datum]
d' ->
      Bool -> Int -> Int -> [Datum] -> (Query_Node, [Datum])
queryTree_group Bool
rc (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
gid) (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nc) [Datum]
d'
    [Datum]
_ -> String -> (Query_Node, [Datum])
forall a. HasCallStack => String -> a
error String
"queryTree_child"

-- | Parse result of ' g_queryTree '.
queryTree :: [Datum] -> Query_Node
queryTree :: [Datum] -> Query_Node
queryTree [Datum]
d =
  case [Datum]
d of
    Int32 Int32
rc : Int32 Int32
gid : Int32 Int32
nc : [Datum]
d' ->
      let rc' :: Bool
rc' = Int32
rc Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
0
          gid' :: Int
gid' = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
gid
          nc' :: Int
nc' = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nc
      in case Bool -> Int -> Int -> [Datum] -> (Query_Node, [Datum])
queryTree_group Bool
rc' Int
gid' Int
nc' [Datum]
d' of
          (Query_Node
r, []) -> Query_Node
r
          (Query_Node, [Datum])
_ -> String -> Query_Node
forall a. HasCallStack => String -> a
error String
"queryTree"
    [Datum]
_ -> String -> Query_Node
forall a. HasCallStack => String -> a
error String
"queryTree"

-- | Extact sequence of 'Group_Id's from 'Query_Node'.
queryNode_to_group_seq :: Query_Node -> [Group_Id]
queryNode_to_group_seq :: Query_Node -> [Int]
queryNode_to_group_seq Query_Node
nd =
  case Query_Node
nd of
    Query_Group Int
k [Query_Node]
ch -> Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Query_Node -> [Int]) -> [Query_Node] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Query_Node -> [Int]
queryNode_to_group_seq [Query_Node]
ch
    Query_Synth Int
_ String
_ Maybe [Query_Ctl]
_ -> []

-- | Transform 'Query_Node' to 'T.Tree'.
queryTree_rt :: Query_Node -> T.Tree Query_Node
queryTree_rt :: Query_Node -> Tree Query_Node
queryTree_rt Query_Node
n =
  case Query_Node
n of
    Query_Synth Int
_ String
_ Maybe [Query_Ctl]
_ -> Query_Node -> [Tree Query_Node] -> Tree Query_Node
forall a. a -> [Tree a] -> Tree a
T.Node Query_Node
n []
    Query_Group Int
_ [Query_Node]
c -> Query_Node -> [Tree Query_Node] -> Tree Query_Node
forall a. a -> [Tree a] -> Tree a
T.Node Query_Node
n ((Query_Node -> Tree Query_Node)
-> [Query_Node] -> [Tree Query_Node]
forall a b. (a -> b) -> [a] -> [b]
map Query_Node -> Tree Query_Node
queryTree_rt [Query_Node]
c)