Commits

paradoxiology committed f50b173

Refactoring and code cleanup

Comments (0)

Files changed (3)

 
 
 appendStateToHistory :: ReadingState -> NavigationState -> NavigationState
-appendStateToHistory ns nav@(NavigationState{ curRState = cs, backList = bls }) = nav{ curRState = ns, backList = bls ++ [cs], forwardList = [] }
+appendStateToHistory ns nav@(NavigationState{ curRState = cs, backList = bls }) = nav{ curRState = ns, backList = cs : bls, forwardList = [] }
 
 
 modifyCurrentState :: ReadingState -> NavigationState -> NavigationState
 
 
 navigateBack :: NavigationState -> NavigationState
+navigateBack nav@(NavigationState{ backList = [] }) = nav
+
 navigateBack nav@(NavigationState{ curRState = cs,
-                                    backList = bls,
-                                 forwardList = fls}) = if length bls <= 1
-                                                          then nav
-                                                            else nav{ curRState = ps,
-                                                                       backList = init bls,
-                                                                    forwardList = cs : fls}
-                                                               where ps = last bls
+                                   backList = ps : bs,
+                                   forwardList = fls})
+                                    | null bs   = nav
+                                    | otherwise = nav{ curRState = ps,
+                                                       backList = bs,
+                                                       forwardList = cs : fls}
                                                                
-navigateForward ::  NavigationState -> NavigationState
+                                                               
+navigateForward :: NavigationState -> NavigationState
+navigateForward nav@(NavigationState{ forwardList = [] }) = nav
+
 navigateForward nav@(NavigationState{ curRState = cs, 
                                       backList = bls,
-                                      forwardList = fls}) = if null fls
-                                                                then nav
-                                                                  else nav{ curRState = ns,
-                                                                             backList = bls ++ [cs],
-                                                                          forwardList = tail fls}
-                                                                where ns = head fls
+                                      forwardList = f: fs}) = nav{ curRState = f,
+                                                                   backList = cs : bls,
+                                                                   forwardList = fs}
+
 
 updateNavCookies cs nav = nav{ cookies = cs }
 
 
 
 parseCommand :: MonadError String m => String -> m Command
-parseCommand s = let args@(_:as) = words s
+parseCommand s = let (_:as) = words s
                      argl         = unwords as in 
                          case words s of
                              "r":subreddit:_ -> return $ GotoSubreddit subreddit
 getUserInput readingState = runInputT inputSettings $ waitForInputStr readingState
 
 						       
-waitForCommand :: R Command
-waitForCommand = do
-                     liftIO $ setCursorColumn 0
-                     readingState <- gets curRState
-                     liftIO $ putStr $ cmdprompt readingState
-                     liftIO $ hFlush stdout
-                     cmdStr <- liftIO  getLine
-                     parseCommand cmdStr
-                     where cmdprompt rState = case rState of
-                                                  ReadingListing _ (Subreddit "")  -> defaultPrompt
-                                                  ReadingListing _ (Subreddit sub) -> sub ++ ">"
-                                                  ReadingListing _ (SearchResults _) -> "results.search>"
-                                                  ReadingComments  _ _ a -> "comments." ++ articelSub a ++ ">"
-                                                  NoState                -> defaultPrompt
-                                                  where defaultPrompt = "reddit>"
-
-
 runCommand :: Command -> R Command
 runCommand Exit    = return Exit;
 runCommand command = do
                                        
 execCommand (OpenArticleDetails index)  = do
                                               a <- lookupArticle index
-                                              readingState <- gets curRState
-                                              displayDetails a
-                                          where displayDetails a = liftIO $ displayDetailArticle a
+                                              liftIO $ displayDetailArticle a
+
 
 execCommand (OpenCommentURL globPat) = do
                                            readingState <- gets curRState
 lookupFM f err ls  = maybe (fail err) (return . snd) (listToMaybe $ filter (f . fst) ls)
 
 
-displayContent (ReadingComments pcs _ a)   = displayComments pcs
+displayContent (ReadingComments pcs _ _)   = displayComments pcs
 displayContent (ReadingListing articleList _) = displayArticles (listing articleList)
-                            
+displayContent NoState = return ()                            
+              
               
 displayArticles articles = do
                                cUTC <- getCurrentTime
 import Reddit
 import Text.JSON
 
-import Network.URI (URI(uriPath))
+import Network.URI (URI)
 
 import Data.List (isInfixOf)
 import Data.Maybe
                                 
 
 titleDomainLinesToDocLines :: [String] -> String -> [Doc]
+titleDomainLinesToDocLines []         _ = []
 titleDomainLinesToDocLines [lastLine] d = case stripSuffix lastLine d of
                                               Just lastTitleLine -> [text lastTitleLine <+> black (text d)] 
                                               Nothing            -> [text lastLine]
 titleDomainLinesToDocLines (l:ls)     d = text l : titleDomainLinesToDocLines ls d
 
+
 articleTitleToDocLines :: Article -> [Doc]
 articleTitleToDocLines a = titleDomainLinesToDocLines (wrapLine wordWrapLineLen (articleTitle a ++ domain)) domain
                            where domain = '(' : articleDomain a ++ ")"