Load and save tasks
This commit includes new popups and proper error messages.
This commit is contained in:
Joscha
parent
9fc57bd056
commit
cad2f5741f
8 changed files with 152 additions and 65 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
54
src/TaskMachine/UI/Stuff.hs
Normal 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}
|
||||
|
|
@ -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
9
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue