Reorganize
This commit is contained in:
Joscha
parent
36e90895f0
commit
15c547fe5e
9 changed files with 343 additions and 166 deletions
|
|
@ -21,6 +21,8 @@ module TaskMachine.Task
|
|||
, Description
|
||||
, Snippet(..)
|
||||
-- * Misc stuff
|
||||
, emptyTask
|
||||
, newTask
|
||||
, compareTasks
|
||||
-- * Formatting
|
||||
, formatTask
|
||||
|
|
@ -313,6 +315,13 @@ pTasks = many pTask <* eof
|
|||
|
||||
{- 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 a b = mconcat
|
||||
[ compare (taskCompletion a) (taskCompletion b)
|
||||
|
|
|
|||
|
|
@ -5,21 +5,19 @@ module TaskMachine.UI
|
|||
|
||||
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
|
||||
|
||||
{- Rendering -}
|
||||
|
||||
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 s@UIState{errorPopup=Just p} = [renderPopup p, drawTaskList s]
|
||||
|
|
@ -27,27 +25,13 @@ drawUIState s = [drawTaskList s]
|
|||
|
||||
{- 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
|
||||
-- Deal with popup if there is one
|
||||
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.
|
||||
selectBehavior s e = closeBehavior taskListBehavior s e
|
||||
selectBehavior s@UIState{errorPopup=Just p} e = closeModifier (popupBehavior p) s e
|
||||
-- Continue editing task if previously editing a task
|
||||
selectBehavior s@UIState{editor=Just edit} e = taskEditBehavior edit s e
|
||||
-- Default task list behavior
|
||||
selectBehavior s e = closeModifier taskListBehavior s e
|
||||
|
||||
updateUIState :: UIState -> B.BrickEvent RName () -> NewState
|
||||
updateUIState s (B.VtyEvent e) = selectBehavior s e
|
||||
|
|
@ -55,15 +39,12 @@ 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 = startEvent
|
||||
, B.appStartEvent = actionLoad
|
||||
, B.appAttrMap = const (B.themeToAttrMap defaultTheme)
|
||||
}
|
||||
|
||||
|
|
@ -72,5 +53,5 @@ startUIState o = UIState
|
|||
{ options = o
|
||||
, errorPopup = Nothing
|
||||
, tasks = taskList RTaskList V.empty
|
||||
, taskEdit = Nothing
|
||||
, editor = Nothing
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,58 +1,212 @@
|
|||
module TaskMachine.UI.Behaviors
|
||||
( taskListBehavior
|
||||
( Behavior
|
||||
--, emptyBehavior
|
||||
-- * Miscellaneous
|
||||
, getCurrentDay
|
||||
, closeModifier
|
||||
-- * Behaviors
|
||||
, popupBehavior
|
||||
, taskListBehavior
|
||||
, taskEditBehavior
|
||||
-- * Actions
|
||||
, actionLoad
|
||||
, actionSave
|
||||
, actionDelete
|
||||
, actionEditNew
|
||||
, actionEditSelected
|
||||
, actionSortTasks
|
||||
, actionFinishEdit
|
||||
) where
|
||||
|
||||
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 Control.Monad
|
||||
|
||||
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.UI.Stuff
|
||||
import TaskMachine.UI.Popup
|
||||
import TaskMachine.UI.TaskEdit
|
||||
import TaskMachine.UI.TaskList
|
||||
import TaskMachine.UI.Types
|
||||
|
||||
startEdit :: UIState -> UIState
|
||||
startEdit s =
|
||||
case taskListSelectedElement (tasks s) of
|
||||
Nothing -> undefined -- TODO: Add popup notification
|
||||
type Behavior = UIState -> VTY.Event -> B.EventM RName (B.Next UIState)
|
||||
|
||||
type Action = UIState -> B.EventM RName UIState
|
||||
|
||||
{- 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 ->
|
||||
let edit = B.editor RTaskEdit (Just 1) (formatTask t)
|
||||
in s{taskEdit=Just edit}
|
||||
let edit = taskEdit RTaskEdit t ExistingTask
|
||||
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 =
|
||||
let editedText = unlines $ B.getEditContents edit
|
||||
in case parse pTask "edited task" editedText of
|
||||
Left parseError -> undefined parseError -- TODO: Add popup notification
|
||||
Right newTask ->
|
||||
let newTaskList = taskListModify (const newTask) (tasks s)
|
||||
in s{tasks=newTaskList, taskEdit=Nothing}
|
||||
case editedTask edit of
|
||||
Left e -> error e -- TODO: Error popup
|
||||
Right task -> s{tasks=modify task, editor=Nothing}
|
||||
where
|
||||
modify :: Task -> TaskList RName
|
||||
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 _ s (VTY.EvKey VTY.KEsc []) = B.continue s{taskEdit=Nothing}
|
||||
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
|
||||
newState <- liftIO $ saveTasks $ finishEdit edit s
|
||||
B.continue newState
|
||||
taskEditBehavior :: TaskEdit RName -> Behavior
|
||||
taskEditBehavior _ s (VTY.EvKey VTY.KEsc []) = B.continue s{editor=Nothing}
|
||||
taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) =
|
||||
actionFinishEdit edit >=> actionSave >=> B.continue $ s
|
||||
--taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) = do
|
||||
-- newState <- liftIO $ saveTasks $ finishEdit edit s
|
||||
-- B.continue newState
|
||||
taskEditBehavior edit s e = do
|
||||
newEdit <- B.handleEditorEvent e edit
|
||||
B.continue s{taskEdit=Just newEdit}
|
||||
newEdit <- updateTaskEdit e edit
|
||||
B.continue s{editor=Just newEdit}
|
||||
|
||||
taskListBehavior :: UIState -> VTY.Event -> NewState
|
||||
{-
|
||||
-- Reload while running
|
||||
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
|
||||
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
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'e') []) = B.continue (startEdit s)
|
||||
-- Update the task list (scroll etc.)
|
||||
taskListBehavior s e = do
|
||||
newTasks <- updateTaskList e (tasks s)
|
||||
B.continue s{tasks=newTasks}
|
||||
-}
|
||||
|
|
|
|||
|
|
@ -1,23 +1,17 @@
|
|||
module TaskMachine.UI.Popup
|
||||
( minPopupWidth
|
||||
-- * Ok popup
|
||||
, Popup
|
||||
( Popup
|
||||
, popup
|
||||
, popup'
|
||||
, renderPopup
|
||||
, handlePopupEvent
|
||||
, popupSelection
|
||||
, minPopupWidth
|
||||
) where
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.Dialog as B
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
minPopupWidth :: Int
|
||||
minPopupWidth = 78
|
||||
|
||||
{- Ok popup -}
|
||||
|
||||
data Popup n r = Popup (B.Dialog r) (B.Widget n)
|
||||
|
||||
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 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,63 +1,96 @@
|
|||
module TaskMachine.UI.TaskList
|
||||
( TaskList
|
||||
, taskList
|
||||
, taskListElements
|
||||
, renderTaskList
|
||||
, updateTaskList
|
||||
, taskListElements
|
||||
, taskListFilter
|
||||
, taskListSelectedElement
|
||||
, taskListModify
|
||||
, sortTaskList
|
||||
, selectedTask
|
||||
, appendTask
|
||||
, replaceTask
|
||||
, deleteTask
|
||||
) where
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.Edit as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
import Data.Function
|
||||
import Data.List
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
import TaskMachine.LTask
|
||||
import TaskMachine.Task
|
||||
import TaskMachine.UI.Task
|
||||
import TaskMachine.UI.TaskEdit
|
||||
|
||||
data TaskList n = TaskList
|
||||
{ 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
|
||||
newtype TaskList n = TaskList (B.List n LTask)
|
||||
|
||||
taskList :: n -> V.Vector LTask -> TaskList n
|
||||
taskList name ltasks = TaskList{visibleTasks=newList name ltasks, invisibleTasks=V.empty}
|
||||
|
||||
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 -}
|
||||
taskList name tasks = TaskList $ B.list name tasks 1
|
||||
|
||||
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
|
||||
taskListFilter f tl =
|
||||
let (yes, no) = V.partition (f . toTask) $ taskListElements tl
|
||||
name = B.listName (visibleTasks tl)
|
||||
list = newList name yes
|
||||
in TaskList{visibleTasks=list, invisibleTasks=no}
|
||||
renderRow :: Maybe (B.Widget n) -> Bool -> LTask -> B.Widget n
|
||||
renderRow (Just w) True _ = w
|
||||
renderRow _ _ lt = renderTask (toTask lt)
|
||||
|
||||
taskListSelectedElement :: TaskList n -> Maybe Task
|
||||
taskListSelectedElement tl = toTask . snd <$> B.listSelectedElement (visibleTasks tl)
|
||||
renderLast :: (Ord n, Show n) => B.Widget n -> Bool -> B.List n LTask -> B.Widget n
|
||||
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
|
||||
taskListModify f tl =
|
||||
let list = B.listModify (modifyLTask f) (visibleTasks tl)
|
||||
in tl{visibleTasks=list}
|
||||
renderTaskList :: (Ord n, Show n) => Maybe (TaskEdit n) -> Bool -> TaskList n -> B.Widget n
|
||||
renderTaskList Nothing focus (TaskList list)
|
||||
| listSize list == 0 = renderLast (B.str "--- empty ---") focus 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.UI.Popup
|
||||
import TaskMachine.UI.Task
|
||||
import TaskMachine.UI.TaskEdit
|
||||
import TaskMachine.UI.TaskList
|
||||
|
||||
-- | Resource names
|
||||
|
|
@ -36,7 +37,7 @@ data UIState = UIState
|
|||
{ options :: Options -- includes todo file and other config
|
||||
, errorPopup :: Maybe (Popup RName (UIState -> NewState))
|
||||
, tasks :: TaskList RName
|
||||
, taskEdit :: Maybe (B.Editor String RName)
|
||||
, editor :: Maybe (TaskEdit RName)
|
||||
}
|
||||
|
||||
type NewState = B.EventM RName (B.Next UIState)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue