diff --git a/app/Main.hs b/app/Main.hs index 1c3dee1..493fc17 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,14 +2,12 @@ module Main where import Control.Monad -import qualified Brick as B +import qualified Brick as B import TaskMachine.Options import TaskMachine.UI -import TaskMachine.UI.TaskList main :: IO() main = do o <- parseOptions - state <- loadTasks (startUIState o) - void $ B.defaultMain myApp state + void $ B.defaultMain myApp (startUIState o) diff --git a/src/TaskMachine/LTask.hs b/src/TaskMachine/LTask.hs index 076c043..1ad58a7 100644 --- a/src/TaskMachine/LTask.hs +++ b/src/TaskMachine/LTask.hs @@ -14,6 +14,7 @@ module TaskMachine.LTask , toTask , fromTasks , toTasks + , modifyLTask , sortLTasks , loadLTasks , saveLTasks @@ -47,6 +48,9 @@ fromTasks = zipWith LTask (map Old [1..]) toTasks :: [LTask] -> [Task] toTasks = map toTask . sortLTasks +modifyLTask :: (Task -> Task) -> LTask -> LTask +modifyLTask f (LTask pos task) = LTask pos (f task) + sortLTasks :: [LTask] -> [LTask] sortLTasks = sortBy (compare `on` lPosition) diff --git a/src/TaskMachine/UI.hs b/src/TaskMachine/UI.hs index c792342..2609c41 100644 --- a/src/TaskMachine/UI.hs +++ b/src/TaskMachine/UI.hs @@ -16,13 +16,41 @@ import TaskMachine.UI.TaskList import TaskMachine.UI.TopBar import TaskMachine.UI.Types +{- Rendering -} + drawBaseLayer :: UIState -> B.Widget RName -drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList s, placeholderNewTask] +drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList True (tasks s), placeholderNewTask] drawUIState :: UIState -> [B.Widget RName] drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s] drawUIState s = [drawBaseLayer 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 -> Result) -> UIState -> VTY.Event -> Result +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 +selectBehavior s@UIState{errorPopup=Just popup} e = undefined popup s e +selectBehavior s e = closeBehavior rootBehavior 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} @@ -43,6 +71,7 @@ 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 -} @@ -60,6 +89,5 @@ startUIState o = UIState { options = o , focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar] , errorPopup = Nothing - , taskList = newTaskList V.empty - , invisibleTasks = V.empty + , tasks = taskList RTaskList V.empty } diff --git a/src/TaskMachine/UI/TaskList.hs b/src/TaskMachine/UI/TaskList.hs index 796ffce..ec74a2a 100644 --- a/src/TaskMachine/UI/TaskList.hs +++ b/src/TaskMachine/UI/TaskList.hs @@ -1,25 +1,67 @@ -{-# LANGUAGE OverloadedStrings #-} - -module TaskMachine.UI.TaskList where +module TaskMachine.UI.TaskList + ( TaskList + , taskList + , renderTaskList + , taskListElements + , taskListFilter + , taskListSelectedElement + , taskListModify + ) where --import Data.Void -import qualified Brick as B -import qualified Brick.Widgets.List as B -import qualified Data.Vector as V -import qualified Brick.Focus as B -import qualified Brick.Widgets.Edit as B +import qualified Brick as B +import qualified Brick.Widgets.List as B +import qualified Data.Vector as V +--import qualified Brick.Focus 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.LTask -import TaskMachine.Options import TaskMachine.Task -import TaskMachine.UI.Types import TaskMachine.UI.Task -import TaskMachine.UI.Popup +--import TaskMachine.Options +--import TaskMachine.UI.Popup +--import TaskMachine.UI.Types +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 + +taskList :: n -> V.Vector LTask -> TaskList n +taskList name ltasks = TaskList{visibleTasks=newList name ltasks, invisibleTasks=V.empty} + +-- TODO: render while editing +renderTaskList :: (Ord n, Show n) => Bool -> TaskList n -> B.Widget n +renderTaskList focus tl = B.renderList (const $ renderTask . toTask) focus (visibleTasks tl) + +{- Managing tasks -} + +taskListElements :: TaskList n -> V.Vector LTask +taskListElements tl = B.listElements (visibleTasks tl) <> invisibleTasks tl + +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} + +taskListSelectedElement :: TaskList n -> Maybe Task +taskListSelectedElement tl = toTask . snd <$> B.listSelectedElement (visibleTasks tl) + +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 @@ -68,8 +110,12 @@ renderTaskList 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 diff --git a/src/TaskMachine/UI/Types.hs b/src/TaskMachine/UI/Types.hs index 5069920..a73063b 100644 --- a/src/TaskMachine/UI/Types.hs +++ b/src/TaskMachine/UI/Types.hs @@ -15,23 +15,26 @@ module TaskMachine.UI.Types --, handlePopupEvent -- * UI state , UIState(..) + , NewState , bigFocusNext, bigFocusPrev --, smallFocusNext, smallFocusPrev , defaultTheme ) where -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 Data.Vector as V -import qualified Graphics.Vty as VTY +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.LTask import TaskMachine.Options import TaskMachine.UI.Popup import TaskMachine.UI.Task +import TaskMachine.UI.TaskList -- | Resource names data RName @@ -76,15 +79,17 @@ handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialo {- 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 - , errorPopup :: Maybe (PopupOk RName) + { 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 - , taskList :: B.List RName LTask - , invisibleTasks :: V.Vector LTask + , tasks :: TaskList RName } +type NewState = B.EventM RName (B.Next UIState)