M discourse-tui.cabal => discourse-tui.cabal +1 -1
@@ 54,7 54,7 @@ executable discourse-tui
main-is: Main.hs
-- Modules included in this executable, other than Main.
- other-modules: Types
+ other-modules: Types, VHList
-- LANGUAGE extensions used by modules in this package.
default-extensions: ScopedTypeVariables,
M src/Main.hs => src/Main.hs +36 -16
@@ 24,6 24,18 @@ import Types
import System.Exit
import Control.Lens
+-- change a protoTopic into a topic by consulting userMap and catagoryMap
+parseTopic :: M.IntMap User -> M.IntMap Category -> ProtoTopic -> Topic
+parseTopic userMap catagoryMap (ProtoTopic topicId catId title likeC postsC posters pinned)
+ = Topic {
+ _title = title,
+ _topicId = topicId,
+ _category = ((catagoryMap M.! catId) ^. categoryName),
+ _likeCount = likeC,
+ _postsCount = postsC,
+ _posters = (map (\x -> (userMap M.! (x ^. posterId)) ^. userName) posters),
+ _pinned = pinned
+ }
helpMessage = "Usage: discourse-tui url \n Ex: discourse-tui http://discourse.haskell.org"
@@ 46,13 58,13 @@ getTuiState :: String -> IO TuiState
getTuiState baseUrl = do
topicsRequest <- parseRequest (baseUrl ++ "/latest.json")
categoriesRequest <- parseRequest (baseUrl ++ "/categories.json")
- (TopicResponse users topicList) <- getResponseBody <$> httpJSON topicsRequest
categoriesResp <- getResponseBody <$> httpJSON categoriesRequest
+ (TopicResponse users topicList) <- getResponseBody <$> httpJSON topicsRequest
+ let userMap = M.fromList . map (\x -> (x ^. userId, x)) $ users
+ let categoryMap = M.fromList . map (\x -> (x ^. categoryId, x)) $ categoriesResp ^. categories
return TuiState {
_posts = Nothing,
- _topics = list "contents" (V.fromList topicList) topicHeight,
- _userMap = M.fromList . map (\x -> (x^.userId, x)) $ users,
- _categoryMap = M.fromList . map (\x -> (x^.categoryId, x)) $ categoriesResp^.categories,
+ _topics = list "contents" (V.fromList $ map (parseTopic userMap categoryMap) topicList) topicHeight,
_baseURL = baseUrl,
_singlePostView = False
}
@@ 98,9 110,9 @@ toMarkdown s = do
-- draws the entire TuiState
-- this pattern matches the topic list
drawTui :: TuiState -> [Widget ResourceName]
-drawTui (TuiState scrollable Nothing userMap categoryMap _ _) = (:[]) $ (renderList drawTopic True $ scrollable) <=> helpBar
+drawTui (TuiState scrollable Nothing _ _) = (:[]) $ (renderList drawTopic True $ scrollable) <=> helpBar
where
- drawTopic selected (Topic _ categoryId title likeCount postsCount posters pinned)
+ drawTopic selected (Topic _ category' title likeCount postsCount posters pinned)
= border
. (if pinned then withAttr "pinned" else id)
. padRight Max
@@ 130,17 142,16 @@ drawTui (TuiState scrollable Nothing userMap categoryMap _ _) = (:[]) $ (renderL
. hBox
. mapFst (withAttr "OP") (withAttr "rest")
. showList
- . map (\x -> view userName $ userMap M.! (x ^. posterId))
$ posters
category :: Widget ResourceName
- category = padLeft (Pad 5) . str . view categoryName $ categoryMap M.! categoryId
+ category = padLeft (Pad 5) . str $ category'
showList :: [String] -> [Widget ResourceName]
showList s = map str $ (map (++ " ") . init $ s) ++ [last s]
-- this pattern matches the post list
-drawTui (TuiState _ (Just posts) _ _ _ False)
+drawTui (TuiState _ (Just posts) _ False)
= (:[])
$ (renderList drawPost True $ posts)
<=> helpBar
@@ 159,7 170,7 @@ drawTui (TuiState _ (Just posts) _ _ _ False)
. padBottom Max
. padRight Max
-drawTui (TuiState _ (Just posts) _ _ _ True) = (:[]) $ case listSelectedElement posts of
+drawTui (TuiState _ (Just posts) _ True) = (:[]) $ case listSelectedElement posts of
(Just (_, post)) -> (withAttr "OP" . str $ post ^. opUserName)
<=> padBottom Max (str $ post ^. contents) <=> helpBar
Nothing -> str "something went wrong"
@@ 167,18 178,27 @@ drawTui (TuiState _ (Just posts) _ _ _ True) = (:[]) $ case listSelectedElement
mapFst :: (a -> a) -> (a -> a) -> [a] -> [a]
mapFst fn fn' (x:xs) = (fn x) : (map fn' xs)
--- handles key presses. TODO: clean
handleTuiEvent :: TuiState -> BrickEvent String e -> EventM String (Next TuiState)
handleTuiEvent tui (VtyEvent (EvKey (KChar 'q') _)) = halt tui
-handleTuiEvent (TuiState topics (Just list) usrMap catMap url singlePostView) (VtyEvent (EvKey KRight _)) = continue $ TuiState topics (Just list) usrMap catMap url (not singlePostView)
-handleTuiEvent (TuiState topics (Just list) usrMap catMap url True) (VtyEvent (EvKey _ _)) = continue $ TuiState topics (Just list) usrMap catMap url False
+
+handleTuiEvent (TuiState topics (Just list) url singlePostView) (VtyEvent (EvKey KRight _))
+ = continue $ TuiState topics (Just list) url (not singlePostView)
+
+handleTuiEvent (TuiState topics (Just list) url True) (VtyEvent (EvKey _ _))
+ = continue $ TuiState topics (Just list) url False
+
handleTuiEvent tui (VtyEvent (EvKey KRight _)) = do
posts' <- liftIO $ getPosts tui
continue $ tui & posts .~ (Just posts')
-handleTuiEvent tui (VtyEvent (EvKey KLeft _)) = continue $ tui & posts .~ Nothing
-handleTuiEvent (TuiState list Nothing usrMap catMap url spv) ev = scrollHandler (\x -> TuiState x Nothing usrMap catMap url spv) list ev
-handleTuiEvent (TuiState topics (Just list) usrMap catMap url spv) ev = scrollHandler (\x -> TuiState topics (Just x) usrMap catMap url spv) list ev
+handleTuiEvent tui (VtyEvent (EvKey KLeft _))
+ = continue $ tui & posts .~ Nothing
+
+handleTuiEvent (TuiState list Nothing url spv) ev
+ = scrollHandler (\x -> TuiState x Nothing url spv) list ev
+
+handleTuiEvent (TuiState topics (Just list) url spv) ev
+ = scrollHandler (\x -> TuiState topics (Just x) url spv) list ev
scrollHandler restoreTuiState list (VtyEvent ev) = continue . restoreTuiState =<< handler
where
M src/Types.hs => src/Types.hs +15 -8
@@ 8,8 8,8 @@ import GHC.Generics
import Control.Lens
import Control.Lens.TH
-instance FromJSON Topic where
- parseJSON = withObject "Topic" $ \v -> do
+instance FromJSON ProtoTopic where
+ parseJSON = withObject "ProtoTopic" $ \v -> do
topicId' <- v .: "id"
title' <- v .: "title"
likeCount' <- v.: "like_count"
@@ 17,7 17,7 @@ instance FromJSON Topic where
posters' <- v.: "posters"
pinned' <- v.: "pinned"
categoryId' <- v.: "category_id"
- return $ Topic topicId' categoryId' title' likeCount' postsCount' posters' pinned'
+ return $ ProtoTopic topicId' categoryId' title' likeCount' postsCount' posters' pinned'
instance FromJSON User where
parseJSON (Object v) = User
@@ 81,13 81,13 @@ data Action = Action
data TopicResponse = TopicResponse
{
_users :: [User],
- _topicList :: [Topic]
+ _topicList :: [ProtoTopic]
} deriving (Show)
topicHeight :: Int
topicHeight = 4
-data Topic = Topic
+data ProtoTopic = ProtoTopic
{
_topicId :: Int,
_categoryID :: Int,
@@ 98,6 98,16 @@ data Topic = Topic
_pinned :: Bool
} deriving (Show)
+data Topic = Topic
+ {
+ _topicId :: Int,
+ _category :: String,
+ _title :: String,
+ _likeCount :: Int,
+ _postsCount :: Int,
+ _posters :: [String],
+ _pinned :: Bool
+ } deriving (Show)
data User = User
{
@@ 124,7 134,6 @@ data PostResponse = PostResponse
_postList :: [Post]
} deriving (Show)
-
data Post = Post
{
_postId :: Int,
@@ 137,8 146,6 @@ data TuiState = TuiState
{
_topics :: List String Topic,
_posts :: Maybe (List String Post), -- Nothing if not in post view
- _userMap :: M.IntMap User,
- _categoryMap :: M.IntMap Category,
_baseURL :: String,
_singlePostView :: Bool -- if we're looking at the full contents of one post
} deriving (Show)