Add basic task editing
This commit is contained in:
Joscha
parent
902c23eb83
commit
133b0ca9ed
7 changed files with 156 additions and 69 deletions
|
|
@ -1,12 +1,16 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module TaskMachine.UI.TaskList where
|
||||
|
||||
import Data.Void
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Focus 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.Text.Zipper as T
|
||||
import qualified Graphics.Vty as VTY
|
||||
import Text.Megaparsec
|
||||
|
||||
import TaskMachine.LTask
|
||||
import TaskMachine.Todotxt
|
||||
|
|
@ -40,28 +44,73 @@ renderLTask highlight (LTask _ Task{..}) =
|
|||
{- Rendering -}
|
||||
|
||||
renderLTask :: Maybe (B.Editor String RName) -> Bool -> LTask -> B.Widget RName
|
||||
renderLTask _ False (LTask _ t) = B.withAttr "normal" $ B.str $ formatTask t
|
||||
renderLTask Nothing True (LTask _ t) = B.withAttr "highlight" $ B.str $ formatTask t
|
||||
renderLTask (Just edit) True _ = B.withAttr "highlight" $ B.renderEditor (B.str . unlines) True edit
|
||||
renderLTask _ False (LTask _ t) = B.str $ formatTask t
|
||||
renderLTask Nothing True (LTask _ t) = B.str $ formatTask t
|
||||
renderLTask (Just edit) True _ = B.renderEditor (B.str . unlines) True edit
|
||||
|
||||
renderTaskList :: B.List RName LTask -> Maybe (B.Editor String RName) -> Bool -> B.Widget RName
|
||||
renderTaskList taskList edit focus = B.renderList (renderLTask edit) focus taskList
|
||||
renderTaskList :: UIState -> B.Widget RName
|
||||
renderTaskList s =
|
||||
let inFocus = B.focusGetCurrent (focus s) == Just BRTaskList
|
||||
in B.renderList (renderLTask (taskEdit s)) inFocus (taskList s)
|
||||
|
||||
{- Editing tasks -}
|
||||
|
||||
toEditText :: Task -> String
|
||||
toEditText Task{taskPriority=Nothing, taskDescription=d} = d
|
||||
toEditText Task{taskPriority=Just p, taskDescription=d} = formatPriority p ++ " " ++ d
|
||||
|
||||
pEditText :: Parser (Maybe Priority, String)
|
||||
pEditText = (,) <$> maybeParse (andSpace pPriority) <*> untilEndOfLine
|
||||
|
||||
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}
|
||||
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
|
||||
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') [])) =
|
||||
case B.listSelectedElement (taskList s) of
|
||||
Nothing -> B.continue s
|
||||
Just (_, (LTask _ t)) ->
|
||||
let edit = B.editor RTaskEdit (Just 1) ("- editor test -" ++ formatTask t)
|
||||
in B.continue s{taskEdit=Just edit}
|
||||
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)
|
||||
|
|
@ -69,14 +118,11 @@ updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent e) = do
|
|||
-- 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 [])) = do
|
||||
let changeTask (LTask n t) = LTask n t{taskDescription="hehe, changed"}
|
||||
newList = B.listModify changeTask (taskList s)
|
||||
B.continue s{taskList=newList, taskEdit=Nothing}
|
||||
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
|
||||
newEdit <- B.handleEditorEvent e edit
|
||||
B.continue s{taskEdit=Just newEdit}
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
module TaskMachine.UI.TopBar where
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick as B
|
||||
|
||||
placeholderTopBar :: B.Widget n
|
||||
placeholderTopBar = B.str "Prune | Reload | Search: " B.<+> B.vLimit 1 (B.fill '_')
|
||||
|
|
|
|||
|
|
@ -8,6 +8,12 @@ module TaskMachine.UI.Types
|
|||
( RName(..)
|
||||
, BigRing(..)
|
||||
, SmallRing(..)
|
||||
-- * Popups
|
||||
, Popup
|
||||
, popup
|
||||
, renderPopup
|
||||
, handlePopupEvent
|
||||
-- * UI state
|
||||
, UIState(..)
|
||||
, startUIState
|
||||
, bigFocusNext, bigFocusPrev
|
||||
|
|
@ -15,12 +21,14 @@ module TaskMachine.UI.Types
|
|||
, defaultTheme
|
||||
) where
|
||||
|
||||
import qualified Brick.Focus as B
|
||||
import qualified Brick.Themes as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Brick.Widgets.Edit 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 Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
import TaskMachine.LTask
|
||||
|
||||
|
|
@ -44,12 +52,31 @@ data SmallRing
|
|||
| 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 -}
|
||||
|
||||
-- | The state of the program and UI
|
||||
data UIState = 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
|
||||
|
|
@ -73,6 +100,7 @@ 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
|
||||
|
|
@ -94,14 +122,20 @@ smallFocusPrev s = s{focusTopBar=B.focusPrev (focusTopBar s)}
|
|||
|
||||
defaultTheme :: B.Theme
|
||||
defaultTheme = B.newTheme VTY.defAttr
|
||||
[ ("normal" , none)
|
||||
, ("normal" <> "description", none)
|
||||
[ (B.dialogAttr, none)
|
||||
, (B.buttonAttr, none)
|
||||
, (B.buttonSelectedAttr, bg' VTY.blue)
|
||||
, (B.editAttr, none)
|
||||
, (B.editFocusedAttr, bg' VTY.blue)
|
||||
, (B.listAttr, none)
|
||||
, (B.listSelectedAttr, st' VTY.bold)
|
||||
, (B.listSelectedFocusedAttr, bg VTY.blue $ st' VTY.bold)
|
||||
, ("normal" , none)
|
||||
, ("normal" <> "priority", fg VTY.cyan $ st' VTY.bold)
|
||||
, ("normal" <> "priority" <> "A", fg VTY.red $ st' VTY.bold)
|
||||
, ("normal" <> "priority" <> "B", fg VTY.yellow $ st' VTY.bold)
|
||||
, ("normal" <> "priority" <> "C", fg VTY.green $ st' VTY.bold)
|
||||
, ("highlight", bg' VTY.blue)
|
||||
, ("highlight" <> "description", bg' VTY.blue)
|
||||
, ("highlight" <> "priority", bg VTY.blue $ fg VTY.cyan $ st' VTY.bold)
|
||||
, ("highlight" <> "priority" <> "A", bg VTY.blue $ fg VTY.red $ st' VTY.bold)
|
||||
, ("highlight" <> "priority" <> "B", bg VTY.blue $ fg VTY.yellow $ st' VTY.bold)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue