{-# LANGUAGE OverloadedStrings #-}

-- | Pure log analysis for the free-agent bus.
--
-- Computes flow metrics from a stamped JSONL log: Re_bus, SNR,
-- posts-per-deliverable, and time-to-quiescence.  Classifications are
-- regex-driven and overridable so old transcripts can be re-analysed.
module Free.Agent.BusStats
  ( -- * Rules
    Rules (..),
    defaultRules,
    Classification (..),
    classify,
    isDeliverable,
    isDoneClaim,

    -- * Slicing
    SliceMode (..),
    slicePosts,

    -- * Statistics
    Stats (..),
    computeStats,

    -- * Rendering
    renderStats,
    renderStatsJson,
  )
where

import Circuit.Agent (Post (..), PostId)
import Circuit.Agent.Framing (Stamped, stamp, stamped)
import Circuit.Parser.Json (Json (..))
import Data.Bifunctor (first)
import Data.List (minimumBy, sort, sortOn)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime)
import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
import Free.Agent.Json (encodeJsonText, jarray, jbool, jnum, jobject, jtext)
import Numeric.Natural (Natural)
import Text.Printf (printf)
import Text.Regex.TDFA ((=~))

-- ---------------------------------------------------------------------------
-- Classification rules
-- ---------------------------------------------------------------------------

-- | Regex-driven classification rules.  Each field is a single regex; the
-- default 'signalRE' combines path, mark, and decision-word alternatives.
data Rules = Rules
  { -- | Regex matching noise (status pings, idle chatter).
    Rules -> Text
noiseRE :: Text,
    -- | Regex matching signal (paths, marks, decisions).
    Rules -> Text
signalRE :: Text,
    -- | Regex matching a conductor deliverable mark.
    Rules -> Text
deliverableRE :: Text
  }
  deriving (Rules -> Rules -> Bool
(Rules -> Rules -> Bool) -> (Rules -> Rules -> Bool) -> Eq Rules
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rules -> Rules -> Bool
== :: Rules -> Rules -> Bool
$c/= :: Rules -> Rules -> Bool
/= :: Rules -> Rules -> Bool
Eq, Int -> Rules -> ShowS
[Rules] -> ShowS
Rules -> String
(Int -> Rules -> ShowS)
-> (Rules -> String) -> ([Rules] -> ShowS) -> Show Rules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rules -> ShowS
showsPrec :: Int -> Rules -> ShowS
$cshow :: Rules -> String
show :: Rules -> String
$cshowList :: [Rules] -> ShowS
showList :: [Rules] -> ShowS
Show)

-- | Sensible defaults decided with the card.
defaultRules :: Rules
defaultRules :: Rules
defaultRules =
  Rules
    { noiseRE :: Text
noiseRE = Text
"standing by|session complete|^ack$|ping|still here|waiting on",
      signalRE :: Text
signalRE = Text
"[^[:space:]]+\\.(md|hs|cabal|jsonl)|🟢|⟝|🚩|decided|fixed|bug|found",
      deliverableRE :: Text
deliverableRE = Text
"🟢"
    }

-- | Path regex shared between signal detection and DONE-claim detection.
pathRE :: Text
pathRE :: Text
pathRE = Text
"[^[:space:]]+\\.(md|hs|cabal|jsonl)"

-- | A post is signal, noise, or neutral.
data Classification = Signal | Noise | Neutral
  deriving (Classification -> Classification -> Bool
(Classification -> Classification -> Bool)
-> (Classification -> Classification -> Bool) -> Eq Classification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Classification -> Classification -> Bool
== :: Classification -> Classification -> Bool
$c/= :: Classification -> Classification -> Bool
/= :: Classification -> Classification -> Bool
Eq, Int -> Classification -> ShowS
[Classification] -> ShowS
Classification -> String
(Int -> Classification -> ShowS)
-> (Classification -> String)
-> ([Classification] -> ShowS)
-> Show Classification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Classification -> ShowS
showsPrec :: Int -> Classification -> ShowS
$cshow :: Classification -> String
show :: Classification -> String
$cshowList :: [Classification] -> ShowS
showList :: [Classification] -> ShowS
Show)

-- | Classify a post.  Signal takes precedence over noise: a post matching the
-- noise regex but carrying a path or mark is counted as signal.
classify :: Rules -> Post Text -> Classification
classify :: Rules -> Post Text -> Classification
classify Rules
rules Post Text
p
  | Text -> Text -> Bool
matches (Rules -> Text
signalRE Rules
rules) (Post Text -> Text
forall a. Post a -> a
body Post Text
p) = Classification
Signal
  | Text -> Text -> Bool
matches (Rules -> Text
noiseRE Rules
rules) (Post Text -> Text
forall a. Post a -> a
body Post Text
p) = Classification
Noise
  | Bool
otherwise = Classification
Neutral

-- | Whether a post is a conductor deliverable.
isDeliverable :: Rules -> Post Text -> Bool
isDeliverable :: Rules -> Post Text -> Bool
isDeliverable Rules
rules Post Text
p = Text -> Text -> Bool
matches (Rules -> Text
deliverableRE Rules
rules) (Post Text -> Text
forall a. Post a -> a
body Post Text
p)

-- | Whether a post claims completion and cites a path.
isDoneClaim :: Post Text -> Bool
isDoneClaim :: Post Text -> Bool
isDoneClaim Post Text
p =
  Text -> Text -> Bool
T.isInfixOf Text
"DONE" (Text -> Text
T.toUpper (Post Text -> Text
forall a. Post a -> a
body Post Text
p)) Bool -> Bool -> Bool
&& Text -> Text -> Bool
matches Text
pathRE (Post Text -> Text
forall a. Post a -> a
body Post Text
p)

-- | Case-insensitive regex match against a body.
matches :: Text -> Text -> Bool
matches :: Text -> Text -> Bool
matches Text
pat Text
txt = Text -> String
T.unpack Text
txt String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> String
T.unpack Text
pat

-- ---------------------------------------------------------------------------
-- Time handling
-- ---------------------------------------------------------------------------

-- | Parse the timestamp format written by the bus scribe.
-- | Format a timestamp for display.
formatTs :: UTCTime -> Text
formatTs :: UTCTime -> Text
formatTs = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M:%S"

-- | Minutes between two timestamps.
minutes :: UTCTime -> UTCTime -> Double
minutes :: UTCTime -> UTCTime -> Double
minutes UTCTime
a UTCTime
b = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
b UTCTime
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60.0

-- ---------------------------------------------------------------------------
-- Slicing
-- ---------------------------------------------------------------------------

-- | How to partition the log for metric computation.
data SliceMode
  = -- | One slice over the entire log.
    WholeLog
  | -- | Fixed-width time buckets in minutes.
    WindowMinutes Int
  | -- | One slice per thread tree (grouped by root post id).
    ByThread
  | -- | One slice per authoring agent.
    ByAgent
  deriving (SliceMode -> SliceMode -> Bool
(SliceMode -> SliceMode -> Bool)
-> (SliceMode -> SliceMode -> Bool) -> Eq SliceMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SliceMode -> SliceMode -> Bool
== :: SliceMode -> SliceMode -> Bool
$c/= :: SliceMode -> SliceMode -> Bool
/= :: SliceMode -> SliceMode -> Bool
Eq, Int -> SliceMode -> ShowS
[SliceMode] -> ShowS
SliceMode -> String
(Int -> SliceMode -> ShowS)
-> (SliceMode -> String)
-> ([SliceMode] -> ShowS)
-> Show SliceMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SliceMode -> ShowS
showsPrec :: Int -> SliceMode -> ShowS
$cshow :: SliceMode -> String
show :: SliceMode -> String
$cshowList :: [SliceMode] -> ShowS
showList :: [SliceMode] -> ShowS
Show)

-- | Partition stamped posts into slices.  Posts without a parseable timestamp
-- are dropped from time-based slicing, but kept for thread slicing (where the
-- id is enough).
slicePosts :: SliceMode -> [Stamped Text] -> [(Text, [Stamped Text])]
slicePosts :: SliceMode -> [Stamped Text] -> [(Text, [Stamped Text])]
slicePosts SliceMode
WholeLog [Stamped Text]
posts = [(Text
"whole", [Stamped Text]
posts)]
slicePosts (WindowMinutes Int
m) [Stamped Text]
posts =
  case [(UTCTime, Stamped Text)]
timed of
    [] -> []
    [(UTCTime, Stamped Text)]
_ -> ((Int, [Stamped Text]) -> (Text, [Stamped Text]))
-> [(Int, [Stamped Text])] -> [(Text, [Stamped Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Text) -> (Int, [Stamped Text]) -> (Text, [Stamped Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Text
bucketLabel) (Map Int [Stamped Text] -> [(Int, [Stamped Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [Stamped Text]
buckets)
  where
    timed :: [(UTCTime, Stamped Text)]
timed = [((UTCTime, PostId) -> UTCTime
forall a b. (a, b) -> a
fst (Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp Stamped Text
p), Stamped Text
p) | Stamped Text
p <- [Stamped Text]
posts]
    base :: UTCTime
base = [UTCTime] -> UTCTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((UTCTime, Stamped Text) -> UTCTime)
-> [(UTCTime, Stamped Text)] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map (UTCTime, Stamped Text) -> UTCTime
forall a b. (a, b) -> a
fst [(UTCTime, Stamped Text)]
timed)
    bucket :: UTCTime -> Int
bucket UTCTime
t = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> UTCTime -> Double
minutes UTCTime
base UTCTime
t) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
m
    buckets :: Map Int [Stamped Text]
buckets = ([Stamped Text] -> [Stamped Text] -> [Stamped Text])
-> [(Int, [Stamped Text])] -> Map Int [Stamped Text]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (([Stamped Text] -> [Stamped Text] -> [Stamped Text])
-> [Stamped Text] -> [Stamped Text] -> [Stamped Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Stamped Text] -> [Stamped Text] -> [Stamped Text]
forall a. [a] -> [a] -> [a]
(++)) (((UTCTime, Stamped Text) -> (Int, [Stamped Text]))
-> [(UTCTime, Stamped Text)] -> [(Int, [Stamped Text])]
forall a b. (a -> b) -> [a] -> [b]
map (\(UTCTime
t, Stamped Text
p) -> (UTCTime -> Int
bucket UTCTime
t, [Stamped Text
p])) [(UTCTime, Stamped Text)]
timed)
    bucketLabel :: Int -> Text
bucketLabel Int
k =
      let start :: UTCTime
start = UTCTime -> Int -> UTCTime
addMinutes UTCTime
base (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m)
          end :: UTCTime
end = UTCTime -> Int -> UTCTime
addMinutes UTCTime
start Int
m
       in [Text] -> Text
T.concat [UTCTime -> Text
formatTs UTCTime
start, Text
"..", UTCTime -> Text
formatTs UTCTime
end]
slicePosts SliceMode
ByThread [Stamped Text]
posts =
  ((Text, [Stamped Text]) -> Text)
-> [(Text, [Stamped Text])] -> [(Text, [Stamped Text])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, [Stamped Text]) -> Text
forall a b. (a, b) -> a
fst [(PostId -> Text
forall a. Show a => a -> Text
showt PostId
k, [Stamped Text]
v) | (PostId
k, [Stamped Text]
v) <- Map PostId [Stamped Text] -> [(PostId, [Stamped Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PostId [Stamped Text]
roots]
  where
    idx :: Map PostId (Stamped Text)
idx = [(PostId, Stamped Text)] -> Map PostId (Stamped Text)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((UTCTime, PostId) -> PostId
forall a b. (a, b) -> b
snd (Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp Stamped Text
p), Stamped Text
p) | Stamped Text
p <- [Stamped Text]
posts]
    rootOf :: Stamped Text -> PostId
rootOf Stamped Text
p = case Post Text -> [PostId]
forall a. Post a -> [PostId]
thread (Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
p) of
      [] -> (UTCTime, PostId) -> PostId
forall a b. (a, b) -> b
snd (Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp Stamped Text
p)
      [PostId]
ts -> case (PostId -> Maybe (Stamped Text)) -> [PostId] -> [Stamped Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PostId -> Map PostId (Stamped Text) -> Maybe (Stamped Text)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map PostId (Stamped Text)
idx) [PostId]
ts of
        [] -> [PostId] -> PostId
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [PostId]
ts
        [Stamped Text]
ps -> Stamped Text -> PostId
rootOf ((Stamped Text -> Stamped Text -> Ordering)
-> [Stamped Text] -> Stamped Text
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((Stamped Text -> PostId)
-> Stamped Text -> Stamped Text -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((UTCTime, PostId) -> PostId
forall a b. (a, b) -> b
snd ((UTCTime, PostId) -> PostId)
-> (Stamped Text -> (UTCTime, PostId)) -> Stamped Text -> PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp)) [Stamped Text]
ps)
    roots :: Map PostId [Stamped Text]
roots = ([Stamped Text] -> [Stamped Text] -> [Stamped Text])
-> [(PostId, [Stamped Text])] -> Map PostId [Stamped Text]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Stamped Text] -> [Stamped Text] -> [Stamped Text]
forall a. [a] -> [a] -> [a]
(++) [(Stamped Text -> PostId
rootOf Stamped Text
p, [Stamped Text
p]) | Stamped Text
p <- [Stamped Text]
posts]
slicePosts SliceMode
ByAgent [Stamped Text]
posts =
  ((Text, [Stamped Text]) -> Text)
-> [(Text, [Stamped Text])] -> [(Text, [Stamped Text])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, [Stamped Text]) -> Text
forall a b. (a, b) -> a
fst [(Text
k, [Stamped Text]
v) | (Text
k, [Stamped Text]
v) <- Map Text [Stamped Text] -> [(Text, [Stamped Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [Stamped Text]
byAuthor]
  where
    byAuthor :: Map Text [Stamped Text]
byAuthor = ([Stamped Text] -> [Stamped Text] -> [Stamped Text])
-> [(Text, [Stamped Text])] -> Map Text [Stamped Text]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Stamped Text] -> [Stamped Text] -> [Stamped Text]
forall a. [a] -> [a] -> [a]
(++) [(Post Text -> Text
forall a. Post a -> Text
from (Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
p), [Stamped Text
p]) | Stamped Text
p <- [Stamped Text]
posts]

addMinutes :: UTCTime -> Int -> UTCTime
addMinutes :: UTCTime -> Int -> UTCTime
addMinutes UTCTime
t Int
n = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) :: NominalDiffTime) UTCTime
t

-- ---------------------------------------------------------------------------
-- Statistics
-- ---------------------------------------------------------------------------

-- | Computed metrics for one slice.
data Stats = Stats
  { Stats -> Text
statSlice :: Text,
    Stats -> Int
statPosts :: Int,
    Stats -> Int
statAgents :: Int,
    Stats -> Double
statDurationMinutes :: Double,
    Stats -> Double
statPostsPerMinute :: Double,
    Stats -> Int
statDamping :: Int,
    Stats -> Double
statReBus :: Double,
    Stats -> Int
statSignal :: Int,
    Stats -> Int
statNoise :: Int,
    Stats -> Int
statUnclassified :: Int,
    Stats -> Maybe Double
statSNR :: Maybe Double,
    Stats -> Maybe Double
statSNRPrime :: Maybe Double,
    Stats -> Int
statDeliverables :: Int,
    Stats -> Int
statDoneClaims :: Int,
    Stats -> Maybe Double
statPostsPerDeliverable :: Maybe Double,
    Stats -> Double
statTimeToQuiescenceMinutes :: Double
  }
  deriving (Stats -> Stats -> Bool
(Stats -> Stats -> Bool) -> (Stats -> Stats -> Bool) -> Eq Stats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stats -> Stats -> Bool
== :: Stats -> Stats -> Bool
$c/= :: Stats -> Stats -> Bool
/= :: Stats -> Stats -> Bool
Eq, Int -> Stats -> ShowS
[Stats] -> ShowS
Stats -> String
(Int -> Stats -> ShowS)
-> (Stats -> String) -> ([Stats] -> ShowS) -> Show Stats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stats -> ShowS
showsPrec :: Int -> Stats -> ShowS
$cshow :: Stats -> String
show :: Stats -> String
$cshowList :: [Stats] -> ShowS
showList :: [Stats] -> ShowS
Show)

-- | Compute stats for one slice given classification rules and a damping count.
computeStats :: Rules -> Int -> Text -> [Stamped Text] -> Stats
computeStats :: Rules -> Int -> Text -> [Stamped Text] -> Stats
computeStats Rules
rules Int
damping Text
label [Stamped Text]
posts =
  Stats
    { statSlice :: Text
statSlice = Text
label,
      statPosts :: Int
statPosts = Int
n,
      statAgents :: Int
statAgents = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
agents,
      statDurationMinutes :: Double
statDurationMinutes = Double
dur,
      statPostsPerMinute :: Double
statPostsPerMinute = Double
ppm,
      statDamping :: Int
statDamping = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
damping,
      statReBus :: Double
statReBus = Double
reBus,
      statSignal :: Int
statSignal = Int
signalCount,
      statNoise :: Int
statNoise = Int
noiseCount,
      statUnclassified :: Int
statUnclassified = Int
unclassifiedCount,
      statSNR :: Maybe Double
statSNR = Maybe Double
snr,
      statSNRPrime :: Maybe Double
statSNRPrime = Maybe Double
snrPrime,
      statDeliverables :: Int
statDeliverables = Int
deliverables,
      statDoneClaims :: Int
statDoneClaims = Int
doneClaims,
      statPostsPerDeliverable :: Maybe Double
statPostsPerDeliverable = Maybe Double
ppd,
      statTimeToQuiescenceMinutes :: Double
statTimeToQuiescenceMinutes = Double
ttq
    }
  where
    n :: Int
n = [Stamped Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Stamped Text]
posts
    agents :: [Text]
agents = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Text () -> [Text]
forall k a. Map k a -> [k]
Map.keys (Map Text () -> [Text]) -> Map Text () -> [Text]
forall a b. (a -> b) -> a -> b
$ [(Text, ())] -> Map Text ()
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Post Text -> Text
forall a. Post a -> Text
from (Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
p), ()) | Stamped Text
p <- [Stamped Text]
posts]
    timestamps :: [UTCTime]
timestamps = (Stamped Text -> UTCTime) -> [Stamped Text] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map ((UTCTime, PostId) -> UTCTime
forall a b. (a, b) -> a
fst ((UTCTime, PostId) -> UTCTime)
-> (Stamped Text -> (UTCTime, PostId)) -> Stamped Text -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp) [Stamped Text]
posts
    (Maybe UTCTime
startTime, Maybe UTCTime
endTime) = case [UTCTime]
timestamps of
      [] -> (Maybe UTCTime
forall a. Maybe a
Nothing, Maybe UTCTime
forall a. Maybe a
Nothing)
      [UTCTime]
ts -> (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just ([UTCTime] -> UTCTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [UTCTime]
ts), UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just ([UTCTime] -> UTCTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UTCTime]
ts))
    dur :: Double
dur = Double -> (UTCTime -> Double) -> Maybe UTCTime -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\UTCTime
s -> Double -> (UTCTime -> Double) -> Maybe UTCTime -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (UTCTime -> UTCTime -> Double
minutes UTCTime
s) Maybe UTCTime
endTime) Maybe UTCTime
startTime
    ppm :: Double
ppm = if Double
dur Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dur else Double
0
    reBus :: Double
reBus =
      if Double
dur Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Int
damping Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
agents) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ppm Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
damping
        else Double
0
    classified :: [Classification]
classified = (Stamped Text -> Classification)
-> [Stamped Text] -> [Classification]
forall a b. (a -> b) -> [a] -> [b]
map (Rules -> Post Text -> Classification
classify Rules
rules (Post Text -> Classification)
-> (Stamped Text -> Post Text) -> Stamped Text -> Classification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped) [Stamped Text]
posts
    signalCount :: Int
signalCount = [Classification] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Classification -> Bool) -> [Classification] -> [Classification]
forall a. (a -> Bool) -> [a] -> [a]
filter (Classification -> Classification -> Bool
forall a. Eq a => a -> a -> Bool
== Classification
Signal) [Classification]
classified)
    noiseCount :: Int
noiseCount = [Classification] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Classification -> Bool) -> [Classification] -> [Classification]
forall a. (a -> Bool) -> [a] -> [a]
filter (Classification -> Classification -> Bool
forall a. Eq a => a -> a -> Bool
== Classification
Noise) [Classification]
classified)
    unclassifiedCount :: Int
unclassifiedCount = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
signalCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
noiseCount
    snr :: Maybe Double
snr
      | Int
noiseCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Double -> Maybe Double
forall a. a -> Maybe a
Just (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
signalCount Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
noiseCount)
      | Int
signalCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Maybe Double
forall a. Maybe a
Nothing -- conceptually infinite
      | Bool
otherwise = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0
    snrPrime :: Maybe Double
snrPrime
      | Int
unclassifiedCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
noiseCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
          Double -> Maybe Double
forall a. a -> Maybe a
Just (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
signalCount Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
unclassifiedCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
noiseCount))
      | Int
signalCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Maybe Double
forall a. Maybe a
Nothing -- conceptually infinite
      | Bool
otherwise = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0
    deliverables :: Int
deliverables = [Stamped Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Stamped Text -> Bool) -> [Stamped Text] -> [Stamped Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Rules -> Post Text -> Bool
isDeliverable Rules
rules (Post Text -> Bool)
-> (Stamped Text -> Post Text) -> Stamped Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped) [Stamped Text]
posts)
    doneClaims :: Int
doneClaims = [Stamped Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Stamped Text -> Bool) -> [Stamped Text] -> [Stamped Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Post Text -> Bool
isDoneClaim (Post Text -> Bool)
-> (Stamped Text -> Post Text) -> Stamped Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped) [Stamped Text]
posts)
    ppd :: Maybe Double
ppd = if Int
deliverables Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Double -> Maybe Double
forall a. a -> Maybe a
Just (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
deliverables) else Maybe Double
forall a. Maybe a
Nothing
    ttq :: Double
ttq = case Maybe UTCTime
startTime of
      Maybe UTCTime
Nothing -> Double
0
      Just UTCTime
start ->
        let signalPosts :: [Stamped Text]
signalPosts = [Stamped Text
p | Stamped Text
p <- [Stamped Text]
posts, Rules -> Post Text -> Classification
classify Rules
rules (Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
p) Classification -> Classification -> Bool
forall a. Eq a => a -> a -> Bool
== Classification
Signal]
            signalTimes :: [UTCTime]
signalTimes = (Stamped Text -> UTCTime) -> [Stamped Text] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map ((UTCTime, PostId) -> UTCTime
forall a b. (a, b) -> a
fst ((UTCTime, PostId) -> UTCTime)
-> (Stamped Text -> (UTCTime, PostId)) -> Stamped Text -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp) [Stamped Text]
signalPosts
         in case [UTCTime]
signalTimes of
              [] -> Double
0
              [UTCTime]
ts -> UTCTime -> UTCTime -> Double
minutes UTCTime
start ([UTCTime] -> UTCTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UTCTime]
ts)

-- ---------------------------------------------------------------------------
-- Rendering
-- ---------------------------------------------------------------------------

-- | Human-readable plain-text report.
renderStats :: Rules -> [Stats] -> Text
renderStats :: Rules -> [Stats] -> Text
renderStats Rules
rules [Stats]
stats =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"bus-stats",
      Text
"  noise regex:    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Rules -> Text
noiseRE Rules
rules,
      Text
"  signal regex:   " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Rules -> Text
signalRE Rules
rules,
      Text
"  deliverable:    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Rules -> Text
deliverableRE Rules
rules,
      Text
""
    ]
      [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Stats -> [Text]) -> [Stats] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stats -> [Text]
renderSlice [Stats]
stats
  where
    renderSlice :: Stats -> [Text]
renderSlice Stats
s =
      [ Text
"slice: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Stats -> Text
statSlice Stats
s,
        Text
"  posts:               " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statPosts Stats
s),
        Text
"  agents:              " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statAgents Stats
s),
        Text
"  duration (min):      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showd (Stats -> Double
statDurationMinutes Stats
s),
        Text
"  posts/min:           " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showd (Stats -> Double
statPostsPerMinute Stats
s),
        Text
"  damping rules:       " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statDamping Stats
s),
        Text
"  Re_bus:              " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showd (Stats -> Double
statReBus Stats
s),
        Text
"  signal:              " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statSignal Stats
s),
        Text
"  noise:               " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statNoise Stats
s),
        Text
"  unclassified:        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statUnclassified Stats
s),
        Text
"  SNR:                 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Double -> Text) -> Maybe Double -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"-" Double -> Text
showd (Stats -> Maybe Double
statSNR Stats
s),
        Text
"  SNR':                " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Double -> Text) -> Maybe Double -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"-" Double -> Text
showd (Stats -> Maybe Double
statSNRPrime Stats
s),
        Text
"  deliverables:        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statDeliverables Stats
s),
        Text
"  done claims:         " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Stats -> Int
statDoneClaims Stats
s),
        Text
"  posts/deliverable:   " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Double -> Text) -> Maybe Double -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"n/a" Double -> Text
showd (Stats -> Maybe Double
statPostsPerDeliverable Stats
s),
        Text
"  time to quiescence (min): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showd (Stats -> Double
statTimeToQuiescenceMinutes Stats
s),
        Text
""
      ]

showt :: (Show a) => a -> Text
showt :: forall a. Show a => a -> Text
showt = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

showd :: Double -> Text
showd :: Double -> Text
showd = String -> Text
T.pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%0.3f"

-- | JSON report.
renderStatsJson :: Rules -> [Stats] -> Text
renderStatsJson :: Rules -> [Stats] -> Text
renderStatsJson Rules
rules [Stats]
stats =
  Json -> Text
encodeJsonText ([(Text, Json)] -> Json
jobject [(Text
"rules", Json
rulesObj), (Text
"slices", [Json] -> Json
jarray ((Stats -> Json) -> [Stats] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map Stats -> Json
statsObject [Stats]
stats))])
  where
    rulesObj :: Json
rulesObj =
      [(Text, Json)] -> Json
jobject
        [ (Text
"noise", Text -> Json
jtext (Rules -> Text
noiseRE Rules
rules)),
          (Text
"signal", Text -> Json
jtext (Rules -> Text
signalRE Rules
rules)),
          (Text
"deliverable", Text -> Json
jtext (Rules -> Text
deliverableRE Rules
rules))
        ]
    statsObject :: Stats -> Json
statsObject Stats
s =
      [(Text, Json)] -> Json
jobject
        [ (Text
"slice", Text -> Json
jtext (Stats -> Text
statSlice Stats
s)),
          (Text
"posts", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statPosts Stats
s)),
          (Text
"agents", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statAgents Stats
s)),
          (Text
"duration_minutes", Double -> Json
jdouble (Stats -> Double
statDurationMinutes Stats
s)),
          (Text
"posts_per_minute", Double -> Json
jdouble (Stats -> Double
statPostsPerMinute Stats
s)),
          (Text
"damping_rules", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statDamping Stats
s)),
          (Text
"re_bus", Double -> Json
jdouble (Stats -> Double
statReBus Stats
s)),
          (Text
"signal", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statSignal Stats
s)),
          (Text
"noise", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statNoise Stats
s)),
          (Text
"unclassified", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statUnclassified Stats
s)),
          (Text
"snr", (Double -> Json) -> Maybe Double -> Json
forall {t}. (t -> Json) -> Maybe t -> Json
jmaybe Double -> Json
jdouble (Stats -> Maybe Double
statSNR Stats
s)),
          (Text
"snr_prime", (Double -> Json) -> Maybe Double -> Json
forall {t}. (t -> Json) -> Maybe t -> Json
jmaybe Double -> Json
jdouble (Stats -> Maybe Double
statSNRPrime Stats
s)),
          (Text
"deliverables", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statDeliverables Stats
s)),
          (Text
"done_claims", Int -> Json
forall a. Integral a => a -> Json
jnum (Stats -> Int
statDoneClaims Stats
s)),
          (Text
"posts_per_deliverable", (Double -> Json) -> Maybe Double -> Json
forall {t}. (t -> Json) -> Maybe t -> Json
jmaybe Double -> Json
jdouble (Stats -> Maybe Double
statPostsPerDeliverable Stats
s)),
          (Text
"time_to_quiescence_minutes", Double -> Json
jdouble (Stats -> Double
statTimeToQuiescenceMinutes Stats
s))
        ]
    jdouble :: Double -> Json
jdouble = Scientific -> Json
JNumber (Scientific -> Json) -> (Double -> Scientific) -> Double -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Rational -> Scientific)
-> (Double -> Rational) -> Double -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
    jmaybe :: (t -> Json) -> Maybe t -> Json
jmaybe t -> Json
_ Maybe t
Nothing = Json
JNull
    jmaybe t -> Json
f (Just t
x) = t -> Json
f t
x