From 59b73d01d6e7b90d9b6aaf8b91f6be007b9d2a7c Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Thu, 2 May 2019 19:41:41 +0100 Subject: [PATCH 01/33] docs: updated taskell.app --- docs/html/index.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/html/index.md b/docs/html/index.md index 5487c20d..1c430a42 100644 --- a/docs/html/index.md +++ b/docs/html/index.md @@ -301,6 +301,8 @@ listLeft = < Available special keys: ``, ``, ``, ``, ``, ``, `` +On a Mac you can use the `alt` characters: e.g. `quit = œ` is equivalent to `alt+q`. + You shouldn't try to assign the `1`-`9` keys, as it will not overwrite the default behaviour. From 7b73632a399508ba17138c154bc6824dfe6bebb1 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Thu, 2 May 2019 19:42:04 +0100 Subject: [PATCH 02/33] chore: updates analytics script --- .bin/analytics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.bin/analytics b/.bin/analytics index 737d60b3..a556fc0c 100755 --- a/.bin/analytics +++ b/.bin/analytics @@ -1 +1 @@ -curl -s https://formulae.brew.sh/analytics/install/30d/ | grep taskell -A 1 | sed -e 's/<[^>]*>//g' +brew info taskell | tail -3 From a61a546acc409163e8ee5da15297b66243aae61a Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Thu, 2 May 2019 19:44:16 +0100 Subject: [PATCH 03/33] docs: adds tasks/bugs --- roadmap.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/roadmap.md b/roadmap.md index 7b7fc746..3c5b5d79 100644 --- a/roadmap.md +++ b/roadmap.md @@ -10,7 +10,6 @@ - Add tests for IO.GitHub - Break up State module - Parse checkItems Trello JSON using Aeson FromJSON rather than needing extra record type -- Use a map in Actions to tidy things up/add custom key support - Avoid having to normalise the state? - Remove duplication of config - currently using ini and hard-coded defaults - Move Help modal creation into Template Haskell @@ -23,6 +22,7 @@ - Very long words should get hyphenated > The cursor gets lost if a word is longer than the line - URLs in particular can cause issues +- No longer a difference between and move right - Help modal needs to wrap and scroll - Modal boxes shouldn't be full height unless they need to be - Up and down in search gets a bit lost @@ -77,6 +77,7 @@ > Using Haskline: https://rootmos.github.io/main/2017/08/31/combining-brick-and-haskeline.html - Editable title? > Use a `# Title` at top of file and display title somewhere in taskell +- Keep undo between sessions? ## In Progress From cec0f944ec717e3b8c4ce28edcf4c0f777d28ef5 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Thu, 2 May 2019 20:10:21 +0100 Subject: [PATCH 04/33] feat: adds missing mappings automatically rather than throwing an error --- roadmap.md | 3 +-- src/IO/Config.hs | 6 +++--- src/IO/Keyboard.hs | 27 ++++++++++++++++++++++++--- src/IO/Keyboard/Types.hs | 22 ++-------------------- test/IO/Keyboard/TypesTest.hs | 25 +++++++++++++++---------- 5 files changed, 45 insertions(+), 38 deletions(-) diff --git a/roadmap.md b/roadmap.md index 3c5b5d79..05593d54 100644 --- a/roadmap.md +++ b/roadmap.md @@ -87,9 +87,8 @@ * [ ] Check for key conflicts: include keys not explicitly mapped (e.g. 1-9, Esc, Enter) * [x] Check for bits of functionality missing a mapping * [x] Update Help dialogue with key mappings - * [ ] Needs to support merging with default options so that it's easy to add new default keys in the future + * [x] Needs to support merging with default options so that it's easy to add new default keys in the future * [ ] Add keys to Help which aren't in bindings - * [ ] Check for duplicate keys * [ ] More detailed error messages for missing/invalid mappings - Add a List widget for common actions between tasks and sub-tasks diff --git a/src/IO/Config.hs b/src/IO/Config.hs index 496cec5a..5f985709 100644 --- a/src/IO/Config.hs +++ b/src/IO/Config.hs @@ -17,9 +17,9 @@ import Brick.Themes (loadCustomizations, themeToAttrMap) import Data.FileEmbed (embedFile) import Data.Ini.Config -import IO.Keyboard (defaultBindings) +import IO.Keyboard (addMissing, badMapping, defaultBindings) import IO.Keyboard.Parser (bindings) -import IO.Keyboard.Types (Bindings, badMapping, missing) +import IO.Keyboard.Types (Bindings) import UI.Theme (defaultTheme) import qualified IO.Config.General as General @@ -101,7 +101,7 @@ getConfig = do getBindings :: IO Bindings getBindings = do bnds <- bindings <$> (T.readFile =<< (bindingsPath <$> getDir)) - case missing =<< badMapping =<< bnds of + case addMissing <$> (badMapping =<< bnds) of Right b -> pure b Left err -> putStrLn ("bindings.ini: " <> err <> " - using default bindings") $> defaultBindings diff --git a/src/IO/Keyboard.hs b/src/IO/Keyboard.hs index 66b98ea7..6908cae3 100644 --- a/src/IO/Keyboard.hs +++ b/src/IO/Keyboard.hs @@ -4,19 +4,40 @@ module IO.Keyboard ( generate , defaultBindings + , badMapping + , addMissing ) where -import ClassyPrelude +import ClassyPrelude hiding ((\\)) import Data.Bitraversable (bitraverse) +import Data.List ((\\)) -import Events.Actions.Types as A -import IO.Keyboard.Types +import qualified Events.Actions.Types as A +import IO.Keyboard.Types generate :: Bindings -> Actions -> BoundActions generate bindings actions = mapFromList . catMaybes $ bitraverse bindingToEvent (`lookup` actions) <$> bindings +badMapping :: Bindings -> Either Text Bindings +badMapping bindings = + if null result + then Right bindings + else Left "invalid mapping" + where + result = filter ((== A.Nothing) . snd) bindings + +addMissing :: Bindings -> Bindings +addMissing bindings = bindings <> replaced + where + bnd = A.Nothing : (snd <$> bindings) + result = A.allActions \\ bnd + replaced = concat $ replace <$> result + +replace :: A.ActionType -> Bindings +replace action = filter ((==) action . snd) defaultBindings + defaultBindings :: Bindings defaultBindings = [ (BChar 'q', A.Quit) diff --git a/src/IO/Keyboard/Types.hs b/src/IO/Keyboard/Types.hs index 04c18710..4f357110 100644 --- a/src/IO/Keyboard/Types.hs +++ b/src/IO/Keyboard/Types.hs @@ -3,13 +3,12 @@ module IO.Keyboard.Types where -import ClassyPrelude hiding ((\\)) +import ClassyPrelude -import Data.List ((\\)) import Data.Map.Strict (Map) import Graphics.Vty.Input.Events (Event (..), Key (..)) -import qualified Events.Actions.Types as A (ActionType (Nothing), allActions) +import qualified Events.Actions.Types as A (ActionType) import Events.State.Types (Stateful) data Binding @@ -31,23 +30,6 @@ instance Show Binding where show (BKey "Right") = "→" show (BKey name) = "<" <> unpack name <> ">" -badMapping :: Bindings -> Either Text Bindings -badMapping bindings = - if null result - then Right bindings - else Left "invalid mapping" - where - result = filter ((== A.Nothing) . snd) bindings - -missing :: Bindings -> Either Text Bindings -missing bindings = - if null result - then Right bindings - else Left "missing mapping" - where - bnd = A.Nothing : (snd <$> bindings) - result = A.allActions \\ bnd - bindingsToText :: Bindings -> A.ActionType -> [Text] bindingsToText bindings key = tshow . fst <$> toList (filterMap (== key) bindings) diff --git a/test/IO/Keyboard/TypesTest.hs b/test/IO/Keyboard/TypesTest.hs index 295d02f1..e989a5ab 100644 --- a/test/IO/Keyboard/TypesTest.hs +++ b/test/IO/Keyboard/TypesTest.hs @@ -11,13 +11,16 @@ import Test.Tasty import Test.Tasty.HUnit import qualified Events.Actions.Types as A (ActionType (..)) -import IO.Keyboard (defaultBindings) -import IO.Keyboard.Types (Binding (..), Bindings, badMapping, missing) +import IO.Keyboard (addMissing, badMapping, defaultBindings) +import IO.Keyboard.Types (Binding (..), Bindings) notFull :: Bindings -notFull = - [ (BChar 'q', A.Quit) - , (BChar 'u', A.Undo) +notFull = [(BChar 'œ', A.Quit), (BChar 'U', A.Undo)] + +notFullResult :: Bindings +notFullResult = + [ (BChar 'œ', A.Quit) + , (BChar 'U', A.Undo) , (BChar '/', A.Search) , (BChar '?', A.Help) , (BChar 'k', A.Previous) @@ -25,6 +28,11 @@ notFull = , (BChar 'h', A.Left) , (BChar 'l', A.Right) , (BChar 'g', A.Bottom) + , (BChar 'a', A.New) + , (BChar 'O', A.NewAbove) + , (BChar 'o', A.NewBelow) + , (BChar 'e', A.Edit) + , (BChar 'A', A.Edit) , (BChar 'i', A.Edit) , (BChar 'C', A.Clear) , (BChar 'D', A.Delete) @@ -53,13 +61,10 @@ test_types = "Events.Actions.Types" [ testCase "not missing" - (assertEqual - "Finds no missing items" - (Right defaultBindings) - (missing defaultBindings)) + (assertEqual "Finds no missing items" defaultBindings (addMissing defaultBindings)) , testCase "not missing" - (assertEqual "Finds missing items" (Left "missing mapping") (missing notFull)) + (assertEqual "Finds missing items" notFullResult (addMissing notFull)) , testCase "bad mapping" (assertEqual "Finds bad mapping" (Left "invalid mapping") (badMapping bad)) From 9083819f0f8f5dcf93c19220fd1e515e5b3ec2be Mon Sep 17 00:00:00 2001 From: "Valery V. Vorotyntsev" Date: Fri, 3 May 2019 16:08:34 +0300 Subject: [PATCH 05/33] Fix a typo The misspelled word was displayed at the homepage [https://taskell.app/]. Whoops! :") --- docs/html/_config.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/html/_config.yml b/docs/html/_config.yml index 68dbc26f..e1722a42 100755 --- a/docs/html/_config.yml +++ b/docs/html/_config.yml @@ -1,6 +1,6 @@ # Setup title: taskell -tagline: Command-line Kanban board/task managment +tagline: Command-line Kanban board/task management baseurl: "" locale: "en" version: 1.4.3 @@ -16,4 +16,4 @@ author: markdown: kramdown kramdown: - parse_block_html: true \ No newline at end of file + parse_block_html: true From 1cf4677e407173e23b38f5eb5b642db61bfbff81 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 29 Jul 2019 11:38:46 +0100 Subject: [PATCH 06/33] chore: updates resolver --- stack.yaml | 6 +++--- stack.yaml.lock | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+), 3 deletions(-) create mode 100644 stack.yaml.lock diff --git a/stack.yaml b/stack.yaml index f127e4d8..69607b11 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,10 +1,10 @@ -resolver: lts-13.15 +resolver: lts-13.29 pvp-bounds: both packages: - . extra-deps: - config-ini-0.2.4.0 - - data-clist-0.1.2.2 + - data-clist-0.1.2.3 - text-zipper-0.10.1 - word-wrap-0.4.1 - - brick-0.47 + - brick-0.47.1 diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 00000000..192925fa --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,47 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: config-ini-0.2.4.0@sha256:38a6d484d471c6fac81445de2eac8c4e8c82760962fca5491ae1c3bfca9c4047,3232 + pantry-tree: + size: 886 + sha256: b608472507ec84e468f768acab36d8c85b46bcf918f2a60604fff46137160d2d + original: + hackage: config-ini-0.2.4.0 +- completed: + hackage: data-clist-0.1.2.3@sha256:0a4ad5f045c285eb533c2baa228581d2ff3ee123a4da7ca84e95a74aea9fb058,936 + pantry-tree: + size: 219 + sha256: 3d708d2da0d526aada2a1bd72e233133ee2a9f96e229ea122e5267a65f683a13 + original: + hackage: data-clist-0.1.2.3 +- completed: + hackage: text-zipper-0.10.1@sha256:8b73a97a3717a17df9b0a722b178950c476ff2268ca5c583e99d010c94af849e,1471 + pantry-tree: + size: 600 + sha256: ebd5f0e2fc8c59b1bde6706cef1fdb012d52bb26b3953a97a4fa6502f56cdd65 + original: + hackage: text-zipper-0.10.1 +- completed: + hackage: word-wrap-0.4.1@sha256:f72233b383ef569c557bfd9812cbb8e306c415ce509082c0bd15ee51c0239ccc,1606 + pantry-tree: + size: 423 + sha256: dcf5071895ee477e60e3c9de1e30eb711e11e9a7335db160616f80baeb20ad71 + original: + hackage: word-wrap-0.4.1 +- completed: + hackage: brick-0.47.1@sha256:de548e3c39cc393dafbc1ecfe788746103fe5233d5a69c2cca5da8ed819ba661,13868 + pantry-tree: + size: 3752 + sha256: bea3f31fbc18a56f0a78d3b27438eba5eb4a81d59c5ca120ddee4ca919183018 + original: + hackage: brick-0.47.1 +snapshots: +- completed: + size: 500539 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/29.yaml + sha256: 006398c5e92d1d64737b7e98ae4d63987c36808814504d1451f56ebd98093f75 + original: lts-13.29 From 8db1bf9b6f26f47de902173ea130593f88309bd3 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 29 Jul 2019 11:59:37 +0100 Subject: [PATCH 07/33] docs: removes explicit bindings, links to `bindings.ini` instead --- README.md | 43 +------------------------------------------ 1 file changed, 1 insertion(+), 42 deletions(-) diff --git a/README.md b/README.md index 0f1fea03..050e53b9 100644 --- a/README.md +++ b/README.md @@ -251,48 +251,7 @@ subtask = "-" You can edit keyboard bindings in the `bindings.ini` config file. -The default bindings are as follows: - -```ini -# general -quit = q -undo = u -search = / -help = ? - -# navigation -previous = k -next = j -left = h -right = l -bottom = G - -# new tasks -new = a -newAbove = O -newBelow = o - -# editing tasks -edit = e, A, i -clear = C -delete = D -detail = -dueDate = @ - -# moving tasks -moveUp = K -moveDown = J -moveLeft = H -moveRight = L, -moveMenu = m - -# lists -listNew = N -listEdit = E -listDelete = X -listRight = > -listLeft = < -``` +The default bindings can be found in [`bindings.ini`](https://github.com/smallhadroncollider/taskell/blob/master/templates/bindings.ini). Available special keys: ``, ``, ``, ``, ``, ``, `` From a7bb49066e3d9f82fe829231338c964f2dae25eb Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 29 Jul 2019 11:13:12 +0100 Subject: [PATCH 08/33] feat: adds basic status bar adds a basic status bar to the bottom includes file path and current list position --- README.md | 4 ++++ roadmap.md | 7 ++++++- src/UI/Draw.hs | 32 ++++++++++++++++++++++++++++---- src/UI/Theme.hs | 11 ++++++++--- templates/theme.ini | 4 ++++ 5 files changed, 50 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index 050e53b9..4ba34790 100644 --- a/README.md +++ b/README.md @@ -270,6 +270,10 @@ You can edit Taskell's colour-scheme by editing `theme.ini`: ; list title title.fg = green +; status bar +statusBar.bg = magenta +statusBar.fg = black + ; current list title titleCurrent.fg = blue diff --git a/roadmap.md b/roadmap.md index 05593d54..078ee9ea 100644 --- a/roadmap.md +++ b/roadmap.md @@ -38,6 +38,7 @@ ## Features +- Add a List widget for common actions between tasks and sub-tasks - Use proper error codes - Performance with large files > Becomes unusable with large files @@ -81,6 +82,8 @@ ## In Progress +- Search should be case insensitive +- Can't remove dates - Add custom key support * [x] Create bindings.ini * [x] Update events to use Map from bindings.ini @@ -90,7 +93,6 @@ * [x] Needs to support merging with default options so that it's easy to add new default keys in the future * [ ] Add keys to Help which aren't in bindings * [ ] More detailed error messages for missing/invalid mappings -- Add a List widget for common actions between tasks and sub-tasks ## Done @@ -268,3 +270,6 @@ - Automate website publishing when doing a new build > Should automatically update the `_config.yml` file, build the website, then deploy it - Can't remove a description +- Title bar for extra info + * [x] File path + * [x] Current position diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs index d0958ee2..633736bc 100644 --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -18,11 +18,11 @@ import Brick import Data.Taskell.Date (Day, dayToText, deadline) import Data.Taskell.List (List, tasks, title) -import Data.Taskell.Lists (Lists) +import Data.Taskell.Lists (Lists, count) import qualified Data.Taskell.Task as T (Task, countCompleteSubtasks, countSubtasks, description, due, hasSubtasks, name) import Events.State (normalise) -import Events.State.Types (Pointer, State, current, lists, mode) +import Events.State.Types (Pointer, State, current, lists, mode, path) import Events.State.Types.Mode (DetailMode (..), InsertType (..), ModalType (..), Mode (..)) import IO.Config.Layout (Config, columnPadding, columnWidth, descriptionIndicator) @@ -37,6 +37,7 @@ data DrawState = DrawState { dsLists :: Lists , dsMode :: Mode , dsLayout :: Config + , dsPath :: FilePath , dsToday :: Day , dsCurrent :: Pointer , dsField :: Maybe Field @@ -173,17 +174,39 @@ renderSearch mainWidget = do if editing then taskCurrentAttr else taskAttr - let widget = attr . padTopBottom 1 . padLeftRight colPad $ txt "/" <+> field searchField + let widget = attr . padLeftRight colPad $ txt "/" <+> field searchField pure $ mainWidget <=> widget _ -> pure mainWidget +-- | Render the status bar +getPosition :: ReaderDrawState Text +getPosition = do + (col, pos) <- asks dsCurrent + len <- count col <$> asks dsLists + let posNorm = + if len > 0 + then pos + 1 + else 0 + pure $ tshow posNorm <> "/" <> tshow len + +renderStatusBar :: ReaderDrawState (Widget ResourceName) +renderStatusBar = do + topPath <- pack <$> asks dsPath + colPad <- columnPadding <$> asks dsLayout + posTxt <- getPosition + let titl = padRight Max . padLeft (Pad colPad) $ txt topPath + let pos = padRight (Pad colPad) $ txt posTxt + let bar = titl <+> pos + pure . padTop (Pad 1) $ withAttr statusBarAttr bar + -- | Renders the main widget main :: ReaderDrawState (Widget ResourceName) main = do ls <- dsLists <$> ask listWidgets <- toList <$> sequence (renderList `mapWithIndex` ls) let mainWidget = viewport RNLists Horizontal . padTopBottom 1 $ hBox listWidgets - renderSearch mainWidget + statusBar <- renderStatusBar + renderSearch (mainWidget <=> statusBar) getField :: Mode -> Maybe Field getField (Insert _ _ f) = Just f @@ -210,6 +233,7 @@ draw layout bindings today state = { dsLists = normalisedState ^. lists , dsMode = stateMode , dsLayout = layout + , dsPath = normalisedState ^. path , dsToday = today , dsField = getField stateMode , dsCurrent = normalisedState ^. current diff --git a/src/UI/Theme.hs b/src/UI/Theme.hs index 8a76003b..ce974a6c 100644 --- a/src/UI/Theme.hs +++ b/src/UI/Theme.hs @@ -2,6 +2,7 @@ module UI.Theme ( titleAttr + , statusBarAttr , titleCurrentAttr , taskCurrentAttr , taskAttr @@ -12,12 +13,15 @@ module UI.Theme import Brick (AttrName, attrName) import Brick.Themes (Theme, newTheme) -import Brick.Util (fg) -import Graphics.Vty (blue, defAttr, green, magenta, red, yellow) +import Brick.Util (fg, on) +import Graphics.Vty import Data.Taskell.Date (Deadline (..)) -- attrs +statusBarAttr :: AttrName +statusBarAttr = attrName "statusBar" + titleAttr :: AttrName titleAttr = attrName "title" @@ -55,7 +59,8 @@ defaultTheme :: Theme defaultTheme = newTheme defAttr - [ (titleAttr, fg green) + [ (statusBarAttr, black `on` green) + , (titleAttr, fg green) , (titleCurrentAttr, fg blue) , (taskCurrentAttr, fg magenta) , (disabledAttr, fg yellow) diff --git a/templates/theme.ini b/templates/theme.ini index d717e636..5e2e7e32 100644 --- a/templates/theme.ini +++ b/templates/theme.ini @@ -3,6 +3,10 @@ ; list title title.fg = green +; status bar +statusBar.bg = blue +statusBar.fg = black + ; current list title titleCurrent.fg = blue From 2b2b2d8addc0c6ff43b7976d96e6a1d1812dc324 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Thu, 1 Aug 2019 16:15:04 +0100 Subject: [PATCH 09/33] feat: makes search case-insensitive (#39) --- src/Data/Taskell/Task/Internal.hs | 5 +++-- test/Data/Taskell/ListTest.hs | 12 +++++++++--- test/Data/Taskell/TaskTest.hs | 6 ++++++ 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/src/Data/Taskell/Task/Internal.hs b/src/Data/Taskell/Task/Internal.hs index ed1f1b62..b520644d 100644 --- a/src/Data/Taskell/Task/Internal.hs +++ b/src/Data/Taskell/Task/Internal.hs @@ -77,9 +77,10 @@ countCompleteSubtasks :: Task -> Int countCompleteSubtasks = length . filter (^. ST.complete) . (^. subtasks) contains :: Text -> Task -> Bool -contains text task = text `isInfixOf` (task ^. name) || not (null sts) +contains text task = check (task ^. name) || not (null sts) where - sts = filter (isInfixOf text) $ (^. ST.name) <$> (task ^. subtasks) + check = isInfixOf (toLower text) . toLower + sts = filter check $ (^. ST.name) <$> (task ^. subtasks) isBlank :: Task -> Bool isBlank task = diff --git a/test/Data/Taskell/ListTest.hs b/test/Data/Taskell/ListTest.hs index f56da5f8..a7ed60f6 100644 --- a/test/Data/Taskell/ListTest.hs +++ b/test/Data/Taskell/ListTest.hs @@ -148,9 +148,15 @@ test_list = , testCase "multiple" (assertEqual - "Blah and Fish" - (List "Populated" (fromList [T.new "Blah", T.new "Fish"])) - (searchFor "h" populatedList)) + "Hello and Blah" + (List "Populated" (fromList [T.new "Hello", T.new "Blah"])) + (searchFor "l" populatedList)) + , testCase + "case-insensitive" + (assertEqual + "Hello" + (List "Populated" (fromList [T.new "Hello"])) + (searchFor "hello" populatedList)) , testCase "doesn't exist" (assertEqual diff --git a/test/Data/Taskell/TaskTest.hs b/test/Data/Taskell/TaskTest.hs index e26cfe32..265f4754 100644 --- a/test/Data/Taskell/TaskTest.hs +++ b/test/Data/Taskell/TaskTest.hs @@ -156,6 +156,12 @@ test_task = "contains" [ testCase "in task" (assertEqual "Finds in task" True (contains "Test" testTask)) , testCase "in sub-task" (assertEqual "Find sub-task" True (contains "One" testTask)) + , testCase + "case-insensitive" + (assertEqual "Find sub-task" True (contains "ONE" testTask)) + , testCase + "case-insensitive" + (assertEqual "Find sub-task" True (contains "two" testTask)) , testCase "missing" (assertEqual "Find sub-task" False (contains "Fish" testTask)) ] , testGroup From b20846a0513500d067eed7d687dcc1a4367540e8 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 29 Jul 2019 11:13:12 +0100 Subject: [PATCH 10/33] feat: adds description search (#39) --- src/Data/Taskell/Task/Internal.hs | 3 ++- test/Data/Taskell/TaskTest.hs | 21 +++++++++++++++------ 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/src/Data/Taskell/Task/Internal.hs b/src/Data/Taskell/Task/Internal.hs index b520644d..1fef8483 100644 --- a/src/Data/Taskell/Task/Internal.hs +++ b/src/Data/Taskell/Task/Internal.hs @@ -77,7 +77,8 @@ countCompleteSubtasks :: Task -> Int countCompleteSubtasks = length . filter (^. ST.complete) . (^. subtasks) contains :: Text -> Task -> Bool -contains text task = check (task ^. name) || not (null sts) +contains text task = + check (task ^. name) || maybe False check (task ^. description) || not (null sts) where check = isInfixOf (toLower text) . toLower sts = filter check $ (^. ST.name) <$> (task ^. subtasks) diff --git a/test/Data/Taskell/TaskTest.hs b/test/Data/Taskell/TaskTest.hs index 265f4754..2d18d9e5 100644 --- a/test/Data/Taskell/TaskTest.hs +++ b/test/Data/Taskell/TaskTest.hs @@ -17,11 +17,14 @@ import Data.Time (fromGregorianValid) import qualified Data.Taskell.Subtask as ST (name, new) import Data.Taskell.Task.Internal +desc :: Maybe Text +desc = Just "A very boring description" + testTask :: Task testTask = Task { _name = "Test" - , _description = Nothing + , _description = desc , _subtasks = fromList [ST.new "One" True, ST.new "Two" False, ST.new "Three" False] , _due = Nothing } @@ -76,7 +79,7 @@ test_task = "Returns the task with added subtask" (Task "Test" - Nothing + desc (fromList [ ST.new "One" True , ST.new "Two" False @@ -107,7 +110,7 @@ test_task = "Returns updated task" (Task "Test" - Nothing + desc (fromList [ST.new "One" True, ST.new "Cow" False, ST.new "Three" False]) Nothing) @@ -118,7 +121,7 @@ test_task = "Returns task" (Task "Test" - Nothing + desc (fromList [ST.new "One" True, ST.new "Two" False, ST.new "Three" False]) Nothing) @@ -132,7 +135,7 @@ test_task = "Returns updated task" (Task "Test" - Nothing + desc (fromList [ST.new "One" True, ST.new "Three" False]) Nothing) (removeSubtask 1 testTask)) @@ -142,7 +145,7 @@ test_task = "Returns task" (Task "Test" - Nothing + desc (fromList [ST.new "One" True, ST.new "Two" False, ST.new "Three" False]) Nothing) @@ -163,6 +166,12 @@ test_task = "case-insensitive" (assertEqual "Find sub-task" True (contains "two" testTask)) , testCase "missing" (assertEqual "Find sub-task" False (contains "Fish" testTask)) + , testCase + "description" + (assertEqual "Finds in description" True (contains "boring" testTask)) + , testCase + "not in description" + (assertEqual "Doesn't find" False (contains "escapades" testTask)) ] , testGroup "isBlank" From e3dcedd3eb444d50a5145aaa6e2ce7b651d5f574 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 29 Jul 2019 11:13:12 +0100 Subject: [PATCH 11/33] fix: fixes fallback keys in search (#39) viewing task detail shows wrong task if indexes don't match need to rethink how search works --- src/Events/Actions.hs | 17 ++++++++++++----- src/Events/Actions/Search.hs | 18 ++++++------------ 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/Events/Actions.hs b/src/Events/Actions.hs index bcb7e547..cabdaeff 100644 --- a/src/Events/Actions.hs +++ b/src/Events/Actions.hs @@ -25,13 +25,19 @@ import qualified Events.Actions.Modal.Help as Help import qualified Events.Actions.Normal as Normal import qualified Events.Actions.Search as Search +fallback :: BoundActions -> Event -> Stateful +fallback norm e state = + case lookup e norm of + Just ev -> ev state + Nothing -> Normal.event e state + -- takes an event and returns a Maybe State -event' :: Event -> Stateful +event' :: Event -> BoundActions -> Stateful -- for other events pass through to relevant modules -event' e state = +event' e norm state = case state ^. mode of Normal -> Normal.event e state - Search {} -> Search.event e state + Search {} -> Search.event (fallback norm) e state Insert {} -> Insert.event e state Modal {} -> Modal.event e state _ -> pure state @@ -39,15 +45,16 @@ event' e state = -- returns new state if successful event :: ActionSets -> Event -> State -> State event actions e state = do + let norm = normal actions let mEv = case state ^. mode of - Normal -> lookup e $ normal actions + Normal -> lookup e norm Modal (Detail _ DetailNormal) -> lookup e $ detail actions Modal Help -> lookup e $ help actions _ -> Nothing fromMaybe state $ case mEv of - Nothing -> event' e state + Nothing -> event' e norm state Just ev -> ev state data ActionSets = ActionSets diff --git a/src/Events/Actions/Search.hs b/src/Events/Actions/Search.hs index 0e6c547b..c0c5cabe 100644 --- a/src/Events/Actions/Search.hs +++ b/src/Events/Actions/Search.hs @@ -14,8 +14,6 @@ import Events.State.Types.Mode (Mode (Search)) import Graphics.Vty.Input.Events import qualified UI.Field as F (event) -import qualified Events.Actions.Normal as Normal - search :: Event -> Stateful search (EvKey KEnter _) s = searchEntered s search e s = @@ -24,14 +22,10 @@ search e s = Search ent field -> s & mode .~ Search ent (F.event e field) _ -> s -event :: Event -> Stateful -event (EvKey KEsc _) s = normalMode s -event e s = +event :: (Event -> Stateful) -> Event -> Stateful +event _ (EvKey KEsc _) s = normalMode s +event fb e s = case s ^. mode of - Search ent _ -> - (if ent - then search - else Normal.event) - e - s - _ -> pure s + Search True _ -> search e s + Search False _ -> fb e s + _ -> pure s From 265c8afa3b4b5b460445b9e71a2dbeccbfe3e0f3 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Thu, 1 Aug 2019 17:06:42 +0100 Subject: [PATCH 12/33] chore: ignores .cmt.bkp --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 50aed8c3..cb1b818d 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ large.md .stack-work-profile/ releases/ homebrew-taskell/ +.cmt.bkp From cac9a1072effb1c0c566c5e6cc0c0df76214eb80 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 29 Jul 2019 11:13:12 +0100 Subject: [PATCH 13/33] feat: added mode info to status bar --- roadmap.md | 6 +++++- src/UI/Draw.hs | 19 +++++++++++++++++-- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/roadmap.md b/roadmap.md index 078ee9ea..ea4e5a7d 100644 --- a/roadmap.md +++ b/roadmap.md @@ -82,8 +82,10 @@ ## In Progress -- Search should be case insensitive - Can't remove dates +- Modals interfere with status bar +- Showing a specific task in search mode shows wrong task + > Based on the index in the full list, rather than the filtered one. So will show the task from the full list if the indexes don't happen to match. - Add custom key support * [x] Create bindings.ini * [x] Update events to use Map from bindings.ini @@ -273,3 +275,5 @@ - Title bar for extra info * [x] File path * [x] Current position +- Search should be case insensitive +- Add Mode to status bar diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs index 633736bc..59258920 100644 --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -189,14 +189,29 @@ getPosition = do else 0 pure $ tshow posNorm <> "/" <> tshow len +getMode :: ReaderDrawState Text +getMode = do + md <- asks dsMode + pure $ + case md of + Normal -> "NORMAL" + Insert {} -> "INSERT" + Modal Help -> "HELP" + Modal MoveTo -> "MOVE" + Modal (Detail {}) -> "DETAIL" + Search {} -> "SEARCH" + _ -> "" + renderStatusBar :: ReaderDrawState (Widget ResourceName) renderStatusBar = do topPath <- pack <$> asks dsPath colPad <- columnPadding <$> asks dsLayout posTxt <- getPosition - let titl = padRight Max . padLeft (Pad colPad) $ txt topPath + modeTxt <- getMode + let titl = padLeftRight colPad $ txt topPath let pos = padRight (Pad colPad) $ txt posTxt - let bar = titl <+> pos + let md = txt modeTxt + let bar = padRight Max (titl <+> md) <+> pos pure . padTop (Pad 1) $ withAttr statusBarAttr bar -- | Renders the main widget From c39e45ead67f947a731099dc8f20adc486c3bf1e Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sat, 3 Aug 2019 15:45:21 +0100 Subject: [PATCH 14/33] fix: fixes modal overlapping status bar issue --- package.yaml | 1 + roadmap.md | 2 +- src/App.hs | 22 +++++++++----- src/Events/State.hs | 17 +++++++++-- src/Events/State/Types.hs | 1 + src/UI/Draw.hs | 63 ++++++++++++++++++++------------------- src/UI/Modal.hs | 20 +++++++------ test/Events/StateTest.hs | 2 ++ 8 files changed, 79 insertions(+), 49 deletions(-) diff --git a/package.yaml b/package.yaml index 29d61d0b..d1d7908b 100644 --- a/package.yaml +++ b/package.yaml @@ -69,6 +69,7 @@ library: - lens - mtl - template-haskell + - terminal-size - text - time - vty diff --git a/roadmap.md b/roadmap.md index ea4e5a7d..06904bf8 100644 --- a/roadmap.md +++ b/roadmap.md @@ -83,7 +83,6 @@ ## In Progress - Can't remove dates -- Modals interfere with status bar - Showing a specific task in search mode shows wrong task > Based on the index in the full list, rather than the filtered one. So will show the task from the full list if the indexes don't happen to match. - Add custom key support @@ -277,3 +276,4 @@ * [x] Current position - Search should be case insensitive - Add Mode to status bar +- Modals interfere with status bar diff --git a/src/App.hs b/src/App.hs index 1aafa3ea..01d898d8 100644 --- a/src/App.hs +++ b/src/App.hs @@ -9,15 +9,16 @@ import ClassyPrelude import Control.Lens ((^.)) import Brick -import Graphics.Vty (Mode (BracketedPaste), outputIface, setMode, supportsMode) -import Graphics.Vty.Input.Events (Event (..)) +import Graphics.Vty (Mode (BracketedPaste), outputIface, setMode, supportsMode) +import Graphics.Vty.Input.Events (Event (..)) +import System.Console.Terminal.Size (height, size) import qualified Control.FoldDebounce as Debounce import Data.Taskell.Date (currentDay) import Data.Taskell.Lists (Lists) import Events.Actions (ActionSets, event, generateActions) -import Events.State (continue, countCurrent) +import Events.State (continue, countCurrent, setHeight) import Events.State.Types (State, current, io, lists, mode, path) import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..)) import IO.Config (Config, generateAttrMap, getBindings, layout) @@ -96,15 +97,21 @@ handleVtyEvent (send, trigger) actions previousState e = do (Insert ITask ICreate _) -> clearList state *> next send state _ -> clearCache previousState *> clearCache state *> next send state +getHeight :: EventM ResourceName Int +getHeight = maybe 1000 height <$> liftIO size + handleEvent :: (DebouncedWrite, Trigger) -> ActionSets -> State -> BrickEvent ResourceName e -> EventM ResourceName (Next State) -handleEvent _ _ state (VtyEvent (EvResize _ _)) = invalidateCache *> Brick.continue state -handleEvent db actions state (VtyEvent ev) = handleVtyEvent db actions state ev -handleEvent _ _ state _ = Brick.continue state +handleEvent _ _ state (VtyEvent (EvResize _ _)) = do + invalidateCache + h <- getHeight + Brick.continue (setHeight h state) +handleEvent db actions state (VtyEvent ev) = handleVtyEvent db actions state ev +handleEvent _ _ state _ = Brick.continue state -- | Runs when the app starts -- Adds paste support @@ -112,7 +119,8 @@ appStart :: State -> EventM ResourceName State appStart state = do output <- outputIface <$> getVtyHandle when (supportsMode output BracketedPaste) . liftIO $ setMode output BracketedPaste True - pure state + h <- getHeight + pure (setHeight h state) -- | Sets up Brick go :: Config -> State -> IO () diff --git a/src/Events/State.hs b/src/Events/State.hs index 7f4ca057..dbdc8a1d 100644 --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -6,6 +6,7 @@ module Events.State ( continue , write , countCurrent + , setHeight -- UI.Main , normalise -- Main @@ -72,7 +73,15 @@ type InternalStateful = State -> State create :: FilePath -> Lists.Lists -> State create p ls = - State {_mode = Normal, _lists = ls, _history = [], _current = (0, 0), _path = p, _io = Nothing} + State + { _mode = Normal + , _lists = ls + , _history = [] + , _current = (0, 0) + , _path = p + , _io = Nothing + , _height = 0 + } -- app state quit :: Stateful @@ -351,7 +360,11 @@ showHelp = Just . (mode .~ Modal Help) showMoveTo :: Stateful showMoveTo = Just . (mode .~ Modal MoveTo) --- view - maybe shouldn't be in here... +-- view +setHeight :: Int -> State -> State +setHeight i = height .~ i + +-- more view - maybe shouldn't be in here... search :: State -> State search state = case state ^. mode of diff --git a/src/Events/State/Types.hs b/src/Events/State/Types.hs index d695bb93..255517e6 100644 --- a/src/Events/State/Types.hs +++ b/src/Events/State/Types.hs @@ -20,6 +20,7 @@ data State = State , _current :: Pointer , _path :: FilePath , _io :: Maybe Lists + , _height :: Int } deriving (Eq, Show) -- create lenses diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs index 59258920..05e110da 100644 --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} module UI.Draw ( draw @@ -22,7 +23,7 @@ import Data.Taskell.Lists (Lists, count) import qualified Data.Taskell.Task as T (Task, countCompleteSubtasks, countSubtasks, description, due, hasSubtasks, name) import Events.State (normalise) -import Events.State.Types (Pointer, State, current, lists, mode, path) +import Events.State.Types (Pointer, State, current, height, lists, mode, path) import Events.State.Types.Mode (DetailMode (..), InsertType (..), ModalType (..), Mode (..)) import IO.Config.Layout (Config, columnPadding, columnWidth, descriptionIndicator) @@ -189,18 +190,19 @@ getPosition = do else 0 pure $ tshow posNorm <> "/" <> tshow len +modeToText :: Mode -> Text +modeToText = + \case + Normal -> "NORMAL" + Insert {} -> "INSERT" + Modal Help -> "HELP" + Modal MoveTo -> "MOVE" + Modal Detail {} -> "DETAIL" + Search {} -> "SEARCH" + _ -> "" + getMode :: ReaderDrawState Text -getMode = do - md <- asks dsMode - pure $ - case md of - Normal -> "NORMAL" - Insert {} -> "INSERT" - Modal Help -> "HELP" - Modal MoveTo -> "MOVE" - Modal (Detail {}) -> "DETAIL" - Search {} -> "SEARCH" - _ -> "" +getMode = modeToText <$> asks dsMode renderStatusBar :: ReaderDrawState (Widget ResourceName) renderStatusBar = do @@ -236,28 +238,29 @@ moveTo (Modal MoveTo) = True moveTo _ = False -- draw +drawR :: Int -> State -> Bindings -> ReaderDrawState [Widget ResourceName] +drawR ht normalisedState bindings = do + modal <- showModal ht bindings normalisedState <$> asks dsToday + mn <- main + pure [modal, mn] + draw :: Config -> Bindings -> Day -> State -> [Widget ResourceName] -draw layout bindings today state = - showModal - bindings - normalisedState - today - [ runReader - main - DrawState - { dsLists = normalisedState ^. lists - , dsMode = stateMode - , dsLayout = layout - , dsPath = normalisedState ^. path - , dsToday = today - , dsField = getField stateMode - , dsCurrent = normalisedState ^. current - , dsEditingTitle = editingTitle stateMode - } - ] +draw layout bindings today state = runReader (drawR ht normalisedState bindings) drawState where normalisedState = normalise state stateMode = state ^. mode + ht = state ^. height + drawState = + DrawState + { dsLists = normalisedState ^. lists + , dsMode = stateMode + , dsLayout = layout + , dsPath = normalisedState ^. path + , dsToday = today + , dsField = getField stateMode + , dsCurrent = normalisedState ^. current + , dsEditingTitle = editingTitle stateMode + } -- cursors chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName) diff --git a/src/UI/Modal.hs b/src/UI/Modal.hs index 05bd5e28..7a172e58 100644 --- a/src/UI/Modal.hs +++ b/src/UI/Modal.hs @@ -23,19 +23,21 @@ import UI.Modal.MoveTo (moveTo) import UI.Theme (titleAttr) import UI.Types (ResourceName (..)) -surround :: (Text, Widget ResourceName) -> Widget ResourceName -surround (title, widget) = +surround :: Int -> (Text, Widget ResourceName) -> Widget ResourceName +surround ht (title, widget) = padTopBottom 1 . centerLayer . - border . padTopBottom 1 . padLeftRight 4 . hLimit 50 . (t <=>) . viewport RNModal Vertical $ + border . + padTopBottom 1 . + padLeftRight 4 . vLimit (ht - 9) . hLimit 50 . (t <=>) . viewport RNModal Vertical $ widget where t = padBottom (Pad 1) . withAttr titleAttr $ textField title -showModal :: Bindings -> State -> Day -> [Widget ResourceName] -> [Widget ResourceName] -showModal bindings state today view = +showModal :: Int -> Bindings -> State -> Day -> Widget ResourceName +showModal ht bindings state today = case state ^. mode of - Modal Help -> surround (help bindings) : view - Modal Detail {} -> surround (detail state today) : view - Modal MoveTo -> surround (moveTo state) : view - _ -> view + Modal Help -> surround ht (help bindings) + Modal Detail {} -> surround ht (detail state today) + Modal MoveTo -> surround ht (moveTo state) + _ -> emptyWidget diff --git a/test/Events/StateTest.hs b/test/Events/StateTest.hs index f3d11381..fde90b02 100644 --- a/test/Events/StateTest.hs +++ b/test/Events/StateTest.hs @@ -28,6 +28,7 @@ testState = , _current = (0, 0) , _path = "test.md" , _io = Nothing + , _height = 0 } moveToState :: State @@ -50,6 +51,7 @@ moveToState = , _current = (4, 0) , _path = "test.md" , _io = Nothing + , _height = 0 } -- tests From 3ebdd9a0c2e6f1304fbaecf5edda95b9027ba4d2 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sat, 3 Aug 2019 15:45:21 +0100 Subject: [PATCH 15/33] chore: fixes issue with weeder --- .weeder.yaml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.weeder.yaml b/.weeder.yaml index d6669c51..0a98510d 100644 --- a/.weeder.yaml +++ b/.weeder.yaml @@ -5,3 +5,8 @@ - message: - name: Redundant build-depends entry - depends: tasty-discover + - section: + - name: library + - message: + - name: Redundant build-depends entry + - depends: terminal-size From f2423b7591fd819db1bb2cc7829838970145c3de Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sat, 3 Aug 2019 18:15:39 +0100 Subject: [PATCH 16/33] refactor: switches search from mode into state still issues with editing wrong task --- src/App.hs | 5 +++-- src/Events/Actions.hs | 17 +++++------------ src/Events/Actions/Normal.hs | 1 + src/Events/Actions/Search.hs | 24 ++++++++++++------------ src/Events/State.hs | 23 ++++++++--------------- src/Events/State/Types.hs | 16 +++++++++------- src/Events/State/Types/Mode.hs | 3 +-- src/UI/Draw.hs | 20 ++++++++++++-------- test/Events/StateTest.hs | 2 ++ 9 files changed, 53 insertions(+), 58 deletions(-) diff --git a/src/App.hs b/src/App.hs index 01d898d8..5ddeece1 100644 --- a/src/App.hs +++ b/src/App.hs @@ -19,7 +19,7 @@ import Data.Taskell.Date (currentDay) import Data.Taskell.Lists (Lists) import Events.Actions (ActionSets, event, generateActions) import Events.State (continue, countCurrent, setHeight) -import Events.State.Types (State, current, io, lists, mode, path) +import Events.State.Types (State, current, io, lists, mode, path, searchTerm) import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..)) import IO.Config (Config, generateAttrMap, getBindings, layout) import IO.Taskell (writeData) @@ -86,8 +86,9 @@ handleVtyEvent :: (DebouncedWrite, Trigger) -> ActionSets -> State -> Event -> EventM ResourceName (Next State) handleVtyEvent (send, trigger) actions previousState e = do let state = event actions e previousState + when (isJust (previousState ^. searchTerm) && isNothing (state ^. searchTerm)) invalidateCache case previousState ^. mode of - Search _ _ -> invalidateCache + Search -> invalidateCache (Modal MoveTo) -> clearAllTitles previousState (Insert ITask ICreate _) -> clearList previousState _ -> pure () diff --git a/src/Events/Actions.hs b/src/Events/Actions.hs index cabdaeff..0cde3b96 100644 --- a/src/Events/Actions.hs +++ b/src/Events/Actions.hs @@ -25,19 +25,13 @@ import qualified Events.Actions.Modal.Help as Help import qualified Events.Actions.Normal as Normal import qualified Events.Actions.Search as Search -fallback :: BoundActions -> Event -> Stateful -fallback norm e state = - case lookup e norm of - Just ev -> ev state - Nothing -> Normal.event e state - -- takes an event and returns a Maybe State -event' :: Event -> BoundActions -> Stateful +event' :: Event -> Stateful -- for other events pass through to relevant modules -event' e norm state = +event' e state = case state ^. mode of Normal -> Normal.event e state - Search {} -> Search.event (fallback norm) e state + Search -> Search.event e state Insert {} -> Insert.event e state Modal {} -> Modal.event e state _ -> pure state @@ -45,16 +39,15 @@ event' e norm state = -- returns new state if successful event :: ActionSets -> Event -> State -> State event actions e state = do - let norm = normal actions let mEv = case state ^. mode of - Normal -> lookup e norm + Normal -> lookup e $ normal actions Modal (Detail _ DetailNormal) -> lookup e $ detail actions Modal Help -> lookup e $ help actions _ -> Nothing fromMaybe state $ case mEv of - Nothing -> event' e norm state + Nothing -> event' e state Just ev -> ev state data ActionSets = ActionSets diff --git a/src/Events/Actions/Normal.hs b/src/Events/Actions/Normal.hs index 689867e9..7132af0b 100644 --- a/src/Events/Actions/Normal.hs +++ b/src/Events/Actions/Normal.hs @@ -60,5 +60,6 @@ event :: Event -> Stateful event (EvKey (KChar n) _) | isDigit n = selectList n | otherwise = pure +event (EvKey KEsc _) = clearSearch -- fallback event _ = pure diff --git a/src/Events/Actions/Search.hs b/src/Events/Actions/Search.hs index c0c5cabe..6777d05d 100644 --- a/src/Events/Actions/Search.hs +++ b/src/Events/Actions/Search.hs @@ -9,23 +9,23 @@ import ClassyPrelude import Control.Lens ((&), (.~), (^.)) import Events.State -import Events.State.Types (Stateful, mode) +import Events.State.Types (Stateful, mode, searchTerm) import Events.State.Types.Mode (Mode (Search)) import Graphics.Vty.Input.Events -import qualified UI.Field as F (event) +import qualified UI.Field as F (blankField, event) search :: Event -> Stateful -search (EvKey KEnter _) s = searchEntered s +search (EvKey KEnter _) s = normalMode s search e s = pure $ case s ^. mode of - Search ent field -> s & mode .~ Search ent (F.event e field) - _ -> s + Search -> do + let field = s ^. searchTerm + case field of + Nothing -> s & searchTerm .~ Just (F.event e F.blankField) + Just f -> s & searchTerm .~ Just (F.event e f) + _ -> s -event :: (Event -> Stateful) -> Event -> Stateful -event _ (EvKey KEsc _) s = normalMode s -event fb e s = - case s ^. mode of - Search True _ -> search e s - Search False _ -> fb e s - _ -> pure s +event :: Event -> Stateful +event (EvKey KEsc _) s = clearSearch =<< normalMode s +event e s = search e s diff --git a/src/Events/State.hs b/src/Events/State.hs index dbdc8a1d..2c951639 100644 --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -37,8 +37,7 @@ module Events.State , undo , store , searchMode - -- Events.Actions.Search - , searchEntered + , clearSearch -- Events.Actions.Insert , createList , removeBlank @@ -81,6 +80,7 @@ create p ls = , _path = p , _io = Nothing , _height = 0 + , _searchTerm = Nothing } -- app state @@ -341,17 +341,10 @@ listRight = listMove 1 -- search searchMode :: Stateful -searchMode state = - Just $ - case state ^. mode of - Search _ field -> state & mode .~ Search True field - _ -> state & mode .~ Search True blankField +searchMode state = Just $ (state & mode .~ Search) & searchTerm .~ Just blankField -searchEntered :: Stateful -searchEntered state = - case state ^. mode of - Search _ field -> Just $ state & mode .~ Search False field - _ -> Nothing +clearSearch :: Stateful +clearSearch state = pure $ state & searchTerm .~ Nothing -- help showHelp :: Stateful @@ -367,9 +360,9 @@ setHeight i = height .~ i -- more view - maybe shouldn't be in here... search :: State -> State search state = - case state ^. mode of - Search _ field -> fixIndex . setLists state $ Lists.search (getText field) (state ^. lists) - _ -> state + case state ^. searchTerm of + Just field -> fixIndex . setLists state $ Lists.search (getText field) (state ^. lists) + Nothing -> state newList :: State -> State newList state = diff --git a/src/Events/State/Types.hs b/src/Events/State/Types.hs index 255517e6..45820ec3 100644 --- a/src/Events/State/Types.hs +++ b/src/Events/State/Types.hs @@ -8,19 +8,21 @@ import ClassyPrelude import Control.Lens (makeLenses) import Data.Taskell.Lists (Lists) +import UI.Field (Field) import qualified Events.State.Types.Mode as M (Mode) type Pointer = (Int, Int) data State = State - { _mode :: M.Mode - , _lists :: Lists - , _history :: [(Pointer, Lists)] - , _current :: Pointer - , _path :: FilePath - , _io :: Maybe Lists - , _height :: Int + { _mode :: M.Mode + , _lists :: Lists + , _history :: [(Pointer, Lists)] + , _current :: Pointer + , _path :: FilePath + , _io :: Maybe Lists + , _height :: Int + , _searchTerm :: Maybe Field } deriving (Eq, Show) -- create lenses diff --git a/src/Events/State/Types/Mode.hs b/src/Events/State/Types/Mode.hs index 97a2d6e1..072a886a 100644 --- a/src/Events/State/Types/Mode.hs +++ b/src/Events/State/Types/Mode.hs @@ -40,7 +40,6 @@ data Mode InsertMode Field | Modal ModalType - | Search Bool - Field + | Search | Shutdown deriving (Eq, Show) diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs index 05e110da..ca4e256a 100644 --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -23,7 +23,8 @@ import Data.Taskell.Lists (Lists, count) import qualified Data.Taskell.Task as T (Task, countCompleteSubtasks, countSubtasks, description, due, hasSubtasks, name) import Events.State (normalise) -import Events.State.Types (Pointer, State, current, height, lists, mode, path) +import Events.State.Types (Pointer, State, current, height, lists, mode, path, + searchTerm) import Events.State.Types.Mode (DetailMode (..), InsertType (..), ModalType (..), Mode (..)) import IO.Config.Layout (Config, columnPadding, columnWidth, descriptionIndicator) @@ -43,6 +44,7 @@ data DrawState = DrawState , dsCurrent :: Pointer , dsField :: Maybe Field , dsEditingTitle :: Bool + , dsSearchTerm :: Maybe Field } -- | Use a Reader to pass around DrawState @@ -166,15 +168,16 @@ renderList listIndex list = do -- | Renders the search area renderSearch :: Widget ResourceName -> ReaderDrawState (Widget ResourceName) renderSearch mainWidget = do - m <- dsMode <$> ask - case m of - Search editing searchField -> do + m <- asks dsMode + term <- asks dsSearchTerm + case term of + Just searchField -> do colPad <- columnPadding . dsLayout <$> ask let attr = withAttr $ - if editing - then taskCurrentAttr - else taskAttr + case m of + Search -> taskCurrentAttr + _ -> taskAttr let widget = attr . padLeftRight colPad $ txt "/" <+> field searchField pure $ mainWidget <=> widget _ -> pure mainWidget @@ -260,6 +263,7 @@ draw layout bindings today state = runReader (drawR ht normalisedState bindings) , dsField = getField stateMode , dsCurrent = normalisedState ^. current , dsEditingTitle = editingTitle stateMode + , dsSearchTerm = normalisedState ^. searchTerm } -- cursors @@ -267,6 +271,6 @@ chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation chooseCursor state = case normalise state ^. mode of Insert {} -> showCursorNamed RNCursor - Search True _ -> showCursorNamed RNCursor + Search -> showCursorNamed RNCursor Modal (Detail _ (DetailInsert _)) -> showCursorNamed RNCursor _ -> neverShowCursor state diff --git a/test/Events/StateTest.hs b/test/Events/StateTest.hs index fde90b02..c13d424d 100644 --- a/test/Events/StateTest.hs +++ b/test/Events/StateTest.hs @@ -29,6 +29,7 @@ testState = , _path = "test.md" , _io = Nothing , _height = 0 + , _searchTerm = Nothing } moveToState :: State @@ -52,6 +53,7 @@ moveToState = , _path = "test.md" , _io = Nothing , _height = 0 + , _searchTerm = Nothing } -- tests From de42516375236b8e1a39e9f575872482434a6650 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sun, 4 Aug 2019 10:08:26 +0100 Subject: [PATCH 17/33] refactor: moves search filtering into Draw filtering search in Draw to avoid working with "normalised" state --- src/Events/State.hs | 8 +------- src/UI/Draw.hs | 18 ++++++++++++++---- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/Events/State.hs b/src/Events/State.hs index 2c951639..2c3e4980 100644 --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -358,12 +358,6 @@ setHeight :: Int -> State -> State setHeight i = height .~ i -- more view - maybe shouldn't be in here... -search :: State -> State -search state = - case state ^. searchTerm of - Just field -> fixIndex . setLists state $ Lists.search (getText field) (state ^. lists) - Nothing -> state - newList :: State -> State newList state = case state ^. mode of @@ -373,4 +367,4 @@ newList state = _ -> state normalise :: State -> State -normalise = newList . search +normalise = newList diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs index ca4e256a..160e7037 100644 --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -20,7 +20,7 @@ import Brick import Data.Taskell.Date (Day, dayToText, deadline) import Data.Taskell.List (List, tasks, title) import Data.Taskell.Lists (Lists, count) -import qualified Data.Taskell.Task as T (Task, countCompleteSubtasks, countSubtasks, +import qualified Data.Taskell.Task as T (Task, contains, countCompleteSubtasks, countSubtasks, description, due, hasSubtasks, name) import Events.State (normalise) import Events.State.Types (Pointer, State, current, height, lists, mode, path, @@ -29,7 +29,7 @@ import Events.State.Types.Mode (DetailMode (..), InsertType (..), Moda Mode (..)) import IO.Config.Layout (Config, columnPadding, columnWidth, descriptionIndicator) import IO.Keyboard.Types (Bindings) -import UI.Field (Field, field, textField, widgetFromMaybe) +import UI.Field (Field, field, getText, textField, widgetFromMaybe) import UI.Modal (showModal) import UI.Theme import UI.Types (ListIndex (..), ResourceName (..), TaskIndex (..)) @@ -77,8 +77,8 @@ indicators task = do ] -- | Renders an individual task -renderTask :: Int -> Int -> T.Task -> ReaderDrawState (Widget ResourceName) -renderTask listIndex taskIndex task = do +renderTask' :: Int -> Int -> T.Task -> ReaderDrawState (Widget ResourceName) +renderTask' listIndex taskIndex task = do eTitle <- dsEditingTitle <$> ask -- is the title being edited? (for visibility) selected <- (== (listIndex, taskIndex)) . dsCurrent <$> ask -- is the current task selected? taskField <- dsField <$> ask -- get the field, if it's being edited @@ -102,6 +102,16 @@ renderTask listIndex taskIndex task = do then widget' else widget +renderTask :: Int -> Int -> T.Task -> ReaderDrawState (Widget ResourceName) +renderTask listIndex taskIndex task = do + searchT <- asks dsSearchTerm + case searchT of + Nothing -> renderTask' listIndex taskIndex task + Just term -> + if T.contains (getText term) task + then renderTask' listIndex taskIndex task + else pure emptyWidget + -- | Gets the relevant column prefix - number in normal mode, letter in moveTo columnPrefix :: Int -> Int -> ReaderDrawState Text columnPrefix selectedList i = do From ac1f871369e22f0e2b3bce92aa1604f7f69e71e4 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sat, 3 Aug 2019 15:45:21 +0100 Subject: [PATCH 18/33] fix: fixes moving up and down in search (#39) sideways still doesn't work --- src/Data/Taskell/List.hs | 2 ++ src/Data/Taskell/List/Internal.hs | 25 +++++++++++++++++++++++-- src/Events/State.hs | 27 +++++++++++---------------- 3 files changed, 36 insertions(+), 18 deletions(-) diff --git a/src/Data/Taskell/List.hs b/src/Data/Taskell/List.hs index a7a274ce..45a9e334 100644 --- a/src/Data/Taskell/List.hs +++ b/src/Data/Taskell/List.hs @@ -17,6 +17,8 @@ module Data.Taskell.List , deleteTask , getTask , searchFor + , nextTask + , prevTask ) where import Data.Taskell.List.Internal diff --git a/src/Data/Taskell/List/Internal.hs b/src/Data/Taskell/List/Internal.hs index 7b3c1c8a..f92dd135 100644 --- a/src/Data/Taskell/List/Internal.hs +++ b/src/Data/Taskell/List/Internal.hs @@ -5,7 +5,7 @@ module Data.Taskell.List.Internal where import ClassyPrelude -import Control.Lens (ix, makeLenses, (%%~), (%~), (&), (.~), (^.), (^?)) +import Control.Lens (element, makeLenses, (%%~), (%~), (&), (.~), (^.), (^?)) import Data.Sequence as S (adjust', deleteAt, insertAt, update, (|>)) @@ -59,7 +59,28 @@ deleteTask :: Int -> Update deleteTask idx = tasks %~ deleteAt idx getTask :: Int -> List -> Maybe T.Task -getTask idx = (^? tasks . ix idx) +getTask idx = (^? tasks . element idx) searchFor :: Text -> Update searchFor text = tasks %~ filter (T.contains text) + +changeTask :: Int -> Int -> Int -> Maybe Text -> List -> Int +changeTask dir original current term list = + case task of + Nothing -> original + Just tsk -> + case term of + Nothing -> next + Just trm -> + if T.contains trm tsk + then next + else changeTask dir original next term list + where + next = current + dir + task = getTask next list + +nextTask :: Int -> Maybe Text -> List -> Int +nextTask idx = changeTask 1 idx idx + +prevTask :: Int -> Maybe Text -> List -> Int +prevTask idx = changeTask (-1) idx idx diff --git a/src/Events/State.hs b/src/Events/State.hs index 2c3e4980..37d9a805 100644 --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -60,7 +60,8 @@ import Control.Lens ((&), (.~), (^.)) import Data.Char (digitToInt, ord) -import Data.Taskell.List (List, deleteTask, getTask, move, new, newAt, title, update) +import Data.Taskell.List (List, deleteTask, getTask, move, new, newAt, nextTask, + prevTask, title, update) import qualified Data.Taskell.Lists as Lists import Data.Taskell.Task (Task, isBlank, name) @@ -240,24 +241,18 @@ setCurrentList state idx = state & current .~ (idx, getIndex state) getIndex :: State -> Int getIndex = snd . (^. current) +changeTask :: (Int -> Maybe Text -> List -> Int) -> Stateful +changeTask fn state = do + list <- getList state + let idx = getIndex state + let term = getText <$> state ^. searchTerm + Just $ setIndex state (fn idx term list) + next :: Stateful -next state = Just $ setIndex state idx' - where - idx = getIndex state - count = countCurrent state - idx' = - if idx < (count - 1) - then succ idx - else idx +next = changeTask nextTask previous :: Stateful -previous state = Just $ setIndex state idx' - where - idx = getIndex state - idx' = - if idx > 0 - then pred idx - else 0 +previous = changeTask prevTask left :: Stateful left state = From cd53b3de92ec102dd9ca49bf3d08310644a1ac76 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sun, 4 Aug 2019 12:14:55 +0100 Subject: [PATCH 19/33] feat: adds 'NORMAL + SEARCH' mode to status bar --- src/UI/Draw.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs index 160e7037..30ac90ce 100644 --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -203,10 +203,13 @@ getPosition = do else 0 pure $ tshow posNorm <> "/" <> tshow len -modeToText :: Mode -> Text -modeToText = +modeToText :: Maybe Field -> Mode -> Text +modeToText fld = \case - Normal -> "NORMAL" + Normal -> + case fld of + Nothing -> "NORMAL" + Just _ -> "NORMAL + SEARCH" Insert {} -> "INSERT" Modal Help -> "HELP" Modal MoveTo -> "MOVE" @@ -215,7 +218,7 @@ modeToText = _ -> "" getMode :: ReaderDrawState Text -getMode = modeToText <$> asks dsMode +getMode = modeToText <$> asks dsSearchTerm <*> asks dsMode renderStatusBar :: ReaderDrawState (Widget ResourceName) renderStatusBar = do From 2de9a0d849a1170be806a83141e20270be70509b Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sat, 3 Aug 2019 15:45:21 +0100 Subject: [PATCH 20/33] docs: adds search issues (#39) --- roadmap.md | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/roadmap.md b/roadmap.md index 06904bf8..1a710b07 100644 --- a/roadmap.md +++ b/roadmap.md @@ -25,7 +25,6 @@ - No longer a difference between and move right - Help modal needs to wrap and scroll - Modal boxes shouldn't be full height unless they need to be -- Up and down in search gets a bit lost - Multiple spaces in a line don't show up as more than one, but are saved as more than one - Task description should be visible by default in task detail > Visibility should be on the description by default? @@ -82,9 +81,13 @@ ## In Progress +- Search navigation issues + > Issues with navigation when in NORMAL + SEARCH mode + * [x] Navigating up and down + * [ ] Navigating between lists + * [ ] Moving task up and down + * [ ] Often nothing is selected when first entering search mode - Can't remove dates -- Showing a specific task in search mode shows wrong task - > Based on the index in the full list, rather than the filtered one. So will show the task from the full list if the indexes don't happen to match. - Add custom key support * [x] Create bindings.ini * [x] Update events to use Map from bindings.ini @@ -277,3 +280,5 @@ - Search should be case insensitive - Add Mode to status bar - Modals interfere with status bar +- Showing a specific task in search mode shows wrong task + > Based on the index in the full list, rather than the filtered one. So will show the task from the full list if the indexes don't happen to match. From fabb9fcf614c3c7acfba5947035d7dc00d05dbb5 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 08:35:14 +0100 Subject: [PATCH 21/33] refactor: removes terminal-size package --- .weeder.yaml | 5 ----- package.yaml | 1 - src/App.hs | 8 ++++---- 3 files changed, 4 insertions(+), 10 deletions(-) diff --git a/.weeder.yaml b/.weeder.yaml index 0a98510d..d6669c51 100644 --- a/.weeder.yaml +++ b/.weeder.yaml @@ -5,8 +5,3 @@ - message: - name: Redundant build-depends entry - depends: tasty-discover - - section: - - name: library - - message: - - name: Redundant build-depends entry - - depends: terminal-size diff --git a/package.yaml b/package.yaml index d1d7908b..29d61d0b 100644 --- a/package.yaml +++ b/package.yaml @@ -69,7 +69,6 @@ library: - lens - mtl - template-haskell - - terminal-size - text - time - vty diff --git a/src/App.hs b/src/App.hs index 5ddeece1..75a6ac6f 100644 --- a/src/App.hs +++ b/src/App.hs @@ -9,9 +9,9 @@ import ClassyPrelude import Control.Lens ((^.)) import Brick -import Graphics.Vty (Mode (BracketedPaste), outputIface, setMode, supportsMode) -import Graphics.Vty.Input.Events (Event (..)) -import System.Console.Terminal.Size (height, size) +import Graphics.Vty (Mode (BracketedPaste), displayBounds, outputIface, setMode, + supportsMode) +import Graphics.Vty.Input.Events (Event (..)) import qualified Control.FoldDebounce as Debounce @@ -99,7 +99,7 @@ handleVtyEvent (send, trigger) actions previousState e = do _ -> clearCache previousState *> clearCache state *> next send state getHeight :: EventM ResourceName Int -getHeight = maybe 1000 height <$> liftIO size +getHeight = snd <$> (displayBounds =<< outputIface <$> getVtyHandle) handleEvent :: (DebouncedWrite, Trigger) From 9361fad51a307fa4204567b5f3662592e13377b4 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 08:35:32 +0100 Subject: [PATCH 22/33] chore: updates stack reslover --- stack.yaml | 2 +- stack.yaml.lock | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/stack.yaml b/stack.yaml index 69607b11..c18495d2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-13.29 +resolver: lts-13.30 pvp-bounds: both packages: - . diff --git a/stack.yaml.lock b/stack.yaml.lock index 192925fa..5d330faa 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -42,6 +42,6 @@ packages: snapshots: - completed: size: 500539 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/29.yaml - sha256: 006398c5e92d1d64737b7e98ae4d63987c36808814504d1451f56ebd98093f75 - original: lts-13.29 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml + sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b + original: lts-13.30 From ee73982f4f9e36e6a336998a15089f026b2fa6b6 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 08:43:06 +0100 Subject: [PATCH 23/33] fix: fixes inability to remove dates --- roadmap.md | 2 +- src/Data/Taskell/Task/Internal.hs | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/roadmap.md b/roadmap.md index 1a710b07..450fe897 100644 --- a/roadmap.md +++ b/roadmap.md @@ -87,7 +87,6 @@ * [ ] Navigating between lists * [ ] Moving task up and down * [ ] Often nothing is selected when first entering search mode -- Can't remove dates - Add custom key support * [x] Create bindings.ini * [x] Update events to use Map from bindings.ini @@ -282,3 +281,4 @@ - Modals interfere with status bar - Showing a specific task in search mode shows wrong task > Based on the index in the full list, rather than the filtered one. So will show the task from the full list if the indexes don't happen to match. +- Can't remove dates diff --git a/src/Data/Taskell/Task/Internal.hs b/src/Data/Taskell/Task/Internal.hs index 1fef8483..d6de9e12 100644 --- a/src/Data/Taskell/Task/Internal.hs +++ b/src/Data/Taskell/Task/Internal.hs @@ -50,10 +50,12 @@ appendDescription text = else description %~ maybeAppend text setDue :: Text -> Update -setDue date = - case textToDay date of - Just day -> due .~ Just day - Nothing -> id +setDue date task = + if null date + then task & due .~ Nothing + else case textToDay date of + Just day -> task & due .~ Just day + Nothing -> task getSubtask :: Int -> Task -> Maybe ST.Subtask getSubtask idx = (^? subtasks . ix idx) From f32ad79be7be21d0c9d6cc2c64bc8e53607f60c7 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 10:49:40 +0100 Subject: [PATCH 24/33] docs: updated bugs/features --- roadmap.md | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/roadmap.md b/roadmap.md index 450fe897..c667033d 100644 --- a/roadmap.md +++ b/roadmap.md @@ -4,16 +4,16 @@ > Update taskell.app to have more than just README.md contents. Use cases, more images, examples, etc. * [ ] Use case example: checklist * [ ] Use case example: Git controlled tasks + * [ ] Blog posts for updates ## Refactoring +- Use Attoparsec for parsing - Add tests for IO.GitHub - Break up State module - Parse checkItems Trello JSON using Aeson FromJSON rather than needing extra record type -- Avoid having to normalise the state? - Remove duplication of config - currently using ini and hard-coded defaults - Move Help modal creation into Template Haskell -- Tidy up load functions in IO.Taskell - Remove `~` style sub-task complete parsing @ 2018-12-10 - Use Shake instead of bash script @@ -24,7 +24,7 @@ > The cursor gets lost if a word is longer than the line - URLs in particular can cause issues - No longer a difference between and move right - Help modal needs to wrap and scroll -- Modal boxes shouldn't be full height unless they need to be +- Limit modal height based on content - Multiple spaces in a line don't show up as more than one, but are saved as more than one - Task description should be visible by default in task detail > Visibility should be on the description by default? @@ -37,7 +37,12 @@ ## Features +- Some way to just see tasks with due dates + * [ ] Sort by date or filter by urgency? - Add a List widget for common actions between tasks and sub-tasks + * [ ] Re-ordering subtasks +- Duplicate task with `+` +- Add tags/labels with `t` - Use proper error codes - Performance with large files > Becomes unusable with large files @@ -46,38 +51,30 @@ * [ ] Invalidate layout cache less frequently * [ ] Benchmarking tests * [ ] Allow cancelling write to avoid trying to write the same file at the same time -- Inifinite task depth? - > No reason, other than UX, that sub-tasks can't have sub-tasks. - Should be able to have new-lines in task descriptions * [x] Trello import * [ ] Regular input (Shift + Enter for new line?) * [x] Markdown parsing * [ ] Text line breaks go a bit funny with multi-line descriptions - Check times work no matter what timezone -- Show filename somewhere -- Add tags/labels with `t` - URL field - plus config to run specific command when selected (e.g. `open -a Chrome.app #{url}`) - Redo functionality +- Always show list title + > Floating list titles - so you can always see what list you're in - Make token UX better * [ ] Open link automatically? * [ ] Ask for token and save to ini file automatically -- Reordering sub-tasks -- Add Trello syncing -- Item count for lists? - > Show the numbers of items in a list next to its title -- Always show list title - > Floating list titles - so you can always see what list you're in -- Duplicate task with `+` -- Some way to just see tasks with due dates - * [ ] Sort by date or filter by urgency? -- Ability to load a taskell file with custom config.ini settings - > Either command line arguments for settings or just a `-c other.ini` command - Import Issues from GitHub using labels - Readline support? > Using Haskline: https://rootmos.github.io/main/2017/08/31/combining-brick-and-haskeline.html - Editable title? > Use a `# Title` at top of file and display title somewhere in taskell - Keep undo between sessions? +- Ability to load a taskell file with custom config.ini settings + > Either command line arguments for settings or just a `-c other.ini` command +- Inifinite task depth? + > No reason, other than UX, that sub-tasks can't have sub-tasks. +- Add Trello syncing ## In Progress @@ -282,3 +279,4 @@ - Showing a specific task in search mode shows wrong task > Based on the index in the full list, rather than the filtered one. So will show the task from the full list if the indexes don't happen to match. - Can't remove dates +- Tidy up load functions in IO.Taskell From f01be476064c1121a5db1ad83011bfe5e181b6e7 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 10:50:17 +0100 Subject: [PATCH 25/33] fix: updated path to config --- templates/github-token.txt | 2 +- templates/trello-token.txt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/templates/github-token.txt b/templates/github-token.txt index 1b749b61..9bec3b8c 100644 --- a/templates/github-token.txt +++ b/templates/github-token.txt @@ -4,7 +4,7 @@ https://github.com/settings/tokens/new Make sure to tick the "repo" scope. -When you have your personal access token, add it to ~/.taskell/config.ini: +When you have your personal access token, add it to ~/.config/taskell/config.ini: [github] token = diff --git a/templates/trello-token.txt b/templates/trello-token.txt index 856827ca..4feb0a11 100644 --- a/templates/trello-token.txt +++ b/templates/trello-token.txt @@ -2,7 +2,7 @@ Please visit: https://trello.com/1/authorize?expiration=never&name=taskell&scope=read&response_type=token&key=80dbcf6f88f62cc5639774e13342c20b -When you have your access token, add it to ~/.taskell/config.ini: +When you have your access token, add it to ~/.config/taskell/config.ini: [trello] token = From 1c5825b507b1af424c220ee9bf0ac459854fed40 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 10:50:44 +0100 Subject: [PATCH 26/33] refactor: tidied up code a bit --- src/IO/Taskell.hs | 45 ++++++++++++--------------------------------- 1 file changed, 12 insertions(+), 33 deletions(-) diff --git a/src/IO/Taskell.hs b/src/IO/Taskell.hs index 9523ba7f..d8c2638b 100644 --- a/src/IO/Taskell.hs +++ b/src/IO/Taskell.hs @@ -45,17 +45,15 @@ parseArgs _ = pure $ Output (unlines ["Invalid options", load :: ReaderConfig Next load = getArgs >>= parseArgs +colonic :: FilePath -> Text -> Text +colonic path = ((pack path <> ": ") <>) + loadFile :: Text -> ReaderConfig Next loadFile filepath = do mPath <- exists filepath case mPath of - Nothing -> pure Exit - Just path -> do - content <- readData path - pure $ - case content of - Right lists -> Load path lists - Left err -> Output $ pack path <> ": " <> err + Nothing -> pure Exit + Just path -> either (Output . colonic path) (Load path) <$> readData path loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next loadRemote createFn identifier filepath = do @@ -76,12 +74,7 @@ fileInfo filepath = do let path = unpack filepath exists' <- fileExists path if exists' - then do - content <- readData path - pure $ - case content of - Right lists -> Output $ analyse filepath lists - Left err -> Output $ pack path <> ": " <> err + then Output . either (colonic path) (analyse filepath) <$> readData path else pure Exit createRemote :: @@ -93,20 +86,15 @@ createRemote :: -> ReaderConfig Next createRemote tokenFn missingToken getFn identifier path = do config <- ask - let maybeToken = tokenFn config - case maybeToken of + case tokenFn config of Nothing -> pure $ Output missingToken Just token -> do lists <- lift $ runReaderT (getFn identifier) token case lists of Left txt -> pure $ Output txt - Right ls -> do - create <- promptCreate path - if create - then do - lift $ writeData config ls path - pure $ Load path ls - else pure Exit + Right ls -> + promptCreate path >>= + bool (pure Exit) (Load path ls <$ lift (writeData config ls path)) createTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next createTrello = @@ -128,13 +116,7 @@ exists filepath = do exists' <- fileExists path if exists' then pure $ Just path - else do - create <- promptCreate path - if create - then do - createPath path - pure $ Just path - else pure Nothing + else promptCreate path >>= bool (pure Nothing) (Just path <$ createPath path) fileExists :: FilePath -> ReaderConfig Bool fileExists path = lift $ doesFileExist path @@ -156,7 +138,4 @@ writeData config tasks path = void (writeFile path $ stringify config tasks) -- reads json file readData :: FilePath -> ReaderConfig (Either Text Lists) -readData path = do - config <- ask - content <- readFile path - pure $ parse config content +readData path = parse <$> ask <*> readFile path From 4ab299a7bd0345e80a539198a3aaa88556baca23 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 11:21:30 +0100 Subject: [PATCH 27/33] fix: fixes search render caching issues --- src/App.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/App.hs b/src/App.hs index 75a6ac6f..f4320db5 100644 --- a/src/App.hs +++ b/src/App.hs @@ -86,9 +86,8 @@ handleVtyEvent :: (DebouncedWrite, Trigger) -> ActionSets -> State -> Event -> EventM ResourceName (Next State) handleVtyEvent (send, trigger) actions previousState e = do let state = event actions e previousState - when (isJust (previousState ^. searchTerm) && isNothing (state ^. searchTerm)) invalidateCache + when (previousState ^. searchTerm /= state ^. searchTerm) invalidateCache case previousState ^. mode of - Search -> invalidateCache (Modal MoveTo) -> clearAllTitles previousState (Insert ITask ICreate _) -> clearList previousState _ -> pure () From 6dd23bf0846a6636276d2f0e78f7bd9433e66e22 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 11:27:44 +0100 Subject: [PATCH 28/33] refactor: moves search appending to State --- src/Events/Actions/Search.hs | 24 ++++++++---------------- src/Events/State.hs | 8 +++++++- 2 files changed, 15 insertions(+), 17 deletions(-) diff --git a/src/Events/Actions/Search.hs b/src/Events/Actions/Search.hs index 6777d05d..2f46fe95 100644 --- a/src/Events/Actions/Search.hs +++ b/src/Events/Actions/Search.hs @@ -6,26 +6,18 @@ module Events.Actions.Search import ClassyPrelude -import Control.Lens ((&), (.~), (^.)) +import Control.Lens ((^.)) import Events.State -import Events.State.Types (Stateful, mode, searchTerm) +import Events.State.Types (Stateful, mode) import Events.State.Types.Mode (Mode (Search)) import Graphics.Vty.Input.Events -import qualified UI.Field as F (blankField, event) - -search :: Event -> Stateful -search (EvKey KEnter _) s = normalMode s -search e s = - pure $ - case s ^. mode of - Search -> do - let field = s ^. searchTerm - case field of - Nothing -> s & searchTerm .~ Just (F.event e F.blankField) - Just f -> s & searchTerm .~ Just (F.event e f) - _ -> s +import qualified UI.Field as F (event) event :: Event -> Stateful event (EvKey KEsc _) s = clearSearch =<< normalMode s -event e s = search e s +event (EvKey KEnter _) s = normalMode s +event e s = + case s ^. mode of + Search -> appendSearch (F.event e) s + _ -> pure s diff --git a/src/Events/State.hs b/src/Events/State.hs index 37d9a805..554ece5a 100644 --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -38,6 +38,7 @@ module Events.State , store , searchMode , clearSearch + , appendSearch -- Events.Actions.Insert , createList , removeBlank @@ -67,7 +68,7 @@ import Data.Taskell.Task (Task, isBlank, name) import Events.State.Types import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..)) -import UI.Field (blankField, getText, textToField) +import UI.Field (Field, blankField, getText, textToField) type InternalStateful = State -> State @@ -341,6 +342,11 @@ searchMode state = Just $ (state & mode .~ Search) & searchTerm .~ Just blankFie clearSearch :: Stateful clearSearch state = pure $ state & searchTerm .~ Nothing +appendSearch :: (Field -> Field) -> Stateful +appendSearch genField state = do + let field = fromMaybe blankField (state ^. searchTerm) + pure $ state & searchTerm .~ Just (genField field) + -- help showHelp :: Stateful showHelp = Just . (mode .~ Modal Help) From fc50f37a4ef073254f9be87f555ef58f23e76877 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Mon, 5 Aug 2019 11:28:19 +0100 Subject: [PATCH 29/33] fix: fixes issue where previous search term was lost on re-entering search mode --- src/Events/State.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Events/State.hs b/src/Events/State.hs index 554ece5a..16d73acf 100644 --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -337,7 +337,9 @@ listRight = listMove 1 -- search searchMode :: Stateful -searchMode state = Just $ (state & mode .~ Search) & searchTerm .~ Just blankField +searchMode state = pure $ (state & mode .~ Search) & searchTerm .~ sTerm + where + sTerm = Just (fromMaybe blankField (state ^. searchTerm)) clearSearch :: Stateful clearSearch state = pure $ state & searchTerm .~ Nothing From 722e0c497cd25b0db2b0b8c0759381151955166b Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Tue, 6 Aug 2019 12:39:25 +0100 Subject: [PATCH 30/33] docs: adds switching to Vectors as a refactoring task --- roadmap.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/roadmap.md b/roadmap.md index c667033d..03284642 100644 --- a/roadmap.md +++ b/roadmap.md @@ -9,6 +9,8 @@ ## Refactoring - Use Attoparsec for parsing +- Switch over to Vectors? + > Sequence has O(log n) lookup. Vector has O(1). Vectors support mapping with index. - Add tests for IO.GitHub - Break up State module - Parse checkItems Trello JSON using Aeson FromJSON rather than needing extra record type From 82d9eee6ea9d5ee418956ab6e2e6c0887838743c Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Tue, 6 Aug 2019 15:23:21 +0100 Subject: [PATCH 31/33] chore: only show test failures --- .bin/tests | 2 +- test/Spec.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.bin/tests b/.bin/tests index 21c6ae8a..a97c3270 100755 --- a/.bin/tests +++ b/.bin/tests @@ -1 +1 @@ -stack test --test-arguments --hide-successes +stack test diff --git a/test/Spec.hs b/test/Spec.hs index 70c55f52..e1cee342 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1 +1 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover #-} +{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes #-} From 765e1df4b69eea9a4baef6b19a9ba40857bdfa95 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Sat, 3 Aug 2019 15:45:21 +0100 Subject: [PATCH 32/33] fix: fixed search navigation issues (#39) moving items up and down lists still doesn't work properly --- roadmap.md | 4 +- src/Data/Taskell/List.hs | 1 + src/Data/Taskell/List/Internal.hs | 56 +++++++++++++----- src/Events/State.hs | 25 +++----- test/Data/Taskell/ListNavigationTest.hs | 78 +++++++++++++++++++++++++ 5 files changed, 129 insertions(+), 35 deletions(-) create mode 100644 test/Data/Taskell/ListNavigationTest.hs diff --git a/roadmap.md b/roadmap.md index 03284642..944e87bb 100644 --- a/roadmap.md +++ b/roadmap.md @@ -83,9 +83,9 @@ - Search navigation issues > Issues with navigation when in NORMAL + SEARCH mode * [x] Navigating up and down - * [ ] Navigating between lists + * [x] Navigating between lists * [ ] Moving task up and down - * [ ] Often nothing is selected when first entering search mode + * [x] Often nothing is selected when first entering search mode - Add custom key support * [x] Create bindings.ini * [x] Update events to use Map from bindings.ini diff --git a/src/Data/Taskell/List.hs b/src/Data/Taskell/List.hs index 45a9e334..9e55cf33 100644 --- a/src/Data/Taskell/List.hs +++ b/src/Data/Taskell/List.hs @@ -19,6 +19,7 @@ module Data.Taskell.List , searchFor , nextTask , prevTask + , nearest ) where import Data.Taskell.List.Internal diff --git a/src/Data/Taskell/List/Internal.hs b/src/Data/Taskell/List/Internal.hs index f92dd135..898531e9 100644 --- a/src/Data/Taskell/List/Internal.hs +++ b/src/Data/Taskell/List/Internal.hs @@ -64,23 +64,47 @@ getTask idx = (^? tasks . element idx) searchFor :: Text -> Update searchFor text = tasks %~ filter (T.contains text) -changeTask :: Int -> Int -> Int -> Maybe Text -> List -> Int -changeTask dir original current term list = - case task of - Nothing -> original - Just tsk -> - case term of - Nothing -> next - Just trm -> - if T.contains trm tsk - then next - else changeTask dir original next term list - where - next = current + dir - task = getTask next list +changeTask :: Int -> Int -> Maybe Text -> List -> Maybe Int +changeTask dir current term list = do + let next = current + dir + tsk <- getTask next list + case term of + Nothing -> Just next + Just trm -> + if T.contains trm tsk + then Just next + else changeTask dir next term list nextTask :: Int -> Maybe Text -> List -> Int -nextTask idx = changeTask 1 idx idx +nextTask idx text lst = fromMaybe idx $ changeTask 1 idx text lst prevTask :: Int -> Maybe Text -> List -> Int -prevTask idx = changeTask (-1) idx idx +prevTask idx text lst = fromMaybe idx $ changeTask (-1) idx text lst + +closest :: Int -> Int -> Int -> Int +closest current previous next = + if (next - current) < (current - previous) + then next + else previous + +bound :: Int -> List -> Int +bound idx lst + | idx < 0 = 0 + | idx > count lst = count lst - 1 + | otherwise = idx + +nearest' :: Int -> Maybe Text -> List -> Maybe Int +nearest' current term lst = do + let prev = changeTask (-1) current term lst + let nxt = changeTask 1 current term lst + let comp idx = Just $ maybe idx (closest current idx) nxt + maybe nxt comp prev + +nearest :: Int -> Maybe Text -> List -> Int +nearest current term lst = idx + where + near = fromMaybe (-1) $ nearest' current term lst + idx = + case term of + Nothing -> bound current lst + Just txt -> maybe near (bool near current . T.contains txt) $ getTask current lst diff --git a/src/Events/State.hs b/src/Events/State.hs index 16d73acf..b2cdf3b4 100644 --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -61,7 +61,7 @@ import Control.Lens ((&), (.~), (^.)) import Data.Char (digitToInt, ord) -import Data.Taskell.List (List, deleteTask, getTask, move, new, newAt, nextTask, +import Data.Taskell.List (List, deleteTask, getTask, move, nearest, new, newAt, nextTask, prevTask, title, update) import qualified Data.Taskell.Lists as Lists import Data.Taskell.Task (Task, isBlank, name) @@ -276,21 +276,12 @@ right state = fixIndex :: InternalStateful fixIndex state = - if getIndex state' > count - then setIndex state' count' - else state' + case getList state of + Just list -> setIndex state (nearest idx trm list) + Nothing -> state where - lists' = state ^. lists - idx = Lists.exists (getCurrentList state) lists' - state' = - if idx - then state - else setCurrentList state (length lists' - 1) - count = countCurrent state' - 1 - count' = - if count < 0 - then 0 - else count + trm = getText <$> state ^. searchTerm + idx = getIndex state -- tasks getCurrentList :: State -> Int @@ -337,7 +328,7 @@ listRight = listMove 1 -- search searchMode :: Stateful -searchMode state = pure $ (state & mode .~ Search) & searchTerm .~ sTerm +searchMode state = pure . fixIndex $ (state & mode .~ Search) & searchTerm .~ sTerm where sTerm = Just (fromMaybe blankField (state ^. searchTerm)) @@ -347,7 +338,7 @@ clearSearch state = pure $ state & searchTerm .~ Nothing appendSearch :: (Field -> Field) -> Stateful appendSearch genField state = do let field = fromMaybe blankField (state ^. searchTerm) - pure $ state & searchTerm .~ Just (genField field) + pure . fixIndex $ state & searchTerm .~ Just (genField field) -- help showHelp :: Stateful diff --git a/test/Data/Taskell/ListNavigationTest.hs b/test/Data/Taskell/ListNavigationTest.hs new file mode 100644 index 00000000..5bcfc082 --- /dev/null +++ b/test/Data/Taskell/ListNavigationTest.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Taskell.ListNavigationTest + ( test_list + ) where + +import ClassyPrelude as CP + +import Test.Tasty +import Test.Tasty.HUnit + +import Data.Taskell.List.Internal as L +import qualified Data.Taskell.Task as T (Task, new) + +taskSeq :: Seq T.Task +taskSeq = + fromList + [ T.new "Hello" + , T.new "Blah" + , T.new "Fish" + , T.new "Spoons" + , T.new "Hello Again!" + , T.new "Computers" + ] + +list :: List +list = List "Populated" taskSeq + +-- tests +test_list :: TestTree +test_list = + testGroup + "Data.Taskell.List Navigation" + [ testGroup + "next" + [ testCase "no term" (assertEqual "1" 1 (L.nextTask 0 Nothing list)) + , testCase "with term" (assertEqual "4" 4 (L.nextTask 0 (Just "Hello") list)) + , testCase + "with term - no match" + (assertEqual "0" 0 (L.nextTask 0 (Just "Wombat") list)) + ] + , testGroup + "prev" + [ testCase "no term" (assertEqual "0" 0 (L.prevTask 1 Nothing list)) + , testCase "with term" (assertEqual "0" 0 (L.prevTask 4 (Just "Hello") list)) + , testCase + "with term - no match" + (assertEqual "4" 4 (L.prevTask 4 (Just "Wombat") list)) + ] + , testGroup + "nearest" + [ testCase "no term" (assertEqual "same task" 2 (L.nearest 2 Nothing list)) + , testCase "term matches" (assertEqual "same task" 2 (L.nearest 2 (Just "ish") list)) + , testCase "term after" (assertEqual "next task" 3 (L.nearest 2 (Just "oons") list)) + , testCase + "term before" + (assertEqual "previous task" 3 (L.nearest 5 (Just "oons") list)) + , testCase + "term both - before closer" + (assertEqual "previous task" 0 (L.nearest 2 (Just "Hello") list)) + , testCase + "term both - after closer" + (assertEqual "next task" 4 (L.nearest 3 (Just "Hello") list)) + , testCase + "no matches" + (assertEqual "nothing" (-1) (L.nearest 3 (Just "Penguins") list)) + , testCase + "nothing to match" + (assertEqual "nothing" 3 (L.nearest (-1) (Just "Spoon") list)) + , testCase + "nothing with no term" + (assertEqual "nothing" 0 (L.nearest (-1) Nothing list)) + , testCase + "out of bounds with no term" + (assertEqual "nothing" 5 (L.nearest 50 Nothing list)) + ] + ] From 8ed4aa188cb1ba38dc71ac9ee56b22f736833b7a Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Tue, 6 Aug 2019 15:59:49 +0100 Subject: [PATCH 33/33] chore: version bump --- docs/html/_config.yml | 2 +- package.yaml | 2 +- src/Config.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/html/_config.yml b/docs/html/_config.yml index e1722a42..61c99934 100755 --- a/docs/html/_config.yml +++ b/docs/html/_config.yml @@ -3,7 +3,7 @@ title: taskell tagline: Command-line Kanban board/task management baseurl: "" locale: "en" -version: 1.4.3 +version: 1.5.0 destination: _site/public exclude: [deployment, Capfile, log, Gemfile, Gemfile.lock] diff --git a/package.yaml b/package.yaml index 29d61d0b..44998d95 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: taskell -version: '1.4.3.0' +version: '1.5.0.0' category: Command Line Tools author: Mark Wales maintainer: mark@smallhadroncollider.com diff --git a/src/Config.hs b/src/Config.hs index be4ee9d9..091acac6 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -9,7 +9,7 @@ import ClassyPrelude import Data.FileEmbed (embedFile) version :: Text -version = "1.4.3" +version = "1.5.0" usage :: Text usage = decodeUtf8 $(embedFile "templates/usage.txt")