diff --git a/LICENSE b/LICENSE index 5714ffc..26bc945 100644 --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,21 @@ -Copyright Joscha Mennicken (c) 2018 +MIT License -All rights reserved. +Copyright (c) 2018 Joscha Mennicken -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Joscha Mennicken nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md index bf17779..98589e7 100644 --- a/README.md +++ b/README.md @@ -1,66 +1,7 @@ # task-machine -A TUI client for the [todo.txt](https://github.com/todotxt/todo.txt) format, written in Haskell, -that supports automatically creating new tasks based on template tasks. +A TUI client for the a format inspired by [todo.txt](https://github.com/todotxt/todo.txt), written in Haskell. -For an introduction to the file format, see the [todo.txt readme](https://github.com/todotxt/todo.txt/blob/master/README.md). +Still in development... -## Template tasks - -Template tasks allow for automatically creating new tasks on certain dates. - -They work by evaluating a formula for the current day. -If the formula evaluates to `true`, a new task gets added to the current day using the template text specified. -If it evaluates to `false`, nothing happens. - -When creating a template task, a start date can be specified. -In that case, the formula will be evaluated for every day from the starting date to the current date. - -Once all tasks are added, the starting date will be set to one day after the current date automatically, -to avoid evaluating any day twice, even if no starting date was specified initially. - -Template tasks are inspired by Ben Crowell's [when](https://github.com/bcrowell/when) calendar program. - -### Format - -This is the format for template tasks. -The square brackets `[]` indicate an optional part of the syntax. -The curly braces `{}` are part of the syntax. - -`# [start-date] {when-formula} [priority] template-text` - -- The `#` signals that this line is a template task, not a normal task. - -- *Optional*: All days from `start-date` to the current date are tested when creating new tasks. -It should be in the `YYYY-MM-DD` format. -If no `start-date` is specified, it is assumed to be the current date. - -- The `when-formula` is evaluated in order to decide whether a new task should be created for a day. - -- *Optional*: The `priority` is a regular todo.txt priority, for example `(E)`. - -- The `template-text` is pretty much a normal task description. -The only difference is that it supports date expressions. - -#### Examples - -`# 2018-09-08 {day_of_week == fri} clean the kitchen @home` - -`# {d2018-10-20 - today >= 0} (A) daily every day up to (and including) 2018-10-20 with priority A` - -`# {day == 20 && month == 10} Tom's birthday ({year - 1978} years old)` -(if Tom was born on 1978-10-20) - -### Date expression - -***TODO***: Document properly once it's actually implemented - -- *date* + - *number* → *date* -- *date* - *date* → *number* -- *number* + - \* / *number* → *number* -- *number* == != > < >= <= *number* → *boolean* -- *boolean* && || == != *boolean* → *boolean* - -### When formula - -### Template text +![exampletodo.txt displayed using i3 and urxvt](example_screenshot.png) diff --git a/app/Main.hs b/app/Main.hs index 493fc17..ad32d25 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,4 +10,4 @@ import TaskMachine.UI main :: IO() main = do o <- parseOptions - void $ B.defaultMain myApp (startUIState o) + void $ B.defaultMain myApp $ startUIState o diff --git a/example_screenshot.png b/example_screenshot.png new file mode 100644 index 0000000..197a170 Binary files /dev/null and b/example_screenshot.png differ diff --git a/package.yaml b/package.yaml index 41e392b..595fb48 100644 --- a/package.yaml +++ b/package.yaml @@ -28,11 +28,12 @@ dependencies: #- bytestring - containers - megaparsec +- mtl - optparse-applicative #- sqlite-simple #- stm #- text - #- text-zipper +- text-zipper - time #- transformers #- unix @@ -47,7 +48,7 @@ library: source-dirs: src executables: - task-machine-exe: + task-machine: main: Main.hs source-dirs: app ghc-options: diff --git a/plan.txt b/plan.txt new file mode 100644 index 0000000..fd7b02d --- /dev/null +++ b/plan.txt @@ -0,0 +1,24 @@ +normal task + - | x(completion date) + (priority) + (due date) + (creation date) + description + +delayed task + (start date) + (priority) + (due date) + (creation date) + description + + on update: + if after start date: + turn into normal task + +formula task + (when formula) + (priority) + (due date) + +"update": diff --git a/src/TaskMachine/History.hs b/src/TaskMachine/History.hs new file mode 100644 index 0000000..b27da08 --- /dev/null +++ b/src/TaskMachine/History.hs @@ -0,0 +1,72 @@ +-- | An undo-redo history that keeps a copy of every state. + +module TaskMachine.History + ( History + , history + , step + , current + , modify + , undo + , maybeUndo + , redo + , maybeRedo + ) where + +data Step a b = Step a b + +-- | Represents the history (only one branch) of some type @a@. +-- +-- Contains backwards (ctrl+z) as well as forwards (ctrl+y or ctrl+shift+z) history, +-- as well as the current state. +data History a b = History [Step a b] a [Step a b] + +-- | Create a new 'History' from a single state. +history :: a -> History a b +history a = History [] a [] + +-- | Add a new step to the history. +-- +-- Any forwards history will be overwritten, as this action starts a new +-- branch in the history tree. +step :: a -> b -> History a b -> History a b +step a (History xs y _) = History (Step y b : xs) a [] + +-- | Read the current state of the history. +current :: History a -> b -> a +current (History _ a _) = a + +{- +-- | Modify the current state, adding a step in the process. +-- +-- @'modify' f h = 'step' (f $ 'current' h) h@ +modify :: (a -> a) -> History a -> History a -- not a functor! +modify f h = step (f $ current h) h +-} + +-- | Jump to the previous state, remembering the future for later redos. +-- +-- If there is no previous state, do nothing. +undo :: History a b -> Maybe (History a b, b) +undo (History (Step x b : xs) y zs) = Just (History xs x (Step y b : zs), b) +undo _ = Nothing + +{- +-- | Like 'undo', but returns 'Nothing' if there was no previous state. +maybeUndo :: History a -> Maybe (History a) +maybeUndo (History (x:xs) y zs) = Just $ History xs x (y:zs) +maybeUndo _ = Nothing +-} + +-- | Jump to the next state, remembering the past for later undos. +-- +-- If there is no next state, do nothing. +redo :: History a b -> Maybe (History a b, b) +redo (History xs y (Step z b : zs)) = Just (History (Step y b : xs) z zs, b) +redo _ = Nothing + +{- +-- | Like 'redo', but returns 'Nothing' if there was no next state. +maybeRedo :: History a -> Maybe (History a) +maybeRedo (History xs y (z:zs)) = Just $ History (y:xs) z zs +maybeRedo _ = Nothing +-} diff --git a/src/TaskMachine/LTask.hs b/src/TaskMachine/LTask.hs index 1ad58a7..c2ae64d 100644 --- a/src/TaskMachine/LTask.hs +++ b/src/TaskMachine/LTask.hs @@ -20,10 +20,12 @@ module TaskMachine.LTask , saveLTasks ) where +import Control.Exception import Data.Function import Data.List +import System.IO.Error -import qualified Data.Vector as V +import qualified Data.Vector as V import Text.Megaparsec import TaskMachine.Task @@ -54,14 +56,36 @@ modifyLTask f (LTask pos task) = LTask pos (f task) sortLTasks :: [LTask] -> [LTask] sortLTasks = sortBy (compare `on` lPosition) +{- Loading -} + +data ErrorAction + = ErrorMessage String + | IgnoreError + deriving (Show) + +loadErrorMessage :: IOError -> Maybe ErrorAction +loadErrorMessage e + | isDoesNotExistError e = Just IgnoreError + | otherwise = Just $ ErrorMessage $ show e + loadLTasks :: FilePath -> IO (Either String (V.Vector LTask)) loadLTasks file = do - content <- readFile file - case parse pTasks file content of - Right taskList -> pure $ Right $ V.fromList $ fromTasks taskList - Left parseError -> pure $ Left $ parseErrorPretty parseError + content <- tryJust loadErrorMessage $ readFile file + case parse pTasks file <$> content of + Left IgnoreError -> pure $ Right V.empty + Left (ErrorMessage msg) -> pure $ Left msg + Right (Left parseError) -> pure $ Left $ parseErrorPretty parseError + Right (Right taskList) -> pure $ Right $ V.fromList $ fromTasks taskList -saveLTasks :: FilePath -> V.Vector LTask -> IO () +{- Saving -} + +saveErrorMessage :: IOError -> Maybe String +saveErrorMessage e = Just $ show e + +saveLTasks :: FilePath -> V.Vector LTask -> IO (Either String ()) saveLTasks file ltasks = do let text = formatTasks $ toTasks $ V.toList ltasks - writeFile file text + result <- tryJust saveErrorMessage $ writeFile file text + case result of + Left ioErrorMessage -> pure $ Left ioErrorMessage + Right _ -> pure $ Right () diff --git a/src/TaskMachine/Task.hs b/src/TaskMachine/Task.hs index ae82c10..eece150 100644 --- a/src/TaskMachine/Task.hs +++ b/src/TaskMachine/Task.hs @@ -21,9 +21,12 @@ module TaskMachine.Task , Description , Snippet(..) -- * Misc stuff + , emptyTask + , newTask , compareTasks -- * Formatting , formatTask + , formatTaskHalves , formatTasks , formatDate , formatDue @@ -71,6 +74,23 @@ data Task = Task , taskDescription :: Description } deriving (Show) +-- | Convert a 'Task' to its string representation. +-- This string representation is split into a pre-description and a description part. +-- +-- For further detail, see 'formatTask' +formatTaskHalves :: Task -> (String, String) +formatTaskHalves t = + ( formatCompletion (taskCompletion t) ++ " " + ++ maybeWithSpace formatPriority (taskPriority t) + ++ maybeWithSpace formatDue(taskDue t) + ++ maybeWithSpace formatCreated (taskCreated t) + , formatDescription (taskDescription t) + ) + where + maybeWithSpace :: (a -> String) -> Maybe a -> String + maybeWithSpace _ Nothing = "" + maybeWithSpace f (Just a) = f a ++ " " + -- | Convert a 'Task' to its string representation, which can be parsed by 'pTask'. -- -- If this string representation is parsed using 'pTask', it should yield the original task, @@ -79,16 +99,9 @@ data Task = Task -- could include the text version of these in the beginning, i. e. @taskDescription = "(A) hello"@. -- In that case, converting the task to a string and back yields a different result. formatTask :: Task -> String -formatTask t - = formatCompletion (taskCompletion t) ++ " " - ++ maybeWithSpace formatPriority (taskPriority t) - ++ maybeWithSpace formatDue(taskDue t) - ++ maybeWithSpace formatCreated (taskCreated t) - ++ formatDescription (taskDescription t) - where - maybeWithSpace :: (a -> String) -> Maybe a -> String - maybeWithSpace _ Nothing = "" - maybeWithSpace f (Just a) = f a ++ " " +formatTask t = + let (predesc, desc) = formatTaskHalves t + in predesc ++ desc -- | Convert a list of tasks to its string representation, which can be parsed by 'pTasks'. formatTasks :: [Task] -> String @@ -313,19 +326,33 @@ pTasks = many pTask <* eof {- Misc stuff -} +emptyTask :: Task +emptyTask = Task Incomplete Nothing Nothing Nothing [] + +-- | Create a new task with empty description and the given date as creation date +newTask :: Day -> Task +newTask day = Task Incomplete Nothing Nothing (Just day) [] + +-- Inverted compare for Maybes: Nothing comes after Just +compareMaybe :: Ord a => Maybe a -> Maybe a -> Ordering +compareMaybe Nothing Nothing = EQ +compareMaybe (Just _) Nothing = LT +compareMaybe Nothing (Just _) = GT +compareMaybe (Just x) (Just y) = compare x y + +compareDescription :: Description -> Description -> Ordering +compareDescription = compare `on` formatDescription + compareTasks :: Task -> Task -> Ordering +compareTasks a@(Task (Complete _) _ _ _ _) b@(Task (Complete _) _ _ _ _) = mconcat + [ compare (taskCompletion b) (taskCompletion a) + , compareMaybe (taskPriority a) (taskPriority b) + , compareMaybe (taskDue a) (taskDue b) + , compareDescription (taskDescription a) (taskDescription b) + ] compareTasks a b = mconcat [ compare (taskCompletion a) (taskCompletion b) , compareMaybe (taskPriority a) (taskPriority b) , compareMaybe (taskDue a) (taskDue b) , compareDescription (taskDescription a) (taskDescription b) ] - where - -- Inverted compare for Maybes: Nothing comes after Just - compareMaybe :: Ord a => Maybe a -> Maybe a -> Ordering - compareMaybe Nothing Nothing = EQ - compareMaybe (Just _) Nothing = LT - compareMaybe Nothing (Just _) = GT - compareMaybe (Just x) (Just y) = compare x y - compareDescription :: Description -> Description -> Ordering - compareDescription = compare `on` formatDescription diff --git a/src/TaskMachine/UI.hs b/src/TaskMachine/UI.hs index 2609c41..38b7048 100644 --- a/src/TaskMachine/UI.hs +++ b/src/TaskMachine/UI.hs @@ -4,75 +4,39 @@ module TaskMachine.UI ) where import qualified Brick as B -import qualified Brick.Focus as B import qualified Brick.Themes as B import qualified Data.Vector as V import qualified Graphics.Vty.Input.Events as VTY import TaskMachine.Options -import TaskMachine.UI.NewTask +import TaskMachine.UI.Behaviors import TaskMachine.UI.Popup import TaskMachine.UI.TaskList -import TaskMachine.UI.TopBar import TaskMachine.UI.Types {- Rendering -} -drawBaseLayer :: UIState -> B.Widget RName -drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList True (tasks s), placeholderNewTask] +drawTaskList :: UIState -> B.Widget RName +drawTaskList s = renderTaskList (editor s) True (tasks s) drawUIState :: UIState -> [B.Widget RName] -drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s] -drawUIState s = [drawBaseLayer s] +drawUIState s@UIState{errorPopup=Just p} = [renderPopup p, drawTaskList s] +drawUIState s = [drawTaskList s] {- Updating the state -} -rootBehavior :: UIState -> VTY.Event -> NewState -rootBehavior s _ = B.continue s - -closeBehavior :: (UIState -> VTY.Event -> NewState) -> UIState -> VTY.Event -> NewState -closeBehavior _ s (VTY.EvKey VTY.KEsc []) = B.halt s -closeBehavior _ s (VTY.EvKey (VTY.KChar 'q') []) = B.halt s -closeBehavior f s e = f s e -- wrapper around another behavior - -{- -focusBehavior :: (UIState -> VTY.Event -> Result) -> UIState -> VTY.Event -> Result -focusBehavior _ s (VTY.EvKey (VTY.KChar '\t') []) = B.continue $ bigFocusNext s -focusBehavior _ s (VTY.EvKey VTY.KBackTab []) = B.continue $ bigFocusPrev s -focusBehavior f s e = f s e -- wrapper around another behavior --} - selectBehavior :: UIState -> VTY.Event -> NewState -selectBehavior s@UIState{errorPopup=Just popup} e = undefined popup s e -selectBehavior s e = closeBehavior rootBehavior s e +-- Deal with popup if there is one +selectBehavior s@UIState{errorPopup=Just p} e = closeModifier (popupBehavior p) s e +-- Continue editing task if previously editing a task +selectBehavior s@UIState{editor=Just edit} e = taskEditBehavior edit s e +-- Default task list behavior +selectBehavior s e = closeModifier taskListBehavior s e updateUIState :: UIState -> B.BrickEvent RName () -> NewState updateUIState s (B.VtyEvent e) = selectBehavior s e updateUIState s _ = B.continue s -{- -updateUIState :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) --- Closing error popup -updateUIState s@UIState{errorPopup=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue s{errorPopup=Nothing} -updateUIState s@UIState{errorPopup=Just _} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.continue s{errorPopup=Nothing} ---updateUIState s@UIState{errorPopup=Just p} (B.VtyEvent e) = do --- newPopup <- handlePopupEvent e p --- B.continue s{errorPopup=Just newPopup} -updateUIState s e = - case B.focusGetCurrent (focus s) of - Nothing -> B.halt s - (Just BRTopBar) -> placeholderUpdate s e - --(Just BRTaskList) -> updateTaskList s e - (Just BRTaskList) -> placeholderUpdate s e - (Just BRNewTask) -> placeholderUpdate s e - -placeholderUpdate :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) -placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.halt s -placeholderUpdate s (B.VtyEvent (VTY.EvKey (VTY.KChar '\t') [])) = B.continue $ bigFocusNext s -placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KBackTab [])) = B.continue $ bigFocusPrev s -placeholderUpdate s _ = B.continue s --} - {- Starting the app -} myApp :: B.App UIState () RName @@ -80,14 +44,14 @@ myApp = B.App { B.appDraw = drawUIState , B.appChooseCursor = B.showFirstCursor , B.appHandleEvent = updateUIState - , B.appStartEvent = pure + , B.appStartEvent = actionLoad , B.appAttrMap = const (B.themeToAttrMap defaultTheme) } startUIState :: Options -> UIState startUIState o = UIState - { options = o - , focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar] - , errorPopup = Nothing - , tasks = taskList RTaskList V.empty + { options = o + , errorPopup = Nothing + , tasks = taskList RTaskList V.empty + , editor = Nothing } diff --git a/src/TaskMachine/UI/Behaviors.hs b/src/TaskMachine/UI/Behaviors.hs new file mode 100644 index 0000000..d592ae4 --- /dev/null +++ b/src/TaskMachine/UI/Behaviors.hs @@ -0,0 +1,215 @@ +module TaskMachine.UI.Behaviors + ( Behavior + -- * Miscellaneous + , getCurrentDay + , closeModifier + -- * Behaviors + , popupBehavior + , taskListBehavior + , taskEditBehavior + -- * Actions + , actionLoad + , actionSave + , actionDelete + , actionEditNew + , actionEditSelected + , actionToggleCompletion + , actionSortTasks + , actionFinishEdit + ) where + +import Control.Monad + +import qualified Brick as B +import Control.Monad.Trans +import Data.Time +import qualified Graphics.Vty as VTY + +import TaskMachine.LTask +import TaskMachine.Options +import TaskMachine.Task +import TaskMachine.UI.Popup +import TaskMachine.UI.TaskEdit +import TaskMachine.UI.TaskList +import TaskMachine.UI.Types + +type Behavior = UIState -> VTY.Event -> B.EventM RName (B.Next UIState) + +type Action = UIState -> B.EventM RName UIState + +{- Miscellaneous -} + +getCurrentDay :: IO Day +getCurrentDay = utctDay <$> liftIO getCurrentTime + +closeModifier :: Behavior -> Behavior +closeModifier _ s (VTY.EvKey VTY.KEsc []) = B.halt s +closeModifier _ s (VTY.EvKey (VTY.KChar 'q') []) = B.halt s +closeModifier f s e = f s e -- wrapper around another behavior + +{- Popups -} + +popupBehavior :: Popup RName (UIState -> NewState) -> Behavior +popupBehavior p s (VTY.EvKey VTY.KEnter []) = + case popupSelection p of + Nothing -> B.continue s{errorPopup=Nothing} -- Just close, no action was specified + Just action -> action s{errorPopup=Nothing} -- Do the thing! (and close the popup) +popupBehavior p s e = do + newPopup <- handlePopupEvent e p + B.continue s{errorPopup=Just newPopup} + +{- On the task list -} + +-- (re-)loading + +actionLoad :: Action +actionLoad s = do + let file = oTodofile $ options s + result <- liftIO $ loadLTasks file + case result of + Right ltasks -> pure s{tasks=taskList RTaskList ltasks} + Left errorMessage -> + let p = popup "Error loading tasks" errorMessage + [ ("Retry", actionLoad >=> B.continue) + , ("Quit", B.halt) + ] + in pure s{errorPopup=Just p} + +-- saving + +actionSave :: Action +actionSave s = do + let filepath = oTodofile (options s) + ltasks = taskListElements (tasks s) + result <- liftIO $ saveLTasks filepath ltasks + case result of + Right _ -> pure s + Left errorMessage -> + let p = popup "Error saving tasks" errorMessage + [ ("Retry", actionSave >=> B.continue) + , ("Continue without saving", B.continue) + , ("Quit", B.halt) + ] + in pure s{errorPopup=Just p} + +-- deleting a task + +actionDelete :: Action +actionDelete s = pure s{tasks=deleteTask (tasks s)} + +-- beginning an edit + +actionEditNew :: Action +actionEditNew s = do + today <- liftIO getCurrentDay + let task = newTask today + edit = taskEdit RTaskEdit task NewTask + pure s{editor=Just edit} + +actionEditSelected :: Action +actionEditSelected s = + case selectedTask (tasks s) of + Nothing -> pure s + Just t -> + let edit = taskEdit RTaskEdit t ExistingTask + in pure s{editor=Just edit} + +-- toggling completion + +actionToggleCompletion :: Action +actionToggleCompletion s = + case selectedTask (tasks s) of + Nothing -> pure s + Just task -> do + newCompletion <- case taskCompletion task of + Complete _ -> pure Incomplete + Incomplete -> Complete . Just <$> liftIO getCurrentDay + let task' = task{taskCompletion=newCompletion} + newTaskList = replaceTask task' (tasks s) + pure s{tasks=newTaskList} + +-- sorting + +actionSortTasks :: Action +actionSortTasks s = pure s{tasks=sortTaskList (tasks s)} + +-- cleaning up tasks + +cleanUpTask :: Day -> Task -> Task +cleanUpTask today (Task (Complete Nothing) p d Nothing desc) = + Task (Complete (Just today)) p d (Just today) desc +cleanUpTask today (Task (Complete Nothing) p d c desc) = + Task (Complete (Just today)) p d c desc +cleanUpTask today (Task c p d Nothing desc) = + Task c p d (Just today) desc +cleanUpTask _ t = t + +actionCleanUp :: Action +actionCleanUp s = do + today <- liftIO getCurrentDay + let tasks' = modifyAllTasks (cleanUpTask today) (tasks s) + pure s{tasks=tasks'} + +-- combining all of the above... + +taskListBehavior :: Behavior +-- Clean up: Add todays date where creation/completion date is missing +taskListBehavior s (VTY.EvKey (VTY.KChar 'c') []) = + actionCleanUp >=> actionSave >=> B.continue $ s +-- Delete currently selected task (implicit save) +taskListBehavior s (VTY.EvKey (VTY.KChar 'd') []) = + actionDelete >=> actionSave >=> B.continue $ s +-- Begin editing currently selected task +taskListBehavior s (VTY.EvKey (VTY.KChar 'e') []) = + actionEditSelected >=> B.continue $ s +-- Begin creating new task +taskListBehavior s (VTY.EvKey (VTY.KChar 'n') []) = + actionEditNew >=> B.continue $ s +-- Reload tasks (and sort them) +taskListBehavior s (VTY.EvKey (VTY.KChar 'r') []) = + actionLoad >=> B.continue $ s +-- Sort tasks +taskListBehavior s (VTY.EvKey (VTY.KChar 's') []) = + actionSortTasks >=> B.continue $ s +-- Toggle completion (implicit save) +taskListBehavior s (VTY.EvKey (VTY.KChar 'x') []) = + actionToggleCompletion >=> actionSave >=> B.continue $ s +-- Update the task list (scroll etc.) +taskListBehavior s e = do + newTasks <- updateTaskList e (tasks s) + B.continue s{tasks=newTasks} + +{- In the task editor -} + +actionFinishEdit :: TaskEdit RName -> Action +actionFinishEdit t = pure . finishEdit t + +-- get result of task editing +-- if editing an existing task, modify that task +-- if editing a new task, append that task +finishEdit :: TaskEdit RName -> UIState -> UIState +finishEdit edit s = + case editedTask edit of + Left e -> + let p = popup "Syntax error" e + [ ("Continue editing", B.continue) + , ("Abort", \s' -> B.continue s'{editor=Nothing}) + ] + in s{errorPopup=Just p} + Right task -> s{tasks=modify task, editor=Nothing} + where + modify :: Task -> TaskList RName + modify task = case editState edit of + ExistingTask -> replaceTask task $ tasks s + NewTask -> appendTask task $ tasks s + +taskEditBehavior :: TaskEdit RName -> Behavior +taskEditBehavior _ s (VTY.EvKey VTY.KEsc []) = B.continue s{editor=Nothing} +taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) = + actionFinishEdit edit >=> actionSave >=> B.continue $ s +--taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) = do +-- newState <- liftIO $ saveTasks $ finishEdit edit s +-- B.continue newState +taskEditBehavior edit s e = do + newEdit <- updateTaskEdit e edit + B.continue s{editor=Just newEdit} diff --git a/src/TaskMachine/UI/NewTask.hs b/src/TaskMachine/UI/NewTask.hs deleted file mode 100644 index ca119ff..0000000 --- a/src/TaskMachine/UI/NewTask.hs +++ /dev/null @@ -1,8 +0,0 @@ -module TaskMachine.UI.NewTask where - -import qualified Brick as B - -import TaskMachine.UI.Types - -placeholderNewTask :: B.Widget RName -placeholderNewTask = B.str "New: " B.<+> B.vLimit 1 (B.fill '_') diff --git a/src/TaskMachine/UI/Popup.hs b/src/TaskMachine/UI/Popup.hs index 219e355..d13cd5b 100644 --- a/src/TaskMachine/UI/Popup.hs +++ b/src/TaskMachine/UI/Popup.hs @@ -1,34 +1,36 @@ module TaskMachine.UI.Popup - ( minPopupWidth - -- * Ok popup - , PopupOk - , popupOk - , popupOk' - , renderPopupOk - , handlePopupOkEvent + ( Popup + , popup + , popup' + , renderPopup + , handlePopupEvent + , popupSelection + , minPopupWidth ) where import qualified Brick as B import qualified Brick.Widgets.Dialog as B import qualified Graphics.Vty as VTY +data Popup n r = Popup (B.Dialog r) (B.Widget n) + +popup :: String -> String -> [(String, r)] -> Popup n r +popup title content = popup' title (B.str content) + +popup' :: String -> B.Widget n -> [(String, r)] -> Popup n r +popup' title widget results = + let spacedTitle = " " ++ title ++ " " + dialog = B.dialog (Just spacedTitle) (Just (0, results)) minPopupWidth + in Popup dialog widget + +renderPopup :: Popup n r -> B.Widget n +renderPopup (Popup dialog widget) = B.renderDialog dialog widget + +handlePopupEvent :: VTY.Event -> Popup n r -> B.EventM n (Popup n r) +handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialog <*> pure widget + +popupSelection :: Popup n r -> Maybe r +popupSelection (Popup dialog _) = B.dialogSelection dialog + minPopupWidth :: Int minPopupWidth = 78 - -{- Ok popup -} - -data PopupOk n = PopupOk (B.Dialog ()) (B.Widget n) - -popupOk :: String -> String -> PopupOk n -popupOk title content = popupOk' title (B.str content) - -popupOk' :: String -> B.Widget n -> PopupOk n -popupOk' title widget = - let dialog = B.dialog (Just $ " " ++ title ++ " ") (Just (0,[("Ok",())])) minPopupWidth - in PopupOk dialog widget - -renderPopupOk :: PopupOk n -> B.Widget n -renderPopupOk (PopupOk dialog widget) = B.renderDialog dialog widget - -handlePopupOkEvent :: VTY.Event -> PopupOk n -> B.EventM n (PopupOk n) -handlePopupOkEvent e (PopupOk dialog widget) = PopupOk <$> B.handleDialogEvent e dialog <*> pure widget diff --git a/src/TaskMachine/UI/Task.hs b/src/TaskMachine/UI/Task.hs index 5a2c311..01fc34e 100644 --- a/src/TaskMachine/UI/Task.hs +++ b/src/TaskMachine/UI/Task.hs @@ -30,7 +30,10 @@ withSpace :: B.Widget n -> B.Widget n withSpace w = w B.<+> B.withDefAttr taskAttr (B.str " ") renderCompletion :: Completion -> B.Widget n -renderCompletion = B.withDefAttr taskCompletionAttr . B.str . formatCompletion +renderCompletion Incomplete = B.str "-" +renderCompletion (Complete Nothing) = B.str "x" +renderCompletion (Complete (Just day)) = + B.str "x" B.<+> B.withDefAttr taskCompletionAttr (B.str $ formatDate day) renderPriority :: Priority -> B.Widget n renderPriority p = diff --git a/src/TaskMachine/UI/TaskEdit.hs b/src/TaskMachine/UI/TaskEdit.hs new file mode 100644 index 0000000..0ebea6b --- /dev/null +++ b/src/TaskMachine/UI/TaskEdit.hs @@ -0,0 +1,69 @@ +module TaskMachine.UI.TaskEdit + ( TaskEdit + , EditState(..) + , taskEdit + , editState + , editedTask + , renderTaskEdit + , updateTaskEdit + ) where + +import qualified Brick as B +import qualified Brick.Widgets.Edit as B +import qualified Data.Text.Zipper as T +import qualified Graphics.Vty as VTY +import Text.Megaparsec + +import TaskMachine.Task +import TaskMachine.UI.Task + +data TaskEdit n = TaskEdit EditState (B.Editor String n) + deriving (Show) + +data EditState = ExistingTask | NewTask + deriving (Show) + +taskEdit :: n -> Task -> EditState -> TaskEdit n +taskEdit name task s = + let (predesc, desc) = formatTaskHalves task + formattedTask = predesc ++ desc + cursor = length predesc + editor = B.editor name (Just 1) formattedTask + newEditor = B.applyEdit (T.moveCursor (0, cursor)) editor + in TaskEdit s newEditor + +editState :: TaskEdit n -> EditState +editState (TaskEdit s _) = s + +editedLine :: TaskEdit n -> Either String String +editedLine (TaskEdit _ edit) = + case B.getEditContents edit of + [s] -> Right s + _ -> Left "Editor empty" + +editedTask :: TaskEdit n -> Either String Task +editedTask te = do + s <- editedLine te + case parse pTask "task editor" s of + Left parseError -> Left $ parseErrorPretty parseError + Right task -> Right task + +renderRow :: String -> B.Widget n +renderRow s = + case parse pTask "" s of + Left _ -> B.str s + Right task -> renderTask task + +renderRows :: [String] -> B.Widget n +renderRows = B.vBox . map renderRow + +renderTaskEdit :: (Ord n, Show n) => Bool -> TaskEdit n -> B.Widget n +renderTaskEdit focus (TaskEdit _ edit) = B.renderEditor renderRows focus edit + +updateTaskEdit :: Ord n => VTY.Event -> TaskEdit n -> B.EventM n (TaskEdit n) +updateTaskEdit (VTY.EvKey VTY.KHome []) (TaskEdit s edit) = + pure $ TaskEdit s $ B.applyEdit T.gotoBOL edit +updateTaskEdit (VTY.EvKey VTY.KEnd []) (TaskEdit s edit) = + pure $ TaskEdit s $ B.applyEdit T.gotoEOL edit +updateTaskEdit event (TaskEdit s edit) = + TaskEdit s <$> B.handleEditorEvent event edit diff --git a/src/TaskMachine/UI/TaskList.hs b/src/TaskMachine/UI/TaskList.hs index ec74a2a..4e7e6f8 100644 --- a/src/TaskMachine/UI/TaskList.hs +++ b/src/TaskMachine/UI/TaskList.hs @@ -1,224 +1,107 @@ module TaskMachine.UI.TaskList ( TaskList , taskList - , renderTaskList , taskListElements - , taskListFilter - , taskListSelectedElement - , taskListModify + , renderTaskList + , updateTaskList + , sortTaskList + , selectedTask + , appendTask + , replaceTask + , deleteTask + , modifyAllTasks ) where ---import Data.Void +import Data.Function +import Data.List -import qualified Brick as B -import qualified Brick.Widgets.List as B -import qualified Data.Vector as V ---import qualified Brick.Focus as B ---import qualified Brick.Widgets.Edit as B ---import qualified Data.Text.Zipper as T ---import qualified Graphics.Vty as VTY ---import Text.Megaparsec +import qualified Brick 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.Task import TaskMachine.UI.Task ---import TaskMachine.Options ---import TaskMachine.UI.Popup ---import TaskMachine.UI.Types +import TaskMachine.UI.TaskEdit -data TaskList n = TaskList - { visibleTasks :: B.List n LTask - , invisibleTasks :: V.Vector LTask - } deriving (Show) - -newList :: n -> V.Vector LTask -> B.List n LTask -newList name ltasks = B.list name ltasks 1 +newtype TaskList n = TaskList (B.List n LTask) taskList :: n -> V.Vector LTask -> TaskList n -taskList name ltasks = TaskList{visibleTasks=newList name ltasks, invisibleTasks=V.empty} - --- TODO: render while editing -renderTaskList :: (Ord n, Show n) => Bool -> TaskList n -> B.Widget n -renderTaskList focus tl = B.renderList (const $ renderTask . toTask) focus (visibleTasks tl) - -{- Managing tasks -} +taskList name tasks = TaskList $ B.list name tasks 1 taskListElements :: TaskList n -> V.Vector LTask -taskListElements tl = B.listElements (visibleTasks tl) <> invisibleTasks tl +taskListElements (TaskList list) = B.listElements list -taskListFilter :: (Task -> Bool) -> TaskList n -> TaskList n -taskListFilter f tl = - let (yes, no) = V.partition (f . toTask) $ taskListElements tl - name = B.listName (visibleTasks tl) - list = newList name yes - in TaskList{visibleTasks=list, invisibleTasks=no} +renderRow :: Maybe (B.Widget n) -> Bool -> LTask -> B.Widget n +renderRow (Just w) True _ = w +renderRow _ _ lt = renderTask (toTask lt) -taskListSelectedElement :: TaskList n -> Maybe Task -taskListSelectedElement tl = toTask . snd <$> B.listSelectedElement (visibleTasks tl) +renderLast :: (Ord n, Show n) => B.Widget n -> Bool -> B.List n LTask -> B.Widget n +renderLast widget focus list = + let listWithPlaceholder = focusOnLastTask $ appendTask' emptyTask list + in B.renderList (renderRow (Just widget)) focus listWithPlaceholder -taskListModify :: (Task -> Task) -> TaskList n -> TaskList n -taskListModify f tl = - let list = B.listModify (modifyLTask f) (visibleTasks tl) - in tl{visibleTasks=list} +renderTaskList :: (Ord n, Show n) => Maybe (TaskEdit n) -> Bool -> TaskList n -> B.Widget n +renderTaskList Nothing focus (TaskList list) + | listSize list == 0 = renderLast (B.str "--- empty ---") focus list + | otherwise = B.renderList (renderRow Nothing) focus list +renderTaskList (Just te) focus (TaskList list) = + case editState te of + ExistingTask -> B.renderList (renderRow (Just teWidget)) focus list + NewTask -> renderLast teWidget focus list + where + teWidget = renderTaskEdit focus te -{- -{- Managing the tasks -} +updateTaskList :: Ord n => VTY.Event -> TaskList n -> B.EventM n (TaskList n) +updateTaskList event (TaskList list) = + TaskList <$> B.handleListEventVi B.handleListEvent event list -allTasks :: UIState -> V.Vector LTask -allTasks s = - let visible = B.listElements $ taskList s - invisible = invisibleTasks s - in visible <> invisible +sortTaskList :: TaskList n -> TaskList n +sortTaskList (TaskList list) = + let index = B.listSelected list + tasks = V.toList $ B.listElements list + sortedTasks = sortBy (compareTasks `on` toTask) tasks + newVector = V.fromList sortedTasks + in TaskList $ B.listReplace newVector index list -newTaskList :: V.Vector LTask -> B.List RName LTask -newTaskList ltasks = B.list RTaskList ltasks 1 +selectedTask :: TaskList n -> Maybe Task +selectedTask (TaskList list) = toTask . snd <$> B.listSelectedElement list --- TODO: Catch errors when loading tasks -loadTasks :: UIState -> IO UIState -loadTasks s = do - let file = oTodofile $ options s - result <- loadLTasks file - case result of - Left errorMessage -> pure s{errorPopup=Just $ popupOk "Error loading tasks" errorMessage} - Right ltasks -> pure s{taskList=newTaskList ltasks, invisibleTasks=V.empty} +appendTask' :: Task -> B.List n LTask -> B.List n LTask +appendTask' task list = + let size = listSize list + lt = lTask task + in focusOnLastTask $ B.listInsert size lt list --- TODO: Catch errors when saving tasks -saveTasks :: UIState -> IO UIState -saveTasks s = do - let file = oTodofile $ options s - ltasks = allTasks s - saveLTasks file ltasks - pure s +appendTask :: Task -> TaskList n -> TaskList n +appendTask task (TaskList list) = TaskList $ appendTask' task list -filterTasks :: (Task -> Bool) -> UIState -> UIState -filterTasks f s = - let (yes, no) = V.partition (f . toTask) (allTasks s) - in s{taskList=newTaskList yes, invisibleTasks=no} +replaceTask :: Task -> TaskList n -> TaskList n +replaceTask task (TaskList list) = TaskList $ B.listModify replace list + where + replace :: LTask -> LTask + replace = modifyLTask (const task) -{- Rendering -} +deleteTask :: TaskList n -> TaskList n +deleteTask tl@(TaskList list) = + case B.listSelected list of + Nothing -> tl + Just index + | index == 0 -> TaskList $ B.listRemove index list + | otherwise -> TaskList $ B.listMoveBy 1 $ B.listRemove index list -renderLTask :: Maybe (B.Editor String RName) -> Bool -> LTask -> B.Widget RName -renderLTask _ False ltask = renderTask $ toTask ltask -renderLTask Nothing True ltask = renderTask $ toTask ltask -renderLTask _ _ _ = undefined ---renderLTask (Just edit) True _ = B.renderEditor (B.str . unlines) True edit +modifyAllTasks :: (Task -> Task) -> TaskList n -> TaskList n +modifyAllTasks f (TaskList list) = + let index = B.listSelected list + vector = B.listElements list + vector' = V.map (modifyLTask f) vector + in TaskList $ B.listReplace vector' index list -renderTaskList :: UIState -> B.Widget RName -renderTaskList s = - let inFocus = B.focusGetCurrent (focus s) == Just BRTaskList - in B.renderList (renderLTask Nothing) inFocus (taskList s) +{- helper functions -} -{- Updating state -} +listSize :: B.List n e -> Int +listSize list = V.length $ B.listElements list -taskListBehavior :: UIState -> VTY.Event -> NewState -taskListBehavior = undefined - -updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) -updateTaskList = undefined --} - -{- -widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n -widgetPriority _ Nothing = B.emptyWidget -widgetPriority highlight (Just prio) = - let attrName = highlight <> "priority" <> B.attrName [priorityToChar prio] - text = formatPriority prio ++ " " - in B.withAttr attrName $ B.str text - -widgetDescription :: B.AttrName -> String -> B.Widget n -widgetDescription highlight desc = - let attrName = highlight <> "description" - in B.withAttr attrName $ B.str desc - -renderLTask :: Bool -> LTask -> B.Widget RName -renderLTask highlight (LTask _ Task{..}) = - let attrHighlight = if highlight then "highlight" else "normal" - wCompleted = B.str $ if taskCompleted then "x " else " " - wPriority = widgetPriority attrHighlight taskPriority - wDescription = widgetDescription attrHighlight taskDescription - in B.hBox [wCompleted, wPriority, wDescription] --} - ---type Editor = B.Editor String RName ---type TaskList = B.List RName LTask - -{- Editing tasks -} - -{- -toEditText :: Task -> String -toEditText Task{taskPriority=Nothing, taskDescription=d} = descriptionToString d -toEditText Task{taskPriority=Just p, taskDescription=d} = formatPriority p ++ " " ++ descriptionToString d - -pEditText :: Parser (Maybe Priority, String) -pEditText = undefined ---pEditText = do --- prio <- maybeParse (andSpace pPriority) --- notFollowedBy (andSpace pDates) --- desc <- untilEndOfLine --- pure (prio, desc) - -parseEditText :: String -> Either (ParseError Char Void) (Maybe Priority, String) -parseEditText = parse pEditText "edited task" --} - -{- Updating state -} - -{- -startEdit :: UIState -> UIState -startEdit s = - case B.listSelectedElement (taskList s) of - Nothing -> s - Just (_, LTask _ t) -> - let edit = B.editor RTaskEdit (Just 1) (toEditText t) - in s{taskEdit=Just edit} - -finishEdit :: UIState -> UIState -finishEdit s@UIState{taskEdit=Just edit} = - case B.getEditContents edit of - [line] -> case parseEditText line of - Right (prio, desc) -> - --let changeTask (LTask n t) = LTask n t{taskPriority=prio, taskDescription=desc} - let changeTask (LTask n t) = LTask n t{taskPriority=prio, taskDescription=undefined desc} - newList = B.listModify changeTask (taskList s) - in s{taskList=newList, taskEdit=Nothing} - - Left parseError -> s{errorPopup=Just $ popup "Parse error" (parseErrorTextPretty parseError)} - _ -> s{errorPopup=Just $ popup "Empty editor" "Enter a task description."} -finishEdit s = s - -updateEditor :: B.Editor String RName -> VTY.Event -> B.EventM RName (B.Editor String RName) -updateEditor edit (VTY.EvKey VTY.KHome []) = pure $ B.applyEdit T.gotoBOL edit -updateEditor edit (VTY.EvKey VTY.KEnd []) = pure $ B.applyEdit T.gotoEOL edit -updateEditor edit e = B.handleEditorEvent e edit - -updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) --- Exit application -updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.halt s - --- Test stuff -updateTaskList s e = do - let changeTask (LTask n t) = LTask n t{taskDescription=show e} - newList = B.listModify changeTask (taskList s) - B.continue s{taskList=newList} - --- Scroll focus -updateTaskList s (B.VtyEvent (VTY.EvKey VTY.KBackTab [])) = B.continue $ bigFocusPrev s -updateTaskList s (B.VtyEvent (VTY.EvKey (VTY.KChar '\t') [])) = B.continue $ bigFocusNext s --- Start editing the current task -updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent (VTY.EvKey (VTY.KChar 'e') [])) = B.continue $ startEdit s --- Update the task list -updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent e) = do - newList <- B.handleListEventVi B.handleListEvent e (taskList s) - B.continue s{taskList=newList} --- Exit the editor (losing all changes) -updateTaskList s@UIState{taskEdit=Just _} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.continue $ s{taskEdit=Nothing} --- Exit the editor (keeping all changes) -updateTaskList s@UIState{taskEdit=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue $ finishEdit s --- Update the editor -updateTaskList s@UIState{taskEdit=Just edit} (B.VtyEvent e) = do - newTaskEdit <- updateEditor edit e - B.continue s{taskEdit=Just newTaskEdit} --- Catch everything else -updateTaskList s _ = B.halt s ---updateTaskList list (Just editor) (B.VtyEvent e) = (,) <$> const list <*> B.handleEditorEvent e editor --} +focusOnLastTask :: B.List n e -> B.List n e +focusOnLastTask list = B.listMoveTo (listSize list - 1) list diff --git a/src/TaskMachine/UI/TopBar.hs b/src/TaskMachine/UI/TopBar.hs deleted file mode 100644 index 16c708f..0000000 --- a/src/TaskMachine/UI/TopBar.hs +++ /dev/null @@ -1,6 +0,0 @@ -module TaskMachine.UI.TopBar where - -import qualified Brick as B - -placeholderTopBar :: B.Widget n -placeholderTopBar = B.str "Prune | Reload | Search: " B.<+> B.vLimit 1 (B.fill '_') diff --git a/src/TaskMachine/UI/Types.hs b/src/TaskMachine/UI/Types.hs index a73063b..93af906 100644 --- a/src/TaskMachine/UI/Types.hs +++ b/src/TaskMachine/UI/Types.hs @@ -6,149 +6,42 @@ module TaskMachine.UI.Types ( RName(..) - , BigRing(..) - --, SmallRing(..) - -- * Popups - --, Popup - --, popup - --, renderPopup - --, handlePopupEvent -- * UI state , UIState(..) , NewState - , bigFocusNext, bigFocusPrev - --, smallFocusNext, smallFocusPrev , defaultTheme ) where import qualified Brick as B -import qualified Brick.Focus as B import qualified Brick.Themes as B import qualified Brick.Widgets.Dialog as B import qualified Brick.Widgets.Edit as B import qualified Brick.Widgets.List as B import qualified Graphics.Vty as VTY ---import qualified Data.Vector as V ---import TaskMachine.LTask import TaskMachine.Options import TaskMachine.UI.Popup import TaskMachine.UI.Task +import TaskMachine.UI.TaskEdit import TaskMachine.UI.TaskList -- | Resource names data RName - = RSearchEdit - | RTaskList + = RTaskList | RTaskEdit - | RNewEdit deriving (Eq, Show, Ord) -data BigRing - = BRTopBar - | BRTaskList - | BRNewTask - deriving (Eq) - -{- -data SmallRing - = SRPurge - | SRReload - | SRSearch - deriving (Eq) --} - -{- Popup -} - -{- -data Popup = Popup (B.Dialog ()) (B.Widget RName) - -popup :: String -> String -> Popup -popup title content = - let dialog = B.dialog (Just title) (Just (0,[("OK",())])) 70 -- with a min terminal width of 80 - widget = B.str content - in Popup dialog widget - -renderPopup :: Popup -> B.Widget RName -renderPopup (Popup dialog widget) = B.renderDialog dialog widget - -handlePopupEvent :: VTY.Event -> Popup -> B.EventM RName Popup -handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialog <*> pure widget --} - {- UI state -} data UIState = UIState { options :: Options -- includes todo file and other config - , focus :: B.FocusRing BigRing -- focus on the top, middle or bottom part - - -- popups - , errorPopup :: Maybe (PopupOk RName) - - -- tasks + , errorPopup :: Maybe (Popup RName (UIState -> NewState)) , tasks :: TaskList RName + , editor :: Maybe (TaskEdit RName) } type NewState = B.EventM RName (B.Next UIState) - - - - - - -{- - , focus :: B.FocusRing BigRing - -- ^ 'B.FocusRing' for tab navigation - --, focusTopBar :: B.FocusRing SmallRing - -- ^ 'B.FocusRing' for the top bar, for ← and → arrow key navigation - , errorPopup :: Maybe Popup - - -- 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 [BRTaskList, BRNewTask, BRTopBar] - --, focusTopBar = B.focusRing [SRPrune, SRReload, SRSearch] - , errorPopup = Nothing - --, searchEdit = B.editor RSearchEdit (Just 1) "" - , taskList = B.list RTaskList ltasks 1 - , invisibleTasks = V.empty - , taskEdit = Nothing - --, newEdit = B.editor RNewEdit (Just 1) "" - } --} - -bigFocusNext :: UIState -> UIState -bigFocusNext s = s{focus=B.focusNext (focus s)} - -bigFocusPrev :: UIState -> UIState -bigFocusPrev s = s{focus=B.focusPrev (focus s)} - -{- -smallFocusNext :: UIState -> UIState -smallFocusNext s = s{focusTopBar=B.focusNext (focusTopBar s)} - -smallFocusPrev :: UIState -> UIState -smallFocusPrev s = s{focusTopBar=B.focusPrev (focusTopBar s)} --} - defaultTheme :: B.Theme defaultTheme = B.newTheme VTY.defAttr [ (B.dialogAttr, none) @@ -160,7 +53,7 @@ defaultTheme = B.newTheme VTY.defAttr , (B.listSelectedAttr, st' VTY.bold) , (B.listSelectedFocusedAttr, bg VTY.blue $ st' VTY.bold) , (taskAttr, none) - , (taskCompletionAttr, none) + , (taskCompletionAttr, fg' VTY.brightBlack) , (taskPriorityAttr, fg VTY.cyan $ st' VTY.bold) , (taskPriorityAttr <> "A", fg VTY.red $ st' VTY.bold) , (taskPriorityAttr <> "B", fg VTY.yellow $ st' VTY.bold) diff --git a/stack.yaml b/stack.yaml index b0252a3..d4c68d1 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-12.9 +resolver: lts-12.14 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/test.txt b/test.txt new file mode 100644 index 0000000..3e67d29 --- /dev/null +++ b/test.txt @@ -0,0 +1,7 @@ +- A simple task +x A simple completed task + +- c2018-12-13 A simple task with creation date + +s2018-12-20 d2018-12-24 A task with start date +-2018-12-20 d2018-12-24 A task with alternate start date diff --git a/todo.txt b/todo.txt index f37e717..393be5b 100644 --- a/todo.txt +++ b/todo.txt @@ -1,7 +1,23 @@ -- c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't load from todo file -- c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't save to todo file -- c2018-09-18 Offer "retry" or "quit" +dialogue - syntax error in todo file -- c2018-09-18 Offer to clean up file when loading (adding creation/completion dates) +x2018-10-23 c2018-09-18 Clean up file (adding creation/completion dates) - c2018-09-18 Purge - move completed tasks to a separate file -- c2018-09-18 Quit using Esc or q -- c2018-09-18 Sort tasks by completion, priority, due date, description +x2018-10-23 c2018-09-28 Move cursor to beginning of task description when editing tasks +x2018-10-24 c2018-09-28 Syntax highlighting while editing tasks +x2018-10-23 c2018-09-30 Display "-empty-" when TaskList is empty +x2018-09-27 c2018-09-18 Quit using Esc or q +x2018-09-29 c2018-09-28 Use B.EventM's MonadIO instance instead of B.suspendAndResume (facepalm) +x2018-09-30 c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't load from todo file +x2018-09-30 c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't save to todo file +x2018-09-30 c2018-09-18 Offer "retry" or "quit" +dialogue - syntax error in todo file +x2018-09-30 c2018-09-30 Custom exception messages +x2018-10-24 c2018-10-23 Don't crash on parse errors etc. +- c2018-10-24 Fix date coloring in editor +x2018-10-24 c2018-10-24 Reverse ordering of completed tasks - most recent at the top +- c2018-10-24 F1 - list keybindings +- c2018-10-26 Add Z - undo (also Ctrl + Z) +- c2018-10-26 Add Y - redo (also Ctrl + Y) +- c2018-10-26 Implement date expressions using GADTs +- c2018-10-26 Move C - cleanup to F - fixup +- c2018-10-26 Add "starting" task type (start date, prio, due date, description) +- c2018-10-26 Add "formula" task type (formula, prio, due date, description) - maybe due date formula? +x2018-11-01 (D) c2018-10-26 Fix crash on attempting to open a folder +- c2018-10-26 Think of something to do with +project tags, @context tags and key:value tags