From b524441d9cc2b025b82d3db83215d7fa0a161543 Mon Sep 17 00:00:00 2001 From: Joscha Date: Sun, 16 Sep 2018 16:30:41 +0000 Subject: [PATCH] Clean up using hlint and --pedantic --- app/Main.hs | 6 ++-- src/TaskMachine/LTask.hs | 7 ++--- src/TaskMachine/Todotxt.hs | 5 ++-- src/TaskMachine/UI.hs | 9 ++---- src/TaskMachine/UI/Colortest.hs | 15 ++++------ src/TaskMachine/UI/TaskList.hs | 12 +++++++- src/TaskMachine/UI/Types.hs | 49 ++++++++++++++++++++++++--------- 7 files changed, 62 insertions(+), 41 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index e787a4b..2ab1a4c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,7 +10,7 @@ import TaskMachine.LTask import TaskMachine.UI import TaskMachine.UI.Types -data Options = Options +newtype Options = Options { oTodofile :: FilePath } deriving (Show) @@ -24,11 +24,9 @@ opts = pure Options ) optsInfo :: O.ParserInfo Options -optsInfo = O.info (opts <**> O.helper) - ( O.fullDesc +optsInfo = O.info (opts <**> O.helper) O.fullDesc -- <> O.progDesc "program description" -- <> O.header "help header" - ) main :: IO() main = do diff --git a/src/TaskMachine/LTask.hs b/src/TaskMachine/LTask.hs index 7f07e23..fa6998c 100644 --- a/src/TaskMachine/LTask.hs +++ b/src/TaskMachine/LTask.hs @@ -11,7 +11,6 @@ import Data.List import Data.Function import qualified Data.Vector as V -import Text.Megaparsec import TaskMachine.Todotxt @@ -30,11 +29,11 @@ loadLTasks :: FilePath -> IO (Either String (V.Vector LTask)) loadLTasks file = do content <- readFile file case parseTasks file content of - Right tasks -> pure $ Right $ V.fromList $ fromTasks tasks + Right taskList -> pure $ Right $ V.fromList $ fromTasks taskList Left parseError -> pure $ Left $ show parseError saveLTasks :: V.Vector LTask -> FilePath -> IO () saveLTasks ltasks file = do - let tasks = map ltaskTask $ sortBy (compare `on` ltaskNumber) $ V.toList ltasks - text = unlines $ map formatTask tasks + let taskList = map ltaskTask $ sortBy (compare `on` ltaskNumber) $ V.toList ltasks + text = unlines $ map formatTask taskList writeFile file text diff --git a/src/TaskMachine/Todotxt.hs b/src/TaskMachine/Todotxt.hs index d6c6337..750ab2c 100644 --- a/src/TaskMachine/Todotxt.hs +++ b/src/TaskMachine/Todotxt.hs @@ -32,7 +32,6 @@ import Data.Set as Set import Data.Time.Calendar import Text.Megaparsec import Text.Megaparsec.Char -import Text.Megaparsec.Error type Parser = Parsec Void String @@ -119,10 +118,10 @@ data Task = Task -- show = formatTask formatTask :: Task -> String -formatTask (Task done prio dates desc) +formatTask (Task done prio tDates desc) = (if done then "x " else "") ++ maybe "" ((++" ") . formatPriority) prio - ++ maybe "" ((++" ") . formatDates) dates + ++ maybe "" ((++" ") . formatDates) tDates ++ desc parseTasks :: FilePath -> String -> Either (ParseError Char Void) [Task] diff --git a/src/TaskMachine/UI.hs b/src/TaskMachine/UI.hs index c8aaea8..432ccbb 100644 --- a/src/TaskMachine/UI.hs +++ b/src/TaskMachine/UI.hs @@ -6,13 +6,8 @@ module TaskMachine.UI where -- import qualified Brick as B import qualified Brick.Themes as B -import qualified Brick.Widgets.Core as B import qualified Brick.Widgets.List as B -import qualified Data.Vector as V -import qualified Graphics.Vty as VTY -import TaskMachine.LTask -import TaskMachine.Todotxt import TaskMachine.UI.TaskList import TaskMachine.UI.Types --import qualified Database.SQLite.Simple as DB @@ -49,7 +44,7 @@ Edit _____________________________ -- [_] display loaded tasks in UI drawUIState :: UIState -> [B.Widget RName] -drawUIState UIState{..} = [B.renderList renderLTask True taskList] +drawUIState UIState{..} = [B.renderList (renderLTask taskEdit) True taskList] myApp :: B.Theme -> B.App UIState () RName myApp theme = B.App @@ -57,7 +52,7 @@ myApp theme = B.App , B.appChooseCursor = B.neverShowCursor , B.appHandleEvent = B.resizeOrQuit , B.appStartEvent = pure - , B.appAttrMap = const $ attrMap + , B.appAttrMap = const attrMap } where attrMap = B.themeToAttrMap theme diff --git a/src/TaskMachine/UI/Colortest.hs b/src/TaskMachine/UI/Colortest.hs index 84ad5a6..ea0954d 100644 --- a/src/TaskMachine/UI/Colortest.hs +++ b/src/TaskMachine/UI/Colortest.hs @@ -9,12 +9,8 @@ module TaskMachine.UI.Colortest where import Control.Monad import Data.List -import qualified Brick as B -import qualified Brick.Focus as B -import qualified Brick.Themes as B -import qualified Brick.Widgets.List as B -import qualified Data.Vector as V -import qualified Graphics.Vty as VTY +import qualified Brick as B +import qualified Graphics.Vty as VTY colors :: [(String, VTY.Color)] colors = @@ -50,14 +46,14 @@ toName :: String -> String -> String -> B.AttrName toName a b c = B.attrName a <> B.attrName b <> B.attrName c useStyles :: [VTY.Style] -> VTY.Attr -> VTY.Attr -useStyles styles = foldr (.) id $ map (flip VTY.withStyle) styles +useStyles = foldr ((.) . flip VTY.withStyle) id attrMap :: B.AttrMap attrMap = B.attrMap VTY.defAttr $ do (fgName, fgColor) <- colors (bgName, bgColor) <- colors styleList <- subsequences styles - let styleName = concat $ map fst styleList + let styleName = concatMap fst styleList name = toName styleName bgName fgName fgAttr = VTY.withForeColor VTY.defAttr fgColor bgAttr = VTY.withBackColor fgAttr bgColor @@ -72,7 +68,8 @@ cw style = B.vBox $ B.str (' ':style) : do let name = toName style bgName fgName pure $ B.withAttr name $ B.str "Hi" -testWidget = B.vBox $ +testWidget :: B.Widget n +testWidget = B.vBox [ B.hBox [cw "", cw "standout"] , B.hBox [cw "", cw "underline"] -- , B.hBox [cw "", cw "reverseVideo"] diff --git a/src/TaskMachine/UI/TaskList.hs b/src/TaskMachine/UI/TaskList.hs index e13d92e..559c2bd 100644 --- a/src/TaskMachine/UI/TaskList.hs +++ b/src/TaskMachine/UI/TaskList.hs @@ -1,14 +1,15 @@ -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module TaskMachine.UI.TaskList where import qualified Brick as B +import qualified Brick.Widgets.Edit as B import TaskMachine.LTask import TaskMachine.Todotxt import TaskMachine.UI.Types +{- widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n widgetPriority _ Nothing = B.emptyWidget widgetPriority highlight (Just prio) = @@ -28,3 +29,12 @@ renderLTask highlight (LTask _ Task{..}) = wPriority = widgetPriority attrHighlight taskPriority wDescription = widgetDescription attrHighlight taskDescription in B.hBox [wCompleted, wPriority, wDescription] +-} + +renderLTask :: Maybe (B.Editor String RName) -> Bool -> LTask -> B.Widget RName +renderLTask _ False (LTask _ t) = B.withAttr normal $ B.str $ formatTask t + where normal = "normal" <> "priority" +renderLTask Nothing True (LTask _ t) = B.withAttr highlight $ B.str $ formatTask t + where highlight = "highlight" <> "priority" +renderLTask (Just edit) True _ = B.withAttr highlight $ B.renderEditor (B.str . unlines) True edit + where highlight = "highlight" <> "priority" diff --git a/src/TaskMachine/UI/Types.hs b/src/TaskMachine/UI/Types.hs index d487dc3..237a8e8 100644 --- a/src/TaskMachine/UI/Types.hs +++ b/src/TaskMachine/UI/Types.hs @@ -14,6 +14,7 @@ module TaskMachine.UI.Types import qualified Brick.Focus as B import qualified Brick.Themes as B import qualified Brick.Widgets.List as B +import qualified Brick.Widgets.Edit as B import qualified Data.Vector as V import qualified Graphics.Vty as VTY @@ -21,35 +22,57 @@ import TaskMachine.LTask -- | Resource names data RName - -- These can be tab-cycled through - = RTopBar + = RSearchEdit | RTaskList - | REdit - -- Items in the top bar that are selected with the ← and → arrow keys - | RPrune - | RReload - | RSearch + | RNewEdit deriving (Eq, Show, Ord) +data BigRing + = BRTopBar + | BRTaskList + | BRNewTask + deriving (Eq) + +data SmallRing + = SRPrune + | SRReload + | SRSearch + deriving (Eq) + -- | The state of the program and UI data UIState = UIState - { focus :: B.FocusRing RName + { focus :: B.FocusRing BigRing -- ^ 'B.FocusRing' for tab navigation - , topBarFocus :: B.FocusRing RName + , focusTopBar :: B.FocusRing SmallRing -- ^ 'B.FocusRing' for the top bar, for ← and → arrow key navigation + + -- TOP BAR + , searchEdit :: B.Editor String RName + -- ^ Content of the search field + + -- TASK LIST , taskList :: B.List RName LTask -- ^ List to display tasks , invisibleTasks :: V.Vector LTask -- ^ All tasks that aren't displayed in the taskList due to search filters + , taskEdit :: Maybe (B.Editor String RName) + -- ^ Task currently being edited + + -- NEW TASK + , newEdit :: B.Editor String RName + -- ^ "New task" text field at the bottom } -- | Create a starting UI state startUIState :: V.Vector LTask -> UIState startUIState ltasks = UIState - { focus = B.focusRing [RTaskList, REdit, RTopBar] - , topBarFocus = B.focusRing [RPrune, RReload, RSearch] + { focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar] + , focusTopBar = B.focusRing [SRPrune, SRReload, SRSearch] + , searchEdit = B.editor RSearchEdit (Just 1) "" , taskList = B.list RTaskList ltasks 1 , invisibleTasks = V.empty + , taskEdit = Nothing + , newEdit = B.editor RNewEdit (Just 1) "" } defaultTheme :: B.Theme @@ -70,8 +93,8 @@ defaultTheme = B.newTheme VTY.defAttr where fg = flip VTY.withForeColor bg = flip VTY.withBackColor - st = flip VTY.withStyle - fg' = VTY.withForeColor none + --st = flip VTY.withStyle + --fg' = VTY.withForeColor none bg' = VTY.withBackColor none st' = VTY.withStyle none none = VTY.defAttr