Clean up old stuff

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
+drawTaskList :: UIState -> B.Widget RName
-placeholderTopBar = B.str "Prune | Reload | Search: " B.<+> B.vLimit 1 (B.fill '_')
+drawTaskList s = renderTaskList (taskEdit s) True (tasks s)
-
-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]
 
 drawUIState :: UIState -> [B.Widget RName]
-drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s]
+--drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawTaskList s]
-drawUIState s                            = [drawBaseLayer s]
+drawUIState s                            = [drawTaskList 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}
 
 {- 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 =
+selectBehavior s e = closeBehavior taskListBehavior 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
 
 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
   }

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

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
--}

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
+  { options  :: Options -- includes todo file and other config
-  , focus      :: B.FocusRing BigRing -- focus on the top, middle or bottom part
+  --, errorPopup :: Maybe (PopupOk RName)
-
+  , tasks    :: TaskList RName
-  -- popups
+  , taskEdit :: Maybe (B.Editor String RName)
-  , errorPopup :: Maybe (PopupOk RName)
-
-  -- tasks
-  , 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 ()
+loadTasks :: UIState -> IO UIState
-saveUIState s = do
+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