Load and save tasks

This commit includes new popups and proper error messages.

app/Main.hs

@@ -10,5 +10,4 @@ import           TaskMachine.UI
 main :: IO()
 main = do
   o <- parseOptions
-  state <- loadTasks $ startUIState o
+  void $ B.defaultMain myApp $ startUIState o
-  void $ B.defaultMain myApp state

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,45 @@ 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
+  | isIllegalOperation e  = Just $ ErrorMessage $ "Could not open file:\n" ++ show e
+  | isPermissionError e   = Just $ ErrorMessage "Could not open file: Permission denied"
+  | otherwise             = Nothing
+
 loadLTasks :: FilePath -> IO (Either String (V.Vector LTask))
 loadLTasks file = do
-  content <- readFile file
+  content <- tryJust loadErrorMessage $ readFile file
-  case parse pTasks file content of
+  case parse pTasks file <$> content of
-    Right taskList  -> pure $ Right $ V.fromList $ fromTasks taskList
+    Left IgnoreError        -> pure $ Right V.empty
-    Left parseError -> pure $ Left $ parseErrorPretty parseError
+    Left (ErrorMessage msg) -> pure $ Left msg
+    Right (Left parseError) -> pure $ Left $ parseErrorPretty parseError
+    Right (Right taskList)  -> pure $ Right $ V.fromList $ fromTasks taskList
+    --Left parseError -> pure $ Left $ parseErrorPretty parseError
+    --Right taskList  -> pure $ Right $ V.fromList $ fromTasks taskList
 
-saveLTasks :: FilePath -> V.Vector LTask -> IO ()
+{- Saving -}
+
+saveErrorMessage :: IOError -> Maybe String
+saveErrorMessage e
+  | isAlreadyInUseError e = Just "Could not save to file: File already in use"
+  | isFullError e         = Just "Could not save to file: Disk full"
+  | isIllegalOperation e  = Just $ "Could not save to file:\n" ++ show e
+  | isPermissionError e   = Just "Could not save to file: Permission denied"
+  | otherwise             = Nothing
+
+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/UI.hs

@@ -1,16 +1,18 @@
 module TaskMachine.UI
   ( myApp
   , startUIState
-  , loadTasks
   ) where
 
 import qualified Brick                     as B
 import qualified Brick.Themes              as B
+import           Control.Monad.Trans
 import qualified Data.Vector               as V
 import qualified Graphics.Vty.Input.Events as VTY
 
 import           TaskMachine.Options
 import           TaskMachine.UI.Behaviors
+import           TaskMachine.UI.Popup
+import           TaskMachine.UI.Stuff
 import           TaskMachine.UI.TaskList
 import           TaskMachine.UI.Types
 
@@ -20,7 +22,7 @@ drawTaskList :: UIState -> B.Widget RName
 drawTaskList s = renderTaskList (taskEdit s) True (tasks s)
 
 drawUIState :: UIState -> [B.Widget RName]
---drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawTaskList s]
+drawUIState s@UIState{errorPopup=Just p} = [renderPopup p, drawTaskList s]
 drawUIState s                            = [drawTaskList s]
 
 {- Updating the state -}
@@ -30,9 +32,19 @@ 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
 
+popupBehavior :: Popup RName (UIState -> NewState) -> UIState -> VTY.Event -> NewState
+popupBehavior p s (VTY.EvKey VTY.KEnter []) =
+  case popupSelection p of
+    Nothing -> B.continue s{errorPopup=Nothing}
+    Just action -> do
+      action s{errorPopup=Nothing}
+popupBehavior p s e = do
+  newPopup <- handlePopupEvent e p
+  B.continue s{errorPopup=Just newPopup}
+
 selectBehavior :: UIState -> VTY.Event -> NewState
 -- Deal with popup if there is one
---selectBehavior s@UIState{errorPopup=Just popup} e = undefined popup s e
+selectBehavior s@UIState{errorPopup=Just p} e = popupBehavior p s e
 -- Under the assumption that tasks can only be edited while the task list is focused, edit a task
 selectBehavior s@UIState{taskEdit=Just edit} e = taskEditBehavior edit s e
 -- If nothing immediately jumps out at you, see which part has focus.
@@ -44,19 +56,22 @@ updateUIState s _              = B.continue s
 
 {- Starting the app -}
 
+startEvent :: UIState -> B.EventM RName UIState
+startEvent = liftIO . loadTasks
+
 myApp :: B.App UIState () RName
 myApp = B.App
   { B.appDraw         = drawUIState
   , B.appChooseCursor = B.showFirstCursor
   , B.appHandleEvent  = updateUIState
-  , B.appStartEvent   = pure
+  , B.appStartEvent   = startEvent
   , B.appAttrMap      = const (B.themeToAttrMap defaultTheme)
   }
 
 startUIState :: Options -> UIState
 startUIState o = UIState
-  { options        = o
+  { options    = o
-  --, errorPopup     = Nothing
+  , errorPopup = Nothing
-  , tasks          = taskList RTaskList V.empty
+  , tasks      = taskList RTaskList V.empty
-  , taskEdit       = Nothing
+  , taskEdit   = Nothing
   }

src/TaskMachine/UI/Behaviors.hs

@@ -13,6 +13,7 @@ import           Text.Megaparsec
 import           TaskMachine.Task
 import           TaskMachine.UI.TaskList
 import           TaskMachine.UI.Types
+import TaskMachine.UI.Stuff
 
 startEdit :: UIState -> UIState
 startEdit s =
@@ -36,8 +37,7 @@ taskEditBehavior _    s (VTY.EvKey VTY.KEsc   []) = B.continue s{taskEdit=Nothin
 taskEditBehavior edit s (VTY.EvKey VTY.KHome  []) = B.continue s{taskEdit=Just (B.applyEdit T.gotoBOL edit)}
 taskEditBehavior edit s (VTY.EvKey VTY.KEnd   []) = B.continue s{taskEdit=Just (B.applyEdit T.gotoEOL edit)}
 taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) = do
-  let newState = finishEdit edit s
+  newState <- liftIO $ saveTasks $ finishEdit edit s
-  liftIO $ saveTasks newState
   B.continue newState
 taskEditBehavior edit s e = do
   newEdit <- B.handleEditorEvent e edit
@@ -45,9 +45,7 @@ taskEditBehavior edit s e = do
 
 taskListBehavior :: UIState -> VTY.Event -> NewState
 -- Reload while running
-taskListBehavior s (VTY.EvKey (VTY.KChar 'r') []) = do
+taskListBehavior s (VTY.EvKey (VTY.KChar 'r') []) = actionLoad s
-  newState <- liftIO $ loadTasks s
-  B.continue newState
 -- Mark/unmark a task as completed
 taskListBehavior s (VTY.EvKey (VTY.KChar 'x') []) = undefined s
 -- Delete tasks

src/TaskMachine/UI/Popup.hs

@@ -1,11 +1,12 @@
 module TaskMachine.UI.Popup
   ( minPopupWidth
   -- * Ok popup
-  , PopupOk
+  , Popup
-  , popupOk
+  , popup
-  , popupOk'
+  , popup'
-  , renderPopupOk
+  , renderPopup
-  , handlePopupOkEvent
+  , handlePopupEvent
+  , popupSelection
   ) where
 
 import qualified Brick                as B
@@ -17,18 +18,22 @@ minPopupWidth = 78
 
 {- Ok popup -}
 
-data PopupOk n = PopupOk (B.Dialog ()) (B.Widget n)
+data Popup n r = Popup (B.Dialog r) (B.Widget n)
 
-popupOk :: String -> String -> PopupOk n
+popup :: String -> String -> [(String, r)] -> Popup n r
-popupOk title content = popupOk' title (B.str content)
+popup title content = popup' title (B.str content)
 
-popupOk' :: String -> B.Widget n -> PopupOk n
+popup' :: String -> B.Widget n -> [(String, r)] -> Popup n r
-popupOk' title widget =
+popup' title widget results =
-  let dialog = B.dialog (Just $ " " ++ title ++ " ") (Just (0,[("Ok",())])) minPopupWidth
+  let spacedTitle = " " ++ title ++ " "
-  in  PopupOk dialog widget
+      dialog = B.dialog (Just spacedTitle) (Just (0, results)) minPopupWidth
+  in  Popup dialog widget
 
-renderPopupOk :: PopupOk n -> B.Widget n
+renderPopup :: Popup n r -> B.Widget n
-renderPopupOk (PopupOk dialog widget) = B.renderDialog dialog widget
+renderPopup (Popup dialog widget) = B.renderDialog dialog widget
 
-handlePopupOkEvent :: VTY.Event -> PopupOk n -> B.EventM n (PopupOk n)
+handlePopupEvent :: VTY.Event -> Popup n r -> B.EventM n (Popup n r)
-handlePopupOkEvent e (PopupOk dialog widget) = PopupOk <$> B.handleDialogEvent e dialog <*> pure widget
+handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialog <*> pure widget
+
+popupSelection :: Popup n r -> Maybe r
+popupSelection (Popup dialog _) = B.dialogSelection dialog

src/TaskMachine/UI/Stuff.hs

@@ -0,0 +1,54 @@
+module TaskMachine.UI.Stuff where
+
+import qualified Brick                   as B
+import           Control.Monad.Trans
+
+import           TaskMachine.LTask
+import           TaskMachine.Options
+import           TaskMachine.UI.Popup
+import           TaskMachine.UI.TaskList
+import           TaskMachine.UI.Types
+
+actionQuit :: UIState -> NewState
+actionQuit = B.halt
+
+actionDoNothing :: UIState -> NewState
+actionDoNothing = B.continue
+
+actionLoad :: UIState -> NewState
+actionLoad s = do
+  state <- liftIO $ loadTasks s
+  B.continue state
+
+loadTasks :: UIState -> IO UIState
+loadTasks s = do
+  let file = oTodofile $ options s
+  result <- loadLTasks file
+  case result of
+    Right ltasks      -> pure s{tasks=taskList RTaskList ltasks}
+    Left errorMessage ->
+      let p = popup "Error loading tasks" errorMessage
+                [ ("Retry", actionLoad)
+                , ("Quit", actionQuit)
+                ]
+      in  pure s{errorPopup=Just p}
+
+actionSave :: UIState -> NewState
+actionSave s = do
+  state <- liftIO $ saveTasks s
+  B.continue state
+
+saveTasks :: UIState -> IO UIState
+saveTasks s = do
+  let filepath = oTodofile (options s)
+      ltasks = taskListElements (tasks s)
+  result <- saveLTasks filepath ltasks
+  case result of
+    Right _ -> pure s
+    Left errorMessage ->
+      let p = popup "Error saving tasks" errorMessage
+                [ ("Retry", actionSave)
+                , ("Continue without saving", actionDoNothing)
+                , ("Quit", actionQuit)
+                ]
+      in  pure s{errorPopup=Just p}

src/TaskMachine/UI/Types.hs

@@ -10,8 +10,6 @@ module TaskMachine.UI.Types
   , UIState(..)
   , NewState
   , defaultTheme
-  , loadTasks
-  , saveTasks
   ) where
 
 import qualified Brick                   as B
@@ -21,8 +19,8 @@ import qualified Brick.Widgets.Edit      as B
 import qualified Brick.Widgets.List      as B
 import qualified Graphics.Vty            as VTY
 
-import           TaskMachine.LTask
 import           TaskMachine.Options
+import           TaskMachine.UI.Popup
 import           TaskMachine.UI.Task
 import           TaskMachine.UI.TaskList
 
@@ -35,10 +33,10 @@ data RName
 {- UI state -}
 
 data UIState = UIState
-  { options  :: Options -- includes todo file and other config
+  { options    :: Options -- includes todo file and other config
-  --, errorPopup :: Maybe (PopupOk RName)
+  , errorPopup :: Maybe (Popup RName (UIState -> NewState))
-  , tasks    :: TaskList RName
+  , tasks      :: TaskList RName
-  , taskEdit :: Maybe (B.Editor String RName)
+  , taskEdit   :: Maybe (B.Editor String RName)
   }
 
 type NewState = B.EventM RName (B.Next UIState)
@@ -73,19 +71,3 @@ defaultTheme = B.newTheme VTY.defAttr
     bg' = VTY.withBackColor none
     st' = VTY.withStyle     none
     none = VTY.defAttr
-
-loadTasks :: UIState -> IO UIState
-loadTasks s = do
-  let file = oTodofile $ options s
-  result <- loadLTasks file
-  case result of
-    -- TODO: Improve error handling when loading files
-    --Left errorMessage -> pure s{errorPopup=Just $ popupOk "Error loading tasks" errorMessage}
-    Left errorMessage -> undefined errorMessage
-    Right ltasks      -> pure s{tasks=taskList RTaskList ltasks}
-
-saveTasks :: UIState -> IO ()
-saveTasks s = do
-  let filepath = oTodofile (options s)
-      ltasks = taskListElements (tasks s)
-  saveLTasks filepath ltasks

todo.txt

@@ -1,10 +1,11 @@
-- 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)
 - c2018-09-18 Purge - move completed tasks to a separate file
-- c2018-09-18 Sort tasks by completion, priority, due date, description
 - c2018-09-28 Move cursor to beginning of task description when editing tasks
 - c2018-09-28 Syntax highlighting while editing tasks
+- c2018-09-30 Sort tasks when (re-)loading
 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