diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -47,7 +47,7 @@ ### Debian/Ubuntu -[A `.deb` package is available for Debian/Ubuntu](https://github.com/smallhadroncollider/taskell/releases). Download it and install with `dpkg -i `. +[A `.deb` package is available for Debian/Ubuntu](https://github.com/smallhadroncollider/taskell/releases). Download it and install with `dpkg -i `. You may also need to install the `libtinfo5` package (`sudo apt install libtinfo5`). ### Fedora @@ -251,51 +251,12 @@ 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: ``, ``, ``, ``, ``, ``, `` +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. @@ -308,6 +269,10 @@ ; list title title.fg = green + +; status bar +statusBar.bg = magenta +statusBar.fg = black ; current list title titleCurrent.fg = blue diff --git a/src/App.hs b/src/App.hs --- a/src/App.hs +++ b/src/App.hs @@ -9,7 +9,8 @@ import Control.Lens ((^.)) import Brick -import Graphics.Vty (Mode (BracketedPaste), outputIface, setMode, supportsMode) +import Graphics.Vty (Mode (BracketedPaste), displayBounds, outputIface, setMode, + supportsMode) import Graphics.Vty.Input.Events (Event (..)) import qualified Control.FoldDebounce as Debounce @@ -17,8 +18,8 @@ import Data.Taskell.Date (currentDay) import Data.Taskell.Lists (Lists) import Events.Actions (ActionSets, event, generateActions) -import Events.State (continue, countCurrent) -import Events.State.Types (State, current, io, lists, mode, path) +import Events.State (continue, countCurrent, setHeight) +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) @@ -85,8 +86,8 @@ (DebouncedWrite, Trigger) -> ActionSets -> State -> Event -> EventM ResourceName (Next State) handleVtyEvent (send, trigger) actions previousState e = do let state = event actions e previousState + when (previousState ^. searchTerm /= state ^. searchTerm) invalidateCache case previousState ^. mode of - Search _ _ -> invalidateCache (Modal MoveTo) -> clearAllTitles previousState (Insert ITask ICreate _) -> clearList previousState _ -> pure () @@ -96,15 +97,21 @@ (Insert ITask ICreate _) -> clearList state *> next send state _ -> clearCache previousState *> clearCache state *> next send state +getHeight :: EventM ResourceName Int +getHeight = snd <$> (displayBounds =<< outputIface <$> getVtyHandle) + 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 = 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/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -9,7 +9,7 @@ import Data.FileEmbed (embedFile) version :: Text -version = "1.4.0" +version = "1.5.0" usage :: Text usage = decodeUtf8 $(embedFile "templates/usage.txt") diff --git a/src/Data/Taskell/List.hs b/src/Data/Taskell/List.hs --- a/src/Data/Taskell/List.hs +++ b/src/Data/Taskell/List.hs @@ -17,6 +17,9 @@ , deleteTask , getTask , 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 --- a/src/Data/Taskell/List/Internal.hs +++ b/src/Data/Taskell/List/Internal.hs @@ -5,7 +5,7 @@ import ClassyPrelude -import Control.Lens (ix, makeLenses, (%%~), (%~), (&), (.~), (^.), (^?)) +import Control.Lens (element, makeLenses, (%%~), (%~), (&), (.~), (^.), (^?)) import Data.Sequence as S (adjust', deleteAt, insertAt, update, (|>)) @@ -59,7 +59,52 @@ 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 -> 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 text lst = fromMaybe idx $ changeTask 1 idx text lst + +prevTask :: Int -> Maybe Text -> List -> Int +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/Data/Taskell/Task/Internal.hs b/src/Data/Taskell/Task/Internal.hs --- a/src/Data/Taskell/Task/Internal.hs +++ b/src/Data/Taskell/Task/Internal.hs @@ -34,9 +34,10 @@ setDescription :: Text -> Update setDescription text = + description .~ if null (strip text) - then id - else description .~ Just text + then Nothing + else Just text maybeAppend :: Text -> Maybe Text -> Maybe Text maybeAppend text (Just current) = Just (concat [current, "\n", text]) @@ -49,10 +50,12 @@ 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) @@ -76,9 +79,11 @@ 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) || maybe False check (task ^. description) || 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/src/Events/Actions.hs b/src/Events/Actions.hs --- a/src/Events/Actions.hs +++ b/src/Events/Actions.hs @@ -31,7 +31,7 @@ event' e state = case state ^. mode of Normal -> Normal.event e state - Search {} -> Search.event e state + Search -> Search.event e state Insert {} -> Insert.event e state Modal {} -> Modal.event e state _ -> pure state diff --git a/src/Events/Actions/Modal/Detail.hs b/src/Events/Actions/Modal/Detail.hs --- a/src/Events/Actions/Modal/Detail.hs +++ b/src/Events/Actions/Modal/Detail.hs @@ -9,27 +9,29 @@ import ClassyPrelude +import Events.Actions.Types as A (ActionType (..)) import Events.State import Events.State.Modal.Detail as Detail import Events.State.Types import Events.State.Types.Mode (DetailItem (..), DetailMode (..)) import Graphics.Vty.Input.Events +import IO.Keyboard.Types (Actions) import qualified UI.Field as F (event) -events :: Map Text Stateful +events :: Actions events -- general = - [ ("quit", quit) - , ("undo", (write =<<) . undo) - , ("previous", previousSubtask) - , ("next", nextSubtask) - , ("new", (Detail.insertMode =<<) . (Detail.lastSubtask =<<) . (Detail.newItem =<<) . store) - , ("edit", (Detail.insertMode =<<) . store) - , ("moveRight", (write =<<) . (setComplete =<<) . store) - , ("delete", (write =<<) . (Detail.remove =<<) . store) - , ("dueDate", (editDue =<<) . store) - , ("detail", (editDescription =<<) . store) + [ (A.Quit, quit) + , (A.Undo, (write =<<) . undo) + , (A.Previous, previousSubtask) + , (A.Next, nextSubtask) + , (A.New, (Detail.insertMode =<<) . (Detail.lastSubtask =<<) . (Detail.newItem =<<) . store) + , (A.Edit, (Detail.insertMode =<<) . store) + , (A.MoveRight, (write =<<) . (setComplete =<<) . store) + , (A.Delete, (write =<<) . (Detail.remove =<<) . store) + , (A.DueDate, (editDue =<<) . store) + , (A.Detail, (editDescription =<<) . store) ] normal :: Event -> Stateful diff --git a/src/Events/Actions/Modal/Help.hs b/src/Events/Actions/Modal/Help.hs --- a/src/Events/Actions/Modal/Help.hs +++ b/src/Events/Actions/Modal/Help.hs @@ -8,12 +8,14 @@ ) where import ClassyPrelude +import Events.Actions.Types as A (ActionType (..)) import Events.State import Events.State.Types (Stateful) import Graphics.Vty.Input.Events +import IO.Keyboard.Types (Actions) -events :: Map Text Stateful -events = [("quit", quit)] +events :: Actions +events = [(A.Quit, quit)] event :: Event -> Stateful event (EvKey _ _) = normalMode diff --git a/src/Events/Actions/Normal.hs b/src/Events/Actions/Normal.hs --- a/src/Events/Actions/Normal.hs +++ b/src/Events/Actions/Normal.hs @@ -9,48 +9,49 @@ import ClassyPrelude hiding (delete) import Data.Char (isDigit) -import Data.Map.Strict (Map) +import Events.Actions.Types as A (ActionType (..)) import Events.State import Events.State.Modal.Detail (editDue, showDetail) import Events.State.Types (Stateful) import Graphics.Vty.Input.Events +import IO.Keyboard.Types (Actions) -events :: Map Text Stateful +events :: Actions events -- general = - [ ("quit", quit) - , ("undo", (write =<<) . undo) - , ("search", searchMode) - , ("help", showHelp) + [ (A.Quit, quit) + , (A.Undo, (write =<<) . undo) + , (A.Search, searchMode) + , (A.Help, showHelp) -- navigation - , ("previous", previous) - , ("next", next) - , ("left", left) - , ("right", right) - , ("bottom", bottom) + , (A.Previous, previous) + , (A.Next, next) + , (A.Left, left) + , (A.Right, right) + , (A.Bottom, bottom) -- new tasks - , ("new", (startCreate =<<) . (newItem =<<) . store) - , ("newAbove", (startCreate =<<) . (above =<<) . store) - , ("newBelow", (startCreate =<<) . (below =<<) . store) + , (A.New, (startCreate =<<) . (newItem =<<) . store) + , (A.NewAbove, (startCreate =<<) . (above =<<) . store) + , (A.NewBelow, (startCreate =<<) . (below =<<) . store) -- editing tasks - , ("edit", (startEdit =<<) . store) - , ("clear", (startEdit =<<) . (clearItem =<<) . store) - , ("delete", (write =<<) . (delete =<<) . store) - , ("detail", showDetail) - , ("dueDate", (editDue =<<) . (store =<<) . showDetail) + , (A.Edit, (startEdit =<<) . store) + , (A.Clear, (startEdit =<<) . (clearItem =<<) . store) + , (A.Delete, (write =<<) . (delete =<<) . store) + , (A.Detail, showDetail) + , (A.DueDate, (editDue =<<) . (store =<<) . showDetail) -- moving tasks - , ("moveUp", (write =<<) . (up =<<) . store) - , ("moveDown", (write =<<) . (down =<<) . store) - , ("moveLeft", (write =<<) . (bottom =<<) . (left =<<) . (moveLeft =<<) . store) - , ("moveRight", (write =<<) . (bottom =<<) . (right =<<) . (moveRight =<<) . store) - , ("moveMenu", showMoveTo) + , (A.MoveUp, (write =<<) . (up =<<) . store) + , (A.MoveDown, (write =<<) . (down =<<) . store) + , (A.MoveLeft, (write =<<) . (bottom =<<) . (left =<<) . (moveLeft =<<) . store) + , (A.MoveRight, (write =<<) . (bottom =<<) . (right =<<) . (moveRight =<<) . store) + , (A.MoveMenu, showMoveTo) -- lists - , ("listNew", (createListStart =<<) . store) - , ("listEdit", (editListStart =<<) . store) - , ("listDelete", (write =<<) . (deleteCurrentList =<<) . store) - , ("listRight", (write =<<) . (listRight =<<) . store) - , ("listLeft", (write =<<) . (listLeft =<<) . store) + , (A.ListNew, (createListStart =<<) . store) + , (A.ListEdit, (editListStart =<<) . store) + , (A.ListDelete, (write =<<) . (deleteCurrentList =<<) . store) + , (A.ListRight, (write =<<) . (listRight =<<) . store) + , (A.ListLeft, (write =<<) . (listLeft =<<) . store) ] -- Normal @@ -59,5 +60,6 @@ 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 --- a/src/Events/Actions/Search.hs +++ b/src/Events/Actions/Search.hs @@ -6,7 +6,7 @@ import ClassyPrelude -import Control.Lens ((&), (.~), (^.)) +import Control.Lens ((^.)) import Events.State import Events.State.Types (Stateful, mode) @@ -14,24 +14,10 @@ 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 = - pure $ - case s ^. mode of - Search ent field -> s & mode .~ Search ent (F.event e field) - _ -> s - event :: Event -> Stateful -event (EvKey KEsc _) s = normalMode s +event (EvKey KEsc _) s = clearSearch =<< normalMode s +event (EvKey KEnter _) s = normalMode s event e s = case s ^. mode of - Search ent _ -> - (if ent - then search - else Normal.event) - e - s - _ -> pure s + Search -> appendSearch (F.event e) s + _ -> pure s diff --git a/src/Events/Actions/Types.hs b/src/Events/Actions/Types.hs new file mode 100644 --- /dev/null +++ b/src/Events/Actions/Types.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Events.Actions.Types where + +import ClassyPrelude hiding (Left, Nothing, Right) + +data ActionType + = Quit + | Undo + | Search + | Help + | Previous + | Next + | Left + | Right + | Bottom + | New + | NewAbove + | NewBelow + | Edit + | Clear + | Delete + | Detail + | DueDate + | MoveUp + | MoveDown + | MoveLeft + | MoveRight + | MoveMenu + | ListNew + | ListEdit + | ListDelete + | ListRight + | ListLeft + | Nothing + deriving (Show, Eq, Ord, Enum) + +allActions :: [ActionType] +allActions = [toEnum 0 ..] + +read :: Text -> ActionType +read "quit" = Quit +read "undo" = Undo +read "search" = Search +read "help" = Help +read "previous" = Previous +read "next" = Next +read "left" = Left +read "right" = Right +read "bottom" = Bottom +read "new" = New +read "newAbove" = NewAbove +read "newBelow" = NewBelow +read "edit" = Edit +read "clear" = Clear +read "delete" = Delete +read "detail" = Detail +read "dueDate" = DueDate +read "moveUp" = MoveUp +read "moveDown" = MoveDown +read "moveLeft" = MoveLeft +read "moveRight" = MoveRight +read "moveMenu" = MoveMenu +read "listNew" = ListNew +read "listEdit" = ListEdit +read "listDelete" = ListDelete +read "listRight" = ListRight +read "listLeft" = ListLeft +read _ = Nothing diff --git a/src/Events/State.hs b/src/Events/State.hs --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -6,6 +6,7 @@ ( continue , write , countCurrent + , setHeight -- UI.Main , normalise -- Main @@ -36,8 +37,8 @@ , undo , store , searchMode - -- Events.Actions.Search - , searchEntered + , clearSearch + , appendSearch -- Events.Actions.Insert , createList , removeBlank @@ -60,19 +61,29 @@ 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, nearest, new, newAt, nextTask, + prevTask, title, update) import qualified Data.Taskell.Lists as Lists 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 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 + , _searchTerm = Nothing + } -- app state quit :: Stateful @@ -231,24 +242,18 @@ 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 = @@ -271,21 +276,12 @@ 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 @@ -332,18 +328,18 @@ -- search searchMode :: Stateful -searchMode state = - Just $ - case state ^. mode of - Search _ field -> state & mode .~ Search True field - _ -> state & mode .~ Search True blankField +searchMode state = pure . fixIndex $ (state & mode .~ Search) & searchTerm .~ sTerm + where + sTerm = Just (fromMaybe blankField (state ^. searchTerm)) -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 +appendSearch :: (Field -> Field) -> Stateful +appendSearch genField state = do + let field = fromMaybe blankField (state ^. searchTerm) + pure . fixIndex $ state & searchTerm .~ Just (genField field) + -- help showHelp :: Stateful showHelp = Just . (mode .~ Modal Help) @@ -351,13 +347,11 @@ showMoveTo :: Stateful showMoveTo = Just . (mode .~ Modal MoveTo) --- 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 +-- view +setHeight :: Int -> State -> State +setHeight i = height .~ i +-- more view - maybe shouldn't be in here... newList :: State -> State newList state = case state ^. mode of @@ -367,4 +361,4 @@ _ -> state normalise :: State -> State -normalise = newList . search +normalise = newList diff --git a/src/Events/State/Types.hs b/src/Events/State/Types.hs --- a/src/Events/State/Types.hs +++ b/src/Events/State/Types.hs @@ -8,18 +8,21 @@ 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 + { _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 --- a/src/Events/State/Types/Mode.hs +++ b/src/Events/State/Types/Mode.hs @@ -40,7 +40,6 @@ InsertMode Field | Modal ModalType - | Search Bool - Field + | Search | Shutdown deriving (Eq, Show) diff --git a/src/IO/Config.hs b/src/IO/Config.hs --- a/src/IO/Config.hs +++ b/src/IO/Config.hs @@ -7,7 +7,6 @@ import ClassyPrelude -import Data.Either (fromRight) import qualified Data.Text.IO as T (readFile) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getHomeDirectory) @@ -18,6 +17,7 @@ import Data.FileEmbed (embedFile) import Data.Ini.Config +import IO.Keyboard (addMissing, badMapping, defaultBindings) import IO.Keyboard.Parser (bindings) import IO.Keyboard.Types (Bindings) import UI.Theme (defaultTheme) @@ -99,7 +99,12 @@ Left s -> putStrLn (pack $ "config.ini: " <> s) $> defaultConfig getBindings :: IO Bindings -getBindings = fromRight [] . bindings <$> (T.readFile =<< (bindingsPath <$> getDir)) +getBindings = do + bnds <- bindings <$> (T.readFile =<< (bindingsPath <$> getDir)) + case addMissing <$> (badMapping =<< bnds) of + Right b -> pure b + Left err -> + putStrLn ("bindings.ini: " <> err <> " - using default bindings") $> defaultBindings -- generate theme generateAttrMap :: IO AttrMap diff --git a/src/IO/Keyboard.hs b/src/IO/Keyboard.hs --- a/src/IO/Keyboard.hs +++ b/src/IO/Keyboard.hs @@ -1,15 +1,73 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} module IO.Keyboard ( generate + , defaultBindings + , badMapping + , addMissing ) where -import ClassyPrelude +import ClassyPrelude hiding ((\\)) import Data.Bitraversable (bitraverse) +import Data.List ((\\)) -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) + , (BChar 'u', A.Undo) + , (BChar '/', A.Search) + , (BChar '?', A.Help) + , (BChar 'k', A.Previous) + , (BChar 'j', A.Next) + , (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) + , (BKey "Enter", A.Detail) + , (BChar '@', A.DueDate) + , (BChar 'K', A.MoveUp) + , (BChar 'J', A.MoveDown) + , (BChar 'H', A.MoveLeft) + , (BChar 'L', A.MoveRight) + , (BKey "Space", A.MoveRight) + , (BChar 'm', A.MoveMenu) + , (BChar 'N', A.ListNew) + , (BChar 'E', A.ListEdit) + , (BChar 'X', A.ListDelete) + , (BChar '>', A.ListRight) + , (BChar '<', A.ListLeft) + ] diff --git a/src/IO/Keyboard/Parser.hs b/src/IO/Keyboard/Parser.hs --- a/src/IO/Keyboard/Parser.hs +++ b/src/IO/Keyboard/Parser.hs @@ -8,6 +8,7 @@ import Data.Attoparsec.Text +import Events.Actions.Types (ActionType, read) import IO.Keyboard.Types -- utility functions @@ -15,7 +16,7 @@ lexeme p = skipSpace *> p <* skipSpace commentP :: Parser () -commentP = lexeme $ skipMany (char '#' *> manyTill anyChar endOfLine) +commentP = lexeme $ skipMany ((char '#' <|> char ';') *> manyTill anyChar endOfLine) stripComments :: Parser a -> Parser a stripComments p = lexeme $ commentP *> p <* commentP @@ -33,10 +34,10 @@ bindingP :: Parser [Binding] bindingP = lexeme $ (keyP <|> charP) `sepBy` char ',' -line :: Parser [(Binding, Text)] +line :: Parser [(Binding, ActionType)] line = stripComments $ do - name <- word + name <- read <$> word _ <- lexeme $ char '=' binds <- bindingP pure $ (, name) <$> binds diff --git a/src/IO/Keyboard/Types.hs b/src/IO/Keyboard/Types.hs --- a/src/IO/Keyboard/Types.hs +++ b/src/IO/Keyboard/Types.hs @@ -8,25 +8,30 @@ import Data.Map.Strict (Map) import Graphics.Vty.Input.Events (Event (..), Key (..)) -import Events.State.Types (Stateful) +import qualified Events.Actions.Types as A (ActionType) +import Events.State.Types (Stateful) data Binding = BChar Char | BKey Text - deriving (Eq, Ord, Show) + deriving (Eq, Ord) -type Bindings = [(Binding, Text)] +type Bindings = [(Binding, A.ActionType)] -type Actions = Map Text Stateful +type Actions = Map A.ActionType Stateful type BoundActions = Map Event Stateful -bindingToText :: Binding -> Text -bindingToText (BChar c) = singleton c -bindingToText (BKey name) = "<" <> name <> ">" +instance Show Binding where + show (BChar c) = singleton c + show (BKey "Up") = "↑" + show (BKey "Down") = "↓" + show (BKey "Left") = "←" + show (BKey "Right") = "→" + show (BKey name) = "<" <> unpack name <> ">" -bindingsToText :: Bindings -> Text -> [Text] -bindingsToText bindings key = bindingToText . fst <$> toList (filterMap (== key) bindings) +bindingsToText :: Bindings -> A.ActionType -> [Text] +bindingsToText bindings key = tshow . fst <$> toList (filterMap (== key) bindings) bindingToEvent :: Binding -> Maybe Event bindingToEvent (BChar char) = pure $ EvKey (KChar char) [] diff --git a/src/IO/Taskell.hs b/src/IO/Taskell.hs --- a/src/IO/Taskell.hs +++ b/src/IO/Taskell.hs @@ -22,7 +22,7 @@ import qualified IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists) import qualified IO.HTTP.Trello as Trello (TrelloBoardID, getLists) -import UI.CLI (promptYN) +import UI.CLI (PromptYN (PromptYes), promptYN) type ReaderConfig a = ReaderT Config IO a @@ -45,17 +45,15 @@ 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 @@ 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 @@ -> 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' <- 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 @@ -142,7 +124,7 @@ promptCreate :: FilePath -> ReaderConfig Bool promptCreate path = do cwd <- lift $ pack <$> getCurrentDirectory - lift $ promptYN $ concat ["Create ", cwd, "/", pack path, "?"] + lift $ promptYN PromptYes $ concat ["Create ", cwd, "/", pack path, "?"] -- creates taskell file createPath :: FilePath -> ReaderConfig () @@ -156,7 +138,4 @@ -- 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 diff --git a/src/UI/CLI.hs b/src/UI/CLI.hs --- a/src/UI/CLI.hs +++ b/src/UI/CLI.hs @@ -4,6 +4,7 @@ module UI.CLI ( prompt , promptYN + , PromptYN(PromptYes) ) where import ClassyPrelude @@ -14,5 +15,10 @@ hFlush stdout -- prevents buffering getLine -promptYN :: Text -> IO Bool -promptYN s = (==) "y" <$> prompt (s <> " (y/n)") +data PromptYN + = PromptYes + | PromptNo + +promptYN :: PromptYN -> Text -> IO Bool +promptYN PromptYes s = not . flip elem ["n", "no"] . toLower <$> prompt (s <> " (Y/n)") +promptYN PromptNo s = not . flip elem ["y", "yes"] . toLower <$> prompt (s <> " (y/N)") diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} module UI.Draw ( draw @@ -18,16 +19,17 @@ import Data.Taskell.Date (Day, dayToText, deadline) import Data.Taskell.List (List, tasks, title) -import Data.Taskell.Lists (Lists) -import qualified Data.Taskell.Task as T (Task, countCompleteSubtasks, countSubtasks, +import Data.Taskell.Lists (Lists, count) +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, lists, mode) +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) 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 (..)) @@ -37,10 +39,12 @@ { dsLists :: Lists , dsMode :: Mode , dsLayout :: Config + , dsPath :: FilePath , dsToday :: Day , dsCurrent :: Pointer , dsField :: Maybe Field , dsEditingTitle :: Bool + , dsSearchTerm :: Maybe Field } -- | Use a Reader to pass around DrawState @@ -73,8 +77,8 @@ ] -- | 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 @@ -98,6 +102,16 @@ 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 @@ -164,26 +178,68 @@ -- | 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 - let widget = attr . padTopBottom 1 . padLeftRight colPad $ txt "/" <+> field searchField + case m of + Search -> taskCurrentAttr + _ -> taskAttr + 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 + +modeToText :: Maybe Field -> Mode -> Text +modeToText fld = + \case + Normal -> + case fld of + Nothing -> "NORMAL" + Just _ -> "NORMAL + SEARCH" + Insert {} -> "INSERT" + Modal Help -> "HELP" + Modal MoveTo -> "MOVE" + Modal Detail {} -> "DETAIL" + Search {} -> "SEARCH" + _ -> "" + +getMode :: ReaderDrawState Text +getMode = modeToText <$> asks dsSearchTerm <*> asks dsMode + +renderStatusBar :: ReaderDrawState (Widget ResourceName) +renderStatusBar = do + topPath <- pack <$> asks dsPath + colPad <- columnPadding <$> asks dsLayout + posTxt <- getPosition + modeTxt <- getMode + let titl = padLeftRight colPad $ txt topPath + let pos = padRight (Pad colPad) $ txt posTxt + let md = txt modeTxt + let bar = padRight Max (titl <+> md) <+> 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 @@ -198,33 +254,36 @@ 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 - , 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 + , dsSearchTerm = normalisedState ^. searchTerm + } -- cursors chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName) 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/src/UI/Modal.hs b/src/UI/Modal.hs --- a/src/UI/Modal.hs +++ b/src/UI/Modal.hs @@ -23,19 +23,21 @@ 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/src/UI/Modal/Help.hs b/src/UI/Modal/Help.hs --- a/src/UI/Modal/Help.hs +++ b/src/UI/Modal/Help.hs @@ -11,34 +11,35 @@ import Brick import Data.Text as T (justifyRight) -import IO.Keyboard.Types (Bindings, bindingsToText) +import Events.Actions.Types as A (ActionType (..)) +import IO.Keyboard.Types (Bindings, bindingsToText) import UI.Field (textField) import UI.Theme (taskCurrentAttr) import UI.Types (ResourceName) -descriptions :: [([Text], Text)] +descriptions :: [([ActionType], Text)] descriptions = - [ (["help"], "Show this list of controls") - , (["previous", "next", "left", "right"], "Move down/up/left/right") - , (["bottom"], "Go to bottom of list") - , (["new"], "Add a task") - , (["newAbove", "newBelow"], "Add a task above/below") - , (["edit"], "Edit a task") - , (["clear"], "Change task") - , (["detail"], "Show task details / Edit task description") - , (["dueDate"], "Add/edit due date (yyyy-mm-dd)") - , (["moveUp", "moveDown"], "Shift task down/up") - , (["moveLeft", "moveRight"], "Shift task left/right") - , (["moveMenu"], "Move task to specific list") - , (["delete"], "Delete task") - , (["undo"], "Undo") - , (["listNew"], "New list") - , (["listEdit"], "Edit list title") - , (["listDelete"], "Delete list") - , (["listLeft", "listRight"], "Move list left/right") - , (["search"], "Search") - , (["quit"], "Quit") + [ ([A.Help], "Show this list of controls") + , ([A.Previous, A.Next, A.Left, A.Right], "Move down / up / left / right") + , ([A.Bottom], "Go to bottom of list") + , ([A.New], "Add a task") + , ([A.NewAbove, A.NewBelow], "Add a task above / below") + , ([A.Edit], "Edit a task") + , ([A.Clear], "Change task") + , ([A.Detail], "Show task details / Edit task description") + , ([A.DueDate], "Add/edit due date (yyyy-mm-dd)") + , ([A.MoveUp, A.MoveDown], "Shift task down / up") + , ([A.MoveLeft, A.MoveRight], "Shift task left / right") + , ([A.MoveMenu], "Move task to specific list") + , ([A.Delete], "Delete task") + , ([A.Undo], "Undo") + , ([A.ListNew], "New list") + , ([A.ListEdit], "Edit list title") + , ([A.ListDelete], "Delete list") + , ([A.ListLeft, A.ListRight], "Move list left / right") + , ([A.Search], "Search") + , ([A.Quit], "Quit") ] generate :: Bindings -> [([Text], Text)] diff --git a/src/UI/Theme.hs b/src/UI/Theme.hs --- 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 @@ 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 = newTheme defAttr - [ (titleAttr, fg green) + [ (statusBarAttr, black `on` green) + , (titleAttr, fg green) , (titleCurrentAttr, fg blue) , (taskCurrentAttr, fg magenta) , (disabledAttr, fg yellow) diff --git a/taskell.cabal b/taskell.cabal --- a/taskell.cabal +++ b/taskell.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell -version: 1.4.0.0 +version: 1.5.0.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales @@ -43,6 +43,7 @@ Data.Taskell.Subtask.Internal Data.Taskell.Task Data.Taskell.Task.Internal + Events.Actions.Types Events.State.Types Events.State.Types.Mode IO.Config.Markdown @@ -93,7 +94,7 @@ aeson >=1.4.2.0 && <1.5, attoparsec >=0.13.2.2 && <0.14, base >=4.12.0.0 && <=5, - brick ==0.47.*, + brick >=0.47.1 && <0.48, bytestring >=0.10.8.2 && <0.11, classy-prelude >=1.5.0 && <1.6, config-ini >=0.2.4.0 && <0.3, @@ -102,9 +103,9 @@ file-embed >=0.0.11 && <0.1, fold-debounce >=0.2.0.8 && <0.3, http-client >=0.5.14 && <0.6, - http-conduit >=2.3.6.1 && <2.4, + http-conduit >=2.3.7.1 && <2.4, http-types >=0.12.3 && <0.13, - lens ==4.17.*, + lens >=4.17.1 && <4.18, mtl >=2.2.2 && <2.3, template-haskell >=2.14.0.0 && <2.15, text >=1.2.3.1 && <1.3, @@ -130,6 +131,7 @@ hs-source-dirs: test other-modules: Data.Taskell.DateTest + Data.Taskell.ListNavigationTest Data.Taskell.ListsTest Data.Taskell.ListTest Data.Taskell.SeqTest @@ -138,6 +140,7 @@ Events.StateTest IO.GitHubTest IO.Keyboard.ParserTest + IO.Keyboard.TypesTest IO.KeyboardTest IO.MarkdownTest IO.TrelloTest @@ -152,7 +155,7 @@ classy-prelude >=1.5.0 && <1.6, containers >=0.6.0.1 && <0.7, file-embed >=0.0.11 && <0.1, - lens ==4.17.*, + lens >=4.17.1 && <4.18, raw-strings-qq ==1.1.*, taskell -any, tasty ==1.2.*, diff --git a/templates/github-token.txt b/templates/github-token.txt --- a/templates/github-token.txt +++ b/templates/github-token.txt @@ -4,7 +4,7 @@ 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/theme.ini b/templates/theme.ini --- 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 diff --git a/templates/trello-token.txt b/templates/trello-token.txt --- a/templates/trello-token.txt +++ b/templates/trello-token.txt @@ -2,7 +2,7 @@ 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 = diff --git a/test/Data/Taskell/ListNavigationTest.hs b/test/Data/Taskell/ListNavigationTest.hs new file mode 100644 --- /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)) + ] + ] diff --git a/test/Data/Taskell/ListTest.hs b/test/Data/Taskell/ListTest.hs --- a/test/Data/Taskell/ListTest.hs +++ b/test/Data/Taskell/ListTest.hs @@ -148,9 +148,15 @@ , 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 --- a/test/Data/Taskell/TaskTest.hs +++ b/test/Data/Taskell/TaskTest.hs @@ -17,11 +17,14 @@ 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 @@ "Returns the task with added subtask" (Task "Test" - Nothing + desc (fromList [ ST.new "One" True , ST.new "Two" False @@ -107,7 +110,7 @@ "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 @@ "Returns task" (Task "Test" - Nothing + desc (fromList [ST.new "One" True, ST.new "Two" False, ST.new "Three" False]) Nothing) @@ -132,7 +135,7 @@ "Returns updated task" (Task "Test" - Nothing + desc (fromList [ST.new "One" True, ST.new "Three" False]) Nothing) (removeSubtask 1 testTask)) @@ -142,7 +145,7 @@ "Returns task" (Task "Test" - Nothing + desc (fromList [ST.new "One" True, ST.new "Two" False, ST.new "Three" False]) Nothing) @@ -156,7 +159,19 @@ "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)) + , testCase + "description" + (assertEqual "Finds in description" True (contains "boring" testTask)) + , testCase + "not in description" + (assertEqual "Doesn't find" False (contains "escapades" testTask)) ] , testGroup "isBlank" diff --git a/test/Events/StateTest.hs b/test/Events/StateTest.hs --- a/test/Events/StateTest.hs +++ b/test/Events/StateTest.hs @@ -28,6 +28,8 @@ , _current = (0, 0) , _path = "test.md" , _io = Nothing + , _height = 0 + , _searchTerm = Nothing } moveToState :: State @@ -50,6 +52,8 @@ , _current = (4, 0) , _path = "test.md" , _io = Nothing + , _height = 0 + , _searchTerm = Nothing } -- tests diff --git a/test/IO/Keyboard/ParserTest.hs b/test/IO/Keyboard/ParserTest.hs --- a/test/IO/Keyboard/ParserTest.hs +++ b/test/IO/Keyboard/ParserTest.hs @@ -15,14 +15,15 @@ import Data.FileEmbed (embedFile) import Text.RawString.QQ (r) -import IO.Keyboard.Parser (bindings) -import IO.Keyboard.Types +import qualified Events.Actions.Types as A +import IO.Keyboard.Parser (bindings) +import IO.Keyboard.Types basic :: Text basic = "quit = q" basicResult :: Bindings -basicResult = [(BChar 'q', "quit")] +basicResult = [(BChar 'q', A.Quit)] basicMulti :: Text basicMulti = @@ -32,50 +33,50 @@ |] basicMultiResult :: Bindings -basicMultiResult = [(BChar 'q', "quit"), (BKey "Enter", "detail")] +basicMultiResult = [(BChar 'q', A.Quit), (BKey "Enter", A.Detail)] ini :: Text ini = decodeUtf8 $(embedFile "test/IO/Keyboard/data/bindings.ini") iniResult :: Bindings iniResult = - [ (BChar 'q', "quit") - , (BChar 'u', "undo") - , (BChar '/', "search") - , (BChar '?', "help") - , (BChar 'k', "previous") - , (BChar 'j', "next") - , (BChar 'h', "left") - , (BChar 'l', "right") - , (BChar 'g', "bottom") - , (BChar 'a', "new") - , (BChar 'O', "newAbove") - , (BChar 'o', "newBelow") - , (BChar 'e', "edit") - , (BChar 'A', "edit") - , (BChar 'i', "edit") - , (BChar 'C', "clear") - , (BChar 'D', "delete") - , (BKey "Enter", "detail") - , (BChar '@', "dueDate") - , (BChar 'K', "moveUp") - , (BChar 'J', "moveDown") - , (BChar 'H', "moveLeft") - , (BChar 'L', "moveRight") - , (BKey "Space", "moveRight") - , (BChar 'm', "moveMenu") - , (BChar 'N', "listNew") - , (BChar 'E', "listEdit") - , (BChar 'X', "listDelete") - , (BChar '>', "listRight") - , (BChar '<', "listLeft") + [ (BChar 'q', A.Quit) + , (BChar 'u', A.Undo) + , (BChar '/', A.Search) + , (BChar '?', A.Help) + , (BChar 'k', A.Previous) + , (BChar 'j', A.Next) + , (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) + , (BKey "Enter", A.Detail) + , (BChar '@', A.DueDate) + , (BChar 'K', A.MoveUp) + , (BChar 'J', A.MoveDown) + , (BChar 'H', A.MoveLeft) + , (BChar 'L', A.MoveRight) + , (BKey "Space", A.MoveRight) + , (BChar 'm', A.MoveMenu) + , (BChar 'N', A.ListNew) + , (BChar 'E', A.ListEdit) + , (BChar 'X', A.ListDelete) + , (BChar '>', A.ListRight) + , (BChar '<', A.ListLeft) ] comma :: Text comma = "quit = ," commaResult :: Bindings -commaResult = [(BChar ',', "quit")] +commaResult = [(BChar ',', A.Quit)] test_parser :: TestTree test_parser = diff --git a/test/IO/Keyboard/TypesTest.hs b/test/IO/Keyboard/TypesTest.hs new file mode 100644 --- /dev/null +++ b/test/IO/Keyboard/TypesTest.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module IO.Keyboard.TypesTest + ( test_types + ) where + +import ClassyPrelude + +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Events.Actions.Types as A (ActionType (..)) +import IO.Keyboard (addMissing, badMapping, defaultBindings) +import IO.Keyboard.Types (Binding (..), Bindings) + +notFull :: Bindings +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) + , (BChar 'j', A.Next) + , (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) + , (BKey "Enter", A.Detail) + , (BChar '@', A.DueDate) + , (BChar 'K', A.MoveUp) + , (BChar 'J', A.MoveDown) + , (BChar 'H', A.MoveLeft) + , (BChar 'L', A.MoveRight) + , (BKey "Space", A.MoveRight) + , (BChar 'm', A.MoveMenu) + , (BChar 'N', A.ListNew) + , (BChar 'E', A.ListEdit) + , (BChar 'X', A.ListDelete) + , (BChar '>', A.ListRight) + , (BChar '<', A.ListLeft) + ] + +bad :: Bindings +bad = [(BChar 'q', A.Quit), (BChar 'u', A.Nothing), (BChar '>', A.Nothing), (BChar '<', A.ListLeft)] + +-- tests +test_types :: TestTree +test_types = + testGroup + "Events.Actions.Types" + [ testCase + "not missing" + (assertEqual "Finds no missing items" defaultBindings (addMissing defaultBindings)) + , testCase + "not missing" + (assertEqual "Finds missing items" notFullResult (addMissing notFull)) + , testCase + "bad mapping" + (assertEqual "Finds bad mapping" (Left "invalid mapping") (badMapping bad)) + ] diff --git a/test/IO/KeyboardTest.hs b/test/IO/KeyboardTest.hs --- a/test/IO/KeyboardTest.hs +++ b/test/IO/KeyboardTest.hs @@ -14,6 +14,7 @@ import Control.Lens ((.~)) import Data.Taskell.Lists.Internal (initial) +import Events.Actions.Types as A import Events.State (create, quit) import Events.State.Types (State, Stateful, mode) import Events.State.Types.Mode (Mode (Shutdown)) @@ -28,10 +29,10 @@ cleanState = create "taskell.md" initial basicBindings :: Bindings -basicBindings = [(BChar 'q', "quit")] +basicBindings = [(BChar 'q', A.Quit)] basicActions :: Actions -basicActions = [("quit", quit)] +basicActions = [(A.Quit, quit)] basicResult :: Maybe State basicResult = Just $ (mode .~ Shutdown) cleanState diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,1 +1,1 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover #-} +{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes #-}