Garmelon/task-machine
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add basic task editing

Browse source
This commit is contained in:
Joscha 2018-09-17 16:21:26 +00:00
parent 902c23eb83
commit 133b0ca9ed
7 changed files with 156 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/TaskMachine/LTask.hs
View file

@ -7,8 +7,8 @@ module TaskMachine.LTask
, saveLTasks
) where
import Data.List
import Data.Function
import Data.Function
import Data.List
import qualified Data.Vector as V
@ -29,7 +29,7 @@ loadLTasks :: FilePath -> IO (Either String (V.Vector LTask))
loadLTasks file = do
content <- readFile file
case parseTasks file content of
Right taskList -> pure $ Right $ V.fromList $ fromTasks taskList
Right taskList -> pure $ Right $ V.fromList $ fromTasks taskList
Left parseError -> pure $ Left $ show parseError
saveLTasks :: V.Vector LTask -> FilePath -> IO ()

55
src/TaskMachine/Todotxt.hs
View file

@ -16,19 +16,22 @@ module TaskMachine.Todotxt
, charToPriority
-- * Parsing
, Parser
, task
, tasks
, day
, dates
, priorityChar
, priority
, pTask
, pTasks
, pDay
, pDates
, pPriorityChar
, pPriority
, andSpace
, maybeParse
, untilEndOfLine
) where
import Control.Monad
import Data.List.NonEmpty
import Data.Void
import Data.Set as Set
import Data.Set as Set
import Data.Time.Calendar
import Text.Megaparsec
import Text.Megaparsec.Char
@ -48,8 +51,8 @@ formatDates (CoCrDate cr co) = show cr ++ " " ++ show co
{- Dates parsing -}
day :: Parser Day
day = label "date" $ fromGregorian
pDay :: Parser Day
pDay = label "date" $ fromGregorian
<$> integer
<*> (char '-' *> int)
<*> (char '-' *> int)
@ -59,13 +62,13 @@ day = label "date" $ fromGregorian
int :: Parser Int
int = read <$> count 2 digitChar
dates :: Parser Dates
dates = try datesCrCo <|> datesCr
pDates :: Parser Dates
pDates = try datesCrCo <|> datesCr
where
datesCrCo :: Parser Dates
datesCrCo = CoCrDate <$> (day <* char ' ') <*> day
datesCrCo = CoCrDate <$> (pDay <* char ' ') <*> pDay
datesCr :: Parser Dates
datesCr = CrDate <$> day
datesCr = CrDate <$> pDay
{- Priority -}
@ -93,16 +96,16 @@ formatPriority p = '(' : priorityToChar p : ")"
{- Priority parsing -}
priorityChar :: Parser Priority
priorityChar = do
pPriorityChar :: Parser Priority
pPriorityChar = do
c <- anyChar
case charToPriority c of
Just p -> pure p
Nothing -> failure (Just $ Tokens $ c :| [])
(Set.singleton $ Label $ 'p' :| "riority character")
priority :: Parser Priority
priority = char '(' *> priorityChar <* char ')'
pPriority :: Parser Priority
pPriority = char '(' *> pPriorityChar <* char ')'
{- Task -}
@ -118,14 +121,14 @@ data Task = Task
-- show = formatTask
formatTask :: Task -> String
formatTask (Task done prio tDates desc)
formatTask (Task done prio dates desc)
= (if done then "x " else "")
++ maybe "" ((++" ") . formatPriority) prio
++ maybe "" ((++" ") . formatDates) tDates
++ maybe "" ((++" ") . formatDates) dates
++ desc
parseTasks :: FilePath -> String -> Either (ParseError Char Void) [Task]
parseTasks = parse tasks -- hehe
parseTasks = parse pTasks -- hehe
{- Task parsing -}
@ -144,12 +147,12 @@ maybeParse p = (Just <$> try p) <|> pure Nothing
untilEndOfLine :: Parser String
untilEndOfLine = takeWhile1P (Just "description") (/='\n')
task :: Parser Task
task = Task
pTask :: Parser Task
pTask = Task
<$> boolParse (andSpace completed)
<*> maybeParse (andSpace priority)
<*> maybeParse (andSpace dates)
<*> maybeParse (andSpace pPriority)
<*> maybeParse (andSpace pDates)
<*> untilEndOfLine
tasks :: Parser [Task]
tasks = many $ task <* (eof <|> void (char '\n'))
pTasks :: Parser [Task]
pTasks = many $ pTask <* (eof <|> void (char '\n'))

23
src/TaskMachine/UI.hs
View file

@ -44,21 +44,24 @@ Edit _____________________________
-- * warn if file only readable
-- [_] display loaded tasks in UI
drawBaseLayer :: UIState -> B.Widget RName
drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList s, placeholderNewTask]
drawUIState :: UIState -> [B.Widget RName]
drawUIState s =
let wTopBar = const placeholderTopBar
wTaskList = renderTaskList (taskList s) (taskEdit s)
wNewTask = const placeholderNewTask
in pure $ case B.focusGetCurrent (focus s) of
Nothing -> B.vBox [wTopBar False, wTaskList False, wNewTask False] -- should never happen
(Just BRTopBar) -> B.vBox [wTopBar True, wTaskList False, wNewTask False]
(Just BRTaskList) -> B.vBox [wTopBar False, wTaskList True, wNewTask False]
(Just BRNewTask) -> B.vBox [wTopBar False, wTaskList False, wNewTask True ]
drawUIState s@UIState{errorPopup=Just p} = [renderPopup p, drawBaseLayer s]
drawUIState s = [drawBaseLayer s]
updateUIState :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
-- Closing any popups
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}
-- If there's no password
updateUIState s e =
case B.focusGetCurrent (focus s) of
Nothing -> undefined
Nothing -> B.halt s
(Just BRTopBar) -> placeholderUpdate s e
(Just BRTaskList) -> updateTaskList s e
(Just BRNewTask) -> placeholderUpdate s e

86
src/TaskMachine/UI/TaskList.hs
View file

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

2
src/TaskMachine/UI/TopBar.hs
View file

@ -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 '_')

52
src/TaskMachine/UI/Types.hs
View file

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