{-# 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' forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
|| Char
'\r' forall a. Eq a => a -> a -> Bool
== Char
c) Text
a) of
    [] ->
      Text
a
    [Item [Text]
firstLine] ->
      Item [Text]
firstLine
    Text
firstLine : (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 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
..} =
  [forall b a. (Show a, IsString b) => a -> b
show Int
i, coerce :: forall a b. Coercible a b => a -> b
coerce InstanceName
sender, coerce :: forall a b. Coercible a b => a -> b
coerce AgentId
source, 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) (forall a. a -> Maybe a
Just Char
':') TimeOfDay
tod)

format :: Int -> NonEmpty Event -> String
format :: Int -> NonEmpty Event -> String
format Int
width (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [Event]
events) =
  forall a.
Cell a =>
[ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> String
tableString [ColSpec]
cols TableStyle
unicodeRoundS HeaderSpec
titles ((Int, Event) -> RowGroup String
row forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Int
lastIndex,Int
lastIndexforall a. Num a => a -> a -> a
-Int
1..Int
0] [Event]
events)
  where
    lastIndex :: Int
lastIndex =
      forall (t :: * -> *) a. Foldable t => t a -> Int
length [Event]
events 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 forall orientation. Position orientation
center, Int -> Position H -> ColSpec
col Int
10 forall orientation. Position orientation
center, Int -> Position H -> ColSpec
fixedCol Int
8 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 forall a. Default a => a
def forall a. Default a => a
def
    titles :: HeaderSpec
titles =
      [String] -> HeaderSpec
titlesH [String
"#", String
"Instance", String
"Agent", String
"Time", String
"Content"]
    row :: (Int, Event) -> RowGroup String
row (Int
i, Event
event) =
      forall a. Row a -> RowGroup a
rowG (forall a. ToString a => a -> String
toString 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 =
      forall a. Ord a => a -> a -> a
min Int
100 (forall a. Ord a => a -> a -> a
max Int
20 (Int
width 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 :: forall (r :: EffectRow).
Members '[Reader ListConfig, Client, Error Text, Embed IO] r =>
Sem r String
buildList = do
  [Event]
history <- forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (r :: EffectRow).
Member Client r =>
Sem r (Either Text [Event])
Client.get
  Maybe Int
limit <- forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks (.limit)
  let
    dropper :: Int -> [Event] -> [Event]
dropper Int
l =
      forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Event]
history forall a. Num a => a -> a -> a
- Int
l)
    events :: [Event]
events =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Int -> [Event] -> [Event]
dropper Maybe Int
limit (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Event]
history)
  Int
width <- forall a. a -> Maybe a -> a
fromMaybe Int
80 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Window a -> a
TerminalSize.width forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall n. Integral n => IO (Maybe (Window n))
TerminalSize.size
  pure (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"No events yet!" (Int -> NonEmpty Event -> String
format Int
width) (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 :: forall (r :: EffectRow).
Members '[Reader ListConfig, Client, Error Text, Embed IO] r =>
Sem r ()
list =
  forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (r :: EffectRow).
Members '[Reader ListConfig, Client, Error Text, Embed IO] r =>
Sem r String
buildList