Add uncommitted files

This commit includes new popups and proper error messages.

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.

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)

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

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:

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":

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
+-}

src/TaskMachine/LTask.hs

@@ -20,8 +20,10 @@ 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           Text.Megaparsec
@@ -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 ()

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

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
+  , editor   = Nothing
   }

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}

src/TaskMachine/UI/NewTask.hs

@@ -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 '_')

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

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 =

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

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 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

src/TaskMachine/UI/TopBar.hs

@@ -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 '_')

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)

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.

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

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