~jackwines/discourse-tui

3b265a5c51c0ee974da93fe396e041f8b7616468 — Jack Wines 1 year, 5 months ago 9a30b6e
refactor
3 files changed, 52 insertions(+), 25 deletions(-)

M discourse-tui.cabal
M src/Main.hs
M src/Types.hs
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)