Add ss and ts to cli

main
staticvoid 2022-06-27 00:21:42 +03:00
parent ef0e3a97b5
commit 72ec006124
2 changed files with 30 additions and 8 deletions

View File

@ -33,6 +33,14 @@ data Section = Section { id :: Integer
instance NFData Section instance NFData Section
instance FromJSON Section instance FromJSON Section
instance PrintColor Section where
printColor Section{id = thread_id, thread_group_name, description} = do
withSgr [SetUnderlining SingleUnderline] do
putTextO thread_group_name
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " #" <> show thread_id
putTextLnO description
data GetTopics = GetTopics data GetTopics = GetTopics
instance ToForm GetTopics where instance ToForm GetTopics where
toForm GetTopics = Form $ M.fromList [("type", ["threads"]), ("key", ["anon"])] toForm GetTopics = Form $ M.fromList [("type", ["threads"]), ("key", ["anon"])]
@ -44,6 +52,16 @@ data TopicInfo = TopicInfo { id, group_id, nbr_ansfers :: Integer
instance NFData TopicInfo instance NFData TopicInfo
instance FromJSON TopicInfo instance FromJSON TopicInfo
instance PrintColor TopicInfo where
printColor TopicInfo{id = topic_id, thrname, last_activity_date, last_activity_user} = do
withSgr [SetUnderlining SingleUnderline] do
putTextO thrname
putTextO ": "
withSgr [SetPaletteColor Foreground (textColor last_activity_user)] do
putTextO $ "@" <> last_activity_user
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " at " <> last_activity_date <> " #" <> show topic_id
data GetTopic = GetTopic { topic_id :: Integer } data GetTopic = GetTopic { topic_id :: Integer }
instance ToForm GetTopic where instance ToForm GetTopic where
toForm GetTopic {topic_id} = Form $ M.fromList [ ("type", ["topic"]) toForm GetTopic {topic_id} = Form $ M.fromList [ ("type", ["topic"])

View File

@ -3,13 +3,14 @@ module Main (main) where
import Relude hiding (Proxy) import Relude hiding (Proxy)
import Api qualified as Api import Api qualified as Api
import Api.Types (last_activity_date)
import Cli import Cli
import Network.HTTP.Client import Network.HTTP.Client
import Polysemy (Member, Members, Sem) import Polysemy (Member, Members, Sem)
import Polysemy.Embed (Embed) import Polysemy.Embed (Embed)
import Polysemy.Error (Error, errorToIOFinal) import Polysemy.Error (Error, errorToIOFinal)
import Polysemy.Output (Output) import Polysemy.Output (Output)
import Polysemy.Output.IO (runOutputToStdout) import Polysemy.Output.IO (putTextLnO, runOutputToStdout)
import Polysemy.Sgr (Sgr, SgrRegion, ignoreSgrFull, runSgrFull, withSgr) import Polysemy.Sgr (Sgr, SgrRegion, ignoreSgrFull, runSgrFull, withSgr)
import Polysemy.Final (Final, embedToFinal, runFinal) import Polysemy.Final (Final, embedToFinal, runFinal)
import Color.Print import Color.Print
@ -40,13 +41,16 @@ sgrFullInterpreter noAnsi = if noAnsi then ignoreSgrFull else runSgrFull
program :: Members [Error ClientError, ServantClient, Output Text, Sgr, SgrRegion] r program :: Members [Error ClientError, ServantClient, Output Text, Sgr, SgrRegion] r
=> Choice -> Sem r () => Choice -> Sem r ()
program GetSections = error "GetSections is not yet implemented" program GetSections = do
program GetTopics = error "GetTopics is not yet implemented" sections <- Api.getSections
program GetTopic{topic_id} = showTopic topic_id withSgr [SetColor Foreground Vivid White] do
sequenceA_ $ intersperse (putTextLnO "") (printColor <$> sections)
showTopic :: Members [ServantClient, Error ClientError, Output Text, Sgr, SgrRegion] r program GetTopics = do
=> Integer -> Sem r () topics <- Api.getTopics
showTopic topic_id = do withSgr [SetColor Foreground Vivid White] do
sequenceA_ $ intersperse (putTextLnO "")
(fmap printColor . reverse $ sortBy (comparing (.last_activity_date)) topics)
program GetTopic{topic_id} = do
topic <- Api.getTopic topic_id topic <- Api.getTopic topic_id
withSgr [SetColor Foreground Vivid White] do withSgr [SetColor Foreground Vivid White] do
printColor topic printColor topic