Garmelon/task-machine
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Load and save tasks

Browse source 
This commit includes new popups and proper error messages.
This commit is contained in:
Joscha 2018-09-30 17:35:57 +00:00
parent 9fc57bd056
commit cad2f5741f
8 changed files with 152 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

3
app/Main.hs
View file

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

47
src/TaskMachine/LTask.hs
View file

@ -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
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
--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 ()

31
src/TaskMachine/UI.hs
View file

@ -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
--, errorPopup = Nothing
, tasks = taskList RTaskList V.empty
, taskEdit = Nothing
{ options = o
, errorPopup = Nothing
, tasks = taskList RTaskList V.empty
, taskEdit = Nothing
}

8
src/TaskMachine/UI/Behaviors.hs
View file

@ -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
liftIO $ saveTasks newState
newState <- liftIO $ saveTasks $ finishEdit edit s
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
newState <- liftIO $ loadTasks s
B.continue newState
taskListBehavior s (VTY.EvKey (VTY.KChar 'r') []) = actionLoad s
-- Mark/unmark a task as completed
taskListBehavior s (VTY.EvKey (VTY.KChar 'x') []) = undefined s
-- Delete tasks

37
src/TaskMachine/UI/Popup.hs
View file

@ -1,11 +1,12 @@
module TaskMachine.UI.Popup
( minPopupWidth
-- * Ok popup
, PopupOk
, popupOk
, popupOk'
, renderPopupOk
, handlePopupOkEvent
, Popup
, popup
, popup'
, renderPopup
, 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
popupOk title content = popupOk' title (B.str content)
popup :: String -> String -> [(String, r)] -> Popup n r
popup title content = popup' 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
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
renderPopupOk :: PopupOk n -> B.Widget n
renderPopupOk (PopupOk dialog widget) = B.renderDialog dialog widget
renderPopup :: Popup n r -> B.Widget n
renderPopup (Popup 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
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

54
src/TaskMachine/UI/Stuff.hs Normal file
View file

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

28
src/TaskMachine/UI/Types.hs
View file

@ -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
--, errorPopup :: Maybe (PopupOk RName)
, tasks :: TaskList RName
, taskEdit :: Maybe (B.Editor String RName)
{ options :: Options -- includes todo file and other config
, errorPopup :: Maybe (Popup RName (UIState -> NewState))
, tasks :: TaskList 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

9
todo.txt
View file

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