Clean up old stuff

This commit is contained in:
Joscha 2018-09-29 11:11:58 +00:00
parent efeeef39eb
commit 55e12992b3
4 changed files with 27 additions and 355 deletions

View file

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

View file

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

View file

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