135 lines
3.8 KiB
Haskell
135 lines
3.8 KiB
Haskell
{-# LANGUAGE Strict #-}
|
|
|
|
module Api.Types (
|
|
GetSections (GetSections)
|
|
, Section (..)
|
|
, GetTopics (GetTopics)
|
|
, TopicInfo (..)
|
|
, GetTopic (..)
|
|
, Topic (..)
|
|
, ThreadHead (..)
|
|
, ThreadPost (..)
|
|
) where
|
|
|
|
import Relude
|
|
|
|
import Color.Print
|
|
import Color.Utils
|
|
import Data.Aeson (FromJSON (parseJSON), Value (Object), withObject, (.:))
|
|
import Data.HashMap.Strict qualified as M
|
|
import Polysemy.Commonmark.AST (commonmark)
|
|
import Polysemy.Output.IO
|
|
import Polysemy.Sgr
|
|
import System.Console.ANSI
|
|
import Web.FormUrlEncoded (Form (Form), ToForm (toForm))
|
|
|
|
data GetSections = GetSections
|
|
instance ToForm GetSections where
|
|
toForm GetSections = Form $ M.fromList [("type", ["sections"]), ("key", ["anon"])]
|
|
|
|
data Section = Section
|
|
{ id :: Integer
|
|
, thread_group_name, description :: Text
|
|
}
|
|
deriving stock (Generic, Show)
|
|
instance NFData 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
|
|
instance ToForm GetTopics where
|
|
toForm GetTopics = Form $ M.fromList [("type", ["threads"]), ("key", ["anon"])]
|
|
|
|
data TopicInfo = TopicInfo
|
|
{ id, group_id, nbr_ansfers :: Integer
|
|
, thrname, date, name, last_activity_date, last_activity_user :: Text
|
|
}
|
|
deriving stock (Generic, Show)
|
|
instance NFData 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}
|
|
instance ToForm GetTopic where
|
|
toForm GetTopic{topic_id} =
|
|
Form $
|
|
M.fromList
|
|
[ ("type", ["topic"])
|
|
, ("key", ["anon"])
|
|
, ("id", [show topic_id])
|
|
]
|
|
|
|
data Topic = Topic
|
|
{ thread :: ThreadHead
|
|
, post :: [ThreadPost]
|
|
}
|
|
deriving stock (Generic, Show)
|
|
instance NFData Topic
|
|
instance FromJSON Topic
|
|
|
|
instance PrintColor Topic where
|
|
printColor Topic{thread, post} =
|
|
sequenceA_ $ intersperse (putTextLnO "") (printColor <$> threadHeadToPost thread : post)
|
|
|
|
data ThreadHead = ThreadHead
|
|
{ info :: TopicInfo
|
|
, message :: Text
|
|
}
|
|
deriving stock (Generic, Show)
|
|
instance NFData ThreadHead
|
|
instance FromJSON ThreadHead where
|
|
parseJSON = withObject "ThreadHead" \o ->
|
|
ThreadHead <$> parseJSON (Object o)
|
|
<*> o .: "message"
|
|
|
|
threadHeadToPost :: ThreadHead -> ThreadPost
|
|
threadHeadToPost ThreadHead{info, message} =
|
|
ThreadPost
|
|
{ id = info.id
|
|
, topic_id = info.id
|
|
, name = info.name
|
|
, date = info.date
|
|
, message
|
|
}
|
|
|
|
data ThreadPost = ThreadPost
|
|
{ id, topic_id :: Integer
|
|
, name, date, message :: Text
|
|
}
|
|
deriving stock (Generic, Show)
|
|
instance NFData ThreadPost
|
|
instance FromJSON ThreadPost
|
|
|
|
instance PrintColor ThreadPost where
|
|
printColor ThreadPost{id = post_id, name, date, message} = do
|
|
withSgr
|
|
[ SetPaletteColor Foreground (textColor name)
|
|
, SetConsoleIntensity BoldIntensity
|
|
-- , SetSwapForegroundBackground True
|
|
]
|
|
do
|
|
putTextO $ "@" <> name
|
|
withSgr [SetColor Foreground Dull White] do
|
|
putTextLnO $ " " <> date <> " #" <> show post_id
|
|
case commonmark "<message>" message of
|
|
Right block -> printColor block
|
|
Left err -> withSgr [SetColor Foreground Vivid Red] do
|
|
putTextLnO $ "Error parsing commonmark: " <> show err
|
|
putTextLnO message
|