Add back basic UI
This commit is contained in:
Joscha
parent
9effbd1d1b
commit
c72ca628f9
12 changed files with 616 additions and 62 deletions
8
src/TaskMachine/UI/NewTask.hs
Normal file
8
src/TaskMachine/UI/NewTask.hs
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
module TaskMachine.UI.NewTask where
|
||||
|
||||
import qualified Brick as B
|
||||
|
||||
import TaskMachine.UI.Types
|
||||
|
||||
placeholderNewTask :: B.Widget RName
|
||||
placeholderNewTask = B.str "New: " B.<+> B.vLimit 1 (B.fill '_')
|
||||
34
src/TaskMachine/UI/Popup.hs
Normal file
34
src/TaskMachine/UI/Popup.hs
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
module TaskMachine.UI.Popup
|
||||
( minPopupWidth
|
||||
-- * Ok popup
|
||||
, PopupOk
|
||||
, popupOk
|
||||
, popupOk'
|
||||
, renderPopupOk
|
||||
, handlePopupOkEvent
|
||||
) where
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.Dialog as B
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
minPopupWidth :: Int
|
||||
minPopupWidth = 70
|
||||
|
||||
{- Ok popup -}
|
||||
|
||||
data PopupOk n = PopupOk (B.Dialog ()) (B.Widget n)
|
||||
|
||||
popupOk :: String -> String -> PopupOk n
|
||||
popupOk title content = popupOk' title (B.str content)
|
||||
|
||||
popupOk' :: String -> B.Widget n -> PopupOk n
|
||||
popupOk' title widget =
|
||||
let dialog = B.dialog (Just title) (Just (0,[("Ok",())])) minPopupWidth
|
||||
in PopupOk dialog widget
|
||||
|
||||
renderPopupOk :: PopupOk n -> B.Widget n
|
||||
renderPopupOk (PopupOk dialog widget) = B.renderDialog dialog widget
|
||||
|
||||
handlePopupOkEvent :: VTY.Event -> PopupOk n -> B.EventM n (PopupOk n)
|
||||
handlePopupOkEvent e (PopupOk dialog widget) = PopupOk <$> B.handleDialogEvent e dialog <*> pure widget
|
||||
86
src/TaskMachine/UI/Task.hs
Normal file
86
src/TaskMachine/UI/Task.hs
Normal file
|
|
@ -0,0 +1,86 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module TaskMachine.UI.Task
|
||||
( renderTask
|
||||
, renderCompletion
|
||||
, renderPriority
|
||||
, renderDue
|
||||
, renderCreated
|
||||
, renderDescription
|
||||
, renderSnippet
|
||||
-- * Attributes
|
||||
, taskAttr
|
||||
, taskCompletionAttr
|
||||
, taskPriorityAttr
|
||||
, taskDueAttr
|
||||
, taskCreatedAttr
|
||||
, taskProjectAttr
|
||||
, taskContextAttr
|
||||
, taskKeyValueAttr
|
||||
) where
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
import qualified Brick as B
|
||||
import Data.Time.Calendar
|
||||
|
||||
import TaskMachine.Task
|
||||
|
||||
withSpace :: B.Widget n -> B.Widget n
|
||||
withSpace w = w B.<+> B.withDefAttr taskAttr (B.str " ")
|
||||
|
||||
renderCompletion :: Completion -> B.Widget n
|
||||
renderCompletion = B.withDefAttr taskCompletionAttr . B.str . formatCompletion
|
||||
|
||||
renderPriority :: Priority -> B.Widget n
|
||||
renderPriority p =
|
||||
let name = taskPriorityAttr <> B.attrName [priorityToChar p]
|
||||
in B.withDefAttr name $ B.str $ formatPriority p
|
||||
|
||||
renderDue :: Day -> B.Widget n
|
||||
renderDue = B.withDefAttr taskDueAttr . B.str . formatDue
|
||||
|
||||
renderCreated :: Day -> B.Widget n
|
||||
renderCreated = B.withDefAttr taskCreatedAttr . B.str . formatCreated
|
||||
|
||||
renderDescription :: Description -> B.Widget n
|
||||
renderDescription = B.withDefAttr taskAttr . B.hBox . map renderSnippet
|
||||
|
||||
renderSnippet :: Snippet -> B.Widget n
|
||||
renderSnippet s@(Project _) = B.withDefAttr taskProjectAttr $ B.str $ formatSnippet s
|
||||
renderSnippet s@(Context _) = B.withDefAttr taskContextAttr $ B.str $ formatSnippet s
|
||||
renderSnippet s@(KeyValue _ _) = B.withDefAttr taskKeyValueAttr $ B.str $ formatSnippet s
|
||||
renderSnippet s = B.str $ formatSnippet s
|
||||
|
||||
renderTask :: Task -> B.Widget n
|
||||
renderTask t = B.hBox $ catMaybes
|
||||
[ Just $ withSpace $ renderCompletion $ taskCompletion t
|
||||
, (withSpace . renderPriority) <$> taskPriority t
|
||||
, (withSpace . renderDue) <$> taskDue t
|
||||
, (withSpace . renderCreated) <$> taskCreated t
|
||||
, Just $ renderDescription $ taskDescription t
|
||||
]
|
||||
|
||||
taskAttr :: B.AttrName
|
||||
taskAttr = "task"
|
||||
|
||||
taskCompletionAttr :: B.AttrName
|
||||
taskCompletionAttr = taskAttr <> "completion"
|
||||
|
||||
taskPriorityAttr :: B.AttrName
|
||||
taskPriorityAttr = taskAttr <> "priority"
|
||||
|
||||
taskDueAttr :: B.AttrName
|
||||
taskDueAttr = taskAttr <> "due"
|
||||
|
||||
taskCreatedAttr :: B.AttrName
|
||||
taskCreatedAttr = taskAttr <> "created"
|
||||
|
||||
taskProjectAttr :: B.AttrName
|
||||
taskProjectAttr = taskAttr <> "project"
|
||||
|
||||
taskContextAttr :: B.AttrName
|
||||
taskContextAttr = taskAttr <> "context"
|
||||
|
||||
taskKeyValueAttr :: B.AttrName
|
||||
taskKeyValueAttr = taskAttr <> "keyvalue"
|
||||
178
src/TaskMachine/UI/TaskList.hs
Normal file
178
src/TaskMachine/UI/TaskList.hs
Normal file
|
|
@ -0,0 +1,178 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module TaskMachine.UI.TaskList 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 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
|
||||
|
||||
{- 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 -}
|
||||
|
||||
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
|
||||
-}
|
||||
6
src/TaskMachine/UI/TopBar.hs
Normal file
6
src/TaskMachine/UI/TopBar.hs
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
module TaskMachine.UI.TopBar where
|
||||
|
||||
import qualified Brick as B
|
||||
|
||||
placeholderTopBar :: B.Widget n
|
||||
placeholderTopBar = B.str "Prune | Reload | Search: " B.<+> B.vLimit 1 (B.fill '_')
|
||||
176
src/TaskMachine/UI/Types.hs
Normal file
176
src/TaskMachine/UI/Types.hs
Normal file
|
|
@ -0,0 +1,176 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | A collection of types necessary for the UI.
|
||||
--
|
||||
-- These were put in a separate module to avoid an import cycle.
|
||||
|
||||
module TaskMachine.UI.Types
|
||||
( RName(..)
|
||||
, BigRing(..)
|
||||
--, SmallRing(..)
|
||||
-- * Popups
|
||||
--, Popup
|
||||
--, popup
|
||||
--, renderPopup
|
||||
--, handlePopupEvent
|
||||
-- * UI state
|
||||
, UIState(..)
|
||||
, 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 TaskMachine.LTask
|
||||
import TaskMachine.Options
|
||||
import TaskMachine.UI.Popup
|
||||
import TaskMachine.UI.Task
|
||||
|
||||
-- | Resource names
|
||||
data RName
|
||||
= RSearchEdit
|
||||
| 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
|
||||
, errorPopup :: Maybe (PopupOk RName)
|
||||
|
||||
-- tasks
|
||||
, taskList :: B.List RName LTask
|
||||
, invisibleTasks :: V.Vector LTask
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{-
|
||||
, 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)
|
||||
, (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)
|
||||
, (taskAttr, none)
|
||||
, (taskCompletionAttr, none)
|
||||
, (taskPriorityAttr, fg VTY.cyan $ st' VTY.bold)
|
||||
, (taskPriorityAttr <> "A", fg VTY.red $ st' VTY.bold)
|
||||
, (taskPriorityAttr <> "B", fg VTY.yellow $ st' VTY.bold)
|
||||
, (taskPriorityAttr <> "C", fg VTY.green $ st' VTY.bold)
|
||||
, (taskDueAttr, fg' VTY.brightBlack)
|
||||
, (taskCreatedAttr, fg' VTY.brightBlack)
|
||||
, (taskProjectAttr, fg' VTY.yellow)
|
||||
, (taskContextAttr, fg' VTY.cyan)
|
||||
, (taskKeyValueAttr, fg' VTY.magenta)
|
||||
]
|
||||
where
|
||||
fg = flip VTY.withForeColor
|
||||
bg = flip VTY.withBackColor
|
||||
--st = flip VTY.withStyle
|
||||
fg' = VTY.withForeColor none
|
||||
bg' = VTY.withBackColor none
|
||||
st' = VTY.withStyle none
|
||||
none = VTY.defAttr
|
||||
Loading…
Add table
Add a link
Reference in a new issue