module Swarm.TUI.View.Robot.Details (renderRobotDetails) where
import Brick
import Brick.Widgets.Border
import Brick.Widgets.List qualified as BL
import Brick.Widgets.Table qualified as BT
import Brick.Focus
import Control.Lens hiding (from, (<.>))
import Data.Map.Strict qualified as M
import Prettyprinter (pretty)
import Swarm.Game.Robot
import Swarm.Game.Robot.Activity (commandsHistogram)
import Swarm.Game.Robot.Concrete
import Swarm.Log
import Swarm.Pretty (prettyText)
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Attribute.Attr (boldAttr, cyanAttr)
import Swarm.TUI.View.Robot.Type
import Swarm.Util (applyWhen)
renderRobotDetails :: Robot -> RobotDetailsPaneState -> Widget Name
renderRobotDetails :: Robot -> RobotDetailsPaneState -> Widget Name
renderRobotDetails Robot
r RobotDetailsPaneState
paneState =
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords
[ String
"Selected robot"
, Text -> String
forall a. Show a => a -> String
show (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Getting Text Robot Text -> Robot -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Robot Text
Lens' Robot Text
robotName Robot
r
]
, Widget Name
forall n. Widget n
hBorder
, [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ RobotDetailSubpane -> Widget Name -> Widget Name
forall {n}. RobotDetailSubpane -> Widget n -> Widget n
highlightBorderFor RobotDetailSubpane
RobotLogPane (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (String -> Widget Name
forall n. String -> Widget n
str String
"Logs") Widget Name
logsTable
, RobotDetailSubpane -> Widget Name -> Widget Name
forall {n}. RobotDetailSubpane -> Widget n -> Widget n
highlightBorderFor RobotDetailSubpane
RobotCommandHistogramPane (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (String -> Widget Name
forall n. String -> Widget n
str String
"Commands") Widget Name
forall n. Widget n
commandsTable
]
]
where
ring :: FocusRing Name
ring = RobotDetailsPaneState
paneState RobotDetailsPaneState
-> Getting (FocusRing Name) RobotDetailsPaneState (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^. Getting (FocusRing Name) RobotDetailsPaneState (FocusRing Name)
Lens' RobotDetailsPaneState (FocusRing Name)
detailFocus
highlightBorderFor :: RobotDetailSubpane -> Widget n -> Widget n
highlightBorderFor RobotDetailSubpane
n =
Bool -> (Widget n -> Widget n) -> Widget n -> Widget n
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
isFocused ((Widget n -> Widget n) -> Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> AttrName -> Widget n -> Widget n
forall n. AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
borderAttr AttrName
cyanAttr
where
isFocused :: Bool
isFocused = FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
ring Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Name
forall a. a -> Maybe a
Just (RobotsDisplayMode -> Name
RobotsListDialog (RobotsDisplayMode -> Name) -> RobotsDisplayMode -> Name
forall a b. (a -> b) -> a -> b
$ RobotDetailSubpane -> RobotsDisplayMode
SingleRobotDetails RobotDetailSubpane
n)
logsTable :: Widget Name
logsTable = FocusRing Name
-> (Bool -> GenericList Name Seq LogEntry -> Widget Name)
-> GenericList Name Seq LogEntry
-> Widget Name
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
withFocusRing FocusRing Name
ring ((Bool -> LogEntry -> Widget Name)
-> Bool -> GenericList Name Seq LogEntry -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
BL.renderList Bool -> LogEntry -> Widget Name
forall {p} {n}. p -> LogEntry -> Widget n
mkLogTableEntry) (GenericList Name Seq LogEntry -> Widget Name)
-> GenericList Name Seq LogEntry -> Widget Name
forall a b. (a -> b) -> a -> b
$ RobotDetailsPaneState
paneState RobotDetailsPaneState
-> Getting
(GenericList Name Seq LogEntry)
RobotDetailsPaneState
(GenericList Name Seq LogEntry)
-> GenericList Name Seq LogEntry
forall s a. s -> Getting a s a -> a
^. Getting
(GenericList Name Seq LogEntry)
RobotDetailsPaneState
(GenericList Name Seq LogEntry)
Lens' RobotDetailsPaneState (GenericList Name Seq LogEntry)
logsList
mkLogTableEntry :: p -> LogEntry -> Widget n
mkLogTableEntry p
_isSelected LogEntry
x =
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox
[ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr (Widget n -> Widget n)
-> (LogEntry -> Widget n) -> LogEntry -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget n
forall n. String -> Widget n
str (String -> Widget n)
-> (LogEntry -> String) -> LogEntry -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (LogEntry -> Doc Any) -> LogEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickNumber -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. TickNumber -> Doc ann
pretty (TickNumber -> Doc Any)
-> (LogEntry -> TickNumber) -> LogEntry -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting TickNumber LogEntry TickNumber -> LogEntry -> TickNumber
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TickNumber LogEntry TickNumber
Lens' LogEntry TickNumber
leTime (LogEntry -> Widget n) -> LogEntry -> Widget n
forall a b. (a -> b) -> a -> b
$ LogEntry
x
, String -> Widget n
forall n. String -> Widget n
str String
": "
, Text -> Widget n
forall n. Text -> Widget n
txtWrap (Text -> Widget n) -> (LogEntry -> Text) -> LogEntry -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text LogEntry Text -> LogEntry -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text LogEntry Text
Lens' LogEntry Text
leText (LogEntry -> Widget n) -> LogEntry -> Widget n
forall a b. (a -> b) -> a -> b
$ LogEntry
x
]
commandsTable :: Widget n
commandsTable =
Table n -> Widget n
forall n. Table n -> Widget n
BT.renderTable
(Table n -> Widget n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.columnBorders Bool
True
(Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.rowBorders Bool
False
(Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.surroundingBorder Bool
False
(Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnAlignment -> Table n -> Table n
forall n. ColumnAlignment -> Table n -> Table n
BT.setDefaultColAlignment ColumnAlignment
BT.AlignLeft
(Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnAlignment -> Int -> Table n -> Table n
forall n. ColumnAlignment -> Int -> Table n -> Table n
BT.setColAlignment ColumnAlignment
BT.AlignRight Int
0
(Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Widget n]] -> Table n
forall n. [[Widget n]] -> Table n
BT.table
([[Widget n]] -> Widget n) -> [[Widget n]] -> Widget n
forall a b. (a -> b) -> a -> b
$ (String -> Widget n) -> [String] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget n -> Widget n)
-> (String -> Widget n) -> String -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget n
forall n. String -> Widget n
str) [String
"Command", String
"Count"] [Widget n] -> [[Widget n]] -> [[Widget n]]
forall a. a -> [a] -> [a]
: [[Widget n]]
forall {n}. [[Widget n]]
commandHistogramEntries
mkHistogramEntry :: (a, a) -> [Widget n]
mkHistogramEntry (a
k, a
v) =
[ Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. PrettyPrec a => a -> Text
prettyText a
k
, String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
v
]
commandHistogramEntries :: [[Widget n]]
commandHistogramEntries =
((Const, Int) -> [Widget n]) -> [(Const, Int)] -> [[Widget n]]
forall a b. (a -> b) -> [a] -> [b]
map (Const, Int) -> [Widget n]
forall {a} {a} {n}. (PrettyPrec a, Show a) => (a, a) -> [Widget n]
mkHistogramEntry ([(Const, Int)] -> [[Widget n]]) -> [(Const, Int)] -> [[Widget n]]
forall a b. (a -> b) -> a -> b
$
Map Const Int -> [(Const, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Const Int -> [(Const, Int)])
-> Map Const Int -> [(Const, Int)]
forall a b. (a -> b) -> a -> b
$
Robot
r Robot
-> Getting (Map Const Int) Robot (Map Const Int) -> Map Const Int
forall s a. s -> Getting a s a -> a
^. (ActivityCounts -> Const (Map Const Int) ActivityCounts)
-> Robot -> Const (Map Const Int) Robot
Lens' Robot ActivityCounts
activityCounts ((ActivityCounts -> Const (Map Const Int) ActivityCounts)
-> Robot -> Const (Map Const Int) Robot)
-> ((Map Const Int -> Const (Map Const Int) (Map Const Int))
-> ActivityCounts -> Const (Map Const Int) ActivityCounts)
-> Getting (Map Const Int) Robot (Map Const Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Const Int -> Const (Map Const Int) (Map Const Int))
-> ActivityCounts -> Const (Map Const Int) ActivityCounts
Lens' ActivityCounts (Map Const Int)
commandsHistogram