{- | 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.SC3.Server.Command.Plain

-- * Status

-- | Get /n/th field of /status.reply message as 'Floating'.
extractStatusField :: Floating n => Int -> [Datum] -> n
extractStatusField :: Int -> [Datum] -> n
extractStatusField Int
n =
    n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> n
forall a. HasCallStack => [Char] -> a
error [Char]
"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 ([Char] -> [Datum] -> Int -> Datum
forall a. HasCallStack => [Char] -> [a] -> Int -> a
Safe.atNote [Char]
"extractStatusField") Int
n

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

-- | Status pretty printer.
statusFormat :: [Datum] -> [String]
statusFormat :: [Datum] -> [[Char]]
statusFormat [Datum]
d =
    let s :: [Char]
s = [Char]
"***** SuperCollider Server Status *****"
    in [Char]
s [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char] -> [Char] -> [Char]) -> [[Char]] -> [[Char]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
statusFields) ((Datum -> [Char]) -> [Datum] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (FP_Precision -> Datum -> [Char]
datum_pp_typed (Int -> FP_Precision
forall a. a -> Maybe a
Just Int
5)) ([Datum] -> [Datum]
forall a. [a] -> [a]
tail [Datum]
d))

-- | Concise pretty printer, one line, omits PEAK-CPU and NOMINAL-SR.
status_format_concise :: [Datum] -> String
status_format_concise :: [Datum] -> [Char]
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] ->
      [Char]
-> Int32 -> Int32 -> Int32 -> Int32 -> Float -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf
      [Char]
"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]
_ -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"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
/= :: Query_Node -> Query_Node -> Bool
$c/= :: Query_Node -> Query_Node -> Bool
== :: Query_Node -> Query_Node -> Bool
$c== :: Query_Node -> Query_Node -> Bool
Eq,Int -> Query_Node -> [Char] -> [Char]
[Query_Node] -> [Char] -> [Char]
Query_Node -> [Char]
(Int -> Query_Node -> [Char] -> [Char])
-> (Query_Node -> [Char])
-> ([Query_Node] -> [Char] -> [Char])
-> Show Query_Node
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Query_Node] -> [Char] -> [Char]
$cshowList :: [Query_Node] -> [Char] -> [Char]
show :: Query_Node -> [Char]
$cshow :: Query_Node -> [Char]
showsPrec :: Int -> Query_Node -> [Char] -> [Char]
$cshowsPrec :: Int -> Query_Node -> [Char] -> [Char]
Show)

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

-- | Pretty-print 'Query_Node'
query_node_pp :: Query_Node -> String
query_node_pp :: Query_Node -> [Char]
query_node_pp Query_Node
n =
    case Query_Node
n of
      Query_Group Int
k [Query_Node]
_ -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
      Query_Synth Int
k [Char]
nm Maybe [Query_Ctl]
c ->
          let c' :: [Char]
c' = [[Char]] -> [Char]
unwords ([[Char]]
-> ([Query_Ctl] -> [[Char]]) -> Maybe [Query_Ctl] -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Query_Ctl -> [Char]) -> [Query_Ctl] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Query_Ctl -> [Char]
query_ctl_pp) Maybe [Query_Ctl]
c)
          in (Int, [Char], [Char]) -> [Char]
forall a. Show a => a -> [Char]
show (Int
k,[Char]
nm,[Char]
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 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error (([Char], b, c) -> [Char]
forall a. Show a => a -> [Char]
show ([Char]
"queryTree_ctl",b
msg,c
val))
        f :: Datum -> Either [Char] b
f Datum
d = case Datum
d of
                ASCII_String ASCII
nm -> [Char] -> Either [Char] b
forall a b. a -> Either a b
Left (ASCII -> [Char]
C.unpack ASCII
nm)
                Int32 Int32
ix -> b -> Either [Char] b
forall a b. b -> Either a b
Right (Int32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ix)
                Datum
_ -> [Char] -> Datum -> Either [Char] b
forall b c a. (Show b, Show c) => b -> c -> a
err [Char]
"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)
                ASCII_String ASCII
b -> case ASCII -> [Char]
C.unpack ASCII
b of
                                    Char
'c' : [Char]
n -> b -> Either a b
forall a b. b -> Either a b
Right ([Char] -> b
forall a. Read a => [Char] -> a
read [Char]
n)
                                    [Char]
_ -> [Char] -> Datum -> Either a b
forall b c a. (Show b, Show c) => b -> c -> a
err [Char]
"c:_" Datum
d
                Datum
_ -> [Char] -> Datum -> Either a b
forall b c a. (Show b, Show c) => b -> c -> a
err [Char]
"float/string" Datum
d
    in (Datum -> Either [Char] Int
forall b. Num b => Datum -> Either [Char] 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 -> [Char] -> [Datum] -> (Query_Node, [Datum])
queryTree_synth Bool
rc Int
k [Char]
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]
_ -> [Char] -> ([Query_Ctl], [Datum])
forall a. HasCallStack => [Char] -> a
error [Char]
"queryTree_synth"
    in if Bool
rc
       then let ([Query_Ctl]
p,[Datum]
d') = [Datum] -> ([Query_Ctl], [Datum])
f [Datum]
d
            in (Int -> [Char] -> Maybe [Query_Ctl] -> Query_Node
Query_Synth Int
k [Char]
nm ([Query_Ctl] -> Maybe [Query_Ctl]
forall a. a -> Maybe a
Just [Query_Ctl]
p),[Datum]
d')
       else (Int -> [Char] -> Maybe [Query_Ctl] -> Query_Node
Query_Synth Int
k [Char]
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) : ASCII_String ASCII
nm : [Datum]
d' ->
          Bool -> Int -> [Char] -> [Datum] -> (Query_Node, [Datum])
queryTree_synth Bool
rc (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nid) (ASCII -> [Char]
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]
_ -> [Char] -> (Query_Node, [Datum])
forall a. HasCallStack => [Char] -> a
error [Char]
"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])
_ -> [Char] -> Query_Node
forall a. HasCallStack => [Char] -> a
error [Char]
"queryTree"
      [Datum]
_ -> [Char] -> Query_Node
forall a. HasCallStack => [Char] -> a
error [Char]
"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
_ [Char]
_ 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
_ [Char]
_ Maybe [Query_Ctl]
_ -> Query_Node -> Forest Query_Node -> Tree Query_Node
forall a. a -> Forest a -> Tree a
T.Node Query_Node
n []
      Query_Group Int
_ [Query_Node]
c -> Query_Node -> Forest Query_Node -> Tree Query_Node
forall a. a -> Forest a -> Tree a
T.Node Query_Node
n ((Query_Node -> Tree Query_Node)
-> [Query_Node] -> Forest Query_Node
forall a b. (a -> b) -> [a] -> [b]
map Query_Node -> Tree Query_Node
queryTree_rt [Query_Node]
c)