Model.hs

{-# LANGUAGE OverloadedStrings #-}

{- | The client's read model: a @\/dag@ snapshot with the event stream folded
onto it, one view per node.

Milestone 6 of @specs\/generic-server.md@ says a client rebuilds the current
state as @dag ⊕ events since the dag's sequence number@. This module is
that ⊕, and nothing else: no socket, no terminal. "Salmon.Client.Http" is
what fetches the two inputs, and a terminal client (@salmon-tui@ in
@salmon-apps@) is a thin rendering of the 'Model' this produces. Keeping
the fold pure is what makes it testable against a recorded event sequence
('Test.ClientModelSpec'), and it is also what keeps the client honest about
the spec's design constraint — __the client holds no state the server does
not__: everything here is derived from @\/dag@ and @\/events@, so a restart
of the client is one @\/dag@ read, and a client that has fallen behind
('modelResync') re-reads rather than guessing.

= What is folded, and what is not

The inputs are the wire objects "Salmon.Reporter.Tagged" and
"Salmon.Actions.Serve.Events" describe, read as 'Aeson.Value': the model
takes every event as data (an 'Event' is what 'eventOf' can see in the
object — @seq@, @stream@, @kind@, @ref@, @origin@ — plus the object itself)
rather than decoding the four report sums back into Haskell. That is
deliberate: the client is generic over salmon binaries the way the server
is, and it should keep rendering a report kind it was not written for
(as its 'nodeLastKind') instead of failing to decode it.

What moves a node's view:

  * the @updown@ stream (and an @upkeep@ @acted@ wrapping one): @eval@ is
    the node being worked on, @done@ and @skip@ make it @converged@ in its
    direction, @failed@ makes it @errored@ with the error kept, @blocked@
    makes it @blocked@ — the same words @\/dag@ uses for @convergence@;
  * the @upkeep@ stream: @next-look@ carries the node's own last check
    verdict, which is the one thing the snapshot cannot keep fresh (a
    @\/dag@ read is at most one command old, and tending happens between
    commands); every other kind is recorded as the node's last event;
  * the @serve@ stream: @converge-start@\/@converge-stop@ for the loop's
    pass, @supervised@, and the two that change the __shape__ of the graph
    — @declared@ and @cleared@ — which set 'modelResync', because an event
    names nodes by 'Ref' and a declaration adds or retires nodes the model
    has never seen.

A node wanted @down@ whose @done@ arrives is dropped: the loop prunes it
after the pass, and @\/dag@ would not show it either. Dropping it costs a
lookup, not a pass over the display order ('Order'): a teardown is one such
event per node, and filtering a list of every node for each of them made
the fold quadratic over one (finding 5 of @resources\/graph-profiles.md@).

= The output stream

The @output@ stream is what a node writes while it works, and it carries
two kinds that are folded into two different fields because a snapshot
covers one and not the other:

  * @output@, a line a /held/ action wrote. The server pushes it into the
    node's ring as it reports it, and @\/dag@ returns that ring as
    @status.output@. So it is appended to 'nodeOutput' under the node's own
    stamp like any other event about the node, and a re-read snapshot
    replaces the lot.
  * @log@, a line a node said during a one-shot @up@
    ("Salmon.Builtin.NodeLog": a streamed command's output, or its own
    progress message). They are not in the ring; a @\/dag@ answer carries
    them in the node's @tail@ (the newest events about it, none numbered
    above the answer's @seq@), and one from before that field existed does
    not have them at all. So they are kept apart in 'nodeSaid' with a
    stamp of their own ('nodeSaidSeq'): seeded from @tail@ at the
    snapshot's number when there is one, and 'rebase' keeps whichever of
    the old and the fresh is current to the later number, so a re-read
    every @declared@ asks for neither loses a build's tail nor repeats
    it.

Neither moves 'nodeLastKind': a line is not something that happened to
the node's convergence, and a table whose last column reads @log@ for the
length of a build says less than one that still reads @eval@. Both are
bounded ('outputKept' lines, the oldest dropped), because a client left
open on a chatty node would otherwise grow without limit.

= Replays are dropped, per stamp

One counter numbers everything on the stream, and a snapshot carries the
last number handed out before it was read. Every part of the model
remembers the number it is current to — each node its 'nodeSeq' (the
snapshot's, then each event's about it), the loop-level fields
('modelPass', 'modelSupervised', 'modelResync') their 'modelLoopSeq' — and
an event numbered at or below the stamp of the part it would change is
one already accounted for, so 'step' leaves that part untouched. That is
what the server's ordering relies on ("Salmon.Actions.Serve.Http" reads
the number before the world so a racing event is replayed rather than
skipped), and it is what lets a client keep folding the live stream while
a re-read snapshot is on its way: the events that land in between are
replayed onto the new snapshot and fall away.

Two stamps rather than one because the two inputs cover different things.
A snapshot says everything about the nodes and nothing about the loop —
whether a pass is running is not in @\/dag@ — so a fresh snapshot must
not swallow the @converge-stop@ of a pass whose @converge-start@ the
client already showed. 'rebase' is how a re-read snapshot joins a model
that has been folding: the nodes are the snapshot's, the loop-level
fields and their stamp are carried over. The @gap@ event has no number
and always applies.
-}
module Salmon.Client.Model (
    -- * Events
    Event (..),
    eventOf,
    RefId (..),

    -- * The model
    Model (..),
    Node (..),
    Check (..),
    Pass (..),
    fromDag,
    step,
    modelResync,
    resolve,
    rebase,

    -- * The display order
    Order,
    orderFromList,
    orderToList,
    orderRemove,
    orderSize,

    -- * Reading it
    nodesInOrder,
    Counts (..),
    counts,
    lookupNode,
    outputKept,
    tailLines,

    -- * Rendering pieces
    renderNodeRow,
    renderHeader,
    renderEventLine,
    describeEvent,
) where

import Data.Aeson (Result (..), Value (..), fromJSON)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Foldable (toList)
import Data.Function (on)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.List (foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word64)

-------------------------------------------------------------------------------
-- events

-- | A node's identity on the wire: the short tag and the full text.
data RefId = RefId
    { refShort :: !Text
    , refFull :: !Text
    }
    deriving (Show, Eq, Ord)

{- | One event as the stream carried it. The fields are what every client
needs to route the object; 'eventValue' keeps the whole thing for whatever
else a report says.
-}
data Event = Event
    { eventSeq :: !(Maybe Word64)
    -- ^ 'Nothing' only for the @gap@ event, which the server sends without one
    , eventStream :: !Text
    , eventKind :: !Text
    , eventRef :: !(Maybe RefId)
    , eventOrigin :: !(Maybe Text)
    -- ^ the origin's name, for an event produced for a command
    , eventValue :: !Value
    }
    deriving (Show, Eq)

-- | Read an event out of its wire object. Total: a shapeless object is an
-- event of kind @?@ with no ref, which the model records and moves past.
eventOf :: Value -> Event
eventOf v =
    Event
        { eventSeq = numberAt ["seq"] v
        , eventStream = fromMaybe "?" (textAt ["stream"] v)
        , eventKind = fromMaybe "?" (textAt ["kind"] v)
        , eventRef = refAt ["ref"] v
        , eventOrigin = textAt ["origin", "name"] v
        , eventValue = v
        }

-------------------------------------------------------------------------------
-- the model

-- | A node's own last word on its effect, as @next-look@ and @\/dag@ carry it.
data Check = Check
    { checkVerdict :: !Text
    -- ^ @success@\/@skipped@\/@completed@\/@failure@\/@unknown@\/@immaterial@
    , checkReason :: !(Maybe Text)
    }
    deriving (Show, Eq)

data Node = Node
    { nodeRef :: !RefId
    , nodeShorthand :: !Text
    , nodeHelp :: !Text
    , nodeNotes :: ![Text]
    , nodeDirection :: !Text
    -- ^ @up@ or @down@
    , nodeConvergence :: !Text
    -- ^ @pending@\/@stale@\/@converged@\/@errored@\/@blocked@
    , nodeCheck :: !(Maybe Check)
    , nodeOutput :: ![Text]
    -- ^ the snapshot's output ring, then each @output@ line since, oldest first
    , nodeSaid :: ![Text]
    -- ^ the @log@ lines the stream carried (what the node said during a
    -- one-shot @up@), oldest first; a line from standard error is prefixed
    -- @err| @ and the node's own message @msg| @. In no snapshot.
    , nodeSaidSeq :: !Word64
    -- ^ the number 'nodeSaid' is current to; 0 until a line arrives
    , nodeError :: !(Maybe Text)
    -- ^ the last @failed@'s error, cleared by a later @done@\/@skip@
    , nodeLastKind :: !(Maybe Text)
    -- ^ the kind of the last event about this node, and its stream
    , nodeLastSeq :: !(Maybe Word64)
    , nodeSeq :: !Word64
    -- ^ the number this view is current to: the snapshot's, then each event's
    , nodeDependencies :: ![RefId]
    , nodeDependants :: ![RefId]
    , nodePaths :: ![Text]
    }
    deriving (Show, Eq)

{- | The order the nodes are shown in: the refs of a snapshot, in the
snapshot's order, less the ones removed since.

It reads as the list it is built from ('orderToList'), and 'orderRemove'
is that list with every copy of a ref filtered out, which is what the
model did on a plain list until a teardown of ten thousand nodes was
measured at two seconds of filtering. Each ref keeps the seat the snapshot
gave it, so removing one is a lookup of its seats and a deletion of each,
and the refs that stay are never renumbered: ascending seats are the
snapshot's order whatever has been removed in between.

A ref listed twice has two seats and is shown twice, as before; a @\/dag@
answer has one node per ref, so this only keeps the fold total on a
document that is not one.

Two orders are equal when they read the same: which seats a removal left
empty is not something a reader can see, and a model that dropped a node
equals one read from a snapshot that never had it (as it did when the
order was a list).
-}
data Order = Order
    { orderSeats :: !(IntMap RefId)
    -- ^ seat to ref; ascending seats are the display order
    , orderPlaces :: !(Map RefId [Int])
    -- ^ the seats of each ref still shown
    }

instance Eq Order where
    (==) = (==) `on` orderToList

instance Show Order where
    showsPrec d o = showParen (d > 10) (showString "orderFromList " . showsPrec 11 (orderToList o))

-- | The order that shows these refs, first to last.
orderFromList :: [RefId] -> Order
orderFromList rs = orderSeated rs (Map.fromListWith (++) [(r, [i]) | (i, r) <- zip [0 ..] rs])

-- | 'orderFromList' for a caller that already has each ref's seats (its
-- positions in the list, counted from 0): 'fromDag', which keys the nodes
-- by ref anyway and would otherwise compare every ref a second time.
orderSeated :: [RefId] -> Map RefId [Int] -> Order
orderSeated rs places =
    Order
        { orderSeats = IntMap.fromDistinctAscList (zip [0 ..] rs)
        , orderPlaces = places
        }

-- | The refs shown, first to last.
orderToList :: Order -> [RefId]
orderToList = IntMap.elems . orderSeats

-- | How many refs are shown (a ref listed twice counts twice).
orderSize :: Order -> Int
orderSize = IntMap.size . orderSeats

{- | Stop showing a ref: @orderToList (orderRemove r o) == filter (/= r)
(orderToList o)@, at the cost of a lookup rather than of the list. A ref
that is not shown leaves the order as it was.
-}
orderRemove :: RefId -> Order -> Order
orderRemove r o = case Map.lookup r o.orderPlaces of
    Nothing -> o
    Just seats ->
        Order
            { orderSeats = foldl' (flip IntMap.delete) o.orderSeats seats
            , orderPlaces = Map.delete r o.orderPlaces
            }

-- | The loop's last convergence pass as the stream told it.
data Pass
    = -- | @converge-start@: nodes to turn down, nodes to turn up
      Converging !Int !Int
    | -- | @converge-stop@: everything applied cleanly, nodes left
      Stopped !Bool !Int
    deriving (Show, Eq)

data Model = Model
    { modelMode :: !Text
    -- ^ @interactive@\/@replay@\/@following@, from the snapshot's envelope
    , modelSeq :: !Word64
    -- ^ the highest sequence number seen: the snapshot's, then each
    -- event's; the cursor to resume @\/events@ from
    , modelLoopSeq :: !Word64
    -- ^ the number the loop-level fields are current to
    , modelOrder :: !Order
    -- ^ the snapshot's dependency order ('Salmon.Op.Dag.dagOrder'), less
    -- the nodes dropped since; read it with 'orderToList'
    , modelNodes :: !(Map RefId Node)
    , modelPass :: !(Maybe Pass)
    , modelSupervised :: !(Maybe Bool)
    -- ^ 'Nothing' until a @supervised@ event says
    , modelLast :: !(Maybe Event)
    -- ^ the last event folded, whatever it was about
    , modelResyncReason :: !(Maybe Text)
    -- ^ why the snapshot should be re-read; cleared by 'resolve' or 'fromDag'
    }
    deriving (Show, Eq)

-- | The snapshot should be re-read: a @gap@, or a declaration changed the
-- node set. The reason is human text for a status line.
modelResync :: Model -> Maybe Text
modelResync = modelResyncReason

-- | Forget the resync request (the snapshot is being re-read).
resolve :: Model -> Model
resolve m = m{modelResyncReason = Nothing}

{- | A re-read snapshot joining a model that has been folding: the nodes,
order and mode are the fresh snapshot's; the loop-level fields, their
stamp and the last event are the old model's; the cursor is the higher of
the two; and the resync request is answered. See the module header for
why the loop's part is not simply the snapshot's. What a node said
('nodeSaid') is the old model's unless the fresh snapshot's is current to a later number
(so always the old model's against a server whose @\/dag@ has no @tail@).
-}
rebase :: Model -> Model -> Model
rebase old fresh =
    fresh
        { modelNodes = Map.mapWithKey keepSaid fresh.modelNodes
        , modelSeq = max old.modelSeq fresh.modelSeq
        , modelLoopSeq = old.modelLoopSeq
        , modelPass = old.modelPass
        , modelSupervised = old.modelSupervised
        , modelLast = old.modelLast
        , modelResyncReason = Nothing
        }
  where
    keepSaid :: RefId -> Node -> Node
    keepSaid r n = case Map.lookup r old.modelNodes of
        Just o | not (n.nodeSaidSeq > o.nodeSaidSeq) -> n{nodeSaid = o.nodeSaid, nodeSaidSeq = o.nodeSaidSeq}
        _ -> n

{- | A model from a @\/dag@ answer. 'Left' names what is missing; a @\/dag@
answer always has @nodes@ and @seq@, so a 'Left' is a wrong URL, not a
version skew.
-}
fromDag :: Value -> Either String Model
fromDag v = do
    nodes <- maybe (Left "/dag answer has no nodes array") Right (arrayAt ["nodes"] v)
    seqNo <- maybe (Left "/dag answer carries no seq") Right (numberAt ["seq"] v)
    parsed <- traverse (nodeOf seqNo) nodes
    let seated = seatedOf parsed
    pure
        Model
            { modelMode = fromMaybe "?" (textAt ["mode"] v)
            , modelSeq = seqNo
            , modelLoopSeq = 0
            , modelOrder = orderSeated (fmap nodeRef parsed) (Map.map snd seated)
            , modelNodes = Map.map fst seated
            , modelPass = Nothing
            , modelSupervised = Nothing
            , modelLast = Nothing
            , modelResyncReason = Nothing
            }
  where
    -- each ref's node (the last listed, as 'Map.fromList' keeps) and its
    -- seats, keyed once: the refs are compared for one map, not for the
    -- node map and again for the order's
    seatedOf :: [Node] -> Map RefId (Node, [Int])
    seatedOf parsed = Map.fromListWith (\(n, new) (_, old) -> (n, new ++ old)) [(nodeRef n, (n, [i])) | (i, n) <- zip [0 ..] parsed]

    nodeOf :: Word64 -> Value -> Either String Node
    nodeOf seqNo n = do
        r <- maybe (Left ("a node without a ref: " <> show n)) Right (refAt ["ref"] n)
        let tailEvents = arrayAt ["tail"] n
            hasTail = isJust tailEvents
            -- what the node said, as 'step' would have folded it live
            saidIn =
                lastKept
                    [ channelMark (textAt ["channel"] e) <> line
                    | e <- fromMaybe [] tailEvents
                    , textAt ["stream"] e == Just "output"
                    , textAt ["kind"] e == Just "log"
                    , Just line <- [textAt ["line"] e]
                    ]
        pure
            Node
                { nodeRef = r
                , nodeShorthand = fromMaybe "?" (textAt ["shorthand"] n)
                , nodeHelp = fromMaybe "" (textAt ["help"] n)
                , nodeNotes = maybe [] (mapMaybe asText) (arrayAt ["notes"] n)
                , nodeDirection = fromMaybe "?" (textAt ["direction"] n)
                , nodeConvergence = fromMaybe "?" (textAt ["convergence"] n)
                , nodeCheck = checkAt ["status", "check"] n
                , nodeOutput = maybe [] (mapMaybe asText) (arrayAt ["status", "output"] n)
                , nodeSaid = saidIn
                , nodeSaidSeq = if hasTail then seqNo else 0
                , nodeError = Nothing
                , nodeLastKind = Nothing
                , nodeLastSeq = Nothing
                , nodeSeq = seqNo
                , nodeDependencies = maybe [] (mapMaybe (refAt [])) (arrayAt ["dependencies"] n)
                , nodeDependants = maybe [] (mapMaybe (refAt [])) (arrayAt ["dependants"] n)
                , nodePaths = maybe [] (mapMaybe asText) (arrayAt ["paths"] n)
                }

{- | Fold one event in. Total; an event already accounted for (numbered at
or below the stamp of the part it would change, see the module header)
leaves that part as it was. Otherwise the cursor moves to the event's
number, the node the event is about is updated, and the loop-level fields
follow the @serve@ stream. An event that changes nothing still becomes
'modelLast' if it is new to the cursor.
-}
step :: Model -> Event -> Model
step m0 e
    | Just s <- e.eventSeq, s <= m0.modelSeq = byStream m0
    | otherwise = byStream (m0{modelSeq = fromMaybe m0.modelSeq e.eventSeq, modelLast = Just e})
  where
    byStream m = case (e.eventStream, e.eventKind) of
        ("server", "gap") -> m{modelResyncReason = Just ("events " <> fromText (numberAt ["from"] e.eventValue) <> " fell off the ring")}
        ("server", _) -> m
        ("serve", "declared") ->
            onLoop m $ \l -> l{modelResyncReason = Just ("epoch " <> fromText (numberAt ["epoch"] e.eventValue) <> " declared " <> fromMaybe "?" (textAt ["direction"] e.eventValue))}
        ("serve", "cleared") -> onLoop m $ \l -> l{modelResyncReason = Just "every seed retired"}
        ("serve", "converge-start") ->
            onLoop m $ \l -> l{modelPass = Just (Converging (intAt ["down"] e.eventValue) (intAt ["up"] e.eventValue))}
        ("serve", "converge-stop") ->
            onLoop m $ \l -> l{modelPass = Just (Stopped (fromMaybe False (boolAt ["ok"] e.eventValue)) (intAt ["remaining"] e.eventValue))}
        ("serve", "supervised") -> onLoop m $ \l -> l{modelSupervised = boolAt ["on"] e.eventValue}
        ("serve", _) -> m
        ("updown", k) -> maybe m (\r -> onNode r (settle k e.eventValue) m) e.eventRef
        -- an @acted@ wraps what the tending machine did in the pass's
        -- vocabulary; the inner object carries the ref
        ("upkeep", "acted") ->
            case KeyMap.lookup "report" =<< asObject e.eventValue of
                Just inner | Just r <- refAt ["ref"] inner ->
                    let k = fromMaybe "?" (textAt ["kind"] inner)
                     in onNode r (updown k inner . touch ("acted " <> k)) m
                _ -> m
        ("upkeep", "next-look") ->
            maybe m (\r -> onNode r (\n -> (touch e.eventKind n){nodeCheck = checkAt ["check"] e.eventValue}) m) e.eventRef
        ("upkeep", k) -> maybe m (\r -> onNode r (touch k) m) e.eventRef
        -- a held action's line: in the ring, so under the node's stamp
        ("output", "output") ->
            case (e.eventRef, textAt ["line"] e.eventValue) of
                (Just r, Just line) -> onNode r (\n -> n{nodeOutput = keepLast (n.nodeOutput ++ [line])}) m
                _ -> m
        -- a line said during a one-shot up: in no snapshot, so its own stamp
        ("output", "log") ->
            case (e.eventRef, textAt ["line"] e.eventValue) of
                (Just r, Just line) -> said r (channelMark (textAt ["channel"] e.eventValue) <> line) m
                _ -> m
        _ -> m

    said :: RefId -> Text -> Model -> Model
    said r line m = case Map.lookup r m.modelNodes of
        Nothing -> m
        Just n
            | Just s <- e.eventSeq, s <= n.nodeSaidSeq -> m
            | otherwise ->
                let n' = n{nodeSaid = keepLast (n.nodeSaid ++ [line]), nodeSaidSeq = fromMaybe n.nodeSaidSeq e.eventSeq}
                 in m{modelNodes = Map.insert r n' m.modelNodes}

    keepLast :: [Text] -> [Text]
    keepLast xs = drop (length xs - outputKept) xs

    -- the loop-level fields, unless the event is at or below their stamp
    onLoop :: Model -> (Model -> Model) -> Model
    onLoop m f = case e.eventSeq of
        Just s | s <= m.modelLoopSeq -> m
        _ -> (f m){modelLoopSeq = fromMaybe m.modelLoopSeq e.eventSeq}

    -- update the node (unless the event is at or below its stamp), or
    -- drop it: a node wanted down that a pass has brought down is pruned
    -- by the loop after the pass, and /dag would no longer show it
    onNode :: RefId -> (Node -> Node) -> Model -> Model
    onNode r f m = case Map.lookup r m.modelNodes of
        Nothing -> m
        Just n
            | Just s <- e.eventSeq, s <= n.nodeSeq -> m
            | otherwise ->
                let n' = (f n){nodeSeq = fromMaybe n.nodeSeq e.eventSeq}
                 in if n'.nodeDirection == "down" && n'.nodeConvergence == "converged" && n'.nodeLastKind `elem` [Just "done", Just "acted done"]
                        then m{modelNodes = Map.delete r m.modelNodes, modelOrder = orderRemove r m.modelOrder}
                        else m{modelNodes = Map.insert r n' m.modelNodes}

    touch :: Text -> Node -> Node
    touch k n = n{nodeLastKind = Just k, nodeLastSeq = e.eventSeq}

    -- the pass's verdict on a node, in /dag's convergence words
    settle :: Text -> Value -> Node -> Node
    settle k v n = updown k v (touch k n)

    updown :: Text -> Value -> Node -> Node
    updown k v n = case k of
        "done" -> n{nodeConvergence = "converged", nodeError = Nothing}
        "skip" -> n{nodeConvergence = "converged", nodeError = Nothing}
        "failed" -> n{nodeConvergence = "errored", nodeError = textAt ["error"] v}
        "blocked" -> n{nodeConvergence = "blocked"}
        _ -> n

-------------------------------------------------------------------------------
-- reading it

-- | The nodes in the snapshot's dependency order.
nodesInOrder :: Model -> [Node]
nodesInOrder m = mapMaybe (`Map.lookup` m.modelNodes) (orderToList m.modelOrder)

lookupNode :: RefId -> Model -> Maybe Node
lookupNode r m = Map.lookup r m.modelNodes

-- | The last 'outputKept' of some lines.
lastKept :: [a] -> [a]
lastKept xs = drop (length xs - outputKept) xs

-- | How many lines of 'nodeOutput' and of 'nodeSaid' a node's view keeps.
outputKept :: Int
outputKept = 200

-- | How a @log@ line's channel shows in front of it: nothing for standard
-- output, the marks the text reporter and the web UI's tail use otherwise.
channelMark :: Maybe Text -> Text
channelMark c = case c of
    Just "stderr" -> "err| "
    Just "message" -> "msg| "
    _ -> ""

{- | The last @k@ lines a live tail of this node shows: what it said during
its one-shot @up@ when it said anything, its ring otherwise (a held
action's output, which is the only other thing that moves while one
watches).
-}
tailLines :: Int -> Node -> [Text]
tailLines k n = lastN (if null n.nodeSaid then n.nodeOutput else n.nodeSaid)
  where
    lastN xs = drop (length xs - k) xs

data Counts = Counts
    { countConverged :: !Int
    , countErrored :: !Int
    , countTotal :: !Int
    }
    deriving (Show, Eq)

counts :: Model -> Counts
counts m =
    foldl' tally (Counts 0 0 0) (Map.elems m.modelNodes)
  where
    tally :: Counts -> Node -> Counts
    tally (Counts c e t) n =
        Counts
            (c + fromEnum (n.nodeConvergence == "converged"))
            (e + fromEnum (n.nodeConvergence == "errored"))
            (t + 1)

-------------------------------------------------------------------------------
-- rendering pieces: the text a terminal shows, kept here so it is testable

{- | One line per node, the columns @salmon-tui@ shows: ref, shorthand,
direction, convergence, last check, last event. Widths are fixed for the
first four so the table reads as one; the last two are open-ended.
-}
renderNodeRow :: Node -> Text
renderNodeRow n =
    Text.unwords
        [ Text.justifyLeft 10 ' ' n.nodeRef.refShort
        , Text.justifyLeft 22 ' ' (Text.take 22 n.nodeShorthand)
        , Text.justifyLeft 4 ' ' n.nodeDirection
        , Text.justifyLeft 9 ' ' n.nodeConvergence
        , Text.justifyLeft 12 ' ' (maybe "-" renderCheck n.nodeCheck)
        , lastEvent
        ]
  where
    lastEvent = case (n.nodeLastKind, n.nodeLastSeq) of
        (Nothing, _) -> "-"
        (Just k, ms) -> k <> maybe "" (\s -> " #" <> Text.pack (show s)) ms <> maybe "" (": " <>) n.nodeError

renderCheck :: Check -> Text
renderCheck c = c.checkVerdict

-- | The header line: socket, mode, seq, the pass, and the counts.
renderHeader :: Text -> Model -> Text
renderHeader socket m =
    Text.unwords
        [ socket
        , "mode=" <> m.modelMode
        , "seq=" <> Text.pack (show m.modelSeq)
        , "converged=" <> tshow c.countConverged
        , "errored=" <> tshow c.countErrored
        , "total=" <> tshow c.countTotal
        , maybe "" renderPass m.modelPass
        , maybe "" (\on -> if on then "supervising" else "not supervising") m.modelSupervised
        ]
  where
    c = counts m
    tshow = Text.pack . show
    renderPass (Converging d u) = "converging(" <> tshow d <> " down, " <> tshow u <> " up)"
    renderPass (Stopped ok left) = (if left == 0 then "converged" else "incomplete(" <> tshow left <> " left)") <> (if ok then "" else "+failure")

-- | An event as one line: its number, stream, kind, and what it is about.
renderEventLine :: Event -> Text
renderEventLine e =
    Text.unwords
        [ maybe "#-" (\s -> "#" <> Text.pack (show s)) e.eventSeq
        , e.eventStream
        , e.eventKind
        , describeEvent e
        ]

-- | The words after the kind: the node's short ref (and, for a line of
-- output, the line), or the loop-level fields worth a glance.
describeEvent :: Event -> Text
describeEvent e = case e.eventRef of
    Just r
        | e.eventStream == "output" ->
            r.refShort <> " " <> channelMark (textAt ["channel"] e.eventValue) <> fromMaybe "" (textAt ["line"] e.eventValue)
    Just r -> r.refShort <> maybe "" (" " <>) (textAt ["node", "shorthand"] e.eventValue)
    Nothing -> Text.unwords (mapMaybe (\k -> (\t -> k <> "=" <> t) <$> scalarAt [k] e.eventValue) ["line", "epoch", "direction", "nodes", "down", "up", "ok", "remaining", "from", "error", "on"])

-------------------------------------------------------------------------------
-- reading JSON, totally

asObject :: Value -> Maybe (KeyMap.KeyMap Value)
asObject (Object o) = Just o
asObject _ = Nothing

asText :: Value -> Maybe Text
asText (String t) = Just t
asText _ = Nothing

at :: [Text] -> Value -> Maybe Value
at [] v = Just v
at (k : ks) (Object o) = KeyMap.lookup (Key.fromText k) o >>= at ks
at _ _ = Nothing

textAt :: [Text] -> Value -> Maybe Text
textAt ks v = at ks v >>= asText

numberAt :: [Text] -> Value -> Maybe Word64
numberAt ks v = case fromJSON <$> at ks v of
    Just (Success n) -> Just n
    _ -> Nothing

intAt :: [Text] -> Value -> Int
intAt ks v = maybe 0 fromIntegral (numberAt ks v)

boolAt :: [Text] -> Value -> Maybe Bool
boolAt ks v = case at ks v of
    Just (Bool b) -> Just b
    _ -> Nothing

arrayAt :: [Text] -> Value -> Maybe [Value]
arrayAt ks v = case at ks v of
    Just (Array xs) -> Just (toList xs)
    _ -> Nothing

refAt :: [Text] -> Value -> Maybe RefId
refAt ks v = RefId <$> textAt (ks ++ ["short"]) v <*> textAt (ks ++ ["full"]) v

checkAt :: [Text] -> Value -> Maybe Check
checkAt ks v = Check <$> textAt (ks ++ ["verdict"]) v <*> pure (textAt (ks ++ ["reason"]) v)

scalarAt :: [Text] -> Value -> Maybe Text
scalarAt ks v = case at ks v of
    Just (String t) -> Just t
    Just (Number n) -> Just $ Text.pack $ case fromJSON (Number n) of
        Success (i :: Integer) -> show i
        _ -> show n
    Just (Bool b) -> Just (if b then "true" else "false")
    _ -> Nothing

fromText :: Maybe Word64 -> Text
fromText = maybe "?" (Text.pack . show)