{-# options_haddock prune #-}

-- |List command logic, Internal
module Helic.List where

import Chronos (Datetime (Datetime), SubsecondPrecision (SubsecondPrecisionFixed), builder_HMS, timeToDatetime)
import Data.Text.Lazy.Builder (toLazyText)
import qualified System.Console.Terminal.Size as TerminalSize
import Text.Layout.Table (center, column, expandUntil, fixedCol, left, right, rowG, tableString, titlesH, unicodeRoundS)

import Helic.Data.AgentId (AgentId (AgentId))
import Helic.Data.Event (Event (Event), content, sender, source, time)
import Helic.Data.InstanceName (InstanceName (InstanceName))
import qualified Helic.Data.ListConfig as ListConfig
import Helic.Data.ListConfig (ListConfig)
import qualified Helic.Effect.Client as Client
import Helic.Effect.Client (Client)

format :: Int -> [Event] -> String
format :: Int -> [Event] -> String
format Int
width [Event]
events =
  [ColSpec]
-> TableStyle -> HeaderSpec -> [RowGroup String] -> String
forall a.
Cell a =>
[ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> String
tableString [ColSpec]
cols TableStyle
unicodeRoundS HeaderSpec
titles ((Int, Event) -> RowGroup String
forall a. Show a => (a, Event) -> RowGroup String
row ((Int, Event) -> RowGroup String)
-> [(Int, Event)] -> [RowGroup String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Event] -> [(Int, Event)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
Item [Int]
lastIndex,Int
lastIndexInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1..Item [Int]
0] [Event]
events)
  where
    lastIndex :: Int
lastIndex =
      [Event] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Event]
events Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    cols :: [ColSpec]
cols =
      [Int -> Position H -> ColSpec
col Int
4 Position H
right, Int -> Position H -> ColSpec
col Int
16 Position H
forall orientation. Position orientation
center, Int -> Position H -> ColSpec
col Int
10 Position H
forall orientation. Position orientation
center, Int -> Position H -> ColSpec
fixedCol Int
8 Position H
forall orientation. Position orientation
center, Int -> Position H -> ColSpec
col Int
contentWidth Position H
left]
    col :: Int -> Position H -> ColSpec
col Int
w Position H
al =
      LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec
column (Int -> LenSpec
expandUntil Int
w) Position H
al AlignSpec
forall a. Default a => a
def CutMark
forall a. Default a => a
def
    titles :: HeaderSpec
titles =
      [String] -> HeaderSpec
titlesH [Item [String]
"#", Item [String]
"Instance", Item [String]
"Agent", Item [String]
"Time", Item [String]
"Content"]
    row :: (a, Event) -> RowGroup String
row (a
i, Event {Text
Time
InstanceName
AgentId
content :: Text
time :: Time
source :: AgentId
sender :: InstanceName
$sel:time:Event :: Event -> Time
$sel:source:Event :: Event -> AgentId
$sel:sender:Event :: Event -> InstanceName
$sel:content:Event :: Event -> Text
..}) =
      [String] -> RowGroup String
forall a. Row a -> RowGroup a
rowG (Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
i, InstanceName -> Text
coerce InstanceName
sender, AgentId -> Text
coerce AgentId
source, Text -> Text
forall l s. LazyStrict l s => l -> s
toStrict (Datetime -> Text
formatTime (Time -> Datetime
timeToDatetime Time
time)), Text
Item [Text]
content])
    formatTime :: Datetime -> Text
formatTime (Datetime Date
_ TimeOfDay
tod) =
      Builder -> Text
toLazyText (SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_HMS (Int -> SubsecondPrecision
SubsecondPrecisionFixed Int
0) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
':') TimeOfDay
tod)
    contentWidth :: Int
contentWidth =
      Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
20 (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40)

-- |Fetch all events from the server, limit them to the configured number and format them in a nice table.
buildList ::
  Members [Reader ListConfig, Client, Error Text, Embed IO] r =>
  Sem r String
buildList :: Sem r String
buildList = do
  [Event]
history <- Either Text [Event] -> Sem r [Event]
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text [Event] -> Sem r [Event])
-> Sem r (Either Text [Event]) -> Sem r [Event]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r (Either Text [Event])
forall (r :: EffectRow).
Member Client r =>
Sem r (Either Text [Event])
Client.get
  Maybe Int
limit <- (ListConfig -> Maybe Int) -> Sem r (Maybe Int)
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks ListConfig -> Maybe Int
ListConfig.limit
  let
    events :: [Event]
events =
      ([Event] -> [Event])
-> (Int -> [Event] -> [Event]) -> Maybe Int -> [Event] -> [Event]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Event] -> [Event]
forall a. a -> a
id Int -> [Event] -> [Event]
forall a. Int -> [a] -> [a]
take Maybe Int
limit ([Event] -> [Event]
forall a. [a] -> [a]
reverse ([Event] -> [Event]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Event]
history))
  Int
width <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
80 (Maybe Int -> Int)
-> (Maybe (Window Int) -> Maybe Int) -> Maybe (Window Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window Int -> Int) -> Maybe (Window Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window Int -> Int
forall a. Window a -> a
TerminalSize.width (Maybe (Window Int) -> Int)
-> Sem r (Maybe (Window Int)) -> Sem r Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Window Int)) -> Sem r (Maybe (Window Int))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
TerminalSize.size
  pure (Int -> [Event] -> String
format Int
width [Event]
events)

-- |Print a number of events to stdout.
list ::
  Members [Reader ListConfig, Client, Error Text, Embed IO] r =>
  Sem r ()
list :: Sem r ()
list =
  String -> Sem r ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> Sem r ()) -> Sem r String -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r String
forall (r :: EffectRow).
Members '[Reader ListConfig, Client, Error Text, Embed IO] r =>
Sem r String
buildList