diff --git a/src/TaskMachine/UI.hs b/src/TaskMachine/UI.hs index 60148a9..1c1d375 100644 --- a/src/TaskMachine/UI.hs +++ b/src/TaskMachine/UI.hs @@ -5,103 +5,44 @@ module TaskMachine.UI ) where import qualified Brick as B -import qualified Brick.Focus as B import qualified Brick.Themes as B import qualified Data.Vector as V import qualified Graphics.Vty.Input.Events as VTY -import TaskMachine.LTask import TaskMachine.Options import TaskMachine.UI.Behaviors.TaskEdit import TaskMachine.UI.Behaviors.TaskList -import TaskMachine.UI.Popup import TaskMachine.UI.TaskList import TaskMachine.UI.Types {- Rendering -} -placeholderTopBar :: B.Widget n -placeholderTopBar = B.str "Prune | Reload | Search: " B.<+> B.vLimit 1 (B.fill '_') - -placeholderNewTask :: B.Widget RName -placeholderNewTask = B.str "New: " B.<+> B.vLimit 1 (B.fill '_') - -drawTaskList :: Bool -> UIState -> B.Widget RName -drawTaskList focused s = renderTaskList (taskEdit s) focused (tasks s) - -drawBaseLayer :: UIState -> B.Widget RName -drawBaseLayer s = B.vBox [placeholderTopBar, drawTaskList True s, placeholderNewTask] +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, drawBaseLayer s] -drawUIState s = [drawBaseLayer s] - -{- Actions -} - -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} - Right ltasks -> pure s{tasks=taskList RTaskList ltasks} +--drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawTaskList s] +drawUIState s = [drawTaskList s] {- Updating the state -} -rootBehavior :: UIState -> VTY.Event -> NewState -rootBehavior s _ = B.continue s - 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 -focusBehavior :: (UIState -> VTY.Event -> NewState) -> UIState -> VTY.Event -> NewState -focusBehavior _ s (VTY.EvKey (VTY.KChar '\t') []) = B.continue $ bigFocusNext s -focusBehavior _ s (VTY.EvKey VTY.KBackTab []) = B.continue $ bigFocusPrev s -focusBehavior f s e = f s e -- wrapper around another behavior - 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 popup} e = undefined popup 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 = - case B.focusGetCurrent (focus s) of - Just BRTopBar -> closeBehavior (focusBehavior rootBehavior) s e - Just BRTaskList -> closeBehavior (focusBehavior taskListBehavior) s e - Just BRNewTask -> closeBehavior (focusBehavior rootBehavior) s e - Nothing -> closeBehavior (focusBehavior rootBehavior) s e +selectBehavior s e = closeBehavior taskListBehavior s e updateUIState :: UIState -> B.BrickEvent RName () -> NewState updateUIState s (B.VtyEvent e) = selectBehavior s e updateUIState s _ = B.continue s -{- -updateUIState :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) --- Closing error popup -updateUIState s@UIState{errorPopup=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue s{errorPopup=Nothing} -updateUIState s@UIState{errorPopup=Just _} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.continue s{errorPopup=Nothing} ---updateUIState s@UIState{errorPopup=Just p} (B.VtyEvent e) = do --- newPopup <- handlePopupEvent e p --- B.continue s{errorPopup=Just newPopup} -updateUIState s e = - case B.focusGetCurrent (focus s) of - Nothing -> B.halt s - (Just BRTopBar) -> placeholderUpdate s e - --(Just BRTaskList) -> updateTaskList s e - (Just BRTaskList) -> placeholderUpdate s e - (Just BRNewTask) -> placeholderUpdate s e - -placeholderUpdate :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) -placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.halt s -placeholderUpdate s (B.VtyEvent (VTY.EvKey (VTY.KChar '\t') [])) = B.continue $ bigFocusNext s -placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KBackTab [])) = B.continue $ bigFocusPrev s -placeholderUpdate s _ = B.continue s --} - {- Starting the app -} myApp :: B.App UIState () RName @@ -116,8 +57,7 @@ myApp = B.App startUIState :: Options -> UIState startUIState o = UIState { options = o - , focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar] - , errorPopup = Nothing + --, errorPopup = Nothing , tasks = taskList RTaskList V.empty , taskEdit = Nothing } diff --git a/src/TaskMachine/UI/Behaviors/TaskEdit.hs b/src/TaskMachine/UI/Behaviors/TaskEdit.hs index b251cf4..dc495fb 100644 --- a/src/TaskMachine/UI/Behaviors/TaskEdit.hs +++ b/src/TaskMachine/UI/Behaviors/TaskEdit.hs @@ -28,7 +28,7 @@ taskEditBehavior edit s (VTY.EvKey VTY.KHome []) = B.continue s{taskEdit=Just ( 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 $ saveUIState newState + liftIO $ saveTasks newState B.continue newState taskEditBehavior edit s e = do newEdit <- B.handleEditorEvent e edit diff --git a/src/TaskMachine/UI/TaskList.hs b/src/TaskMachine/UI/TaskList.hs index d1bb3aa..4423904 100644 --- a/src/TaskMachine/UI/TaskList.hs +++ b/src/TaskMachine/UI/TaskList.hs @@ -9,23 +9,15 @@ module TaskMachine.UI.TaskList , taskListModify ) where ---import Data.Void - 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 qualified Brick.Focus as B ---import qualified Data.Text.Zipper as T ---import Text.Megaparsec import TaskMachine.LTask import TaskMachine.Task import TaskMachine.UI.Task ---import TaskMachine.Options ---import TaskMachine.UI.Popup ---import TaskMachine.UI.Types data TaskList n = TaskList { visibleTasks :: B.List n LTask @@ -69,165 +61,3 @@ taskListModify :: (Task -> Task) -> TaskList n -> TaskList n taskListModify f tl = let list = B.listModify (modifyLTask f) (visibleTasks tl) in tl{visibleTasks=list} - -{- -{- Managing the tasks -} - -allTasks :: UIState -> V.Vector LTask -allTasks s = - let visible = B.listElements $ taskList s - invisible = invisibleTasks s - in visible <> invisible - -newTaskList :: V.Vector LTask -> B.List RName LTask -newTaskList ltasks = B.list RTaskList ltasks 1 - --- TODO: Catch errors when loading tasks -loadTasks :: UIState -> IO UIState -loadTasks s = do - let file = oTodofile $ options s - result <- loadLTasks file - case result of - Left errorMessage -> pure s{errorPopup=Just $ popupOk "Error loading tasks" errorMessage} - Right ltasks -> pure s{taskList=newTaskList ltasks, invisibleTasks=V.empty} - --- TODO: Catch errors when saving tasks -saveTasks :: UIState -> IO UIState -saveTasks s = do - let file = oTodofile $ options s - ltasks = allTasks s - saveLTasks file ltasks - pure s - -filterTasks :: (Task -> Bool) -> UIState -> UIState -filterTasks f s = - let (yes, no) = V.partition (f . toTask) (allTasks s) - in s{taskList=newTaskList yes, invisibleTasks=no} - -{- Rendering -} - -renderLTask :: Maybe (B.Editor String RName) -> Bool -> LTask -> B.Widget RName -renderLTask _ False ltask = renderTask $ toTask ltask -renderLTask Nothing True ltask = renderTask $ toTask ltask -renderLTask _ _ _ = undefined ---renderLTask (Just edit) True _ = B.renderEditor (B.str . unlines) True edit - -renderTaskList :: UIState -> B.Widget RName -renderTaskList s = - let inFocus = B.focusGetCurrent (focus s) == Just BRTaskList - in B.renderList (renderLTask Nothing) inFocus (taskList s) - -{- Updating state -} - -taskListBehavior :: UIState -> VTY.Event -> NewState -taskListBehavior = undefined - -updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) -updateTaskList = undefined --} - -{- -widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n -widgetPriority _ Nothing = B.emptyWidget -widgetPriority highlight (Just prio) = - let attrName = highlight <> "priority" <> B.attrName [priorityToChar prio] - text = formatPriority prio ++ " " - in B.withAttr attrName $ B.str text - -widgetDescription :: B.AttrName -> String -> B.Widget n -widgetDescription highlight desc = - let attrName = highlight <> "description" - in B.withAttr attrName $ B.str desc - -renderLTask :: Bool -> LTask -> B.Widget RName -renderLTask highlight (LTask _ Task{..}) = - let attrHighlight = if highlight then "highlight" else "normal" - wCompleted = B.str $ if taskCompleted then "x " else " " - wPriority = widgetPriority attrHighlight taskPriority - wDescription = widgetDescription attrHighlight taskDescription - in B.hBox [wCompleted, wPriority, wDescription] --} - ---type Editor = B.Editor String RName ---type TaskList = B.List RName LTask - -{- Editing tasks -} - -{- -toEditText :: Task -> String -toEditText Task{taskPriority=Nothing, taskDescription=d} = descriptionToString d -toEditText Task{taskPriority=Just p, taskDescription=d} = formatPriority p ++ " " ++ descriptionToString d - -pEditText :: Parser (Maybe Priority, String) -pEditText = undefined ---pEditText = do --- prio <- maybeParse (andSpace pPriority) --- notFollowedBy (andSpace pDates) --- desc <- untilEndOfLine --- pure (prio, desc) - -parseEditText :: String -> Either (ParseError Char Void) (Maybe Priority, String) -parseEditText = parse pEditText "edited task" --} - -{- Updating state -} - -{- -startEdit :: UIState -> UIState -startEdit s = - case B.listSelectedElement (taskList s) of - Nothing -> s - Just (_, LTask _ t) -> - let edit = B.editor RTaskEdit (Just 1) (toEditText t) - in s{taskEdit=Just edit} - -finishEdit :: UIState -> UIState -finishEdit s@UIState{taskEdit=Just edit} = - case B.getEditContents edit of - [line] -> case parseEditText line of - Right (prio, desc) -> - --let changeTask (LTask n t) = LTask n t{taskPriority=prio, taskDescription=desc} - let changeTask (LTask n t) = LTask n t{taskPriority=prio, taskDescription=undefined desc} - newList = B.listModify changeTask (taskList s) - in s{taskList=newList, taskEdit=Nothing} - - Left parseError -> s{errorPopup=Just $ popup "Parse error" (parseErrorTextPretty parseError)} - _ -> s{errorPopup=Just $ popup "Empty editor" "Enter a task description."} -finishEdit s = s - -updateEditor :: B.Editor String RName -> VTY.Event -> B.EventM RName (B.Editor String RName) -updateEditor edit (VTY.EvKey VTY.KHome []) = pure $ B.applyEdit T.gotoBOL edit -updateEditor edit (VTY.EvKey VTY.KEnd []) = pure $ B.applyEdit T.gotoEOL edit -updateEditor edit e = B.handleEditorEvent e edit - -updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) --- Exit application -updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.halt s - --- Test stuff -updateTaskList s e = do - let changeTask (LTask n t) = LTask n t{taskDescription=show e} - newList = B.listModify changeTask (taskList s) - B.continue s{taskList=newList} - --- Scroll focus -updateTaskList s (B.VtyEvent (VTY.EvKey VTY.KBackTab [])) = B.continue $ bigFocusPrev s -updateTaskList s (B.VtyEvent (VTY.EvKey (VTY.KChar '\t') [])) = B.continue $ bigFocusNext s --- Start editing the current task -updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent (VTY.EvKey (VTY.KChar 'e') [])) = B.continue $ startEdit s --- Update the task list -updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent e) = do - newList <- B.handleListEventVi B.handleListEvent e (taskList s) - B.continue s{taskList=newList} --- Exit the editor (losing all changes) -updateTaskList s@UIState{taskEdit=Just _} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.continue $ s{taskEdit=Nothing} --- Exit the editor (keeping all changes) -updateTaskList s@UIState{taskEdit=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue $ finishEdit s --- Update the editor -updateTaskList s@UIState{taskEdit=Just edit} (B.VtyEvent e) = do - newTaskEdit <- updateEditor edit e - B.continue s{taskEdit=Just newTaskEdit} --- Catch everything else -updateTaskList s _ = B.halt s ---updateTaskList list (Just editor) (B.VtyEvent e) = (,) <$> const list <*> B.handleEditorEvent e editor --} diff --git a/src/TaskMachine/UI/Types.hs b/src/TaskMachine/UI/Types.hs index 157d7de..7500ea7 100644 --- a/src/TaskMachine/UI/Types.hs +++ b/src/TaskMachine/UI/Types.hs @@ -6,151 +6,43 @@ module TaskMachine.UI.Types ( RName(..) - , BigRing(..) - --, SmallRing(..) - -- * Popups - --, Popup - --, popup - --, renderPopup - --, handlePopupEvent -- * UI state , UIState(..) , NewState - , bigFocusNext, bigFocusPrev - --, smallFocusNext, smallFocusPrev , defaultTheme - , saveUIState + , loadTasks + , saveTasks ) where import qualified Brick as B -import qualified Brick.Focus as B import qualified Brick.Themes as B import qualified Brick.Widgets.Dialog as B import qualified Brick.Widgets.Edit as B import qualified Brick.Widgets.List as B import qualified Graphics.Vty as VTY ---import qualified Data.Vector as V import TaskMachine.LTask import TaskMachine.Options -import TaskMachine.UI.Popup import TaskMachine.UI.Task import TaskMachine.UI.TaskList -- | Resource names data RName - = RSearchEdit - | RTaskList + = RTaskList | RTaskEdit - | RNewEdit deriving (Eq, Show, Ord) -data BigRing - = BRTopBar - | BRTaskList - | BRNewTask - deriving (Eq) - -{- -data SmallRing - = SRPurge - | SRReload - | SRSearch - deriving (Eq) --} - -{- Popup -} - -{- -data Popup = Popup (B.Dialog ()) (B.Widget RName) - -popup :: String -> String -> Popup -popup title content = - let dialog = B.dialog (Just title) (Just (0,[("OK",())])) 70 -- with a min terminal width of 80 - widget = B.str content - in Popup dialog widget - -renderPopup :: Popup -> B.Widget RName -renderPopup (Popup dialog widget) = B.renderDialog dialog widget - -handlePopupEvent :: VTY.Event -> Popup -> B.EventM RName Popup -handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialog <*> pure widget --} - {- UI state -} data UIState = UIState - { options :: Options -- includes todo file and other config - , focus :: B.FocusRing BigRing -- focus on the top, middle or bottom part - - -- popups - , errorPopup :: Maybe (PopupOk RName) - - -- tasks - , tasks :: TaskList RName - , taskEdit :: Maybe (B.Editor String RName) + { options :: Options -- includes todo file and other config + --, errorPopup :: Maybe (PopupOk RName) + , tasks :: TaskList RName + , taskEdit :: Maybe (B.Editor String RName) } type NewState = B.EventM RName (B.Next UIState) - - - - - - -{- - , focus :: B.FocusRing BigRing - -- ^ 'B.FocusRing' for tab navigation - --, focusTopBar :: B.FocusRing SmallRing - -- ^ 'B.FocusRing' for the top bar, for ← and → arrow key navigation - , errorPopup :: Maybe Popup - - -- TOP BAR - --, searchEdit :: B.Editor String RName - -- ^ Content of the search field - - -- TASK LIST - , taskList :: B.List RName LTask - -- ^ List to display tasks - , invisibleTasks :: V.Vector LTask - -- ^ All tasks that aren't displayed in the taskList due to search filters - , taskEdit :: Maybe (B.Editor String RName) - -- ^ Task currently being edited - - -- NEW TASK - --, newEdit :: B.Editor String RName - -- ^ "New task" text field at the bottom - } - --- | Create a starting UI state -startUIState :: V.Vector LTask -> UIState -startUIState ltasks = UIState - { focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar] - --, focusTopBar = B.focusRing [SRPrune, SRReload, SRSearch] - , errorPopup = Nothing - --, searchEdit = B.editor RSearchEdit (Just 1) "" - , taskList = B.list RTaskList ltasks 1 - , invisibleTasks = V.empty - , taskEdit = Nothing - --, newEdit = B.editor RNewEdit (Just 1) "" - } --} - -bigFocusNext :: UIState -> UIState -bigFocusNext s = s{focus=B.focusNext (focus s)} - -bigFocusPrev :: UIState -> UIState -bigFocusPrev s = s{focus=B.focusPrev (focus s)} - -{- -smallFocusNext :: UIState -> UIState -smallFocusNext s = s{focusTopBar=B.focusNext (focusTopBar s)} - -smallFocusPrev :: UIState -> UIState -smallFocusPrev s = s{focusTopBar=B.focusPrev (focusTopBar s)} --} - defaultTheme :: B.Theme defaultTheme = B.newTheme VTY.defAttr [ (B.dialogAttr, none) @@ -182,8 +74,18 @@ defaultTheme = B.newTheme VTY.defAttr st' = VTY.withStyle none none = VTY.defAttr -saveUIState :: UIState -> IO () -saveUIState s = do +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