Merge branch 'release/1.7.2'

.gitignore

@@ -11,4 +11,5 @@ large.md
 releases/
 files/
 homebrew-taskell/
+.jekyll-cache/
 .cmt.bkp

app/Main.hs

@@ -4,6 +4,8 @@ module Main where
 
 import ClassyPrelude
 
+import System.Exit (die)
+
 import App          (go)
 import Events.State (create)
 import IO.Config    (setup)
@@ -17,4 +19,5 @@ main = do
     case next of
         Exit            -> pure ()
         Output text     -> putStrLn text
+        Error text      -> die $ unpack text
         Load path lists -> go config $ create time path lists

docs/html/_config.yml

@@ -3,7 +3,7 @@ title:        taskell
 tagline:      Command-line Kanban board/task management
 baseurl:      ""
 locale:       "en"
-version:      1.7.1
+version:      1.7.2
 destination:  _site/public
 exclude:      [deployment, Capfile, log, Gemfile, Gemfile.lock]
 

package.yaml

@@ -1,5 +1,5 @@
 name: taskell
-version: '1.7.1.0'
+version: '1.7.2.0'
 category: Command Line Tools
 author: Mark Wales
 maintainer: [email protected]
@@ -40,6 +40,7 @@ library:
   - Data.Taskell.Task
   - Data.Taskell.Task.Internal
   - Events.Actions.Types
+  - Events.State.History
   - Events.State.Types
   - Events.State.Types.Mode
   - IO.Config.Markdown

roadmap.md

@@ -57,7 +57,6 @@
     * [ ] Add keys to Help which aren't in bindings
     * [ ] More detailed error messages for missing/invalid mappings
 - Add tags/labels with `t`
-- Use proper error codes
 - Performance with large files
     > Becomes unusable with large files
     * [x] Initially use debouncing to avoid writing too often
@@ -71,7 +70,6 @@
     * [x] Markdown parsing
     * [ ] Text line breaks go a bit funny with multi-line descriptions
 - Check times work no matter what timezone
-- Redo functionality
 - Always show list title
     > Floating list titles - so you can always see what list you're in
 - Make token UX better
@@ -325,3 +323,5 @@
     * [x] DUE mode
 - Update screenshot
 - Date should update if taskell is left open
+- Use proper error codes
+- Redo functionality

src/Config.hs

@@ -9,7 +9,7 @@ import ClassyPrelude
 import Data.FileEmbed (embedFile)
 
 version :: Text
-version = "1.7.1"
+version = "1.7.2"
 
 usage :: Text
 usage = decodeUtf8 $(embedFile "templates/usage.txt")

src/Events/Actions/Normal.hs

@@ -23,6 +23,7 @@ events
  =
     [ (A.Quit, quit)
     , (A.Undo, (write =<<) . undo)
+    , (A.Redo, (write =<<) . redo)
     , (A.Search, searchMode)
     , (A.Help, showHelp)
     , (A.Due, showDue)

src/Events/Actions/Types.hs

@@ -8,6 +8,7 @@ import ClassyPrelude hiding (Left, Nothing, Right)
 data ActionType
     = Quit
     | Undo
+    | Redo
     | Search
     | Due
     | Help

src/Events/State.hs

@@ -39,6 +39,7 @@ module Events.State
     , listLeft
     , listRight
     , undo
+    , redo
     , store
     , searchMode
     , clearSearch
@@ -61,7 +62,7 @@ module Events.State
 
 import ClassyPrelude hiding (delete)
 
-import Control.Lens ((&), (.~), (^.))
+import Control.Lens ((%~), (&), (.~), (?~), (^.))
 
 import Data.Char (digitToInt, ord)
 
@@ -71,19 +72,19 @@ import qualified Data.Taskell.Lists as Lists
 import           Data.Taskell.Task  (Task, isBlank, name)
 import           Types
 
-import Events.State.Types
-import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))
-import UI.Draw.Field           (Field, blankField, getText, textToField)
+import qualified Events.State.History    as History (redo, store, undo)
+import           Events.State.Types
+import           Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..),
+                                          Mode (..))
+import           UI.Draw.Field           (Field, blankField, getText, textToField)
 
 type InternalStateful = State -> State
 
 create :: UTCTime -> FilePath -> Lists.Lists -> State
 create t p ls =
     State
     { _mode = Normal
-    , _lists = ls
-    , _history = []
-    , _current = (ListIndex 0, TaskIndex 0)
+    , _history = fresh ls
     , _path = p
     , _io = Nothing
     , _height = 0
@@ -98,21 +99,20 @@ quit = pure . (mode .~ Shutdown)
 continue :: State -> State
 continue = io .~ Nothing
 
+store :: Stateful
+store state = pure $ state & history %~ History.store
+
+undo :: Stateful
+undo state = pure $ state & history %~ History.undo
+
+redo :: Stateful
+redo state = pure $ state & history %~ History.redo
+
 setTime :: UTCTime -> State -> State
 setTime t = time .~ t
 
 write :: Stateful
-write state = pure $ state & io .~ Just (state ^. lists)
-
-store :: Stateful
-store state = pure $ state & history .~ (state ^. current, state ^. lists) : state ^. history
-
-undo :: Stateful
-undo state =
-    pure $
-    case state ^. history of
-        []          -> state
-        ((c, l):xs) -> state & current .~ c & lists .~ l & history .~ xs
+write state = pure $ state & (io ?~ (state ^. lists))
 
 -- createList
 createList :: Stateful

src/Events/State/History.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Events.State.History
+    ( undo
+    , redo
+    , store
+    ) where
+
+import ClassyPrelude
+
+import Control.Lens (Lens', (&), (.~), (^.))
+
+import Events.State.Types (History, future, past, present)
+
+λstack :: Lens' (History a) [a] -> History a -> [a]
+λstack fn history = history ^. present : (history ^. fn)
+
+store :: History a -> History a
+store history = history & past .~ λstack past history & future .~ empty
+
+undo :: History a -> History a
+undo history =
+    case history ^. past of
+        []          -> history
+        (moment:xs) -> history & present .~ moment & past .~ xs & future .~ λstack future history
+
+redo :: History a -> History a
+redo history =
+    case history ^. future of
+        []          -> history
+        (moment:xs) -> history & present .~ moment & future .~ xs & past .~ λstack past history

src/Events/State/Types.hs

@@ -5,19 +5,29 @@ module Events.State.Types where
 
 import ClassyPrelude
 
-import Control.Lens (makeLenses)
+import Control.Lens             (Lens', makeLenses)
+import Control.Lens.Combinators (_1, _2)
 
 import Data.Taskell.Lists (Lists)
-import Types              (Pointer)
+import Types              (Pointer, startPointer)
 import UI.Draw.Field      (Field)
 
 import qualified Events.State.Types.Mode as M (Mode)
 
+type Moment = (Pointer, Lists)
+
+data History a = History
+    { _past    :: [a]
+    , _present :: a
+    , _future  :: [a]
+    } deriving (Eq, Show)
+
+fresh :: Lists -> History Moment
+fresh ls = History empty (startPointer, ls) empty
+
 data State = State
     { _mode       :: M.Mode
-    , _lists      :: Lists
-    , _history    :: [(Pointer, Lists)]
-    , _current    :: Pointer
+    , _history    :: History Moment
     , _path       :: FilePath
     , _io         :: Maybe Lists
     , _height     :: Int
@@ -28,4 +38,12 @@ data State = State
 -- create lenses
 $(makeLenses ''State)
 
+$(makeLenses ''History)
+
 type Stateful = State -> Maybe State
+
+current :: Lens' State Pointer
+current = history . present . _1
+
+lists :: Lens' State Lists
+lists = history . present . _2

src/IO/Keyboard.hs

@@ -42,6 +42,7 @@ defaultBindings :: Bindings
 defaultBindings =
     [ (BChar 'q', A.Quit)
     , (BChar 'u', A.Undo)
+    , (BChar 'r', A.Redo)
     , (BChar '/', A.Search)
     , (BChar '!', A.Due)
     , (BChar '?', A.Help)

src/IO/Taskell.hs

@@ -28,6 +28,7 @@ type ReaderConfig a = ReaderT Config IO a
 
 data Next
     = Output Text
+    | Error Text
     | Load FilePath
            Lists
     | Exit
@@ -40,7 +41,7 @@ parseArgs ["-g", identifier, file] = loadGitHub identifier file
 parseArgs ["-i", file]             = fileInfo file
 parseArgs [file]                   = loadFile file
 parseArgs []                       = (pack . filename . general <$> ask) >>= loadFile
-parseArgs _                        = pure $ Output (unlines ["Invalid options", "", usage])
+parseArgs _                        = pure $ Error (unlines ["Invalid options", "", usage])
 
 load :: ReaderConfig Next
 load = getArgs >>= parseArgs
@@ -53,14 +54,14 @@ loadFile filepath = do
     mPath <- exists filepath
     case mPath of
         Nothing   -> pure Exit
-        Just path -> either (Output . colonic path) (Load path) <$> readData path
+        Just path -> either (Error . colonic path) (Load path) <$> readData path
 
 loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next
 loadRemote createFn identifier filepath = do
     let path = unpack filepath
     exists' <- fileExists path
     if exists'
-        then pure $ Output (filepath <> " already exists")
+        then pure $ Error (filepath <> " already exists")
         else createFn identifier path
 
 loadTrello :: Trello.TrelloBoardID -> Text -> ReaderConfig Next
@@ -74,8 +75,8 @@ fileInfo filepath = do
     let path = unpack filepath
     exists' <- fileExists path
     if exists'
-        then Output . either (colonic path) (analyse filepath) <$> readData path
-        else pure Exit
+        then either (Error . colonic path) (Output . analyse filepath) <$> readData path
+        else pure $ Error (filepath <> " does not exist")
 
 createRemote ::
        (Config -> Maybe token)
@@ -87,11 +88,11 @@ createRemote ::
 createRemote tokenFn missingToken getFn identifier path = do
     config <- ask
     case tokenFn config of
-        Nothing -> pure $ Output missingToken
+        Nothing -> pure $ Error missingToken
         Just token -> do
             lists <- lift $ runReaderT (getFn identifier) token
             case lists of
-                Left txt -> pure $ Output txt
+                Left txt -> pure $ Error txt
                 Right ls ->
                     promptCreate path >>=
                     bool (pure Exit) (Load path ls <$ lift (writeData config ls path))

src/Types.hs

@@ -13,3 +13,6 @@ newtype TaskIndex = TaskIndex
     } deriving (Show, Eq, Ord)
 
 type Pointer = (ListIndex, TaskIndex)
+
+startPointer :: Pointer
+startPointer = (ListIndex 0, TaskIndex 0)

src/UI/Draw/Modal/Help.hs

@@ -38,6 +38,7 @@ descriptions =
     , ([A.MoveMenu], "Move task to specific list")
     , ([A.Delete], "Delete task")
     , ([A.Undo], "Undo")
+    , ([A.Redo], "Redo")
     , ([A.ListNew], "New list")
     , ([A.ListEdit], "Edit list title")
     , ([A.ListDelete], "Delete list")

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-14.12
+resolver: lts-14.14
 pvp-bounds: both
 packages:
   - .

stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 545658
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/12.yaml
-    sha256: 26b807457213126d26b595439d705dc824dbb7618b0de6b900adc2bf6a059406
-  original: lts-14.12
+    size: 525663
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/14.yaml
+    sha256: 6edc48df46eb8bf7b861e98dd30d021a92c2e1820c9bb6528aac5d997b0e14ef
+  original: lts-14.14

templates/bindings.ini

@@ -1,6 +1,7 @@
 # general
 quit = q
 undo = u
+redo = r
 search = /
 help = ?
 due = !