Reorganize
This commit is contained in:
parent
36e90895f0
commit
15c547fe5e
9 changed files with 343 additions and 166 deletions
|
|
@ -21,6 +21,8 @@ module TaskMachine.Task
|
||||||
, Description
|
, Description
|
||||||
, Snippet(..)
|
, Snippet(..)
|
||||||
-- * Misc stuff
|
-- * Misc stuff
|
||||||
|
, emptyTask
|
||||||
|
, newTask
|
||||||
, compareTasks
|
, compareTasks
|
||||||
-- * Formatting
|
-- * Formatting
|
||||||
, formatTask
|
, formatTask
|
||||||
|
|
@ -313,6 +315,13 @@ pTasks = many pTask <* eof
|
||||||
|
|
||||||
{- Misc stuff -}
|
{- 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) []
|
||||||
|
|
||||||
compareTasks :: Task -> Task -> Ordering
|
compareTasks :: Task -> Task -> Ordering
|
||||||
compareTasks a b = mconcat
|
compareTasks a b = mconcat
|
||||||
[ compare (taskCompletion a) (taskCompletion b)
|
[ compare (taskCompletion a) (taskCompletion b)
|
||||||
|
|
|
||||||
|
|
@ -5,21 +5,19 @@ module TaskMachine.UI
|
||||||
|
|
||||||
import qualified Brick as B
|
import qualified Brick as B
|
||||||
import qualified Brick.Themes as B
|
import qualified Brick.Themes as B
|
||||||
import Control.Monad.Trans
|
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified Graphics.Vty.Input.Events as VTY
|
import qualified Graphics.Vty.Input.Events as VTY
|
||||||
|
|
||||||
import TaskMachine.Options
|
import TaskMachine.Options
|
||||||
import TaskMachine.UI.Behaviors
|
import TaskMachine.UI.Behaviors
|
||||||
import TaskMachine.UI.Popup
|
import TaskMachine.UI.Popup
|
||||||
import TaskMachine.UI.Stuff
|
|
||||||
import TaskMachine.UI.TaskList
|
import TaskMachine.UI.TaskList
|
||||||
import TaskMachine.UI.Types
|
import TaskMachine.UI.Types
|
||||||
|
|
||||||
{- Rendering -}
|
{- Rendering -}
|
||||||
|
|
||||||
drawTaskList :: UIState -> B.Widget RName
|
drawTaskList :: UIState -> B.Widget RName
|
||||||
drawTaskList s = renderTaskList (taskEdit s) True (tasks s)
|
drawTaskList s = renderTaskList (editor s) True (tasks s)
|
||||||
|
|
||||||
drawUIState :: UIState -> [B.Widget RName]
|
drawUIState :: UIState -> [B.Widget RName]
|
||||||
drawUIState s@UIState{errorPopup=Just p} = [renderPopup p, drawTaskList s]
|
drawUIState s@UIState{errorPopup=Just p} = [renderPopup p, drawTaskList s]
|
||||||
|
|
@ -27,27 +25,13 @@ drawUIState s = [drawTaskList s]
|
||||||
|
|
||||||
{- Updating the state -}
|
{- Updating the state -}
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
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 -> action s{errorPopup=Nothing}
|
|
||||||
popupBehavior p s e = do
|
|
||||||
newPopup <- handlePopupEvent e p
|
|
||||||
B.continue s{errorPopup=Just newPopup}
|
|
||||||
|
|
||||||
selectBehavior :: UIState -> VTY.Event -> NewState
|
selectBehavior :: UIState -> VTY.Event -> NewState
|
||||||
-- Deal with popup if there is one
|
-- Deal with popup if there is one
|
||||||
selectBehavior s@UIState{errorPopup=Just p} e = popupBehavior p s e
|
selectBehavior s@UIState{errorPopup=Just p} e = closeModifier (popupBehavior p) s e
|
||||||
-- Under the assumption that tasks can only be edited while the task list is focused, edit a task
|
-- Continue editing task if previously editing a task
|
||||||
selectBehavior s@UIState{taskEdit=Just edit} e = taskEditBehavior edit s e
|
selectBehavior s@UIState{editor=Just edit} e = taskEditBehavior edit s e
|
||||||
-- If nothing immediately jumps out at you, see which part has focus.
|
-- Default task list behavior
|
||||||
selectBehavior s e = closeBehavior taskListBehavior s e
|
selectBehavior s e = closeModifier taskListBehavior s e
|
||||||
|
|
||||||
updateUIState :: UIState -> B.BrickEvent RName () -> NewState
|
updateUIState :: UIState -> B.BrickEvent RName () -> NewState
|
||||||
updateUIState s (B.VtyEvent e) = selectBehavior s e
|
updateUIState s (B.VtyEvent e) = selectBehavior s e
|
||||||
|
|
@ -55,15 +39,12 @@ updateUIState s _ = B.continue s
|
||||||
|
|
||||||
{- Starting the app -}
|
{- Starting the app -}
|
||||||
|
|
||||||
startEvent :: UIState -> B.EventM RName UIState
|
|
||||||
startEvent = liftIO . loadTasks
|
|
||||||
|
|
||||||
myApp :: B.App UIState () RName
|
myApp :: B.App UIState () RName
|
||||||
myApp = B.App
|
myApp = B.App
|
||||||
{ B.appDraw = drawUIState
|
{ B.appDraw = drawUIState
|
||||||
, B.appChooseCursor = B.showFirstCursor
|
, B.appChooseCursor = B.showFirstCursor
|
||||||
, B.appHandleEvent = updateUIState
|
, B.appHandleEvent = updateUIState
|
||||||
, B.appStartEvent = startEvent
|
, B.appStartEvent = actionLoad
|
||||||
, B.appAttrMap = const (B.themeToAttrMap defaultTheme)
|
, B.appAttrMap = const (B.themeToAttrMap defaultTheme)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -72,5 +53,5 @@ startUIState o = UIState
|
||||||
{ options = o
|
{ options = o
|
||||||
, errorPopup = Nothing
|
, errorPopup = Nothing
|
||||||
, tasks = taskList RTaskList V.empty
|
, tasks = taskList RTaskList V.empty
|
||||||
, taskEdit = Nothing
|
, editor = Nothing
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,58 +1,212 @@
|
||||||
module TaskMachine.UI.Behaviors
|
module TaskMachine.UI.Behaviors
|
||||||
( taskListBehavior
|
( Behavior
|
||||||
|
--, emptyBehavior
|
||||||
|
-- * Miscellaneous
|
||||||
|
, getCurrentDay
|
||||||
|
, closeModifier
|
||||||
|
-- * Behaviors
|
||||||
|
, popupBehavior
|
||||||
|
, taskListBehavior
|
||||||
, taskEditBehavior
|
, taskEditBehavior
|
||||||
|
-- * Actions
|
||||||
|
, actionLoad
|
||||||
|
, actionSave
|
||||||
|
, actionDelete
|
||||||
|
, actionEditNew
|
||||||
|
, actionEditSelected
|
||||||
|
, actionSortTasks
|
||||||
|
, actionFinishEdit
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Brick as B
|
import Control.Monad
|
||||||
import qualified Brick.Widgets.Edit as B
|
|
||||||
import Control.Monad.Trans
|
|
||||||
import qualified Data.Text.Zipper as T
|
|
||||||
import qualified Graphics.Vty as VTY
|
|
||||||
import Text.Megaparsec
|
|
||||||
|
|
||||||
|
import qualified Brick as B
|
||||||
|
--import qualified Brick.Widgets.Edit as B
|
||||||
|
import Control.Monad.Trans
|
||||||
|
--import qualified Data.Text.Zipper as T
|
||||||
|
import qualified Graphics.Vty as VTY
|
||||||
|
--import Text.Megaparsec
|
||||||
|
import Data.Time
|
||||||
|
|
||||||
|
import TaskMachine.LTask
|
||||||
|
import TaskMachine.Options
|
||||||
import TaskMachine.Task
|
import TaskMachine.Task
|
||||||
import TaskMachine.UI.Stuff
|
import TaskMachine.UI.Popup
|
||||||
|
import TaskMachine.UI.TaskEdit
|
||||||
import TaskMachine.UI.TaskList
|
import TaskMachine.UI.TaskList
|
||||||
import TaskMachine.UI.Types
|
import TaskMachine.UI.Types
|
||||||
|
|
||||||
startEdit :: UIState -> UIState
|
type Behavior = UIState -> VTY.Event -> B.EventM RName (B.Next UIState)
|
||||||
startEdit s =
|
|
||||||
case taskListSelectedElement (tasks s) of
|
type Action = UIState -> B.EventM RName UIState
|
||||||
Nothing -> undefined -- TODO: Add popup notification
|
|
||||||
|
{- 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 -> error "no task selected" -- TODO: Add popup notification
|
||||||
Just t ->
|
Just t ->
|
||||||
let edit = B.editor RTaskEdit (Just 1) (formatTask t)
|
let edit = taskEdit RTaskEdit t ExistingTask
|
||||||
in s{taskEdit=Just edit}
|
in pure s{editor=Just edit}
|
||||||
|
|
||||||
finishEdit :: B.Editor String RName -> UIState -> UIState
|
-- 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)}
|
||||||
|
|
||||||
|
-- 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') []) = undefined 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 =
|
finishEdit edit s =
|
||||||
let editedText = unlines $ B.getEditContents edit
|
case editedTask edit of
|
||||||
in case parse pTask "edited task" editedText of
|
Left e -> error e -- TODO: Error popup
|
||||||
Left parseError -> undefined parseError -- TODO: Add popup notification
|
Right task -> s{tasks=modify task, editor=Nothing}
|
||||||
Right newTask ->
|
where
|
||||||
let newTaskList = taskListModify (const newTask) (tasks s)
|
modify :: Task -> TaskList RName
|
||||||
in s{tasks=newTaskList, taskEdit=Nothing}
|
modify task = case editState edit of
|
||||||
|
ExistingTask -> replaceTask task $ tasks s
|
||||||
|
NewTask -> appendTask task $ tasks s
|
||||||
|
|
||||||
taskEditBehavior :: B.Editor String RName -> UIState -> VTY.Event -> NewState
|
taskEditBehavior :: TaskEdit RName -> Behavior
|
||||||
taskEditBehavior _ s (VTY.EvKey VTY.KEsc []) = B.continue s{taskEdit=Nothing}
|
taskEditBehavior _ s (VTY.EvKey VTY.KEsc []) = B.continue s{editor=Nothing}
|
||||||
taskEditBehavior edit s (VTY.EvKey VTY.KHome []) = B.continue s{taskEdit=Just (B.applyEdit T.gotoBOL edit)}
|
taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) =
|
||||||
taskEditBehavior edit s (VTY.EvKey VTY.KEnd []) = B.continue s{taskEdit=Just (B.applyEdit T.gotoEOL edit)}
|
actionFinishEdit edit >=> actionSave >=> B.continue $ s
|
||||||
taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) = do
|
--taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) = do
|
||||||
newState <- liftIO $ saveTasks $ finishEdit edit s
|
-- newState <- liftIO $ saveTasks $ finishEdit edit s
|
||||||
B.continue newState
|
-- B.continue newState
|
||||||
taskEditBehavior edit s e = do
|
taskEditBehavior edit s e = do
|
||||||
newEdit <- B.handleEditorEvent e edit
|
newEdit <- updateTaskEdit e edit
|
||||||
B.continue s{taskEdit=Just newEdit}
|
B.continue s{editor=Just newEdit}
|
||||||
|
|
||||||
taskListBehavior :: UIState -> VTY.Event -> NewState
|
{-
|
||||||
-- Reload while running
|
-- Reload while running
|
||||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'r') []) = actionLoad s
|
taskListBehavior s (VTY.EvKey (VTY.KChar 'r') []) = actionLoad s
|
||||||
-- Mark/unmark a task as completed
|
-- Mark/unmark a task as completed
|
||||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'x') []) = undefined s
|
taskListBehavior s (VTY.EvKey (VTY.KChar 'x') []) = undefined s
|
||||||
-- Delete tasks
|
-- Delete tasks
|
||||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'd') []) = undefined s
|
taskListBehavior s (VTY.EvKey (VTY.KChar 'd') []) = undefined s
|
||||||
|
-- Delete tasks
|
||||||
|
taskListBehavior s (VTY.EvKey (VTY.KChar 'd') []) = undefined s
|
||||||
-- Start editing a new task
|
-- Start editing a new task
|
||||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'e') []) = B.continue (startEdit s)
|
taskListBehavior s (VTY.EvKey (VTY.KChar 'e') []) = B.continue (startEdit s)
|
||||||
-- Update the task list (scroll etc.)
|
-- Update the task list (scroll etc.)
|
||||||
taskListBehavior s e = do
|
taskListBehavior s e = do
|
||||||
newTasks <- updateTaskList e (tasks s)
|
newTasks <- updateTaskList e (tasks s)
|
||||||
B.continue s{tasks=newTasks}
|
B.continue s{tasks=newTasks}
|
||||||
|
-}
|
||||||
|
|
|
||||||
|
|
@ -1,23 +1,17 @@
|
||||||
module TaskMachine.UI.Popup
|
module TaskMachine.UI.Popup
|
||||||
( minPopupWidth
|
( Popup
|
||||||
-- * Ok popup
|
|
||||||
, Popup
|
|
||||||
, popup
|
, popup
|
||||||
, popup'
|
, popup'
|
||||||
, renderPopup
|
, renderPopup
|
||||||
, handlePopupEvent
|
, handlePopupEvent
|
||||||
, popupSelection
|
, popupSelection
|
||||||
|
, minPopupWidth
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Brick as B
|
import qualified Brick as B
|
||||||
import qualified Brick.Widgets.Dialog as B
|
import qualified Brick.Widgets.Dialog as B
|
||||||
import qualified Graphics.Vty as VTY
|
import qualified Graphics.Vty as VTY
|
||||||
|
|
||||||
minPopupWidth :: Int
|
|
||||||
minPopupWidth = 78
|
|
||||||
|
|
||||||
{- Ok popup -}
|
|
||||||
|
|
||||||
data Popup n r = Popup (B.Dialog r) (B.Widget n)
|
data Popup n r = Popup (B.Dialog r) (B.Widget n)
|
||||||
|
|
||||||
popup :: String -> String -> [(String, r)] -> Popup n r
|
popup :: String -> String -> [(String, r)] -> Popup n r
|
||||||
|
|
@ -37,3 +31,6 @@ handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialo
|
||||||
|
|
||||||
popupSelection :: Popup n r -> Maybe r
|
popupSelection :: Popup n r -> Maybe r
|
||||||
popupSelection (Popup dialog _) = B.dialogSelection dialog
|
popupSelection (Popup dialog _) = B.dialogSelection dialog
|
||||||
|
|
||||||
|
minPopupWidth :: Int
|
||||||
|
minPopupWidth = 78
|
||||||
|
|
|
||||||
|
|
@ -1,54 +0,0 @@
|
||||||
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}
|
|
||||||
56
src/TaskMachine/UI/TaskEdit.hs
Normal file
56
src/TaskMachine/UI/TaskEdit.hs
Normal file
|
|
@ -0,0 +1,56 @@
|
||||||
|
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
|
||||||
|
|
||||||
|
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 = TaskEdit s $ B.editor name (Just 1) (formatTask task)
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
renderRows :: [String] -> B.Widget n
|
||||||
|
renderRows = B.vBox . map B.str
|
||||||
|
|
||||||
|
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
|
||||||
|
|
@ -1,16 +1,20 @@
|
||||||
module TaskMachine.UI.TaskList
|
module TaskMachine.UI.TaskList
|
||||||
( TaskList
|
( TaskList
|
||||||
, taskList
|
, taskList
|
||||||
|
, taskListElements
|
||||||
, renderTaskList
|
, renderTaskList
|
||||||
, updateTaskList
|
, updateTaskList
|
||||||
, taskListElements
|
, sortTaskList
|
||||||
, taskListFilter
|
, selectedTask
|
||||||
, taskListSelectedElement
|
, appendTask
|
||||||
, taskListModify
|
, replaceTask
|
||||||
|
, deleteTask
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.Function
|
||||||
|
import Data.List
|
||||||
|
|
||||||
import qualified Brick as B
|
import qualified Brick as B
|
||||||
import qualified Brick.Widgets.Edit as B
|
|
||||||
import qualified Brick.Widgets.List as B
|
import qualified Brick.Widgets.List as B
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified Graphics.Vty as VTY
|
import qualified Graphics.Vty as VTY
|
||||||
|
|
@ -18,46 +22,75 @@ import qualified Graphics.Vty as VTY
|
||||||
import TaskMachine.LTask
|
import TaskMachine.LTask
|
||||||
import TaskMachine.Task
|
import TaskMachine.Task
|
||||||
import TaskMachine.UI.Task
|
import TaskMachine.UI.Task
|
||||||
|
import TaskMachine.UI.TaskEdit
|
||||||
|
|
||||||
data TaskList n = TaskList
|
newtype TaskList n = TaskList (B.List n LTask)
|
||||||
{ 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
|
|
||||||
|
|
||||||
taskList :: n -> V.Vector LTask -> TaskList n
|
taskList :: n -> V.Vector LTask -> TaskList n
|
||||||
taskList name ltasks = TaskList{visibleTasks=newList name ltasks, invisibleTasks=V.empty}
|
taskList name tasks = TaskList $ B.list name tasks 1
|
||||||
|
|
||||||
renderLTask :: (Ord n, Show n) => Maybe (B.Editor String n) -> Bool -> LTask -> B.Widget n
|
|
||||||
renderLTask (Just e) True _ = B.renderEditor (B.str . unlines) True e
|
|
||||||
renderLTask _ _ lt = renderTask (toTask lt)
|
|
||||||
|
|
||||||
renderTaskList :: (Ord n, Show n) => Maybe (B.Editor String n) -> Bool -> TaskList n -> B.Widget n
|
|
||||||
renderTaskList edit focus tl = B.renderList (renderLTask edit) focus (visibleTasks tl)
|
|
||||||
|
|
||||||
updateTaskList :: (Ord n) => VTY.Event -> TaskList n -> B.EventM n (TaskList n)
|
|
||||||
updateTaskList e tl = do
|
|
||||||
updatedList <- B.handleListEventVi B.handleListEvent e (visibleTasks tl)
|
|
||||||
pure tl{visibleTasks=updatedList}
|
|
||||||
|
|
||||||
{- Managing tasks -}
|
|
||||||
|
|
||||||
taskListElements :: TaskList n -> V.Vector LTask
|
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
|
renderRow :: Maybe (B.Widget n) -> Bool -> LTask -> B.Widget n
|
||||||
taskListFilter f tl =
|
renderRow (Just w) True _ = w
|
||||||
let (yes, no) = V.partition (f . toTask) $ taskListElements tl
|
renderRow _ _ lt = renderTask (toTask lt)
|
||||||
name = B.listName (visibleTasks tl)
|
|
||||||
list = newList name yes
|
|
||||||
in TaskList{visibleTasks=list, invisibleTasks=no}
|
|
||||||
|
|
||||||
taskListSelectedElement :: TaskList n -> Maybe Task
|
renderLast :: (Ord n, Show n) => B.Widget n -> Bool -> B.List n LTask -> B.Widget n
|
||||||
taskListSelectedElement tl = toTask . snd <$> B.listSelectedElement (visibleTasks tl)
|
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
|
renderTaskList :: (Ord n, Show n) => Maybe (TaskEdit n) -> Bool -> TaskList n -> B.Widget n
|
||||||
taskListModify f tl =
|
renderTaskList Nothing focus (TaskList list)
|
||||||
let list = B.listModify (modifyLTask f) (visibleTasks tl)
|
| listSize list == 0 = renderLast (B.str "--- empty ---") focus list
|
||||||
in tl{visibleTasks=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
|
||||||
|
|
||||||
|
updateTaskList :: Ord n => VTY.Event -> TaskList n -> B.EventM n (TaskList n)
|
||||||
|
updateTaskList event (TaskList list) =
|
||||||
|
TaskList <$> B.handleListEventVi B.handleListEvent event list
|
||||||
|
|
||||||
|
sortTaskList :: TaskList n -> TaskList n
|
||||||
|
sortTaskList (TaskList list) =
|
||||||
|
let tasks = V.toList $ B.listElements list
|
||||||
|
sortedTasks = sortBy (compareTasks `on` toTask) tasks
|
||||||
|
newVector = V.fromList sortedTasks
|
||||||
|
in TaskList $ B.listReplace newVector Nothing list
|
||||||
|
|
||||||
|
selectedTask :: TaskList n -> Maybe Task
|
||||||
|
selectedTask (TaskList list) = toTask . snd <$> B.listSelectedElement list
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
appendTask :: Task -> TaskList n -> TaskList n
|
||||||
|
appendTask task (TaskList list) = TaskList $ appendTask' task list
|
||||||
|
|
||||||
|
replaceTask :: Task -> TaskList n -> TaskList n
|
||||||
|
replaceTask task (TaskList list) = TaskList $ B.listModify replace list
|
||||||
|
where
|
||||||
|
replace :: LTask -> LTask
|
||||||
|
replace = modifyLTask (const task)
|
||||||
|
|
||||||
|
deleteTask :: TaskList n -> TaskList n
|
||||||
|
deleteTask tl@(TaskList list) =
|
||||||
|
case listSize list of
|
||||||
|
0 -> tl
|
||||||
|
n -> TaskList $ B.listRemove (n-1) list
|
||||||
|
|
||||||
|
{- helper functions -}
|
||||||
|
|
||||||
|
listSize :: B.List n e -> Int
|
||||||
|
listSize list = V.length $ B.listElements list
|
||||||
|
|
||||||
|
focusOnLastTask :: B.List n e -> B.List n e
|
||||||
|
focusOnLastTask list = B.listMoveTo (listSize list - 1) list
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,7 @@ import qualified Graphics.Vty as VTY
|
||||||
import TaskMachine.Options
|
import TaskMachine.Options
|
||||||
import TaskMachine.UI.Popup
|
import TaskMachine.UI.Popup
|
||||||
import TaskMachine.UI.Task
|
import TaskMachine.UI.Task
|
||||||
|
import TaskMachine.UI.TaskEdit
|
||||||
import TaskMachine.UI.TaskList
|
import TaskMachine.UI.TaskList
|
||||||
|
|
||||||
-- | Resource names
|
-- | Resource names
|
||||||
|
|
@ -36,7 +37,7 @@ data UIState = UIState
|
||||||
{ options :: Options -- includes todo file and other config
|
{ options :: Options -- includes todo file and other config
|
||||||
, errorPopup :: Maybe (Popup RName (UIState -> NewState))
|
, errorPopup :: Maybe (Popup RName (UIState -> NewState))
|
||||||
, tasks :: TaskList RName
|
, tasks :: TaskList RName
|
||||||
, taskEdit :: Maybe (B.Editor String RName)
|
, editor :: Maybe (TaskEdit RName)
|
||||||
}
|
}
|
||||||
|
|
||||||
type NewState = B.EventM RName (B.Next UIState)
|
type NewState = B.EventM RName (B.Next UIState)
|
||||||
|
|
|
||||||
2
todo.txt
2
todo.txt
|
|
@ -2,7 +2,7 @@
|
||||||
- c2018-09-18 Purge - move completed tasks to a separate file
|
- c2018-09-18 Purge - move completed tasks to a separate file
|
||||||
- c2018-09-28 Move cursor to beginning of task description when editing tasks
|
- c2018-09-28 Move cursor to beginning of task description when editing tasks
|
||||||
- c2018-09-28 Syntax highlighting while editing tasks
|
- c2018-09-28 Syntax highlighting while editing tasks
|
||||||
- c2018-09-30 Sort tasks when (re-)loading
|
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-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-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 load from todo file
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue