{-# 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 Polysemy.Http (Manager)
import qualified Polysemy.Http.Effect.Manager as Manager
import Servant.Client (mkClientEnv, runClientM)
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 Helic.Data.NetConfig (NetConfig)
import qualified Helic.Net.Client as Api
import Helic.Net.Client (localhostUrl)

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 [[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..Item [Int]
0] [Event]
events)
  where
    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 [Manager, Reader ListConfig, Reader NetConfig, Error Text, Embed IO] r =>
  Sem r String
buildList :: Sem r String
buildList = do
  BaseUrl
url <- Sem r BaseUrl
forall (r :: EffectRow).
Members '[Reader NetConfig, Error Text] r =>
Sem r BaseUrl
localhostUrl
  Manager
mgr <- Sem r Manager
forall (r :: EffectRow). Member Manager r => Sem r Manager
Manager.get
  let
    env :: ClientEnv
env =
      Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
mgr BaseUrl
url
    req :: IO (Either Text (Seq Event))
req =
      (ClientError -> Text)
-> Either ClientError (Seq Event) -> Either Text (Seq Event)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ClientError -> Text
forall b a. (Show a, IsString b) => a -> b
show (Either ClientError (Seq Event) -> Either Text (Seq Event))
-> IO (Either ClientError (Seq Event))
-> IO (Either Text (Seq Event))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientM (Seq Event)
-> ClientEnv -> IO (Either ClientError (Seq Event))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (Seq Event)
Api.get ClientEnv
env
  Seq Event
history <- Either Text (Seq Event) -> Sem r (Seq Event)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text (Seq Event) -> Sem r (Seq Event))
-> Sem r (Either Text (Seq Event)) -> Sem r (Seq Event)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Text (Seq Event)) -> Sem r (Either Text (Seq Event))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (Either Text (Seq Event))
req
  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 (Seq Event -> [Event]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq 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 [Manager, Reader ListConfig, Reader NetConfig, 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
  '[Manager, Reader ListConfig, Reader NetConfig, Error Text,
    Embed IO]
  r =>
Sem r String
buildList