-- | Nrt statistics.
module Sound.Sc3.Server.Nrt.Stat where

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

import Sound.Sc3.Common.Base {- hsc3 -}
import Sound.Sc3.Server.Nrt {- hsc3 -}

-- | Nrt statistics, see nrt_stat_param for meanings.
type Nrt_Stat =
    ((String, Time)
    ,(String, Int)
    ,(String, Int)
    ,(String, [(String,Int)]))

-- | Nrt_Stat names.
nrt_stat_param :: (String, String, String, String)
nrt_stat_param :: (String, String, String, String)
nrt_stat_param = (String
"duration",String
"# bundles",String
"# messages",String
"command set")

-- | Trivial Nrt statistics.
nrt_stat :: Nrt -> Nrt_Stat
nrt_stat :: Nrt -> Nrt_Stat
nrt_stat (Nrt [Bundle]
b_seq) =
    let b_msg :: [[Message]]
b_msg = forall a b. (a -> b) -> [a] -> [b]
map Bundle -> [Message]
bundleMessages [Bundle]
b_seq
    in forall a b c d e f g h.
(a, b, c, d) -> (e, f, g, h) -> ((a, e), (b, f), (c, g), (d, h))
p4_zip
       (String, String, String, String)
nrt_stat_param
       (Bundle -> Time
bundleTime (forall a. [a] -> a
last [Bundle]
b_seq)
       ,forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bundle]
b_seq
       ,forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Message]]
b_msg)
       ,forall a. Ord a => [a] -> [(a, Int)]
histogram (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map Message -> String
messageAddress) [[Message]]
b_msg))