{-# options_haddock prune #-}

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

import Chronos (Datetime (Datetime), SubsecondPrecision (SubsecondPrecisionFixed), builder_HMS, timeToDatetime)
import qualified Data.Text as Text
import Data.Text.Lazy.Builder (toLazyText)
import Exon (exon)
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)

truncateLines :: Int -> Text -> Text
truncateLines :: Int -> Text -> Text
truncateLines Int
maxWidth Text
a =
  case Text -> [Text]
Text.lines ((Char -> Bool) -> Text -> Text
Text.dropWhile (\ Char
c -> Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
|| Char
'\r' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
a) of
    [] ->
      Text
a
    [Item [Text]
firstLine] ->
      Text
Item [Text]
firstLine
    Text
firstLine : ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
count) ->
      let
        lineIndicator :: Text
lineIndicator =
          [exon| [#{show (count + 1)} lines]|]
        maxlen :: Int
maxlen =
          Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
lineIndicator
      in [exon|#{Text.take maxlen firstLine}#{lineIndicator}|]

eventColumns :: Int -> Int -> Event -> [Text]
eventColumns :: Int -> Int -> Event -> [Text]
eventColumns Int
maxWidth Int
i Event {Text
Time
AgentId
InstanceName
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
..} =
  [Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
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)), Int -> Text -> Text
truncateLines Int
maxWidth Text
content]
  where
    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)

format :: Int -> NonEmpty Event -> String
format :: Int -> NonEmpty Event -> String
format Int
width (NonEmpty Event -> [Event]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [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
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 :: (Int, Event) -> RowGroup String
row (Int
i, Event
event) =
      [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
<$> Int -> Int -> Event -> [Text]
eventColumns Int
contentWidth Int
i Event
event)
    contentWidth :: Int
contentWidth =
      Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
100 (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
    dropper :: Int -> [Event] -> [Event]
dropper Int
l =
      Int -> [Event] -> [Event]
forall a. Int -> [a] -> [a]
drop ([Event] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Event]
history Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)
    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]
dropper Maybe Int
limit ([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 (String
-> (NonEmpty Event -> String) -> Maybe (NonEmpty Event) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"No events yet!" (Int -> NonEmpty Event -> String
format Int
width) ([Event] -> Maybe (NonEmpty Event)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [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 =
  IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> (String -> IO ()) -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
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