diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 `. 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. 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.9.1" +version = "1.9.2" usage :: Text usage = decodeUtf8 $(embedFile "templates/usage.txt") 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 @@ -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) diff --git a/src/Events/Actions/Types.hs b/src/Events/Actions/Types.hs --- a/src/Events/Actions/Types.hs +++ b/src/Events/Actions/Types.hs @@ -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 diff --git a/src/Events/State.hs b/src/Events/State.hs --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -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 diff --git a/src/IO/Config/General.hs b/src/IO/Config/General.hs --- a/src/IO/Config/General.hs +++ b/src/IO/Config/General.hs @@ -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) diff --git a/src/IO/Config/GitHub.hs b/src/IO/Config/GitHub.hs --- a/src/IO/Config/GitHub.hs +++ b/src/IO/Config/GitHub.hs @@ -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) diff --git a/src/IO/Config/Layout.hs b/src/IO/Config/Layout.hs --- a/src/IO/Config/Layout.hs +++ b/src/IO/Config/Layout.hs @@ -1,4 +1,13 @@ -module IO.Config.Layout where +module IO.Config.Layout + ( Config + , defaultConfig + , parser + , padding + , columnWidth + , columnPadding + , descriptionIndicator + , statusBar + ) where import ClassyPrelude diff --git a/src/IO/Config/Markdown.hs b/src/IO/Config/Markdown.hs --- a/src/IO/Config/Markdown.hs +++ b/src/IO/Config/Markdown.hs @@ -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) diff --git a/src/IO/Config/Trello.hs b/src/IO/Config/Trello.hs --- a/src/IO/Config/Trello.hs +++ b/src/IO/Config/Trello.hs @@ -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) diff --git a/src/IO/HTTP/GitHub.hs b/src/IO/HTTP/GitHub.hs --- a/src/IO/HTTP/GitHub.hs +++ b/src/IO/HTTP/GitHub.hs @@ -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 diff --git a/src/IO/HTTP/GitHub/AutomatedCard.hs b/src/IO/HTTP/GitHub/AutomatedCard.hs new file mode 100644 --- /dev/null +++ b/src/IO/HTTP/GitHub/AutomatedCard.hs @@ -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) diff --git a/src/IO/HTTP/GitHub/Card.hs b/src/IO/HTTP/GitHub/Card.hs --- a/src/IO/HTTP/GitHub/Card.hs +++ b/src/IO/HTTP/GitHub/Card.hs @@ -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 diff --git a/src/IO/HTTP/GitHub/Column.hs b/src/IO/HTTP/GitHub/Column.hs --- a/src/IO/HTTP/GitHub/Column.hs +++ b/src/IO/HTTP/GitHub/Column.hs @@ -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) diff --git a/src/IO/HTTP/GitHub/Utility.hs b/src/IO/HTTP/GitHub/Utility.hs new file mode 100644 --- /dev/null +++ b/src/IO/HTTP/GitHub/Utility.hs @@ -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 diff --git a/src/IO/Keyboard.hs b/src/IO/Keyboard.hs --- a/src/IO/Keyboard.hs +++ b/src/IO/Keyboard.hs @@ -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) diff --git a/src/UI/Draw/Main.hs b/src/UI/Draw/Main.hs --- a/src/UI/Draw/Main.hs +++ b/src/UI/Draw/Main.hs @@ -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) diff --git a/src/UI/Draw/Modal/Help.hs b/src/UI/Draw/Modal/Help.hs --- a/src/UI/Draw/Modal/Help.hs +++ b/src/UI/Draw/Modal/Help.hs @@ -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") 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.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 diff --git a/templates/bindings.ini b/templates/bindings.ini --- a/templates/bindings.ini +++ b/templates/bindings.ini @@ -12,6 +12,7 @@ left = h right = l bottom = G +top = g # new tasks new = a diff --git a/test/IO/GitHub/CardsTest.hs b/test/IO/GitHub/CardsTest.hs new file mode 100644 --- /dev/null +++ b/test/IO/GitHub/CardsTest.hs @@ -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\"}]")) + ] diff --git a/test/IO/Keyboard/TypesTest.hs b/test/IO/Keyboard/TypesTest.hs --- a/test/IO/Keyboard/TypesTest.hs +++ b/test/IO/Keyboard/TypesTest.hs @@ -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)