{-# options_haddock prune #-}
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)
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)
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