taskell 1.9.1.0 → 1.9.2.0

raw patch · 22 files changed

+248/−91 lines, 22 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +10/−2
• src/Config.hs +1/−1
• src/Events/Actions/Normal.hs +1/−0
• src/Events/Actions/Types.hs +2/−0
• src/Events/State.hs +7/−0
• src/IO/Config/General.hs +14/−9
• src/IO/Config/GitHub.hs +10/−7
• src/IO/Config/Layout.hs +10/−1
• src/IO/Config/Markdown.hs +34/−24
• src/IO/Config/Trello.hs +10/−7
• src/IO/HTTP/GitHub.hs +34/−13
• src/IO/HTTP/GitHub/AutomatedCard.hs +33/−0
• src/IO/HTTP/GitHub/Card.hs +13/−12
• src/IO/HTTP/GitHub/Column.hs +4/−4
• src/IO/HTTP/GitHub/Utility.hs +13/−0
• src/IO/Keyboard.hs +2/−1
• src/UI/Draw/Main.hs +2/−7
• src/UI/Draw/Modal/Help.hs +1/−0
• taskell.cabal +5/−2
• templates/bindings.ini +1/−0
• test/IO/GitHub/CardsTest.hs +39/−0
• test/IO/Keyboard/TypesTest.hs +2/−1

@@ -44,8 +44,6 @@ brew install taskell ``` -There are usually bottles (binaries) available. If these are not available for your computer, Homebrew will build Taskell from scratch, which can take a while, particularly on older machines. Occasionally the build fails the first time, but usually works on a second attempt.- ### Debian/Ubuntu  [A `.deb` package is available for Debian/Ubuntu](https://github.com/smallhadroncollider/taskell/releases). Download it and install with `dpkg -i <package-name>`. You may also need to install the `libtinfo5` package (`sudo apt install libtinfo5`).@@ -274,6 +272,16 @@ #### Due Dates  Due dates must be input with the format `YYYY-MM-DD` or `YYYY-MM-DD HH:MM`. The date will not be accepted otherwise.++You can also pass in relative times such as `1w 2d` (for 1 week and 2 days). Valid units are:++- `s` (seconds)+- `m` (minutes)+- `h` (hours)+- `d` (days)+- `w` (weeks)++These can be used in any combination. If the time is made up only of days and/or weeks, the due date will not include a time.  By default times are stored in the Markdown file as UTC. If you would like local times (and are unlikely to open the file in lots of different timezones) then you can set `localTimes` to `true` in the `markdown` section of the [config file](#configuration). If you have this setting on and you change timezone, you'll get a diff on all your times the next time you make changes to the file. 

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

@@ -33,6 +33,7 @@     , (A.Left, left)     , (A.Right, right)     , (A.Bottom, bottom)+    , (A.Top, top)     -- new tasks     , (A.New, (startCreate =<<) . (newItem =<<) . store)     , (A.NewAbove, (startCreate =<<) . (above =<<) . store)

@@ -17,6 +17,7 @@     | Left     | Right     | Bottom+    | Top     | New     | NewAbove     | NewBelow@@ -56,6 +57,7 @@ read "left"       = Left read "right"      = Right read "bottom"     = Bottom+read "top"        = Top read "new"        = New read "newAbove"   = NewAbove read "newBelow"   = NewBelow

@@ -24,6 +24,7 @@     , above     , below     , bottom+    , top     , previous     , duplicate     , next@@ -205,6 +206,12 @@  selectLast :: InternalStateful selectLast state = setIndex state (countCurrent state - 1)++top :: Stateful+top = pure . selectFirst++selectFirst :: InternalStateful+selectFirst state = setIndex state (0)  removeBlank :: Stateful removeBlank state = do

@@ -1,4 +1,10 @@-module IO.Config.General where+module IO.Config.General+    ( Config+    , defaultConfig+    , parser+    , filename+    , debug+    ) where  import ClassyPrelude @@ -14,12 +20,11 @@ defaultConfig :: Config defaultConfig = Config {filename = "taskell.md", debug = False} +filenameP :: SectionParser String+filenameP = maybe (filename defaultConfig) unpack . (noEmpty =<<) <$> fieldMb "filename"++debugP :: SectionParser Bool+debugP = fieldFlagDef "debug" False+ parser :: IniParser Config-parser =-    fromMaybe defaultConfig <$>-    sectionMb-        "general"-        (do filenameCf <--                maybe (filename defaultConfig) unpack . (noEmpty =<<) <$> fieldMb "filename"-            debugCf <- fieldFlagDef "debug" False-            pure Config {filename = filenameCf, debug = debugCf})+parser = fromMaybe defaultConfig <$> sectionMb "general" (Config <$> filenameP <*> debugP)

@@ -1,4 +1,9 @@-module IO.Config.GitHub where+module IO.Config.GitHub+    ( Config+    , defaultConfig+    , parser+    , token+    ) where  import ClassyPrelude @@ -13,10 +18,8 @@ defaultConfig :: Config defaultConfig = Config {token = Nothing} +tokenP :: SectionParser (Maybe GitHubToken)+tokenP = fieldMb "token"+ parser :: IniParser Config-parser =-    fromMaybe defaultConfig <$>-    sectionMb-        "github"-        (do tokenCf <- fieldMb "token"-            pure Config {token = tokenCf})+parser = fromMaybe defaultConfig <$> sectionMb "github" (Config <$> tokenP)

@@ -1,4 +1,13 @@-module IO.Config.Layout where+module IO.Config.Layout+    ( Config+    , defaultConfig+    , parser+    , padding+    , columnWidth+    , columnPadding+    , descriptionIndicator+    , statusBar+    ) where  import ClassyPrelude 

@@ -1,4 +1,14 @@-module IO.Config.Markdown where+module IO.Config.Markdown+    ( Config(Config)+    , defaultConfig+    , parser+    , titleOutput+    , taskOutput+    , descriptionOutput+    , dueOutput+    , subtaskOutput+    , localTimes+    ) where  import ClassyPrelude @@ -26,31 +36,31 @@     , localTimes = False     } +titleOutputP :: SectionParser Text+titleOutputP = fromMaybe (titleOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "title"++taskOutputP :: SectionParser Text+taskOutputP = fromMaybe (taskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "task"++descriptionOutputP :: SectionParser Text+descriptionOutputP =+    fromMaybe (descriptionOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "summary"++dueOutputP :: SectionParser Text+dueOutputP = fromMaybe (dueOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "due"++subtaskOutputP :: SectionParser Text+subtaskOutputP =+    fromMaybe (subtaskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "subtask"++localTimesP :: SectionParser Bool+localTimesP = fieldFlagDef "localTimes" (localTimes defaultConfig)+ parser :: IniParser Config parser =     fromMaybe defaultConfig <$>     sectionMb         "markdown"-        (do titleOutputCf <--                fromMaybe (titleOutput defaultConfig) . (noEmpty . parseText =<<) <$>-                fieldMb "title"-            taskOutputCf <--                fromMaybe (taskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "task"-            descriptionOutputCf <--                fromMaybe (descriptionOutput defaultConfig) . (noEmpty . parseText =<<) <$>-                fieldMb "summary"-            dueOutputCf <--                fromMaybe (dueOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "due"-            subtaskOutputCf <--                fromMaybe (subtaskOutput defaultConfig) . (noEmpty . parseText =<<) <$>-                fieldMb "subtask"-            localTimesCf <- fieldFlagDef "localTimes" (localTimes defaultConfig)-            pure-                Config-                { titleOutput = titleOutputCf-                , taskOutput = taskOutputCf-                , descriptionOutput = descriptionOutputCf-                , dueOutput = dueOutputCf-                , subtaskOutput = subtaskOutputCf-                , localTimes = localTimesCf-                })+        (Config <$> titleOutputP <*> taskOutputP <*> descriptionOutputP <*> dueOutputP <*>+         subtaskOutputP <*>+         localTimesP)

@@ -1,4 +1,9 @@-module IO.Config.Trello where+module IO.Config.Trello+    ( Config+    , defaultConfig+    , parser+    , token+    ) where  import ClassyPrelude @@ -13,10 +18,8 @@ defaultConfig :: Config defaultConfig = Config {token = Nothing} +tokenP :: SectionParser (Maybe TrelloToken)+tokenP = fieldMb "token"+ parser :: IniParser Config-parser =-    fromMaybe defaultConfig <$>-    sectionMb-        "trello"-        (do tokenCf <- fieldMb "token"-            pure Config {token = tokenCf})+parser = fromMaybe defaultConfig <$> sectionMb "trello" (Config <$> tokenP)

@@ -23,13 +23,15 @@                                   parseRequest) import Network.HTTP.Types.Header (HeaderName) -import IO.HTTP.Aeson          (parseError)-import IO.HTTP.GitHub.Card    (Card)-import IO.HTTP.GitHub.Column  (Column, cardsURL, columnToList)-import IO.HTTP.GitHub.Project (Project, columnsURL, name)+import IO.HTTP.Aeson                (parseError)+import IO.HTTP.GitHub.AutomatedCard (automatedCardToTask)+import IO.HTTP.GitHub.Card          (MaybeCard, content_url, maybeCardToTask)+import IO.HTTP.GitHub.Column        (Column, cardsURL, columnToList)+import IO.HTTP.GitHub.Project       (Project, columnsURL, name)  import Data.Taskell.List  (List) import Data.Taskell.Lists (Lists)+import Data.Taskell.Task  (Task)  type GitHubToken = Text @@ -78,17 +80,36 @@ fetch :: Text -> ReaderGitHubToken (Int, [ByteString]) fetch = fetch' [] -getCards :: Text -> ReaderGitHubToken (Either Text [Card])+fetchContent :: MaybeCard -> ReaderGitHubToken (Either Text Task)+fetchContent card =+    case maybeCardToTask card of+        Just tsk -> pure $ Right tsk+        Nothing ->+            case card ^. content_url of+                Nothing -> pure $ Left "Could not parse card"+                Just url -> do+                    (_, body) <- fetch url+                    case headMay body of+                        Nothing -> pure $ Left "Could not find card content"+                        Just is ->+                            pure . first parseError $ automatedCardToTask <$> eitherDecodeStrict is++getCards :: Text -> ReaderGitHubToken (Either Text [Task]) getCards url = do     (status, body) <- fetch url-    pure $-        case status of-            200 ->-                case concatEithers (eitherDecodeStrict <$> body) of-                    Right cards -> Right cards-                    Left err    -> Left (parseError err)-            429 -> Left "Too many cards"-            _ -> Left $ tshow status <> " error while fetching " <> url+    case status of+        200 ->+            case concatEithers (eitherDecodeStrict <$> body) of+                Right cards -> do+                    cds <- sequence (fetchContent <$> cards)+                    let (ls, rs) = partitionEithers cds+                    pure $+                        if null ls+                            then Right rs+                            else Left (unlines ls)+                Left err -> pure $ Left (parseError err)+        429 -> pure $ Left "Too many cards"+        _ -> pure . Left $ tshow status <> " error while fetching " <> url  addCard :: Column -> ReaderGitHubToken (Either Text List) addCard column = do

@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.HTTP.GitHub.AutomatedCard+    ( AutomatedCard(AutomatedCard)+    , automatedCardToTask+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (^.))++import qualified Data.Taskell.Task      as T (Task, new, setDescription)+import           IO.HTTP.Aeson          (deriveFromJSON)+import           IO.HTTP.GitHub.Utility (cleanUp)++data AutomatedCard = AutomatedCard+    { _title :: Text+    , _body  :: Text+    } deriving (Eq, Show)++-- strip underscores from field labels+$(deriveFromJSON ''AutomatedCard)++-- create lenses+$(makeLenses ''AutomatedCard)++-- operations+automatedCardToTask :: AutomatedCard -> T.Task+automatedCardToTask automatedCard = T.setDescription (cleanUp (automatedCard ^. body)) task+  where+    task = T.new $ cleanUp (automatedCard ^. title)

@@ -3,29 +3,30 @@ {-# LANGUAGE TemplateHaskell #-}  module IO.HTTP.GitHub.Card-    ( Card-    , cardToTask+    ( MaybeCard(MaybeCard)+    , maybeCardToTask+    , content_url     ) where  import ClassyPrelude  import Control.Lens (makeLenses, (^.)) -import Data.Text (replace)--import qualified Data.Taskell.Task as T (Task, new)-import           IO.HTTP.Aeson     (deriveFromJSON)+import qualified Data.Taskell.Task      as T (Task, new)+import           IO.HTTP.Aeson          (deriveFromJSON)+import           IO.HTTP.GitHub.Utility (cleanUp) -data Card = Card-    { _note :: Text+data MaybeCard = MaybeCard+    { _note        :: Maybe Text+    , _content_url :: Maybe Text     } deriving (Eq, Show)  -- strip underscores from field labels-$(deriveFromJSON ''Card)+$(deriveFromJSON ''MaybeCard)  -- create lenses-$(makeLenses ''Card)+$(makeLenses ''MaybeCard)  -- operations-cardToTask :: Card -> T.Task-cardToTask card = T.new $ replace "\r" "" $ replace "\n" " " (card ^. note)+maybeCardToTask :: MaybeCard -> Maybe T.Task+maybeCardToTask card = T.new . cleanUp <$> card ^. note

@@ -11,10 +11,10 @@  import Control.Lens (Lens', makeLenses, (^.)) -import IO.HTTP.Aeson       (deriveFromJSON)-import IO.HTTP.GitHub.Card (Card, cardToTask)+import IO.HTTP.Aeson (deriveFromJSON)  import qualified Data.Taskell.List as L (List, create)+import qualified Data.Taskell.Task as T (Task)  data Column = Column     { _name      :: Text@@ -31,5 +31,5 @@ cardsURL :: Lens' Column Text cardsURL = cards_url -columnToList :: Column -> [Card] -> L.List-columnToList ls cards = L.create (ls ^. name) (fromList $ cardToTask <$> cards)+columnToList :: Column -> [T.Task] -> L.List+columnToList ls tasks = L.create (ls ^. name) (fromList tasks)

@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.HTTP.GitHub.Utility+    ( cleanUp+    ) where++import ClassyPrelude++import Data.Text (replace)++cleanUp :: Text -> Text+cleanUp txt = replace "\r" "" $ replace "\n" " " txt

@@ -50,7 +50,8 @@     , (BChar 'j', A.Next)     , (BChar 'h', A.Left)     , (BChar 'l', A.Right)-    , (BChar 'g', A.Bottom)+    , (BChar 'G', A.Bottom)+    , (BChar 'g', A.Top)     , (BChar 'a', A.New)     , (BChar 'O', A.NewAbove)     , (BChar 'o', A.NewBelow)

@@ -24,10 +24,5 @@     listWidgets <- toList <$> sequence (renderList `mapWithIndex` ls)     pad <- padding <$> asks dsLayout     let mainWidget = viewport RNLists Horizontal . padTopBottom pad $ hBox listWidgets-    showStatusBar <- statusBar <$> asks dsLayout-    sb <- renderStatusBar-    let sb' =-            if showStatusBar-                then sb-                else emptyWidget-    renderSearch (mainWidget <=> sb')+    sb <- bool emptyWidget <$> renderStatusBar <*> (statusBar <$> asks dsLayout)+    renderSearch (mainWidget <=> sb)

@@ -24,6 +24,7 @@     , ([A.Due], "Show tasks with due dates")     , ([A.Previous, A.Next, A.Left, A.Right], "Move down / up / left / right")     , ([A.Bottom], "Go to bottom of list")+    , ([A.Top], "Go to top of list")     , ([A.New], "Add a task")     , ([A.NewAbove, A.NewBelow], "Add a task above / below")     , ([A.Duplicate], "Duplicate a task")

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell-version: 1.9.1.0+version: 1.9.2.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales@@ -52,6 +52,7 @@         IO.Markdown.Parser         IO.Markdown.Serializer         IO.HTTP.GitHub+        IO.HTTP.GitHub.Card         IO.HTTP.Trello.List         IO.HTTP.Trello.ChecklistItem         IO.Keyboard@@ -80,9 +81,10 @@         IO.Config.Parser         IO.Config.Trello         IO.HTTP.Aeson-        IO.HTTP.GitHub.Card+        IO.HTTP.GitHub.AutomatedCard         IO.HTTP.GitHub.Column         IO.HTTP.GitHub.Project+        IO.HTTP.GitHub.Utility         IO.HTTP.Trello         IO.HTTP.Trello.Card         IO.Markdown@@ -158,6 +160,7 @@         Data.Taskell.TaskTest         Events.State.HistoryTest         Events.StateTest+        IO.GitHub.CardsTest         IO.GitHubTest         IO.Keyboard.ParserTest         IO.Keyboard.TypesTest

@@ -12,6 +12,7 @@ left = h right = l bottom = G+top = g  # new tasks new = a

@@ -0,0 +1,39 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.GitHub.CardsTest+    ( test_cards+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Aeson++import IO.HTTP.GitHub.Card (MaybeCard (MaybeCard))++decodeCards :: Text -> Either String [MaybeCard]+decodeCards txt = eitherDecodeStrict $ encodeUtf8 txt++-- tests+test_cards :: TestTree+test_cards =+    testGroup+        "IO.HTTP.GitHub.Card"+        [ testCase+              "parses basic card"+              (assertEqual+                   "Gives back card"+                   (Right [MaybeCard (Just "blah") Nothing])+                   (decodeCards "[{\"note\": \"blah\"}]"))+        , testCase+              "parses basic card"+              (assertEqual+                   "Gives back card"+                   (Right+                        [MaybeCard Nothing (Just "https://api.github.com/projects/columns/7850783")])+                   (decodeCards+                        "[{\"note\": null, \"content_url\": \"https://api.github.com/projects/columns/7850783\"}]"))+        ]

@@ -29,7 +29,8 @@     , (BChar 'j', A.Next)     , (BChar 'h', A.Left)     , (BChar 'l', A.Right)-    , (BChar 'g', A.Bottom)+    , (BChar 'G', A.Bottom)+    , (BChar 'g', A.Top)     , (BChar 'a', A.New)     , (BChar 'O', A.NewAbove)     , (BChar 'o', A.NewBelow)