Merge branch 'release/1.2.3'

docs/html/_config.yml

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

package.yaml

@@ -1,5 +1,5 @@
 name: taskell
-version: '1.2.2.0'
+version: '1.2.3.0'
 category: CLI
 author: Mark Wales
 maintainer: [email protected]

roadmap.md

@@ -62,7 +62,6 @@
     > Use a `# Title` at top of file and display title somewhere in taskell
 - Add tags/labels with `t`
 - URL field - plus config to run specific command when selected (e.g. `open -a Chrome.app #{url}`)
-- Should change list numbering to letters when in move list mode
 - Redo functionality
 - Make trello token UX better
     * Open link automatically?
@@ -79,10 +78,6 @@
 
 ## In Progress
 
-- Improve Trello checklist import
-    * ~Take checklist fetch errors into account~
-    * ~Refactor code~
-    * Use Reader to pass around trello token?
 
 ## Done
 
@@ -218,3 +213,8 @@
     * ~Add due date support~
     * ~Add sub-tasks support~
     * ~Add card summary support~
+- Improve Trello checklist import
+    * ~Take checklist fetch errors into account~
+    * ~Refactor code~
+    * ~Use Reader to pass around trello token?~
+- Should change list numbering to letters when in move list mode

src/App.hs

@@ -9,9 +9,9 @@ import Graphics.Vty (Mode(BracketedPaste), outputIface, supportsMode, setMode)
 import Graphics.Vty.Input.Events (Event(..))
 
 import Data.Taskell.Lists (Lists)
-import Data.Taskell.Date (currentDay, deadline)
+import Data.Taskell.Date (currentDay)
 import Events.Actions (event)
-import Events.State (State, Mode(..), continue, path, mode, io, current)
+import Events.State (State, Mode(..), ModalType(..), continue, path, mode, io, current, lists)
 import IO.Config (Config, layout, generateAttrMap)
 import IO.Taskell (writeData)
 import UI.Draw (draw, chooseCursor)
@@ -34,16 +34,25 @@ clearCache state = do
     invalidateCacheEntry (RNList li)
     invalidateCacheEntry (RNTask (li, ti))
 
+clearAllTitles :: State -> EventM ResourceName ()
+clearAllTitles state = do
+    let count = length (lists state)
+    let range = [0 .. (count - 1)]
+    void . sequence $ invalidateCacheEntry . RNList <$> range
+    void . sequence $ invalidateCacheEntry . (\x -> RNTask (x, -1)) <$> range
+
 handleVtyEvent :: Config -> State -> Event -> EventM ResourceName (Next State)
 handleVtyEvent config previousState e = do
     let state = event e previousState
 
     case mode previousState of
         Search _ _ -> invalidateCache
-        _ -> return  ()
+        (Modal MoveTo) -> clearAllTitles previousState
+        _ -> return ()
 
     case mode state of
         Shutdown -> Brick.halt state
+        (Modal MoveTo) -> clearAllTitles state >> next config state
         _ -> clearCache previousState >> clearCache state >> next config state
 
 -- App code
@@ -63,9 +72,9 @@ appStart state = do
 go :: Config -> State -> IO ()
 go config initial = do
     attrMap' <- const <$> generateAttrMap
-    deadlineFn <- deadline <$> currentDay
+    today <- currentDay
     let app = App {
-            appDraw = draw (layout config) deadlineFn
+            appDraw = draw (layout config) today
           , appChooseCursor = chooseCursor
           , appHandleEvent = handleEvent config
           , appStartEvent = appStart

src/Config.hs

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

src/Data/Taskell/Date.hs

@@ -17,14 +17,17 @@ import ClassyPrelude
 import Data.Time (Day)
 import Data.Time.Clock (secondsToDiffTime)
 import Data.Time.Format (parseTimeM, formatTime)
-import Data.Time.Calendar (diffDays)
+import Data.Time.Calendar (toGregorian, diffDays)
 import Data.Time.LocalTime (TimeZone, utcToZonedTime, zonedTimeToLocalTime, localDay)
 
 data Deadline = Passed | Today | Tomorrow | ThisWeek | Plenty deriving (Show, Eq)
 type DeadlineFn = Day -> Deadline
 
-dayToText :: Day -> Text
-dayToText day = pack $ formatTime defaultTimeLocale "%d-%b" (UTCTime day (secondsToDiffTime 0))
+dayToText :: Day -> Day -> Text
+dayToText today day = pack $ formatTime defaultTimeLocale format (UTCTime day (secondsToDiffTime 0))
+    where (currentYear, _, _) = toGregorian today
+          (dateYear, _, _) = toGregorian day
+          format = if currentYear == dateYear then "%d-%b" else "%d-%b %Y"
 
 dayToOutput :: Day -> Text
 dayToOutput day = pack $ formatTime defaultTimeLocale "%Y-%m-%d" (UTCTime day (secondsToDiffTime 0))

src/IO/Taskell.hs

@@ -57,7 +57,7 @@ createTrello boardID path = do
     case maybeToken of
         Nothing -> return $ Output $ decodeUtf8 $(embedFile "templates/token.txt")
         Just trelloToken -> do
-            lists <- lift $ getCards trelloToken boardID
+            lists <- lift $ runReaderT (getCards boardID) trelloToken
             case lists of
                 Left txt -> return $ Output txt
                 Right ls -> do

src/IO/Trello.hs

@@ -11,12 +11,14 @@ import ClassyPrelude
 import Network.HTTP.Simple (parseRequest, httpBS, getResponseBody, getResponseStatusCode)
 import Data.Aeson
 
-import IO.Trello.List (List, trelloListToList, cards)
+import IO.Trello.List (List, trelloListToList, setCards, cards)
 import IO.Trello.Card (Card, idChecklists, setChecklists)
 import IO.Trello.ChecklistItem (ChecklistItem, checkItems)
 import Data.Taskell.Lists (Lists)
 import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
 
+type ReaderTrelloToken a = ReaderT TrelloToken IO a
+
 type TrelloToken = Text
 type TrelloBoardID = Text
 type TrelloChecklistID = Text
@@ -27,18 +29,20 @@ key = "80dbcf6f88f62cc5639774e13342c20b"
 root :: Text
 root = "https://api.trello.com/1/"
 
-fullURL :: Text -> TrelloToken -> String
-fullURL uri token = unpack $ concat [root, uri, "&key=", key, "&token=", token]
+fullURL :: Text -> ReaderTrelloToken String
+fullURL uri = do
+    token <- ask
+    return . unpack $ concat [root, uri, "&key=", key, "&token=", token]
 
-boardURL :: TrelloBoardID -> TrelloToken -> String
+boardURL :: TrelloBoardID -> ReaderTrelloToken String
 boardURL board = fullURL $ concat [
         "boards/", board, "/lists",
         "?cards=open",
         "&card_fields=name,due,desc,idChecklists",
         "&fields=id,name,cards"
     ]
 
-checklistURL :: TrelloChecklistID -> TrelloToken -> String
+checklistURL :: TrelloChecklistID -> ReaderTrelloToken String
 checklistURL checklist = fullURL $ concat [
         "checklists/", checklist,
         "?fields=id",
@@ -54,9 +58,10 @@ fetch url = do
     response <- httpBS request
     return (getResponseStatusCode response, getResponseBody response)
 
-getChecklist :: TrelloToken -> TrelloChecklistID -> IO (Either Text [ChecklistItem])
-getChecklist token checklist = do
-    (status, body) <- fetch (checklistURL checklist token)
+getChecklist :: TrelloChecklistID -> ReaderTrelloToken (Either Text [ChecklistItem])
+getChecklist checklist = do
+    url <- checklistURL checklist
+    (status, body) <- lift $ fetch url
 
     return $ case status of
         200 -> case checkItems <$> decodeStrict body of
@@ -65,35 +70,27 @@ getChecklist token checklist = do
         429 -> Left "Too many checklists"
         _ -> Left $ tshow status ++ " error while fetching checklist " ++ checklist
 
-updateCard :: TrelloToken -> Card -> IO (Either Text Card)
-updateCard token card = do
-    let ids = idChecklists card
-    checklists <- sequence $ getChecklist token <$> ids
-    return $ setChecklists card . concat <$> sequence checklists
+updateCard :: Card -> ReaderTrelloToken (Either Text Card)
+updateCard card = (setChecklists card . concat <$>) . sequence <$> checklists
+    where checklists = sequence $ getChecklist <$> idChecklists card
 
-updateList :: TrelloToken -> List -> IO (Either Text List)
-updateList token l = do
-    let set c = l { cards = c }
-    cs <- sequence $ updateCard token <$> cards l
-    return $ set <$> sequence cs
+updateList :: List -> ReaderTrelloToken (Either Text List)
+updateList l = (setCards l <$>) . sequence <$> sequence (updateCard <$> cards l)
 
-getChecklists :: TrelloToken -> [List] -> IO (Either Text [List])
-getChecklists token ls = do
-    lists <- sequence $ updateList token <$> ls
-    return $ sequence lists
+getChecklists :: [List] -> ReaderTrelloToken (Either Text [List])
+getChecklists ls = sequence <$> sequence (updateList <$> ls)
 
-getCards :: TrelloToken -> TrelloBoardID -> IO (Either Text Lists)
-getCards token board = do
-    (status, body) <- fetch (boardURL board token)
-    timezone <- getCurrentTimeZone
+getCards :: TrelloBoardID -> ReaderTrelloToken (Either Text Lists)
+getCards board = do
+    url <- boardURL board
+    (status, body) <- lift $ fetch url
+    timezone <- lift getCurrentTimeZone
 
     putStrLn "Fetching from Trello..."
 
     case status of
         200 -> case decodeStrict body of
-            Just raw -> do
-                lists <- getChecklists token raw
-                return $ trelloListsToLists timezone <$> lists
+            Just raw -> fmap (trelloListsToLists timezone) <$> getChecklists raw
             Nothing -> return $ Left "Could not parse response. Please file an Issue on GitHub."
         404 -> return . Left $ "Could not find Trello board " ++ board ++ ". Make sure the ID is correct"
         401 -> return . Left $ "You do not have permission to view Trello board " ++ board

src/IO/Trello/List.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 module IO.Trello.List (
     List(..)
+  , setCards
   , trelloListToList
 ) where
 
@@ -18,6 +19,9 @@ data List = List {
   , cards :: [Card]
 } deriving (Eq, Show, Generic, ToJSON, FromJSON)
 
+setCards :: List -> [Card] -> List
+setCards list cs = list { cards = cs }
+
 trelloListToList :: TimeZone -> List -> TL.List
 trelloListToList tz ls = TL.List {
         TL.title = name ls