Compare commits
No commits in common. "master" and "new-format" have entirely different histories.
master
...
new-format
21 changed files with 522 additions and 640 deletions
43
LICENSE
43
LICENSE
|
|
@ -1,21 +1,30 @@
|
|||
MIT License
|
||||
Copyright Joscha Mennicken (c) 2018
|
||||
|
||||
Copyright (c) 2018 Joscha Mennicken
|
||||
All rights reserved.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Joscha Mennicken nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
|
|
|||
65
README.md
65
README.md
|
|
@ -1,7 +1,66 @@
|
|||
# task-machine
|
||||
|
||||
A TUI client for the a format inspired by [todo.txt](https://github.com/todotxt/todo.txt), written in Haskell.
|
||||
A TUI client for the [todo.txt](https://github.com/todotxt/todo.txt) format, written in Haskell,
|
||||
that supports automatically creating new tasks based on template tasks.
|
||||
|
||||
Still in development...
|
||||
For an introduction to the file format, see the [todo.txt readme](https://github.com/todotxt/todo.txt/blob/master/README.md).
|
||||
|
||||
|
||||
## Template tasks
|
||||
|
||||
Template tasks allow for automatically creating new tasks on certain dates.
|
||||
|
||||
They work by evaluating a formula for the current day.
|
||||
If the formula evaluates to `true`, a new task gets added to the current day using the template text specified.
|
||||
If it evaluates to `false`, nothing happens.
|
||||
|
||||
When creating a template task, a start date can be specified.
|
||||
In that case, the formula will be evaluated for every day from the starting date to the current date.
|
||||
|
||||
Once all tasks are added, the starting date will be set to one day after the current date automatically,
|
||||
to avoid evaluating any day twice, even if no starting date was specified initially.
|
||||
|
||||
Template tasks are inspired by Ben Crowell's [when](https://github.com/bcrowell/when) calendar program.
|
||||
|
||||
### Format
|
||||
|
||||
This is the format for template tasks.
|
||||
The square brackets `[]` indicate an optional part of the syntax.
|
||||
The curly braces `{}` are part of the syntax.
|
||||
|
||||
`# [start-date] {when-formula} [priority] template-text`
|
||||
|
||||
- The `#` signals that this line is a template task, not a normal task.
|
||||
|
||||
- *Optional*: All days from `start-date` to the current date are tested when creating new tasks.
|
||||
It should be in the `YYYY-MM-DD` format.
|
||||
If no `start-date` is specified, it is assumed to be the current date.
|
||||
|
||||
- The `when-formula` is evaluated in order to decide whether a new task should be created for a day.
|
||||
|
||||
- *Optional*: The `priority` is a regular todo.txt priority, for example `(E)`.
|
||||
|
||||
- The `template-text` is pretty much a normal task description.
|
||||
The only difference is that it supports date expressions.
|
||||
|
||||
#### Examples
|
||||
|
||||
`# 2018-09-08 {day_of_week == fri} clean the kitchen @home`
|
||||
|
||||
`# {d2018-10-20 - today >= 0} (A) daily every day up to (and including) 2018-10-20 with priority A`
|
||||
|
||||
`# {day == 20 && month == 10} Tom's birthday ({year - 1978} years old)`
|
||||
(if Tom was born on 1978-10-20)
|
||||
|
||||
### Date expression
|
||||
|
||||
***TODO***: Document properly once it's actually implemented
|
||||
|
||||
- *date* + - *number* → *date*
|
||||
- *date* - *date* → *number*
|
||||
- *number* + - \* / *number* → *number*
|
||||
- *number* == != > < >= <= *number* → *boolean*
|
||||
- *boolean* && || == != *boolean* → *boolean*
|
||||
|
||||
### When formula
|
||||
|
||||
### Template text
|
||||
|
|
|
|||
|
|
@ -10,4 +10,4 @@ import TaskMachine.UI
|
|||
main :: IO()
|
||||
main = do
|
||||
o <- parseOptions
|
||||
void $ B.defaultMain myApp $ startUIState o
|
||||
void $ B.defaultMain myApp (startUIState o)
|
||||
|
|
|
|||
Binary file not shown.
|
Before Width: | Height: | Size: 5.5 KiB |
|
|
@ -28,12 +28,11 @@ dependencies:
|
|||
#- bytestring
|
||||
- containers
|
||||
- megaparsec
|
||||
- mtl
|
||||
- optparse-applicative
|
||||
#- sqlite-simple
|
||||
#- stm
|
||||
#- text
|
||||
- text-zipper
|
||||
#- text-zipper
|
||||
- time
|
||||
#- transformers
|
||||
#- unix
|
||||
|
|
@ -48,7 +47,7 @@ library:
|
|||
source-dirs: src
|
||||
|
||||
executables:
|
||||
task-machine:
|
||||
task-machine-exe:
|
||||
main: Main.hs
|
||||
source-dirs: app
|
||||
ghc-options:
|
||||
|
|
|
|||
24
plan.txt
24
plan.txt
|
|
@ -1,24 +0,0 @@
|
|||
normal task
|
||||
- | x(completion date)
|
||||
(priority)
|
||||
(due date)
|
||||
(creation date)
|
||||
description
|
||||
|
||||
delayed task
|
||||
(start date)
|
||||
(priority)
|
||||
(due date)
|
||||
(creation date)
|
||||
description
|
||||
|
||||
on update:
|
||||
if after start date:
|
||||
turn into normal task
|
||||
|
||||
formula task
|
||||
(when formula)
|
||||
(priority)
|
||||
(due date)
|
||||
|
||||
"update":
|
||||
|
|
@ -1,72 +0,0 @@
|
|||
-- | An undo-redo history that keeps a copy of every state.
|
||||
|
||||
module TaskMachine.History
|
||||
( History
|
||||
, history
|
||||
, step
|
||||
, current
|
||||
, modify
|
||||
, undo
|
||||
, maybeUndo
|
||||
, redo
|
||||
, maybeRedo
|
||||
) where
|
||||
|
||||
data Step a b = Step a b
|
||||
|
||||
-- | Represents the history (only one branch) of some type @a@.
|
||||
--
|
||||
-- Contains backwards (ctrl+z) as well as forwards (ctrl+y or ctrl+shift+z) history,
|
||||
-- as well as the current state.
|
||||
data History a b = History [Step a b] a [Step a b]
|
||||
|
||||
-- | Create a new 'History' from a single state.
|
||||
history :: a -> History a b
|
||||
history a = History [] a []
|
||||
|
||||
-- | Add a new step to the history.
|
||||
--
|
||||
-- Any forwards history will be overwritten, as this action starts a new
|
||||
-- branch in the history tree.
|
||||
step :: a -> b -> History a b -> History a b
|
||||
step a (History xs y _) = History (Step y b : xs) a []
|
||||
|
||||
-- | Read the current state of the history.
|
||||
current :: History a -> b -> a
|
||||
current (History _ a _) = a
|
||||
|
||||
{-
|
||||
-- | Modify the current state, adding a step in the process.
|
||||
--
|
||||
-- @'modify' f h = 'step' (f $ 'current' h) h@
|
||||
modify :: (a -> a) -> History a -> History a -- not a functor!
|
||||
modify f h = step (f $ current h) h
|
||||
-}
|
||||
|
||||
-- | Jump to the previous state, remembering the future for later redos.
|
||||
--
|
||||
-- If there is no previous state, do nothing.
|
||||
undo :: History a b -> Maybe (History a b, b)
|
||||
undo (History (Step x b : xs) y zs) = Just (History xs x (Step y b : zs), b)
|
||||
undo _ = Nothing
|
||||
|
||||
{-
|
||||
-- | Like 'undo', but returns 'Nothing' if there was no previous state.
|
||||
maybeUndo :: History a -> Maybe (History a)
|
||||
maybeUndo (History (x:xs) y zs) = Just $ History xs x (y:zs)
|
||||
maybeUndo _ = Nothing
|
||||
-}
|
||||
|
||||
-- | Jump to the next state, remembering the past for later undos.
|
||||
--
|
||||
-- If there is no next state, do nothing.
|
||||
redo :: History a b -> Maybe (History a b, b)
|
||||
redo (History xs y (Step z b : zs)) = Just (History (Step y b : xs) z zs, b)
|
||||
redo _ = Nothing
|
||||
|
||||
{-
|
||||
-- | Like 'redo', but returns 'Nothing' if there was no next state.
|
||||
maybeRedo :: History a -> Maybe (History a)
|
||||
maybeRedo (History xs y (z:zs)) = Just $ History (y:xs) z zs
|
||||
maybeRedo _ = Nothing
|
||||
-}
|
||||
|
|
@ -20,12 +20,10 @@ module TaskMachine.LTask
|
|||
, saveLTasks
|
||||
) where
|
||||
|
||||
import Control.Exception
|
||||
import Data.Function
|
||||
import Data.List
|
||||
import System.IO.Error
|
||||
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Vector as V
|
||||
import Text.Megaparsec
|
||||
|
||||
import TaskMachine.Task
|
||||
|
|
@ -56,36 +54,14 @@ modifyLTask f (LTask pos task) = LTask pos (f task)
|
|||
sortLTasks :: [LTask] -> [LTask]
|
||||
sortLTasks = sortBy (compare `on` lPosition)
|
||||
|
||||
{- Loading -}
|
||||
|
||||
data ErrorAction
|
||||
= ErrorMessage String
|
||||
| IgnoreError
|
||||
deriving (Show)
|
||||
|
||||
loadErrorMessage :: IOError -> Maybe ErrorAction
|
||||
loadErrorMessage e
|
||||
| isDoesNotExistError e = Just IgnoreError
|
||||
| otherwise = Just $ ErrorMessage $ show e
|
||||
|
||||
loadLTasks :: FilePath -> IO (Either String (V.Vector LTask))
|
||||
loadLTasks file = do
|
||||
content <- tryJust loadErrorMessage $ readFile file
|
||||
case parse pTasks file <$> content of
|
||||
Left IgnoreError -> pure $ Right V.empty
|
||||
Left (ErrorMessage msg) -> pure $ Left msg
|
||||
Right (Left parseError) -> pure $ Left $ parseErrorPretty parseError
|
||||
Right (Right taskList) -> pure $ Right $ V.fromList $ fromTasks taskList
|
||||
content <- readFile file
|
||||
case parse pTasks file content of
|
||||
Right taskList -> pure $ Right $ V.fromList $ fromTasks taskList
|
||||
Left parseError -> pure $ Left $ parseErrorPretty parseError
|
||||
|
||||
{- Saving -}
|
||||
|
||||
saveErrorMessage :: IOError -> Maybe String
|
||||
saveErrorMessage e = Just $ show e
|
||||
|
||||
saveLTasks :: FilePath -> V.Vector LTask -> IO (Either String ())
|
||||
saveLTasks :: FilePath -> V.Vector LTask -> IO ()
|
||||
saveLTasks file ltasks = do
|
||||
let text = formatTasks $ toTasks $ V.toList ltasks
|
||||
result <- tryJust saveErrorMessage $ writeFile file text
|
||||
case result of
|
||||
Left ioErrorMessage -> pure $ Left ioErrorMessage
|
||||
Right _ -> pure $ Right ()
|
||||
writeFile file text
|
||||
|
|
|
|||
|
|
@ -21,12 +21,9 @@ module TaskMachine.Task
|
|||
, Description
|
||||
, Snippet(..)
|
||||
-- * Misc stuff
|
||||
, emptyTask
|
||||
, newTask
|
||||
, compareTasks
|
||||
-- * Formatting
|
||||
, formatTask
|
||||
, formatTaskHalves
|
||||
, formatTasks
|
||||
, formatDate
|
||||
, formatDue
|
||||
|
|
@ -74,23 +71,6 @@ data Task = Task
|
|||
, taskDescription :: Description
|
||||
} deriving (Show)
|
||||
|
||||
-- | Convert a 'Task' to its string representation.
|
||||
-- This string representation is split into a pre-description and a description part.
|
||||
--
|
||||
-- For further detail, see 'formatTask'
|
||||
formatTaskHalves :: Task -> (String, String)
|
||||
formatTaskHalves t =
|
||||
( formatCompletion (taskCompletion t) ++ " "
|
||||
++ maybeWithSpace formatPriority (taskPriority t)
|
||||
++ maybeWithSpace formatDue(taskDue t)
|
||||
++ maybeWithSpace formatCreated (taskCreated t)
|
||||
, formatDescription (taskDescription t)
|
||||
)
|
||||
where
|
||||
maybeWithSpace :: (a -> String) -> Maybe a -> String
|
||||
maybeWithSpace _ Nothing = ""
|
||||
maybeWithSpace f (Just a) = f a ++ " "
|
||||
|
||||
-- | Convert a 'Task' to its string representation, which can be parsed by 'pTask'.
|
||||
--
|
||||
-- If this string representation is parsed using 'pTask', it should yield the original task,
|
||||
|
|
@ -99,9 +79,16 @@ formatTaskHalves t =
|
|||
-- could include the text version of these in the beginning, i. e. @taskDescription = "(A) hello"@.
|
||||
-- In that case, converting the task to a string and back yields a different result.
|
||||
formatTask :: Task -> String
|
||||
formatTask t =
|
||||
let (predesc, desc) = formatTaskHalves t
|
||||
in predesc ++ desc
|
||||
formatTask t
|
||||
= formatCompletion (taskCompletion t) ++ " "
|
||||
++ maybeWithSpace formatPriority (taskPriority t)
|
||||
++ maybeWithSpace formatDue(taskDue t)
|
||||
++ maybeWithSpace formatCreated (taskCreated t)
|
||||
++ formatDescription (taskDescription t)
|
||||
where
|
||||
maybeWithSpace :: (a -> String) -> Maybe a -> String
|
||||
maybeWithSpace _ Nothing = ""
|
||||
maybeWithSpace f (Just a) = f a ++ " "
|
||||
|
||||
-- | Convert a list of tasks to its string representation, which can be parsed by 'pTasks'.
|
||||
formatTasks :: [Task] -> String
|
||||
|
|
@ -326,33 +313,19 @@ pTasks = many pTask <* eof
|
|||
|
||||
{- Misc stuff -}
|
||||
|
||||
emptyTask :: Task
|
||||
emptyTask = Task Incomplete Nothing Nothing Nothing []
|
||||
|
||||
-- | Create a new task with empty description and the given date as creation date
|
||||
newTask :: Day -> Task
|
||||
newTask day = Task Incomplete Nothing Nothing (Just day) []
|
||||
|
||||
-- Inverted compare for Maybes: Nothing comes after Just
|
||||
compareMaybe :: Ord a => Maybe a -> Maybe a -> Ordering
|
||||
compareMaybe Nothing Nothing = EQ
|
||||
compareMaybe (Just _) Nothing = LT
|
||||
compareMaybe Nothing (Just _) = GT
|
||||
compareMaybe (Just x) (Just y) = compare x y
|
||||
|
||||
compareDescription :: Description -> Description -> Ordering
|
||||
compareDescription = compare `on` formatDescription
|
||||
|
||||
compareTasks :: Task -> Task -> Ordering
|
||||
compareTasks a@(Task (Complete _) _ _ _ _) b@(Task (Complete _) _ _ _ _) = mconcat
|
||||
[ compare (taskCompletion b) (taskCompletion a)
|
||||
, compareMaybe (taskPriority a) (taskPriority b)
|
||||
, compareMaybe (taskDue a) (taskDue b)
|
||||
, compareDescription (taskDescription a) (taskDescription b)
|
||||
]
|
||||
compareTasks a b = mconcat
|
||||
[ compare (taskCompletion a) (taskCompletion b)
|
||||
, compareMaybe (taskPriority a) (taskPriority b)
|
||||
, compareMaybe (taskDue a) (taskDue b)
|
||||
, compareDescription (taskDescription a) (taskDescription b)
|
||||
]
|
||||
where
|
||||
-- Inverted compare for Maybes: Nothing comes after Just
|
||||
compareMaybe :: Ord a => Maybe a -> Maybe a -> Ordering
|
||||
compareMaybe Nothing Nothing = EQ
|
||||
compareMaybe (Just _) Nothing = LT
|
||||
compareMaybe Nothing (Just _) = GT
|
||||
compareMaybe (Just x) (Just y) = compare x y
|
||||
compareDescription :: Description -> Description -> Ordering
|
||||
compareDescription = compare `on` formatDescription
|
||||
|
|
|
|||
|
|
@ -4,39 +4,75 @@ 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.Options
|
||||
import TaskMachine.UI.Behaviors
|
||||
import TaskMachine.UI.NewTask
|
||||
import TaskMachine.UI.Popup
|
||||
import TaskMachine.UI.TaskList
|
||||
import TaskMachine.UI.TopBar
|
||||
import TaskMachine.UI.Types
|
||||
|
||||
{- Rendering -}
|
||||
|
||||
drawTaskList :: UIState -> B.Widget RName
|
||||
drawTaskList s = renderTaskList (editor s) True (tasks s)
|
||||
drawBaseLayer :: UIState -> B.Widget RName
|
||||
drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList True (tasks s), placeholderNewTask]
|
||||
|
||||
drawUIState :: UIState -> [B.Widget RName]
|
||||
drawUIState s@UIState{errorPopup=Just p} = [renderPopup p, drawTaskList s]
|
||||
drawUIState s = [drawTaskList s]
|
||||
drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s]
|
||||
drawUIState s = [drawBaseLayer s]
|
||||
|
||||
{- 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 -> Result) -> UIState -> VTY.Event -> Result
|
||||
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 p} e = closeModifier (popupBehavior p) s e
|
||||
-- Continue editing task if previously editing a task
|
||||
selectBehavior s@UIState{editor=Just edit} e = taskEditBehavior edit s e
|
||||
-- Default task list behavior
|
||||
selectBehavior s e = closeModifier taskListBehavior s e
|
||||
selectBehavior s@UIState{errorPopup=Just popup} e = undefined popup s e
|
||||
selectBehavior s e = closeBehavior 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
|
||||
|
|
@ -44,14 +80,14 @@ myApp = B.App
|
|||
{ B.appDraw = drawUIState
|
||||
, B.appChooseCursor = B.showFirstCursor
|
||||
, B.appHandleEvent = updateUIState
|
||||
, B.appStartEvent = actionLoad
|
||||
, B.appStartEvent = pure
|
||||
, B.appAttrMap = const (B.themeToAttrMap defaultTheme)
|
||||
}
|
||||
|
||||
startUIState :: Options -> UIState
|
||||
startUIState o = UIState
|
||||
{ options = o
|
||||
, errorPopup = Nothing
|
||||
, tasks = taskList RTaskList V.empty
|
||||
, editor = Nothing
|
||||
{ options = o
|
||||
, focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar]
|
||||
, errorPopup = Nothing
|
||||
, tasks = taskList RTaskList V.empty
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,215 +0,0 @@
|
|||
module TaskMachine.UI.Behaviors
|
||||
( Behavior
|
||||
-- * Miscellaneous
|
||||
, getCurrentDay
|
||||
, closeModifier
|
||||
-- * Behaviors
|
||||
, popupBehavior
|
||||
, taskListBehavior
|
||||
, taskEditBehavior
|
||||
-- * Actions
|
||||
, actionLoad
|
||||
, actionSave
|
||||
, actionDelete
|
||||
, actionEditNew
|
||||
, actionEditSelected
|
||||
, actionToggleCompletion
|
||||
, actionSortTasks
|
||||
, actionFinishEdit
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
|
||||
import qualified Brick as B
|
||||
import Control.Monad.Trans
|
||||
import Data.Time
|
||||
import qualified Graphics.Vty as VTY
|
||||
|
||||
import TaskMachine.LTask
|
||||
import TaskMachine.Options
|
||||
import TaskMachine.Task
|
||||
import TaskMachine.UI.Popup
|
||||
import TaskMachine.UI.TaskEdit
|
||||
import TaskMachine.UI.TaskList
|
||||
import TaskMachine.UI.Types
|
||||
|
||||
type Behavior = UIState -> VTY.Event -> B.EventM RName (B.Next UIState)
|
||||
|
||||
type Action = UIState -> B.EventM RName UIState
|
||||
|
||||
{- Miscellaneous -}
|
||||
|
||||
getCurrentDay :: IO Day
|
||||
getCurrentDay = utctDay <$> liftIO getCurrentTime
|
||||
|
||||
closeModifier :: Behavior -> Behavior
|
||||
closeModifier _ s (VTY.EvKey VTY.KEsc []) = B.halt s
|
||||
closeModifier _ s (VTY.EvKey (VTY.KChar 'q') []) = B.halt s
|
||||
closeModifier f s e = f s e -- wrapper around another behavior
|
||||
|
||||
{- Popups -}
|
||||
|
||||
popupBehavior :: Popup RName (UIState -> NewState) -> Behavior
|
||||
popupBehavior p s (VTY.EvKey VTY.KEnter []) =
|
||||
case popupSelection p of
|
||||
Nothing -> B.continue s{errorPopup=Nothing} -- Just close, no action was specified
|
||||
Just action -> action s{errorPopup=Nothing} -- Do the thing! (and close the popup)
|
||||
popupBehavior p s e = do
|
||||
newPopup <- handlePopupEvent e p
|
||||
B.continue s{errorPopup=Just newPopup}
|
||||
|
||||
{- On the task list -}
|
||||
|
||||
-- (re-)loading
|
||||
|
||||
actionLoad :: Action
|
||||
actionLoad s = do
|
||||
let file = oTodofile $ options s
|
||||
result <- liftIO $ loadLTasks file
|
||||
case result of
|
||||
Right ltasks -> pure s{tasks=taskList RTaskList ltasks}
|
||||
Left errorMessage ->
|
||||
let p = popup "Error loading tasks" errorMessage
|
||||
[ ("Retry", actionLoad >=> B.continue)
|
||||
, ("Quit", B.halt)
|
||||
]
|
||||
in pure s{errorPopup=Just p}
|
||||
|
||||
-- saving
|
||||
|
||||
actionSave :: Action
|
||||
actionSave s = do
|
||||
let filepath = oTodofile (options s)
|
||||
ltasks = taskListElements (tasks s)
|
||||
result <- liftIO $ saveLTasks filepath ltasks
|
||||
case result of
|
||||
Right _ -> pure s
|
||||
Left errorMessage ->
|
||||
let p = popup "Error saving tasks" errorMessage
|
||||
[ ("Retry", actionSave >=> B.continue)
|
||||
, ("Continue without saving", B.continue)
|
||||
, ("Quit", B.halt)
|
||||
]
|
||||
in pure s{errorPopup=Just p}
|
||||
|
||||
-- deleting a task
|
||||
|
||||
actionDelete :: Action
|
||||
actionDelete s = pure s{tasks=deleteTask (tasks s)}
|
||||
|
||||
-- beginning an edit
|
||||
|
||||
actionEditNew :: Action
|
||||
actionEditNew s = do
|
||||
today <- liftIO getCurrentDay
|
||||
let task = newTask today
|
||||
edit = taskEdit RTaskEdit task NewTask
|
||||
pure s{editor=Just edit}
|
||||
|
||||
actionEditSelected :: Action
|
||||
actionEditSelected s =
|
||||
case selectedTask (tasks s) of
|
||||
Nothing -> pure s
|
||||
Just t ->
|
||||
let edit = taskEdit RTaskEdit t ExistingTask
|
||||
in pure s{editor=Just edit}
|
||||
|
||||
-- toggling completion
|
||||
|
||||
actionToggleCompletion :: Action
|
||||
actionToggleCompletion s =
|
||||
case selectedTask (tasks s) of
|
||||
Nothing -> pure s
|
||||
Just task -> do
|
||||
newCompletion <- case taskCompletion task of
|
||||
Complete _ -> pure Incomplete
|
||||
Incomplete -> Complete . Just <$> liftIO getCurrentDay
|
||||
let task' = task{taskCompletion=newCompletion}
|
||||
newTaskList = replaceTask task' (tasks s)
|
||||
pure s{tasks=newTaskList}
|
||||
|
||||
-- sorting
|
||||
|
||||
actionSortTasks :: Action
|
||||
actionSortTasks s = pure s{tasks=sortTaskList (tasks s)}
|
||||
|
||||
-- cleaning up tasks
|
||||
|
||||
cleanUpTask :: Day -> Task -> Task
|
||||
cleanUpTask today (Task (Complete Nothing) p d Nothing desc) =
|
||||
Task (Complete (Just today)) p d (Just today) desc
|
||||
cleanUpTask today (Task (Complete Nothing) p d c desc) =
|
||||
Task (Complete (Just today)) p d c desc
|
||||
cleanUpTask today (Task c p d Nothing desc) =
|
||||
Task c p d (Just today) desc
|
||||
cleanUpTask _ t = t
|
||||
|
||||
actionCleanUp :: Action
|
||||
actionCleanUp s = do
|
||||
today <- liftIO getCurrentDay
|
||||
let tasks' = modifyAllTasks (cleanUpTask today) (tasks s)
|
||||
pure s{tasks=tasks'}
|
||||
|
||||
-- combining all of the above...
|
||||
|
||||
taskListBehavior :: Behavior
|
||||
-- Clean up: Add todays date where creation/completion date is missing
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'c') []) =
|
||||
actionCleanUp >=> actionSave >=> B.continue $ s
|
||||
-- Delete currently selected task (implicit save)
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'd') []) =
|
||||
actionDelete >=> actionSave >=> B.continue $ s
|
||||
-- Begin editing currently selected task
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'e') []) =
|
||||
actionEditSelected >=> B.continue $ s
|
||||
-- Begin creating new task
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'n') []) =
|
||||
actionEditNew >=> B.continue $ s
|
||||
-- Reload tasks (and sort them)
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'r') []) =
|
||||
actionLoad >=> B.continue $ s
|
||||
-- Sort tasks
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 's') []) =
|
||||
actionSortTasks >=> B.continue $ s
|
||||
-- Toggle completion (implicit save)
|
||||
taskListBehavior s (VTY.EvKey (VTY.KChar 'x') []) =
|
||||
actionToggleCompletion >=> actionSave >=> B.continue $ s
|
||||
-- Update the task list (scroll etc.)
|
||||
taskListBehavior s e = do
|
||||
newTasks <- updateTaskList e (tasks s)
|
||||
B.continue s{tasks=newTasks}
|
||||
|
||||
{- In the task editor -}
|
||||
|
||||
actionFinishEdit :: TaskEdit RName -> Action
|
||||
actionFinishEdit t = pure . finishEdit t
|
||||
|
||||
-- get result of task editing
|
||||
-- if editing an existing task, modify that task
|
||||
-- if editing a new task, append that task
|
||||
finishEdit :: TaskEdit RName -> UIState -> UIState
|
||||
finishEdit edit s =
|
||||
case editedTask edit of
|
||||
Left e ->
|
||||
let p = popup "Syntax error" e
|
||||
[ ("Continue editing", B.continue)
|
||||
, ("Abort", \s' -> B.continue s'{editor=Nothing})
|
||||
]
|
||||
in s{errorPopup=Just p}
|
||||
Right task -> s{tasks=modify task, editor=Nothing}
|
||||
where
|
||||
modify :: Task -> TaskList RName
|
||||
modify task = case editState edit of
|
||||
ExistingTask -> replaceTask task $ tasks s
|
||||
NewTask -> appendTask task $ tasks s
|
||||
|
||||
taskEditBehavior :: TaskEdit RName -> Behavior
|
||||
taskEditBehavior _ s (VTY.EvKey VTY.KEsc []) = B.continue s{editor=Nothing}
|
||||
taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) =
|
||||
actionFinishEdit edit >=> actionSave >=> B.continue $ s
|
||||
--taskEditBehavior edit s (VTY.EvKey VTY.KEnter []) = do
|
||||
-- newState <- liftIO $ saveTasks $ finishEdit edit s
|
||||
-- B.continue newState
|
||||
taskEditBehavior edit s e = do
|
||||
newEdit <- updateTaskEdit e edit
|
||||
B.continue s{editor=Just newEdit}
|
||||
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 '_')
|
||||
|
|
@ -1,36 +1,34 @@
|
|||
module TaskMachine.UI.Popup
|
||||
( Popup
|
||||
, popup
|
||||
, popup'
|
||||
, renderPopup
|
||||
, handlePopupEvent
|
||||
, popupSelection
|
||||
, minPopupWidth
|
||||
( 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
|
||||
|
||||
data Popup n r = Popup (B.Dialog r) (B.Widget n)
|
||||
|
||||
popup :: String -> String -> [(String, r)] -> Popup n r
|
||||
popup title content = popup' title (B.str content)
|
||||
|
||||
popup' :: String -> B.Widget n -> [(String, r)] -> Popup n r
|
||||
popup' title widget results =
|
||||
let spacedTitle = " " ++ title ++ " "
|
||||
dialog = B.dialog (Just spacedTitle) (Just (0, results)) minPopupWidth
|
||||
in Popup dialog widget
|
||||
|
||||
renderPopup :: Popup n r -> B.Widget n
|
||||
renderPopup (Popup dialog widget) = B.renderDialog dialog widget
|
||||
|
||||
handlePopupEvent :: VTY.Event -> Popup n r -> B.EventM n (Popup n r)
|
||||
handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialog <*> pure widget
|
||||
|
||||
popupSelection :: Popup n r -> Maybe r
|
||||
popupSelection (Popup dialog _) = B.dialogSelection dialog
|
||||
|
||||
minPopupWidth :: Int
|
||||
minPopupWidth = 78
|
||||
|
||||
{- 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
|
||||
|
|
|
|||
|
|
@ -30,10 +30,7 @@ withSpace :: B.Widget n -> B.Widget n
|
|||
withSpace w = w B.<+> B.withDefAttr taskAttr (B.str " ")
|
||||
|
||||
renderCompletion :: Completion -> B.Widget n
|
||||
renderCompletion Incomplete = B.str "-"
|
||||
renderCompletion (Complete Nothing) = B.str "x"
|
||||
renderCompletion (Complete (Just day)) =
|
||||
B.str "x" B.<+> B.withDefAttr taskCompletionAttr (B.str $ formatDate day)
|
||||
renderCompletion = B.withDefAttr taskCompletionAttr . B.str . formatCompletion
|
||||
|
||||
renderPriority :: Priority -> B.Widget n
|
||||
renderPriority p =
|
||||
|
|
|
|||
|
|
@ -1,69 +0,0 @@
|
|||
module TaskMachine.UI.TaskEdit
|
||||
( TaskEdit
|
||||
, EditState(..)
|
||||
, taskEdit
|
||||
, editState
|
||||
, editedTask
|
||||
, renderTaskEdit
|
||||
, updateTaskEdit
|
||||
) where
|
||||
|
||||
import qualified Brick 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.Task
|
||||
import TaskMachine.UI.Task
|
||||
|
||||
data TaskEdit n = TaskEdit EditState (B.Editor String n)
|
||||
deriving (Show)
|
||||
|
||||
data EditState = ExistingTask | NewTask
|
||||
deriving (Show)
|
||||
|
||||
taskEdit :: n -> Task -> EditState -> TaskEdit n
|
||||
taskEdit name task s =
|
||||
let (predesc, desc) = formatTaskHalves task
|
||||
formattedTask = predesc ++ desc
|
||||
cursor = length predesc
|
||||
editor = B.editor name (Just 1) formattedTask
|
||||
newEditor = B.applyEdit (T.moveCursor (0, cursor)) editor
|
||||
in TaskEdit s newEditor
|
||||
|
||||
editState :: TaskEdit n -> EditState
|
||||
editState (TaskEdit s _) = s
|
||||
|
||||
editedLine :: TaskEdit n -> Either String String
|
||||
editedLine (TaskEdit _ edit) =
|
||||
case B.getEditContents edit of
|
||||
[s] -> Right s
|
||||
_ -> Left "Editor empty"
|
||||
|
||||
editedTask :: TaskEdit n -> Either String Task
|
||||
editedTask te = do
|
||||
s <- editedLine te
|
||||
case parse pTask "task editor" s of
|
||||
Left parseError -> Left $ parseErrorPretty parseError
|
||||
Right task -> Right task
|
||||
|
||||
renderRow :: String -> B.Widget n
|
||||
renderRow s =
|
||||
case parse pTask "" s of
|
||||
Left _ -> B.str s
|
||||
Right task -> renderTask task
|
||||
|
||||
renderRows :: [String] -> B.Widget n
|
||||
renderRows = B.vBox . map renderRow
|
||||
|
||||
renderTaskEdit :: (Ord n, Show n) => Bool -> TaskEdit n -> B.Widget n
|
||||
renderTaskEdit focus (TaskEdit _ edit) = B.renderEditor renderRows focus edit
|
||||
|
||||
updateTaskEdit :: Ord n => VTY.Event -> TaskEdit n -> B.EventM n (TaskEdit n)
|
||||
updateTaskEdit (VTY.EvKey VTY.KHome []) (TaskEdit s edit) =
|
||||
pure $ TaskEdit s $ B.applyEdit T.gotoBOL edit
|
||||
updateTaskEdit (VTY.EvKey VTY.KEnd []) (TaskEdit s edit) =
|
||||
pure $ TaskEdit s $ B.applyEdit T.gotoEOL edit
|
||||
updateTaskEdit event (TaskEdit s edit) =
|
||||
TaskEdit s <$> B.handleEditorEvent event edit
|
||||
|
|
@ -1,107 +1,224 @@
|
|||
module TaskMachine.UI.TaskList
|
||||
( TaskList
|
||||
, taskList
|
||||
, taskListElements
|
||||
, renderTaskList
|
||||
, updateTaskList
|
||||
, sortTaskList
|
||||
, selectedTask
|
||||
, appendTask
|
||||
, replaceTask
|
||||
, deleteTask
|
||||
, modifyAllTasks
|
||||
, taskListElements
|
||||
, taskListFilter
|
||||
, taskListSelectedElement
|
||||
, taskListModify
|
||||
) where
|
||||
|
||||
import Data.Function
|
||||
import Data.List
|
||||
--import Data.Void
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
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.Task
|
||||
import TaskMachine.UI.Task
|
||||
import TaskMachine.UI.TaskEdit
|
||||
--import TaskMachine.Options
|
||||
--import TaskMachine.UI.Popup
|
||||
--import TaskMachine.UI.Types
|
||||
|
||||
newtype TaskList n = TaskList (B.List n LTask)
|
||||
data TaskList n = TaskList
|
||||
{ visibleTasks :: B.List n LTask
|
||||
, invisibleTasks :: V.Vector LTask
|
||||
} deriving (Show)
|
||||
|
||||
newList :: n -> V.Vector LTask -> B.List n LTask
|
||||
newList name ltasks = B.list name ltasks 1
|
||||
|
||||
taskList :: n -> V.Vector LTask -> TaskList n
|
||||
taskList name tasks = TaskList $ B.list name tasks 1
|
||||
taskList name ltasks = TaskList{visibleTasks=newList name ltasks, invisibleTasks=V.empty}
|
||||
|
||||
-- TODO: render while editing
|
||||
renderTaskList :: (Ord n, Show n) => Bool -> TaskList n -> B.Widget n
|
||||
renderTaskList focus tl = B.renderList (const $ renderTask . toTask) focus (visibleTasks tl)
|
||||
|
||||
{- Managing tasks -}
|
||||
|
||||
taskListElements :: TaskList n -> V.Vector LTask
|
||||
taskListElements (TaskList list) = B.listElements list
|
||||
taskListElements tl = B.listElements (visibleTasks tl) <> invisibleTasks tl
|
||||
|
||||
renderRow :: Maybe (B.Widget n) -> Bool -> LTask -> B.Widget n
|
||||
renderRow (Just w) True _ = w
|
||||
renderRow _ _ lt = renderTask (toTask lt)
|
||||
taskListFilter :: (Task -> Bool) -> TaskList n -> TaskList n
|
||||
taskListFilter f tl =
|
||||
let (yes, no) = V.partition (f . toTask) $ taskListElements tl
|
||||
name = B.listName (visibleTasks tl)
|
||||
list = newList name yes
|
||||
in TaskList{visibleTasks=list, invisibleTasks=no}
|
||||
|
||||
renderLast :: (Ord n, Show n) => B.Widget n -> Bool -> B.List n LTask -> B.Widget n
|
||||
renderLast widget focus list =
|
||||
let listWithPlaceholder = focusOnLastTask $ appendTask' emptyTask list
|
||||
in B.renderList (renderRow (Just widget)) focus listWithPlaceholder
|
||||
taskListSelectedElement :: TaskList n -> Maybe Task
|
||||
taskListSelectedElement tl = toTask . snd <$> B.listSelectedElement (visibleTasks tl)
|
||||
|
||||
renderTaskList :: (Ord n, Show n) => Maybe (TaskEdit n) -> Bool -> TaskList n -> B.Widget n
|
||||
renderTaskList Nothing focus (TaskList list)
|
||||
| listSize list == 0 = renderLast (B.str "--- empty ---") focus list
|
||||
| otherwise = B.renderList (renderRow Nothing) focus list
|
||||
renderTaskList (Just te) focus (TaskList list) =
|
||||
case editState te of
|
||||
ExistingTask -> B.renderList (renderRow (Just teWidget)) focus list
|
||||
NewTask -> renderLast teWidget focus list
|
||||
where
|
||||
teWidget = renderTaskEdit focus te
|
||||
taskListModify :: (Task -> Task) -> TaskList n -> TaskList n
|
||||
taskListModify f tl =
|
||||
let list = B.listModify (modifyLTask f) (visibleTasks tl)
|
||||
in tl{visibleTasks=list}
|
||||
|
||||
updateTaskList :: Ord n => VTY.Event -> TaskList n -> B.EventM n (TaskList n)
|
||||
updateTaskList event (TaskList list) =
|
||||
TaskList <$> B.handleListEventVi B.handleListEvent event list
|
||||
{-
|
||||
{- Managing the tasks -}
|
||||
|
||||
sortTaskList :: TaskList n -> TaskList n
|
||||
sortTaskList (TaskList list) =
|
||||
let index = B.listSelected list
|
||||
tasks = V.toList $ B.listElements list
|
||||
sortedTasks = sortBy (compareTasks `on` toTask) tasks
|
||||
newVector = V.fromList sortedTasks
|
||||
in TaskList $ B.listReplace newVector index list
|
||||
allTasks :: UIState -> V.Vector LTask
|
||||
allTasks s =
|
||||
let visible = B.listElements $ taskList s
|
||||
invisible = invisibleTasks s
|
||||
in visible <> invisible
|
||||
|
||||
selectedTask :: TaskList n -> Maybe Task
|
||||
selectedTask (TaskList list) = toTask . snd <$> B.listSelectedElement list
|
||||
newTaskList :: V.Vector LTask -> B.List RName LTask
|
||||
newTaskList ltasks = B.list RTaskList ltasks 1
|
||||
|
||||
appendTask' :: Task -> B.List n LTask -> B.List n LTask
|
||||
appendTask' task list =
|
||||
let size = listSize list
|
||||
lt = lTask task
|
||||
in focusOnLastTask $ B.listInsert size lt list
|
||||
-- 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}
|
||||
|
||||
appendTask :: Task -> TaskList n -> TaskList n
|
||||
appendTask task (TaskList list) = TaskList $ appendTask' task list
|
||||
-- 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
|
||||
|
||||
replaceTask :: Task -> TaskList n -> TaskList n
|
||||
replaceTask task (TaskList list) = TaskList $ B.listModify replace list
|
||||
where
|
||||
replace :: LTask -> LTask
|
||||
replace = modifyLTask (const task)
|
||||
filterTasks :: (Task -> Bool) -> UIState -> UIState
|
||||
filterTasks f s =
|
||||
let (yes, no) = V.partition (f . toTask) (allTasks s)
|
||||
in s{taskList=newTaskList yes, invisibleTasks=no}
|
||||
|
||||
deleteTask :: TaskList n -> TaskList n
|
||||
deleteTask tl@(TaskList list) =
|
||||
case B.listSelected list of
|
||||
Nothing -> tl
|
||||
Just index
|
||||
| index == 0 -> TaskList $ B.listRemove index list
|
||||
| otherwise -> TaskList $ B.listMoveBy 1 $ B.listRemove index list
|
||||
{- Rendering -}
|
||||
|
||||
modifyAllTasks :: (Task -> Task) -> TaskList n -> TaskList n
|
||||
modifyAllTasks f (TaskList list) =
|
||||
let index = B.listSelected list
|
||||
vector = B.listElements list
|
||||
vector' = V.map (modifyLTask f) vector
|
||||
in TaskList $ B.listReplace vector' index list
|
||||
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
|
||||
|
||||
{- helper functions -}
|
||||
renderTaskList :: UIState -> B.Widget RName
|
||||
renderTaskList s =
|
||||
let inFocus = B.focusGetCurrent (focus s) == Just BRTaskList
|
||||
in B.renderList (renderLTask Nothing) inFocus (taskList s)
|
||||
|
||||
listSize :: B.List n e -> Int
|
||||
listSize list = V.length $ B.listElements list
|
||||
{- Updating state -}
|
||||
|
||||
focusOnLastTask :: B.List n e -> B.List n e
|
||||
focusOnLastTask list = B.listMoveTo (listSize list - 1) list
|
||||
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
|
||||
-}
|
||||
|
|
|
|||
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 '_')
|
||||
|
|
@ -6,42 +6,149 @@
|
|||
|
||||
module TaskMachine.UI.Types
|
||||
( RName(..)
|
||||
, BigRing(..)
|
||||
--, SmallRing(..)
|
||||
-- * Popups
|
||||
--, Popup
|
||||
--, popup
|
||||
--, renderPopup
|
||||
--, handlePopupEvent
|
||||
-- * UI state
|
||||
, UIState(..)
|
||||
, NewState
|
||||
, bigFocusNext, bigFocusPrev
|
||||
--, smallFocusNext, smallFocusPrev
|
||||
, defaultTheme
|
||||
) 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.TaskEdit
|
||||
import TaskMachine.UI.TaskList
|
||||
|
||||
-- | Resource names
|
||||
data RName
|
||||
= RTaskList
|
||||
= 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
|
||||
, errorPopup :: Maybe (Popup RName (UIState -> NewState))
|
||||
, focus :: B.FocusRing BigRing -- focus on the top, middle or bottom part
|
||||
|
||||
-- popups
|
||||
, errorPopup :: Maybe (PopupOk RName)
|
||||
|
||||
-- tasks
|
||||
, tasks :: TaskList RName
|
||||
, editor :: Maybe (TaskEdit 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)
|
||||
|
|
@ -53,7 +160,7 @@ defaultTheme = B.newTheme VTY.defAttr
|
|||
, (B.listSelectedAttr, st' VTY.bold)
|
||||
, (B.listSelectedFocusedAttr, bg VTY.blue $ st' VTY.bold)
|
||||
, (taskAttr, none)
|
||||
, (taskCompletionAttr, fg' VTY.brightBlack)
|
||||
, (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)
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
# resolver:
|
||||
# name: custom-snapshot
|
||||
# location: "./custom-snapshot.yaml"
|
||||
resolver: lts-12.14
|
||||
resolver: lts-12.9
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
|
|
|
|||
7
test.txt
7
test.txt
|
|
@ -1,7 +0,0 @@
|
|||
- A simple task
|
||||
x A simple completed task
|
||||
|
||||
- c2018-12-13 A simple task with creation date
|
||||
|
||||
s2018-12-20 d2018-12-24 A task with start date
|
||||
-2018-12-20 d2018-12-24 A task with alternate start date
|
||||
28
todo.txt
28
todo.txt
|
|
@ -1,23 +1,7 @@
|
|||
x2018-10-23 c2018-09-18 Clean up file (adding creation/completion dates)
|
||||
- c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't load from todo file
|
||||
- c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't save to todo file
|
||||
- c2018-09-18 Offer "retry" or "quit" +dialogue - syntax error in todo file
|
||||
- c2018-09-18 Offer to clean up file when loading (adding creation/completion dates)
|
||||
- c2018-09-18 Purge - move completed tasks to a separate file
|
||||
x2018-10-23 c2018-09-28 Move cursor to beginning of task description when editing tasks
|
||||
x2018-10-24 c2018-09-28 Syntax highlighting while editing tasks
|
||||
x2018-10-23 c2018-09-30 Display "-empty-" when TaskList is empty
|
||||
x2018-09-27 c2018-09-18 Quit using Esc or q
|
||||
x2018-09-29 c2018-09-28 Use B.EventM's MonadIO instance instead of B.suspendAndResume (facepalm)
|
||||
x2018-09-30 c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't load from todo file
|
||||
x2018-09-30 c2018-09-18 Offer "retry" or "quit" +dialogue - couldn't save to todo file
|
||||
x2018-09-30 c2018-09-18 Offer "retry" or "quit" +dialogue - syntax error in todo file
|
||||
x2018-09-30 c2018-09-30 Custom exception messages
|
||||
x2018-10-24 c2018-10-23 Don't crash on parse errors etc.
|
||||
- c2018-10-24 Fix date coloring in editor
|
||||
x2018-10-24 c2018-10-24 Reverse ordering of completed tasks - most recent at the top
|
||||
- c2018-10-24 F1 - list keybindings
|
||||
- c2018-10-26 Add Z - undo (also Ctrl + Z)
|
||||
- c2018-10-26 Add Y - redo (also Ctrl + Y)
|
||||
- c2018-10-26 Implement date expressions using GADTs
|
||||
- c2018-10-26 Move C - cleanup to F - fixup
|
||||
- c2018-10-26 Add "starting" task type (start date, prio, due date, description)
|
||||
- c2018-10-26 Add "formula" task type (formula, prio, due date, description) - maybe due date formula?
|
||||
x2018-11-01 (D) c2018-10-26 Fix crash on attempting to open a folder
|
||||
- c2018-10-26 Think of something to do with +project tags, @context tags and key:value tags
|
||||
- c2018-09-18 Quit using Esc or q
|
||||
- c2018-09-18 Sort tasks by completion, priority, due date, description
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue