Add basic task editing

package.yaml

@@ -25,6 +25,7 @@ dependencies:
 - containers
 - megaparsec
 - optparse-applicative
+- text-zipper
 - time
 - vector
 - vty

src/TaskMachine/LTask.hs

@@ -7,8 +7,8 @@ module TaskMachine.LTask
   , saveLTasks
   ) where
 
-import Data.List
+import           Data.Function
-import Data.Function
+import           Data.List
 
 import qualified Data.Vector         as V
 
@@ -29,7 +29,7 @@ loadLTasks :: FilePath -> IO (Either String (V.Vector LTask))
 loadLTasks file = do
   content <- readFile file
   case parseTasks file content of
-    Right taskList     -> pure $ Right $ V.fromList $ fromTasks taskList
+    Right taskList  -> pure $ Right $ V.fromList $ fromTasks taskList
     Left parseError -> pure $ Left $ show parseError
 
 saveLTasks :: V.Vector LTask -> FilePath -> IO ()

src/TaskMachine/Todotxt.hs

@@ -16,19 +16,22 @@ module TaskMachine.Todotxt
   , charToPriority
   -- * Parsing
   , Parser
-  , task
+  , pTask
-  , tasks
+  , pTasks
-  , day
+  , pDay
-  , dates
+  , pDates
-  , priorityChar
+  , pPriorityChar
-  , priority
+  , pPriority
+  , andSpace
+  , maybeParse
+  , untilEndOfLine
   ) where
 
 import           Control.Monad
 import           Data.List.NonEmpty
 import           Data.Void
 
-import           Data.Set              as Set
+import           Data.Set             as Set
 import           Data.Time.Calendar
 import           Text.Megaparsec
 import           Text.Megaparsec.Char
@@ -48,8 +51,8 @@ formatDates (CoCrDate cr co) = show cr ++ " " ++ show co
 
 {- Dates parsing -}
 
-day :: Parser Day
+pDay :: Parser Day
-day = label "date" $ fromGregorian
+pDay = label "date" $ fromGregorian
     <$> integer
     <*> (char '-' *> int)
     <*> (char '-' *> int)
@@ -59,13 +62,13 @@ day = label "date" $ fromGregorian
     int :: Parser Int
     int = read <$> count 2 digitChar
 
-dates :: Parser Dates
+pDates :: Parser Dates
-dates = try datesCrCo <|> datesCr
+pDates = try datesCrCo <|> datesCr
   where
     datesCrCo :: Parser Dates
-    datesCrCo = CoCrDate <$> (day <* char ' ') <*> day
+    datesCrCo = CoCrDate <$> (pDay <* char ' ') <*> pDay
     datesCr :: Parser Dates
-    datesCr = CrDate <$> day
+    datesCr = CrDate <$> pDay
 
 {- Priority -}
 
@@ -93,16 +96,16 @@ formatPriority p = '(' : priorityToChar p : ")"
 
 {- Priority parsing -}
 
-priorityChar :: Parser Priority
+pPriorityChar :: Parser Priority
-priorityChar = do
+pPriorityChar = do
   c <- anyChar
   case charToPriority c of
     Just p -> pure p
     Nothing -> failure (Just $ Tokens $ c :| [])
                        (Set.singleton $ Label $ 'p' :| "riority character")
 
-priority :: Parser Priority
+pPriority :: Parser Priority
-priority = char '(' *> priorityChar <* char ')'
+pPriority = char '(' *> pPriorityChar <* char ')'
 
 {- Task -}
 
@@ -118,14 +121,14 @@ data Task = Task
 --  show = formatTask
 
 formatTask :: Task -> String
-formatTask (Task done prio tDates desc)
+formatTask (Task done prio dates desc)
   =  (if done then "x " else "")
   ++ maybe "" ((++" ") . formatPriority) prio
-  ++ maybe "" ((++" ") . formatDates) tDates
+  ++ maybe "" ((++" ") . formatDates) dates
   ++ desc
 
 parseTasks :: FilePath -> String -> Either (ParseError Char Void) [Task]
-parseTasks = parse tasks -- hehe
+parseTasks = parse pTasks -- hehe
 
 {- Task parsing -}
 
@@ -144,12 +147,12 @@ maybeParse p = (Just <$> try p) <|> pure Nothing
 untilEndOfLine :: Parser String
 untilEndOfLine = takeWhile1P (Just "description") (/='\n')
 
-task :: Parser Task
+pTask :: Parser Task
-task =   Task
+pTask =   Task
      <$> boolParse  (andSpace completed)
-     <*> maybeParse (andSpace priority)
+     <*> maybeParse (andSpace pPriority)
-     <*> maybeParse (andSpace dates)
+     <*> maybeParse (andSpace pDates)
      <*> untilEndOfLine
 
-tasks :: Parser [Task]
+pTasks :: Parser [Task]
-tasks = many $ task <* (eof <|> void (char '\n'))
+pTasks = many $ pTask <* (eof <|> void (char '\n'))

src/TaskMachine/UI.hs

@@ -44,21 +44,24 @@ Edit _____________________________
 --  * warn if file only readable
 -- [_] display loaded tasks in UI
 
+drawBaseLayer :: UIState -> B.Widget RName
+drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList s, placeholderNewTask]
+
 drawUIState :: UIState -> [B.Widget RName]
-drawUIState s =
+drawUIState s@UIState{errorPopup=Just p} = [renderPopup p, drawBaseLayer s]
-  let wTopBar = const placeholderTopBar
+drawUIState s                            = [drawBaseLayer s]
-      wTaskList = renderTaskList (taskList s) (taskEdit s)
-      wNewTask = const placeholderNewTask
-  in  pure $ case B.focusGetCurrent (focus s) of
-        Nothing           -> B.vBox [wTopBar False, wTaskList False, wNewTask False] -- should never happen
-        (Just BRTopBar)   -> B.vBox [wTopBar True,  wTaskList False, wNewTask False]
-        (Just BRTaskList) -> B.vBox [wTopBar False, wTaskList True,  wNewTask False]
-        (Just BRNewTask)  -> B.vBox [wTopBar False, wTaskList False, wNewTask True ]
 
 updateUIState :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
+-- Closing any popups
+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}
+-- If there's no password
 updateUIState s e =
   case B.focusGetCurrent (focus s) of
-    Nothing           -> undefined
+    Nothing           -> B.halt s
     (Just BRTopBar)   -> placeholderUpdate s e
     (Just BRTaskList) -> updateTaskList s e
     (Just BRNewTask)  -> placeholderUpdate s e

src/TaskMachine/UI/TaskList.hs

@@ -1,12 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
 
 module TaskMachine.UI.TaskList where
 
+import           Data.Void
+
 import qualified Brick                as B
+import qualified Brick.Focus          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.Text.Zipper     as T
+import qualified Graphics.Vty         as VTY
+import           Text.Megaparsec
 
 import           TaskMachine.LTask
 import           TaskMachine.Todotxt
@@ -40,28 +44,73 @@ renderLTask highlight (LTask _ Task{..}) =
 {- Rendering -}
 
 renderLTask :: Maybe (B.Editor String RName) -> Bool -> LTask -> B.Widget RName
-renderLTask _           False (LTask _ t) = B.withAttr "normal"    $ B.str $ formatTask t
+renderLTask _           False (LTask _ t) = B.str $ formatTask t
-renderLTask Nothing     True  (LTask _ t) = B.withAttr "highlight" $ B.str $ formatTask t
+renderLTask Nothing     True  (LTask _ t) = B.str $ formatTask t
-renderLTask (Just edit) True  _           = B.withAttr "highlight" $ B.renderEditor (B.str . unlines) True edit
+renderLTask (Just edit) True  _           = B.renderEditor (B.str . unlines) True edit
 
-renderTaskList :: B.List RName LTask -> Maybe (B.Editor String RName) -> Bool -> B.Widget RName
+renderTaskList :: UIState -> B.Widget RName
-renderTaskList taskList edit focus = B.renderList (renderLTask edit) focus taskList
+renderTaskList s =
+  let inFocus = B.focusGetCurrent (focus s) == Just BRTaskList
+  in  B.renderList (renderLTask (taskEdit s)) inFocus (taskList s)
+
+{- Editing tasks -}
+
+toEditText :: Task -> String
+toEditText Task{taskPriority=Nothing, taskDescription=d} = d
+toEditText Task{taskPriority=Just p, taskDescription=d} = formatPriority p ++ " " ++ d
+
+pEditText :: Parser (Maybe Priority, String)
+pEditText = (,) <$> maybeParse (andSpace pPriority) <*> untilEndOfLine
+
+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}
+            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
+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') [])) =
+updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent (VTY.EvKey (VTY.KChar 'e') [])) = B.continue $ startEdit s
-  case B.listSelectedElement (taskList s) of
-    Nothing               -> B.continue s
-    Just (_, (LTask _ t)) ->
-      let edit = B.editor RTaskEdit (Just 1) ("- editor test -" ++ formatTask t)
-      in  B.continue s{taskEdit=Just edit}
 -- Update the task list
 updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent e) = do
   newList <- B.handleListEventVi B.handleListEvent e (taskList s)
@@ -69,14 +118,11 @@ updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent e) = do
 -- 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 [])) = do
+updateTaskList s@UIState{taskEdit=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue $ finishEdit s
-  let changeTask (LTask n t) = LTask n t{taskDescription="hehe, changed"}
-      newList = B.listModify changeTask (taskList s)
-  B.continue s{taskList=newList, taskEdit=Nothing}
 -- Update the editor
 updateTaskList s@UIState{taskEdit=Just edit} (B.VtyEvent e) = do
-  newEdit <- B.handleEditorEvent e edit
+  newTaskEdit <- updateEditor edit e
-  B.continue s{taskEdit=Just newEdit}
+  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

src/TaskMachine/UI/TopBar.hs

@@ -1,6 +1,6 @@
 module TaskMachine.UI.TopBar where
 
-import qualified Brick                as B
+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

@@ -8,6 +8,12 @@ module TaskMachine.UI.Types
   ( RName(..)
   , BigRing(..)
   , SmallRing(..)
+  -- * Popups
+  , Popup
+  , popup
+  , renderPopup
+  , handlePopupEvent
+  -- * UI state
   , UIState(..)
   , startUIState
   , bigFocusNext, bigFocusPrev
@@ -15,12 +21,14 @@ module TaskMachine.UI.Types
   , defaultTheme
   ) where
 
-import qualified Brick.Focus        as B
+import qualified Brick                as B
-import qualified Brick.Themes       as B
+import qualified Brick.Focus          as B
-import qualified Brick.Widgets.List as B
+import qualified Brick.Themes         as B
-import qualified Brick.Widgets.Edit as B
+import qualified Brick.Widgets.Dialog as B
-import qualified Data.Vector        as V
+import qualified Brick.Widgets.Edit   as B
-import qualified Graphics.Vty       as VTY
+import qualified Brick.Widgets.List   as B
+import qualified Data.Vector          as V
+import qualified Graphics.Vty         as VTY
 
 import           TaskMachine.LTask
 
@@ -44,12 +52,31 @@ data SmallRing
   | 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 -}
+
 -- | The state of the program and UI
 data UIState = 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
@@ -73,6 +100,7 @@ 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
@@ -94,14 +122,20 @@ smallFocusPrev s = s{focusTopBar=B.focusPrev (focusTopBar s)}
 
 defaultTheme :: B.Theme
 defaultTheme = B.newTheme VTY.defAttr
-  [ ("normal"   ,                                                            none)
+  [ (B.dialogAttr,                                    none)
-  , ("normal"    <> "description",                                           none)
+  , (B.buttonAttr,                                    none)
+  , (B.buttonSelectedAttr,                    bg' VTY.blue)
+  , (B.editAttr,                                      none)
+  , (B.editFocusedAttr,                       bg' VTY.blue)
+  , (B.listAttr,                                      none)
+  , (B.listSelectedAttr,                      st' VTY.bold)
+  , (B.listSelectedFocusedAttr, bg VTY.blue $ st' VTY.bold)
+  , ("normal"   ,                                                            none)
   , ("normal"    <> "priority",                      fg VTY.cyan   $ st' VTY.bold)
   , ("normal"    <> "priority" <> "A",               fg VTY.red    $ st' VTY.bold)
   , ("normal"    <> "priority" <> "B",               fg VTY.yellow $ st' VTY.bold)
   , ("normal"    <> "priority" <> "C",               fg VTY.green  $ st' VTY.bold)
   , ("highlight",                                                    bg' VTY.blue)
-  , ("highlight" <> "description",                                   bg' VTY.blue)
   , ("highlight" <> "priority",        bg VTY.blue $ fg VTY.cyan   $ st' VTY.bold)
   , ("highlight" <> "priority" <> "A", bg VTY.blue $ fg VTY.red    $ st' VTY.bold)
   , ("highlight" <> "priority" <> "B", bg VTY.blue $ fg VTY.yellow $ st' VTY.bold)