taskell 1.7.0.0 → 1.8.2.0

raw patch · 43 files changed

+1010/−302 lines, 43 filesdep +tzdep ~brickdep ~vtyPVP ok

version bump matches the API change (PVP)

Dependencies added: tz

Dependency ranges changed: brick, vty

API changes (from Hackage documentation)

Files

• README.md +12/−0
• app/Main.hs +9/−3
• src/App.hs +10/−7
• src/Config.hs +1/−1
• src/Data/Taskell/Date.hs +100/−31
• src/Data/Taskell/Date/RelativeParser.hs +57/−0
• src/Data/Taskell/Task/Internal.hs +8/−9
• src/Events/Actions/Modal/Detail.hs +4/−2
• src/Events/Actions/Normal.hs +1/−0
• src/Events/Actions/Types.hs +2/−0
• src/Events/State.hs +23/−21
• src/Events/State/History.hs +32/−0
• src/Events/State/Modal/Detail.hs +30/−5
• src/Events/State/Types.hs +26/−5
• src/IO/Config/Markdown.hs +4/−0
• src/IO/HTTP/Trello.hs +4/−6
• src/IO/HTTP/Trello/Card.hs +6/−13
• src/IO/HTTP/Trello/List.hs +3/−4
• src/IO/Keyboard.hs +1/−0
• src/IO/Keyboard/Parser.hs +2/−6
• src/IO/Markdown.hs +1/−0
• src/IO/Markdown/Internal.hs +60/−52
• src/IO/Taskell.hs +33/−20
• src/Types.hs +3/−0
• src/UI/Draw/Modal/Detail.hs +11/−8
• src/UI/Draw/Modal/Help.hs +3/−1
• src/UI/Draw/Task.hs +5/−4
• src/UI/Draw/Types.hs +2/−1
• src/Utility/Parser.hs +13/−0
• taskell.cabal +14/−5
• templates/bindings.ini +1/−0
• templates/config.ini +1/−0
• test/Data/Taskell/Date/RelativeParserTest.hs +84/−0
• test/Data/Taskell/DateTest.hs +204/−34
• test/Data/Taskell/ListsTest.hs +17/−11
• test/Data/Taskell/TaskTest.hs +4/−2
• test/Events/State/HistoryTest.hs +98/−0
• test/Events/StateTest.hs +23/−18
• test/IO/Keyboard/ParserTest.hs +4/−2
• test/IO/Keyboard/TypesTest.hs +1/−0
• test/IO/KeyboardTest.hs +2/−1
• test/IO/MarkdownTest.hs +75/−11
• test/IO/TrelloTest.hs +16/−19

@@ -30,6 +30,7 @@     - [Importing GitHub Projects](#importing-github-projects) - [Configuration](#configuration)     - [Controls](#controls)+        - [Due Dates](#due-dates)     - [Theming](#theming) - [Roadmap](#roadmap) @@ -228,6 +229,11 @@  ; the markdown to start a sub-task line with subtask = "    *"++; by default times are stored in UTC to avoid diffs if you+; change locations. Set this to true if it will always be+; edited in the same timezone+localTimes = false ```  Make sure that the values in the `[markdown]` section are surrounded by **double**-quotes.@@ -258,6 +264,12 @@ 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.++#### 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.++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.   ### Theming

@@ -4,17 +4,23 @@  import ClassyPrelude +import System.Exit (die)++import Data.Time.Zones (loadLocalTZ)+ import App          (go) import Events.State (create) import IO.Config    (setup)-import IO.Taskell   (Next (..), load)+import IO.Taskell   (IOInfo (IOInfo), Next (..), load)  main :: IO () main = do     config <- setup-    next <- runReaderT load config+    timezone <- loadLocalTZ+    next <- runReaderT load (IOInfo timezone config)     time <- getCurrentTime     case next of         Exit            -> pure ()         Output text     -> putStrLn text-        Load path lists -> go config $ create time path lists+        Error text      -> die $ unpack text+        Load path lists -> go config $ create timezone time path lists

@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TupleSections #-}  module App     ( go@@ -10,6 +11,8 @@  import Control.Lens ((^.)) +import Data.Time.Zones (TZ)+ import Brick import Brick.BChan               (BChan, newBChan, writeBChan) import Graphics.Vty              (Mode (BracketedPaste), defaultConfig, displayBounds, mkVty,@@ -21,7 +24,7 @@ import Data.Taskell.Lists      (Lists) import Events.Actions          (ActionSets, event, generateActions) import Events.State            (continue, countCurrent, setHeight, setTime)-import Events.State.Types      (State, current, io, lists, mode, path, searchTerm)+import Events.State.Types      (State, current, io, lists, mode, path, searchTerm, timeZone) import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..)) import IO.Config               (Config, debugging, generateAttrMap, getBindings, layout) import IO.Taskell              (writeData)@@ -29,7 +32,7 @@ import UI.Draw                 (chooseCursor, draw) import UI.Types                (ResourceName (..)) -type DebouncedMessage = (Lists, FilePath)+type DebouncedMessage = (Lists, FilePath, TZ)  type DebouncedWrite = DebouncedMessage -> IO () @@ -53,14 +56,14 @@  -- store store :: Config -> DebouncedMessage -> IO ()-store config (ls, pth) = writeData config ls pth+store config (ls, pth, tz) = writeData tz config ls pth  next :: DebouncedWrite -> State -> EventM ResourceName (Next State) next send state =     case state ^. io of         Just ls -> do             invalidateCache-            liftIO $ send (ls, state ^. path)+            liftIO $ send (ls, state ^. path, state ^. timeZone)             Brick.continue $ Events.State.continue state         Nothing -> Brick.continue state @@ -72,7 +75,7 @@             Debounce.Args             { Debounce.cb = store config             , Debounce.fold = flip const-            , Debounce.init = (initial ^. lists, initial ^. path)+            , Debounce.init = (initial ^. lists, initial ^. path, initial ^. timeZone)             }             Debounce.def     let send = Debounce.send trigger@@ -90,7 +93,7 @@     let count = length (state ^. lists)     let range = [0 .. (count - 1)]     traverse_ (invalidateCacheEntry . RNList) range-    traverse_ (invalidateCacheEntry . RNTask . flip (,) (TaskIndex (-1)) . ListIndex) range+    traverse_ (invalidateCacheEntry . RNTask . (, TaskIndex (-1)) . ListIndex) range  clearList :: State -> EventM ResourceName () clearList state = do@@ -126,7 +129,7 @@         _ -> clearCache previousState *> clearCache state *> next send state  getHeight :: EventM ResourceName Int-getHeight = snd <$> (displayBounds =<< outputIface <$> getVtyHandle)+getHeight = snd <$> (liftIO . displayBounds =<< outputIface <$> getVtyHandle)  handleEvent ::        (DebouncedWrite, Trigger)

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

@@ -4,22 +4,40 @@ module Data.Taskell.Date     ( Day     , Deadline(..)-    , DeadlineFn-    , dayToText-    , dayToOutput-    , textToDay-    , utcToLocalDay+    , Due(..)+    , timeToText+    , timeToDisplay+    , timeToOutput+    , timeToOutputLocal+    , textToTime+    , inputToTime+    , isoToTime     , deadline     ) where  import ClassyPrelude -import Data.Time           (Day)-import Data.Time.Calendar  (diffDays, toGregorian)-import Data.Time.Clock     (secondsToDiffTime)-import Data.Time.Format    (formatTime, parseTimeM)-import Data.Time.LocalTime (TimeZone, localDay, utcToZonedTime, zonedTimeToLocalTime)+import Control.Monad.Fail (MonadFail) +import Data.Time.LocalTime (ZonedTime (ZonedTime))+import Data.Time.Zones     (TZ, localTimeToUTCTZ, timeZoneForUTCTime, utcToLocalTimeTZ)++import Data.Time.Calendar (diffDays)+import Data.Time.Format   (FormatTime, ParseTime, formatTime, iso8601DateFormat, parseTimeM)++import Data.Taskell.Date.RelativeParser (parseRelative)++data Due+    = DueTime UTCTime+    | DueDate Day+    deriving (Show, Eq)++instance Ord Due where+    compare (DueTime t) (DueDate d)   = t `compare` UTCTime d 0+    compare (DueDate d) (DueTime t)   = UTCTime d 0 `compare` t+    compare (DueDate d1) (DueDate d2) = d1 `compare` d2+    compare (DueTime t1) (DueTime t2) = t1 `compare` t2+ data Deadline     = Passed     | Today@@ -28,37 +46,88 @@     | Plenty     deriving (Show, Eq) -type DeadlineFn = Day -> Deadline+-- formats+dateFormat :: String+dateFormat = "%Y-%m-%d" -dayToText :: Day -> Day -> Text-dayToText today day = pack $ formatTime defaultTimeLocale format (UTCTime day (secondsToDiffTime 0))+timeDisplayFormat :: String+timeDisplayFormat = "%Y-%m-%d %H:%M"++timeFormat :: String+timeFormat = "%Y-%m-%d %H:%M %Z"++isoFormat :: String+isoFormat = iso8601DateFormat (Just "%H:%M:%S%Q%Z")++-- utility functions+utcToZonedTime :: TZ -> UTCTime -> ZonedTime+utcToZonedTime tz time = ZonedTime (utcToLocalTimeTZ tz time) (timeZoneForUTCTime tz time)++appendYear :: (FormatTime t, FormatTime s) => String -> t -> s -> String+appendYear txt t1 t2 =+    if format "%Y" t1 == format "%Y" t2+        then txt+        else txt <> " %Y"++-- output+format :: (FormatTime t) => String -> t -> Text+format fmt = pack . formatTime defaultTimeLocale fmt++timeToText :: TZ -> UTCTime -> Due -> Text+timeToText _ now (DueDate day) = format fmt day   where-    (currentYear, _, _) = toGregorian today-    (dateYear, _, _) = toGregorian day-    format =-        if currentYear == dateYear-            then "%d-%b"-            else "%d-%b %Y"+    fmt = appendYear "%d-%b" now day+timeToText tz now (DueTime time) = format fmt local+  where+    local = utcToLocalTimeTZ tz time+    fmt = appendYear "%H:%M %d-%b" now local -dayToOutput :: Day -> Text-dayToOutput day = pack $ formatTime defaultTimeLocale "%Y-%m-%d" (UTCTime day (secondsToDiffTime 0))+timeToDisplay :: TZ -> Due -> Text+timeToDisplay _ (DueDate day)   = format dateFormat day+timeToDisplay tz (DueTime time) = format timeDisplayFormat (utcToLocalTimeTZ tz time) -utcToLocalDay :: TimeZone -> UTCTime -> Day-utcToLocalDay tz = localDay . zonedTimeToLocalTime . utcToZonedTime tz+timeToOutput :: Due -> Text+timeToOutput (DueDate day)  = format dateFormat day+timeToOutput (DueTime time) = format timeFormat time -textToTime :: Text -> Maybe UTCTime-textToTime = parseTimeM False defaultTimeLocale "%Y-%m-%d" . unpack+timeToOutputLocal :: TZ -> Due -> Text+timeToOutputLocal _ (DueDate day)   = format dateFormat day+timeToOutputLocal tz (DueTime time) = format timeFormat (utcToZonedTime tz time) -textToDay :: Text -> Maybe Day-textToDay = (utctDay <$>) . textToTime+-- input+parseT :: (Monad m, MonadFail m, ParseTime t) => String -> Text -> m t+parseT fmt txt = parseTimeM False defaultTimeLocale fmt (unpack txt) --- work out the deadline-deadline :: Day -> Day -> Deadline-deadline today date+parseDate :: Text -> Maybe Due+parseDate txt = DueDate <$> parseT dateFormat txt++(<?>) :: Maybe a -> Maybe a -> Maybe a+(<?>) Nothing b = b+(<?>) a _       = a++textToTime :: Text -> Maybe Due+textToTime txt = parseDate txt <?> (DueTime <$> parseT timeFormat txt)++inputToTime :: TZ -> UTCTime -> Text -> Maybe Due+inputToTime tz now txt =+    parseDate txt <?> (DueTime . localTimeToUTCTZ tz <$> parseT timeDisplayFormat txt) <?>+    case parseRelative now txt of+        Right utc -> Just $ DueTime utc+        Left _    -> Nothing++isoToTime :: Text -> Maybe Due+isoToTime txt = DueTime <$> parseT isoFormat txt++-- deadlines+deadline :: UTCTime -> Due -> Deadline+deadline now date     | days < 0 = Passed     | days == 0 = Today     | days == 1 = Tomorrow     | days < 7 = ThisWeek     | otherwise = Plenty   where-    days = diffDays date today+    days =+        case date of+            DueTime t -> diffDays (utctDay t) (utctDay now)+            DueDate d -> diffDays d (utctDay now)

@@ -0,0 +1,57 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.Date.RelativeParser+    ( parseRelative+    ) where++import ClassyPrelude++import Data.Attoparsec.Text++import Data.Time.Clock (addUTCTime)++import Utility.Parser (lexeme)++-- relative date parsing+minute :: Int+minute = 60++hour :: Int+hour = minute * 60++day :: Int+day = hour * 24++week :: Int+week = day * 7++periodP :: Char -> Parser Int+periodP c = lexeme decimal <* char c++wP :: Parser Int+wP = (* week) <$> periodP 'w'++dP :: Parser Int+dP = (* day) <$> periodP 'd'++hP :: Parser Int+hP = (* hour) <$> periodP 'h'++mP :: Parser Int+mP = (* minute) <$> periodP 'm'++sP :: Parser Int+sP = periodP 's'++relativeP :: UTCTime -> Parser (Maybe UTCTime)+relativeP now =+    lexeme $ do+        period <- fromIntegral . sum <$> many1 (sP <|> mP <|> hP <|> dP <|> wP)+        pure $ Just (addUTCTime period now)++parseRelative :: UTCTime -> Text -> Either Text UTCTime+parseRelative now text =+    case parseOnly (relativeP now) text of+        Right (Just time) -> Right time+        _                 -> Left "Could not parse date."

@@ -6,18 +6,19 @@  import ClassyPrelude -import Control.Lens (ix, makeLenses, (%~), (&), (.~), (^.), (^?))+import Control.Lens (ix, makeLenses, (%~), (&), (.~), (?~), (^.), (^?))  import           Data.Sequence        as S (adjust', deleteAt, (|>))-import           Data.Taskell.Date    (Day, textToDay)+import           Data.Taskell.Date    (Due (..), inputToTime) import qualified Data.Taskell.Subtask as ST (Subtask, Update, complete, duplicate, name) import           Data.Text            (strip)+import           Data.Time.Zones      (TZ)  data Task = Task     { _name        :: Text     , _description :: Maybe Text     , _subtasks    :: Seq ST.Subtask-    , _due         :: Maybe Day+    , _due         :: Maybe Due     } deriving (Show, Eq)  type Update = Task -> Task@@ -49,13 +50,11 @@         then id         else description %~ maybeAppend text -setDue :: Text -> Update-setDue date task =+setDue :: TZ -> UTCTime -> Text -> Task -> Maybe Task+setDue tz now date task =     if null date-        then task & due .~ Nothing-        else case textToDay date of-                 Just day -> task & due .~ Just day-                 Nothing  -> task+        then Just (task & due .~ Nothing)+        else (\d -> task & due ?~ d) <$> inputToTime tz now (strip date)  clearDue :: Update clearDue task = task & due .~ Nothing

@@ -10,7 +10,7 @@ import ClassyPrelude  import           Events.Actions.Types      as A (ActionType (..))-import           Events.State+import           Events.State              (clearDate, normalMode, quit, store, undo, write) import           Events.State.Modal.Detail as Detail import           Events.State.Types import           Events.State.Types.Mode   (DetailItem (..), DetailMode (..))@@ -26,6 +26,8 @@     , (A.Undo, (write =<<) . undo)     , (A.Previous, previousSubtask)     , (A.Next, nextSubtask)+    , (A.MoveUp, (write =<<) . (up =<<) . store)+    , (A.MoveDown, (write =<<) . (down =<<) . store)     , (A.New, (Detail.insertMode =<<) . (Detail.lastSubtask =<<) . (Detail.newItem =<<) . store)     , (A.Edit, (Detail.insertMode =<<) . store)     , (A.Complete, (write =<<) . (setComplete =<<) . store)@@ -44,7 +46,7 @@     item <- getCurrentItem s     case item of         DetailDescription -> (write =<<) $ finishDescription s-        DetailDate        -> (write =<<) $ finishDue s+        DetailDate        -> showDetail s         (DetailItem _)    -> (write =<<) . (showDetail =<<) $ finishSubtask s insert (EvKey KEnter _) s = do     item <- getCurrentItem s

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

@@ -8,6 +8,7 @@ data ActionType     = Quit     | Undo+    | Redo     | Search     | Due     | Help@@ -46,6 +47,7 @@ read :: Text -> ActionType read "quit"       = Quit read "undo"       = Undo+read "redo"       = Redo read "search"     = Search read "due"        = Due read "help"       = Help

@@ -39,6 +39,7 @@     , listLeft     , listRight     , undo+    , redo     , store     , searchMode     , clearSearch@@ -61,9 +62,10 @@  import ClassyPrelude hiding (delete) -import Control.Lens ((&), (.~), (^.))+import Control.Lens ((%~), (&), (.~), (?~), (^.)) -import Data.Char (digitToInt, ord)+import Data.Char       (digitToInt, ord)+import Data.Time.Zones (TZ)  import qualified Data.Taskell.List  as L (List, deleteTask, duplicate, getTask, move, nearest, new,                                           newAt, nextTask, prevTask, title, update)@@ -71,24 +73,25 @@ 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 =+create :: TZ -> UTCTime -> FilePath -> Lists.Lists -> State+create tz t p ls =     State     { _mode = Normal-    , _lists = ls-    , _history = []-    , _current = (ListIndex 0, TaskIndex 0)+    , _history = fresh ls     , _path = p     , _io = Nothing     , _height = 0     , _searchTerm = Nothing     , _time = t+    , _timeZone = tz     }  -- app state@@ -98,21 +101,20 @@ 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

@@ -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 (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 xs moment (λstack future history)++redo :: History a -> History a+redo history =+    case history ^. future of+        []          -> history+        (moment:xs) -> History (λstack past history) moment xs

@@ -19,19 +19,22 @@     , nextSubtask     , previousSubtask     , lastSubtask+    , up+    , down     ) where  import ClassyPrelude  import Control.Lens ((&), (.~), (^.)) -import           Data.Taskell.Date       (dayToOutput)+import           Data.Taskell.Date       (timeToDisplay)+import qualified Data.Taskell.Seq        as S import qualified Data.Taskell.Subtask    as ST (blank, name, toggle) import           Data.Taskell.Task       (Task, addSubtask, countSubtasks, description, due,                                           getSubtask, removeSubtask, setDescription, setDue,-                                          updateSubtask)+                                          subtasks, updateSubtask) import           Events.State            (getCurrentTask, setCurrentTask)-import           Events.State.Types      (State, Stateful, mode)+import           Events.State.Types      (State, Stateful, mode, time, timeZone) import           Events.State.Types.Mode (DetailItem (..), DetailMode (..), ModalType (Detail),                                           Mode (Modal)) import           UI.Draw.Field           (Field, blankField, getText, textToField)@@ -61,7 +64,12 @@ finishDescription = finish setDescription  finishDue :: Stateful-finishDue = finish setDue+finishDue state = do+    let tz = state ^. timeZone+    let now = state ^. time+    text <- getText <$> getField state+    task <- setDue tz now text =<< getCurrentTask state+    setCurrentTask task $ state & mode .~ Modal (Detail (DetailItem 0) DetailNormal)  showDetail :: Stateful showDetail s = do@@ -125,7 +133,8 @@ editDue :: Stateful editDue state = do     day <- (^. due) <$> getCurrentTask state-    let day' = maybe "" dayToOutput day+    let tz = state ^. timeZone+    let day' = maybe "" (timeToDisplay tz) day     pure $ state & mode .~ Modal (Detail DetailDate (DetailInsert (textToField day')))  newItem :: Stateful@@ -160,3 +169,19 @@             | i < 0 = 0             | otherwise = i     return $ state & mode .~ Modal (Detail (DetailItem newIndex) m)++-- moving tasks+moveVertical :: Int -> Stateful+moveVertical dir state = do+    task <- getCurrentTask state+    let tasks = task ^. subtasks+    i <- getCurrentSubtask state+    shifted <- S.shiftBy i dir tasks+    state' <- setCurrentTask (task & subtasks .~ shifted) state+    changeSubtask dir state'++up :: Stateful+up = moveVertical (-1)++down :: Stateful+down = moveVertical 1

@@ -5,27 +5,48 @@  import ClassyPrelude -import Control.Lens (makeLenses)+import Control.Lens             (Lens', makeLenses)+import Control.Lens.Combinators (_1, _2) +import Data.Time.Zones (TZ)+ 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     , _searchTerm :: Maybe Field     , _time       :: UTCTime+    , _timeZone   :: TZ     } deriving (Eq, Show)  -- 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

@@ -12,6 +12,7 @@     , descriptionOutput :: Text     , dueOutput         :: Text     , subtaskOutput     :: Text+    , localTimes        :: Bool     }  defaultConfig :: Config@@ -22,6 +23,7 @@     , descriptionOutput = "    >"     , dueOutput = "    @"     , subtaskOutput = "    *"+    , localTimes = False     }  parser :: IniParser Config@@ -42,6 +44,7 @@             subtaskOutputCf <-                 fromMaybe (subtaskOutput defaultConfig) . (noEmpty . parseText =<<) <$>                 fieldMb "subtask"+            localTimesCf <- fieldFlagDef "localTimes" (localTimes defaultConfig)             pure                 Config                 { titleOutput = titleOutputCf@@ -49,4 +52,5 @@                 , descriptionOutput = descriptionOutputCf                 , dueOutput = dueOutputCf                 , subtaskOutput = subtaskOutputCf+                , localTimes = localTimesCf                 })

@@ -19,8 +19,7 @@ import IO.HTTP.Trello.ChecklistItem (ChecklistItem, checkItems) import IO.HTTP.Trello.List          (List, cards, listToList, setCards) -import Data.Taskell.Lists  (Lists)-import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)+import Data.Taskell.Lists (Lists)  type ReaderTrelloToken a = ReaderT TrelloToken IO a @@ -57,8 +56,8 @@ checklistURL checklist =     fullURL $ concat ["checklists/", checklist, "?fields=id", "&checkItem_fields=name,state"] -trelloListsToLists :: TimeZone -> [List] -> Lists-trelloListsToLists tz ls = fromList $ listToList tz <$> ls+trelloListsToLists :: [List] -> Lists+trelloListsToLists ls = fromList $ listToList <$> ls  fetch :: String -> IO (Int, ByteString) fetch url = do@@ -95,11 +94,10 @@     putStrLn "Fetching from Trello..."     url <- boardURL board     (status, body) <- lift $ fetch url-    timezone <- lift getCurrentTimeZone     case status of         200 ->             case eitherDecodeStrict body of-                Right raw -> fmap (trelloListsToLists timezone) <$> getChecklists raw+                Right raw -> fmap trelloListsToLists <$> getChecklists raw                 Left err  -> pure . Left $ parseError err         404 ->             pure . Left $ "Could not find Trello board " <> board <> ". Make sure the ID is correct"

@@ -13,14 +13,12 @@  import Control.Lens (makeLenses, (&), (.~), (^.)) -import           Data.Taskell.Date   (utcToLocalDay)-import qualified Data.Taskell.Task   as T (Task, due, new, setDescription, subtasks)-import           Data.Time.Format    (iso8601DateFormat, parseTimeM)-import           Data.Time.LocalTime (TimeZone)- import IO.HTTP.Aeson                (deriveFromJSON) import IO.HTTP.Trello.ChecklistItem (ChecklistItem, checklistItemToSubTask) +import           Data.Taskell.Date (isoToTime)+import qualified Data.Taskell.Task as T (Task, due, new, setDescription, subtasks)+ data Card = Card     { _name         :: Text     , _desc         :: Text@@ -36,14 +34,9 @@ $(makeLenses ''Card)  -- operations-textToTime :: TimeZone -> Text -> Maybe Day-textToTime tz text = utcToLocalDay tz <$> utc-  where-    utc = parseTimeM False defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S%Q%Z")) $ unpack text--cardToTask :: TimeZone -> Card -> T.Task-cardToTask tz card =-    task & T.due .~ textToTime tz (fromMaybe "" (card ^. due)) & T.subtasks .~+cardToTask :: Card -> T.Task+cardToTask card =+    task & T.due .~ isoToTime (fromMaybe "" (card ^. due)) & T.subtasks .~     fromList (checklistItemToSubTask <$> fromMaybe [] (card ^. checklists))   where     task = T.setDescription (card ^. desc) $ T.new (card ^. name)

@@ -15,8 +15,7 @@ import IO.HTTP.Aeson       (deriveFromJSON) import IO.HTTP.Trello.Card (Card, cardToTask) -import qualified Data.Taskell.List   as L (List, create)-import           Data.Time.LocalTime (TimeZone)+import qualified Data.Taskell.List as L (List, create)  data List = List     { _name  :: Text@@ -33,5 +32,5 @@ setCards :: List -> [Card] -> List setCards list cs = list & cards .~ cs -listToList :: TimeZone -> List -> L.List-listToList tz ls = L.create (ls ^. name) (fromList $ cardToTask tz <$> (ls ^. cards))+listToList :: List -> L.List+listToList ls = L.create (ls ^. name) (fromList $ cardToTask <$> (ls ^. cards))

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

@@ -8,21 +8,17 @@  import Data.Attoparsec.Text +import Utility.Parser+ import Events.Actions.Types (ActionType, read) import IO.Keyboard.Types  -- utility functions-lexeme :: Parser a -> Parser a-lexeme p = skipSpace *> p <* skipSpace- commentP :: Parser () commentP = lexeme $ skipMany ((char '#' <|> char ';') *> manyTill anyChar endOfLine)  stripComments :: Parser a -> Parser a stripComments p = lexeme $ commentP *> p <* commentP--word :: Parser Text-word = lexeme $ pack <$> many1 letter  -- ini parser keyP :: Parser Binding

@@ -1,6 +1,7 @@ module IO.Markdown     ( parse     , stringify+    , MarkdownInfo(MarkdownInfo)     ) where  import IO.Markdown.Internal

@@ -5,23 +5,32 @@  import ClassyPrelude -import Control.Lens ((^.))+import Control.Lens ((.~), (^.)) -import Data.Sequence      (adjust')-import Data.Text          as T (splitOn, strip)-import Data.Text.Encoding (decodeUtf8With)+import           Data.Sequence      (adjust')+import qualified Data.Text          as T (splitOn, strip)+import           Data.Text.Encoding (decodeUtf8With) -import           Data.Taskell.Date    (dayToOutput)+import Data.Time.Zones (TZ)++import           Data.Taskell.Date    (Due, textToTime, timeToOutput, timeToOutputLocal) import           Data.Taskell.List    (List, count, tasks, title, updateFn) import           Data.Taskell.Lists   (Lists, appendToLast, newList) import qualified Data.Taskell.Subtask as ST (Subtask, complete, name, new) import qualified Data.Taskell.Task    as T (Task, addSubtask, appendDescription, description, due,-                                            name, new, setDue, subtasks)+                                            name, new, subtasks)  import qualified IO.Config          as C (Config, markdown)-import           IO.Config.Markdown (Config, descriptionOutput, dueOutput, subtaskOutput,-                                     taskOutput, titleOutput)+import           IO.Config.Markdown (Config, descriptionOutput, dueOutput, localTimes,+                                     subtaskOutput, taskOutput, titleOutput) +data MarkdownInfo = MarkdownInfo+    { mdTZ     :: TZ+    , mdConfig :: Config+    }++type ReaderMarkdown = Reader MarkdownInfo Text+ -- parse code addSubItem :: Text -> Lists -> Lists addSubItem t ls = adjust' updateList i ls@@ -47,7 +56,7 @@ addDue t ls = adjust' updateList i ls   where     i = length ls - 1-    updateList l = updateFn j (T.setDue t) l+    updateList l = updateFn j (T.due .~ textToTime t) l       where         j = count l - 1 @@ -72,7 +81,7 @@     case find isJust $ uncurry (prefix config text) <$> matches of         Just (Just set) -> (set current, errs)         _ ->-            if not (null (strip text))+            if not (null (T.strip text))                 then (current, errs <> [line])                 else (current, errs) @@ -90,51 +99,50 @@         else Left $ "could not parse line(s) " <> intercalate ", " (tshow <$> errs)  -- stringify code-subtaskStringify :: Config -> Text -> ST.Subtask -> Text-subtaskStringify config t st =-    foldl' (<>) t [subtaskOutput config, " ", pre, " ", st ^. ST.name, "\n"]-  where-    pre =-        if st ^. ST.complete-            then "[x]"-            else "[ ]"+subtaskSymbol :: Bool -> Text+subtaskSymbol True  = "[x]"+subtaskSymbol False = "[ ]" -descriptionStringify :: Config -> Text -> Text-descriptionStringify config desc = concat $ add <$> splitOn "\n" desc-  where-    add d = concat [descriptionOutput config, " ", d, "\n"]+subtaskStringify :: ST.Subtask -> ReaderMarkdown+subtaskStringify st = do+    symbol <- subtaskOutput <$> asks mdConfig+    pure . concat $ [symbol, " ", subtaskSymbol (st ^. ST.complete), " ", st ^. ST.name] -dueStringify :: Config -> Day -> Text-dueStringify config day = concat [dueOutput config, " ", dayToOutput day, "\n"]+descriptionStringify :: Text -> ReaderMarkdown+descriptionStringify desc = do+    symbol <- descriptionOutput <$> asks mdConfig+    let add d = concat [symbol, " ", d]+    pure . intercalate "\n" $ add <$> T.splitOn "\n" desc -nameStringify :: Config -> Text -> Text-nameStringify config desc = concat [taskOutput config, " ", desc, "\n"]+dueStringify :: Due -> ReaderMarkdown+dueStringify time = do+    symbol <- dueOutput <$> asks mdConfig+    useLocal <- localTimes <$> asks mdConfig+    tz <- asks mdTZ+    let fn =+            if useLocal+                then timeToOutputLocal tz+                else timeToOutput+    pure $ concat [symbol, " ", fn time] -taskStringify :: Config -> Text -> T.Task -> Text-taskStringify config s t =-    foldl'-        (<>)-        s-        [ nameStringify config (t ^. T.name)-        , maybe "" (dueStringify config) (t ^. T.due)-        , maybe "" (descriptionStringify config) (t ^. T.description)-        , foldl' (subtaskStringify config) "" (t ^. T.subtasks)-        ]+nameStringify :: Text -> ReaderMarkdown+nameStringify desc = do+    symbol <- taskOutput <$> asks mdConfig+    pure $ concat [symbol, " ", desc] -listStringify :: Config -> Text -> List -> Text-listStringify config text list =-    foldl'-        (<>)-        text-        [ if null text-              then ""-              else "\n"-        , titleOutput config-        , " "-        , list ^. title-        , "\n\n"-        , foldl' (taskStringify config) "" (list ^. tasks)-        ]+taskStringify :: T.Task -> ReaderMarkdown+taskStringify t = do+    nameString <- nameStringify (t ^. T.name)+    dueString <- fromMaybe "" <$> sequence (dueStringify <$> t ^. T.due)+    descriptionString <- fromMaybe "" <$> sequence (descriptionStringify <$> t ^. T.description)+    subtaskString <- intercalate "\n" <$> sequence (subtaskStringify <$> t ^. T.subtasks)+    pure . unlines . filter (/= "") $ [nameString, dueString, descriptionString, subtaskString] -stringify :: C.Config -> Lists -> ByteString-stringify config ls = encodeUtf8 $ foldl' (listStringify (C.markdown config)) "" ls+listStringify :: List -> ReaderMarkdown+listStringify list = do+    symbol <- titleOutput <$> asks mdConfig+    taskString <- concat <$> sequence (taskStringify <$> list ^. tasks)+    pure $ concat [symbol, " ", list ^. title, "\n\n", taskString]++stringify :: Lists -> ReaderMarkdown+stringify ls = intercalate "\n" <$> sequence (listStringify <$> ls)

@@ -6,28 +6,37 @@  import ClassyPrelude -import Data.FileEmbed   (embedFile)-import System.Directory (doesFileExist, getCurrentDirectory)+import Control.Monad.Reader (runReader)+import Data.FileEmbed       (embedFile)+import System.Directory     (doesFileExist, getCurrentDirectory) +import Data.Time.Zones (TZ)+ import Config             (usage, version) import Data.Taskell.Lists (Lists, analyse, initial) -import           IO.Config         (Config, general, github, trello)+import           IO.Config         (Config, general, github, markdown, trello) import           IO.Config.General (filename) import qualified IO.Config.GitHub  as GitHub (token) import qualified IO.Config.Trello  as Trello (token) -import IO.Markdown (parse, stringify)+import IO.Markdown (MarkdownInfo (MarkdownInfo), parse, stringify)  import qualified IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists) import qualified IO.HTTP.Trello as Trello (TrelloBoardID, getLists)  import UI.CLI (PromptYN (PromptYes), promptYN) -type ReaderConfig a = ReaderT Config IO a+data IOInfo = IOInfo+    { ioTZ     :: TZ+    , ioConfig :: Config+    } +type ReaderConfig a = ReaderT IOInfo IO a+ data Next     = Output Text+    | Error Text     | Load FilePath            Lists     | Exit@@ -39,8 +48,8 @@ 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 []                       = (pack . filename . general <$> asks ioConfig) >>= loadFile+parseArgs _                        = pure $ Error (unlines ["Invalid options", "", usage])  load :: ReaderConfig Next load = getArgs >>= parseArgs@@ -53,14 +62,14 @@     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 +83,8 @@     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)@@ -85,16 +94,17 @@     -> FilePath     -> ReaderConfig Next createRemote tokenFn missingToken getFn identifier path = do-    config <- ask+    config <- asks ioConfig+    tz <- asks ioTZ     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))+                    bool (pure Exit) (Load path ls <$ lift (writeData tz config ls path))  createTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next createTrello =@@ -129,13 +139,16 @@ -- creates taskell file createPath :: FilePath -> ReaderConfig () createPath path = do-    config <- ask-    lift (writeData config initial path)+    config <- asks ioConfig+    tz <- asks ioTZ+    lift (writeData tz config initial path)  -- writes Tasks to json file-writeData :: Config -> Lists -> FilePath -> IO ()-writeData config tasks path = void (writeFile path $ stringify config tasks)+writeData :: TZ -> Config -> Lists -> FilePath -> IO ()+writeData tz config tasks path = void (writeFile path output)+  where+    output = encodeUtf8 $ runReader (stringify tasks) (MarkdownInfo tz (markdown config))  -- reads json file readData :: FilePath -> ReaderConfig (Either Text Lists)-readData path = parse <$> ask <*> readFile path+readData path = parse <$> asks ioConfig <*> readFile path

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

@@ -13,12 +13,14 @@  import Brick -import           Data.Taskell.Date         (Day, dayToOutput, deadline)+import Data.Time.Zones (TZ)++import           Data.Taskell.Date         (deadline, timeToDisplay) import qualified Data.Taskell.Subtask      as ST (Subtask, complete, name) import           Data.Taskell.Task         (Task, description, due, name, subtasks) import           Events.State              (getCurrentTask) import           Events.State.Modal.Detail (getCurrentItem, getField)-import           Events.State.Types        (time)+import           Events.State.Types        (time, timeZone) import           Events.State.Types.Mode   (DetailItem (..)) import           UI.Draw.Field             (Field, textField, widgetFromMaybe) import           UI.Draw.Types             (DrawState (..), ModalWidget, TWidget)@@ -58,23 +60,24 @@             DetailDescription -> visible $ widgetFromMaybe w f             _                 -> w -renderDate :: Day -> Maybe Field -> DetailItem -> Task -> TWidget-renderDate today field item task =+renderDate :: TZ -> UTCTime -> Maybe Field -> DetailItem -> Task -> TWidget+renderDate tz now field item task =     case item of         DetailDate -> visible $ prefix <+> widgetFromMaybe widget field         _ ->             case day of-                Just d  -> prefix <+> withAttr (dlToAttr (deadline today d)) widget+                Just d  -> prefix <+> withAttr (dlToAttr (deadline now d)) widget                 Nothing -> emptyWidget   where     day = task ^. due     prefix = txt "Due: "-    widget = textField $ maybe "" dayToOutput day+    widget = textField $ maybe "" (timeToDisplay tz) day  detail :: ModalWidget detail = do     state <- asks dsState-    let today = utctDay (state ^. time)+    let now = state ^. time+    let tz = state ^. timeZone     pure $         fromMaybe ("Error", txt "Oops") $ do             task <- getCurrentTask state@@ -84,4 +87,4 @@                 w                     | null sts = withAttr disabledAttr $ txt "No sub-tasks"                     | otherwise = vBox . toList $ renderSubtask f i `mapWithIndex` sts-            pure (task ^. name, renderDate today f i task <=> renderSummary f i task <=> w)+            pure (task ^. name, renderDate tz now f i task <=> renderSummary f i task <=> w)

@@ -34,10 +34,12 @@     , ([A.ClearDate], "Removes due date")     , ([A.MoveUp, A.MoveDown], "Shift task down / up")     , ([A.MoveLeft, A.MoveRight], "Shift task left / right")-    , ([A.Complete], "Move task to last list and remove any due dates")+    , ( [A.Complete]+      , "Move task to last list and remove any due dates / Mark subtask as (in)complete")     , ([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")

@@ -13,10 +13,10 @@  import Brick -import           Data.Taskell.Date  (dayToText, deadline)+import           Data.Taskell.Date  (deadline, timeToText) import qualified Data.Taskell.Task  as T (Task, contains, countCompleteSubtasks, countSubtasks,                                           description, due, hasSubtasks, name)-import           Events.State.Types (current, mode, searchTerm, time)+import           Events.State.Types (current, mode, searchTerm, time, timeZone) import           IO.Config.Layout   (descriptionIndicator) import           Types              (ListIndex (..), TaskIndex (..)) import           UI.Draw.Field      (getText, textField, widgetFromMaybe)@@ -35,9 +35,10 @@ -- | Takes a task's 'due' property and renders a date with appropriate styling (e.g. red if overdue) renderDate :: T.Task -> DSWidget renderDate task = do-    today <- utctDay . (^. time) <$> asks dsState+    now <- (^. time) <$> asks dsState+    tz <- (^. timeZone) <$> asks dsState     pure . fromMaybe emptyWidget $-        (\day -> withAttr (dlToAttr $ deadline today day) (txt $ dayToText today day)) <$>+        (\date -> withAttr (dlToAttr $ deadline now date) (txt $ timeToText tz now date)) <$>         task ^. T.due  -- | Renders the appropriate completed sub task count e.g. "[2/3]"

@@ -4,7 +4,8 @@  import ClassyPrelude -import Brick              (Widget)+import Brick (Widget)+ import Events.State.Types (State) import IO.Config.Layout   (Config) import IO.Keyboard.Types  (Bindings)

@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Utility.Parser where++import ClassyPrelude++import Data.Attoparsec.Text++lexeme :: Parser a -> Parser a+lexeme p = skipSpace *> p <* skipSpace++word :: Parser Text+word = lexeme $ pack <$> many1 letter

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell-version: 1.7.0.0+version: 1.8.2.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales@@ -34,6 +34,7 @@         IO.Config         IO.Taskell         Data.Taskell.Date+        Data.Taskell.Date.RelativeParser         Data.Taskell.List         Data.Taskell.List.Internal         Data.Taskell.Lists@@ -44,6 +45,7 @@         Data.Taskell.Task         Data.Taskell.Task.Internal         Events.Actions.Types+        Events.State.History         Events.State.Types         Events.State.Types.Mode         IO.Config.Markdown@@ -98,6 +100,7 @@         UI.Draw.Types         UI.Theme         UI.Types+        Utility.Parser         Paths_taskell     default-language: Haskell2010     default-extensions: OverloadedStrings NoImplicitPrelude@@ -105,7 +108,7 @@         aeson >=1.4.5.0 && <1.5,         attoparsec >=0.13.2.3 && <0.14,         base >=4.12.0.0 && <=5,-        brick >=0.47.1 && <0.48,+        brick ==0.50.*,         bytestring >=0.10.8.2 && <0.11,         classy-prelude >=1.5.0 && <1.6,         config-ini >=0.2.4.0 && <0.3,@@ -121,7 +124,8 @@         template-haskell >=2.14.0.0 && <2.15,         text >=1.2.3.1 && <1.3,         time >=1.8.0.2 && <1.9,-        vty >=5.25.1 && <5.26+        tz >=0.1.3.2 && <0.2,+        vty ==5.26.*  executable taskell     main-is: Main.hs@@ -134,13 +138,15 @@     build-depends:         base >=4.12.0.0 && <4.13,         classy-prelude >=1.5.0 && <1.6,-        taskell -any+        taskell -any,+        tz >=0.1.3.2 && <0.2  test-suite taskell-test     type: exitcode-stdio-1.0     main-is: Spec.hs     hs-source-dirs: test     other-modules:+        Data.Taskell.Date.RelativeParserTest         Data.Taskell.DateTest         Data.Taskell.ListNavigationTest         Data.Taskell.ListsTest@@ -148,6 +154,7 @@         Data.Taskell.SeqTest         Data.Taskell.SubtaskTest         Data.Taskell.TaskTest+        Events.State.HistoryTest         Events.StateTest         IO.GitHubTest         IO.Keyboard.ParserTest@@ -167,6 +174,7 @@         containers >=0.6.0.1 && <0.7,         file-embed >=0.0.11 && <0.1,         lens >=4.17.1 && <4.18,+        mtl >=2.2.2 && <2.3,         raw-strings-qq ==1.1.*,         taskell -any,         tasty >=1.2.3 && <1.3,@@ -175,4 +183,5 @@         tasty-hunit >=0.10.0.2 && <0.11,         text >=1.2.3.1 && <1.3,         time >=1.8.0.2 && <1.9,-        vty >=5.25.1 && <5.26+        tz >=0.1.3.2 && <0.2,+        vty ==5.26.*

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

@@ -12,3 +12,4 @@ summary = "    >" due = "    @" subtask = "    *"+localTimes = false

@@ -0,0 +1,84 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.Date.RelativeParserTest+    ( test_relative_parser+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Time.Calendar (fromGregorian)+import Data.Time.Clock    (secondsToDiffTime)++import Data.Taskell.Date.RelativeParser (parseRelative)++toTime :: (Integer, Int, Int) -> Integer -> UTCTime+toTime (y, m, d) seconds = UTCTime (fromGregorian y m d) (secondsToDiffTime seconds)++-- 08:53:03 18th December 2019+time :: UTCTime+time = toTime (2019, 12, 18) 31983++-- tests+test_relative_parser :: TestTree+test_relative_parser =+    testGroup+        "Data.Taskell.Date.RelativeParser"+        [ testCase+              "Second"+              (assertEqual+                   "Adds a second"+                   (Right (toTime (2019, 12, 18) 31984))+                   (parseRelative time "1s"))+        , testCase+              "Minute"+              (assertEqual+                   "Adds a minute"+                   (Right (toTime (2019, 12, 18) 32043))+                   (parseRelative time "1m"))+        , testCase+              "Hour"+              (assertEqual+                   "Adds an hour"+                   (Right (toTime (2019, 12, 18) 35583))+                   (parseRelative time "1h"))+        , testCase+              "Day"+              (assertEqual+                   "Adds a day"+                   (Right (toTime (2019, 12, 19) 31983))+                   (parseRelative time "1d"))+        , testCase+              "Days"+              (assertEqual+                   "Adds 29 days"+                   (Right (toTime (2020, 1, 16) 31983))+                   (parseRelative time "29 d"))+        , testCase+              "Week"+              (assertEqual+                   "Adds a week"+                   (Right (toTime (2019, 12, 25) 31983))+                   (parseRelative time "1w"))+        , testCase+              "Mix"+              (assertEqual+                   "Adds 1 week 2 days and 29 seconds"+                   (Right (toTime (2019, 12, 27) 32012))+                   (parseRelative time " 1 w 2d 29 s "))+        , testCase+              "Mix out of order"+              (assertEqual+                   "Adds 1 week 2 days and 29 seconds"+                   (Right (toTime (2019, 12, 27) 32012))+                   (parseRelative time " 2d 1 w 29 s"))+        , testCase+              "invalid format"+              (assertEqual "Error" (Left "Could not parse date.") (parseRelative time "18/12/2019"))+        , testCase+              "invalid numbers"+              (assertEqual "Error" (Left "Could not parse date.") (parseRelative time "2019-39-59"))+        ]

@@ -12,48 +12,209 @@  import Data.Taskell.Date import Data.Time+import Data.Time.Zones     (utcTZ)+import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel) -testDate :: Day-testDate = fromGregorian 2018 05 18+testDate :: UTCTime+testDate = UTCTime (fromGregorian 2018 5 18) (secondsToDiffTime 0) +-- sorting test data+sort1 :: Due+sort1 = DueTime (UTCTime (fromGregorian 2017 2 4) 0)++sort2 :: Due+sort2 = DueDate (fromGregorian 2016 12 15)++sort3 :: Due+sort3 = DueTime (UTCTime (fromGregorian 2020 8 9) 44000)++sort4 :: Due+sort4 = DueDate (fromGregorian 2019 8 30)+ -- tests test_date :: TestTree test_date =     testGroup         "Data.Taskell.Date"         [ testCase-              "dayToOutput"+              "Sorting"               (assertEqual-                   "Date in yyyy-mm-dd format"-                   (Just "2018-05-18")-                   (dayToOutput <$> fromGregorianValid 2018 05 18))+                   "Sorted in date order"+                   [sort2, sort1, sort4, sort3]+                   (sort [sort1, sort2, sort3, sort4]))         , testGroup-              "dayToText"-              [ testCase-                    "same year"-                    (assertEqual-                         "Date in 18-May format"-                         (Just "18-May")-                         (dayToText <$> fromGregorianValid 2018 08 18 <*>-                          fromGregorianValid 2018 05 18))-              , testCase-                    "different year"-                    (assertEqual-                         "Date in 18-May 2019 format"-                         (Just "18-May 2019")-                         (dayToText <$> fromGregorianValid 2018 08 18 <*>-                          fromGregorianValid 2019 05 18))+              "Date Output"+              [ testGroup+                    "timeToDisplay"+                    [ testCase+                          "timeToDisplay time"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18 00:00"+                               (timeToDisplay utcTZ (DueTime testDate)))+                    , testCase+                          "timeToDisplay time - non-utc"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-17 20:00"+                               (timeToDisplay (tzByLabel America__New_York) (DueTime testDate)))+                    , testCase+                          "timeToDisplay date"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToDisplay utcTZ (DueDate (fromGregorian 2018 05 18))))+                    ]+              , testGroup+                    "timeToOutput"+                    [ testCase+                          "timeToOutput time"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18 00:00 UTC"+                               (timeToOutput (DueTime testDate)))+                    , testCase+                          "timeToOutput date"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToOutput (DueDate (fromGregorian 2018 05 18))))+                    ]+              , testGroup+                    "timeToOutputLocal"+                    [ testCase+                          "timeToOutputLocal time"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18 00:00 UTC"+                               (timeToOutputLocal utcTZ (DueTime testDate)))+                    , testCase+                          "timeToOutputLocal time - non-utc"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-17 20:00 EDT"+                               (timeToOutputLocal (tzByLabel America__New_York) (DueTime testDate)))+                    , testCase+                          "timeToOutputLocal date"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToOutputLocal utcTZ (DueDate (fromGregorian 2018 05 18))))+                    , testCase+                          "timeToOutputLocal date - non-utc"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToOutputLocal+                                    (tzByLabel America__New_York)+                                    (DueDate (fromGregorian 2018 05 18))))+                    ]+              , testGroup+                    "timeToText"+                    [ testCase+                          "time"+                          (assertEqual+                               "Date in 18-May format"+                               "00:00 18-May"+                               (timeToText utcTZ testDate (DueTime testDate)))+                    , testCase+                          "time - non-utc"+                          (assertEqual+                               "Date in 17-May format"+                               "20:00 17-May"+                               (timeToText (tzByLabel America__New_York) testDate (DueTime testDate)))+                    , testCase+                          "same year"+                          (assertEqual+                               "Date in 18-May format"+                               "18-May"+                               (timeToText utcTZ testDate (DueDate (fromGregorian 2018 5 18))))+                    , testCase+                          "different year"+                          (assertEqual+                               "Date in 18-May 2019 format"+                               "18-May 2019"+                               (timeToText utcTZ testDate (DueDate (fromGregorian 2019 5 18))))+                    , testCase+                          "different year"+                          (assertEqual+                               "Date in 18-May 2017 format"+                               "18-May 2017"+                               (timeToText utcTZ testDate (DueDate (fromGregorian 2017 5 18))))+                    ]+              ]+        , testGroup+              "Input"+              [ testGroup+                    "textToTime"+                    [ testCase+                          "simple date"+                          (assertEqual+                               "A valid Day"+                               (DueDate <$> fromGregorianValid 2018 05 18)+                               (textToTime "2018-05-18"))+                    , testCase+                          "simple time"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 64800 <$> fromGregorianValid 2018 05 18)+                               (textToTime "2018-05-18 18:00 UTC"))+                    , testCase+                          "time with timezone"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 0 <$> fromGregorianValid 2018 05 18)+                               (textToTime "2018-05-17 20:00 EDT"))+                    ]+              , testGroup+                    "inputToTime"+                    [ testCase+                          "simple date"+                          (assertEqual+                               "A valid Day"+                               (DueDate <$> fromGregorianValid 2018 05 18)+                               (inputToTime utcTZ testDate "2018-05-18"))+                    , testCase+                          "simple time"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 64800 <$> fromGregorianValid 2018 05 18)+                               (inputToTime utcTZ testDate "2018-05-18 18:00"))+                    , testCase+                          "time with timezone"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 79200 <$> fromGregorianValid 2018 05 18)+                               (inputToTime+                                    (tzByLabel America__New_York)+                                    testDate+                                    "2018-05-18 18:00"))+                    , testCase+                          "relative time - seconds"+                          (assertEqual+                               "Adds 7 seconds"+                               (DueTime . flip UTCTime 7 <$> fromGregorianValid 2018 05 18)+                               (inputToTime utcTZ testDate "7s"))+                    , testCase+                          "relative time - days"+                          (assertEqual+                               "Adds 29 days, 12 hours"+                               (DueTime . flip UTCTime 43200 <$> fromGregorianValid 2018 06 16)+                               (inputToTime utcTZ testDate "29 d 12h"))+                    , testCase+                          "relative time - weeks"+                          (assertEqual+                               "Adds four weeks, two days, 12 hours"+                               (DueTime . flip UTCTime 43200 <$> fromGregorianValid 2018 06 17)+                               (inputToTime utcTZ testDate "4w 2d 12h"))+                    ]               , testCase-                    "different year"+                    "isoToTime"                     (assertEqual-                         "Date in 18-May 2017 format"-                         (Just "18-May 2017")-                         (dayToText <$> fromGregorianValid 2018 08 18 <*>-                          fromGregorianValid 2017 05 18))+                         "Gives back time"+                         (Just (DueTime (UTCTime (fromGregorian 2020 8 11) 82800)))+                         (isoToTime "2020-08-11T23:00:00.000Z"))               ]-        , testCase-              "textToDay"-              (assertEqual "A valid Day" (fromGregorianValid 2018 05 18) (textToDay "2018-05-18"))         , testGroup               "deadline"               [ testCase@@ -61,16 +222,25 @@                     (assertEqual                          "Plenty of time"                          Plenty-                         (deadline testDate (fromGregorian 2018 05 28)))+                         (deadline testDate (DueDate (fromGregorian 2018 05 28))))               , testCase                     "ThisWeek"-                    (assertEqual "This week" ThisWeek (deadline testDate (fromGregorian 2018 05 24)))+                    (assertEqual+                         "This week"+                         ThisWeek+                         (deadline testDate (DueDate (fromGregorian 2018 05 24))))               , testCase                     "Tomorrow"-                    (assertEqual "Tomorrow" Tomorrow (deadline testDate (fromGregorian 2018 05 19)))-              , testCase "Today" (assertEqual "Today" Today (deadline testDate testDate))+                    (assertEqual+                         "Tomorrow"+                         Tomorrow+                         (deadline testDate (DueDate (fromGregorian 2018 05 19))))+              , testCase "Today" (assertEqual "Today" Today (deadline testDate (DueTime testDate)))               , testCase                     "Passed"-                    (assertEqual "Passed" Passed (deadline testDate (fromGregorian 2018 05 17)))+                    (assertEqual+                         "Passed"+                         Passed+                         (deadline testDate (DueDate (fromGregorian 2018 05 17))))               ]         ]

@@ -10,6 +10,9 @@ import Test.Tasty import Test.Tasty.HUnit +import Control.Lens ((.~))++import           Data.Taskell.Date           (textToTime) import qualified Data.Taskell.List           as L import           Data.Taskell.Lists.Internal import qualified Data.Taskell.Task           as T@@ -21,19 +24,19 @@     foldl'         (flip L.append)         (L.empty "List 1")-        [T.new "One", T.setDue "2019-08-14" (T.new "Two"), T.new "Three"]+        [T.new "One", (T.due .~ textToTime "2019-08-14") (T.new "Two"), T.new "Three"]  list2 =     foldl'         (flip L.append)         (L.empty "List 2")-        [T.new "1", T.new "2", T.setDue "2018-12-03" (T.new "3")]+        [T.new "1", T.new "2", (T.due .~ textToTime "2018-12-03") (T.new "3")]  list3 =     foldl'         (flip L.append)         (L.empty "List 3")-        [T.setDue "2019-04-05" (T.new "01"), T.new "10", T.new "11"]+        [(T.due .~ textToTime "2019-04-05") (T.new "01"), T.new "10", T.new "11"]  testLists :: Lists testLists = fromList [list1, list2, list3]@@ -81,11 +84,11 @@                                    , foldl'                                          (flip L.append)                                          (L.empty "List 2")-                                         [T.new "1", T.setDue "2018-12-03" (T.new "3")]+                                         [T.new "1", (T.due .~ textToTime "2018-12-03") (T.new "3")]                                    , foldl'                                          (flip L.append)                                          (L.empty "List 3")-                                         [ T.setDue "2019-04-05" (T.new "01")+                                         [ (T.due .~ textToTime "2019-04-05") (T.new "01")                                          , T.new "10"                                          , T.new "11"                                          , T.new "2"@@ -102,14 +105,14 @@                                          (flip L.append)                                          (L.empty "List 1")                                          [ T.new "One"-                                         , T.setDue "2019-08-14" (T.new "Two")+                                         , (T.due .~ textToTime "2019-08-14") (T.new "Two")                                          , T.new "Three"                                          , T.new "2"                                          ]                                    , foldl'                                          (flip L.append)                                          (L.empty "List 2")-                                         [T.new "1", T.setDue "2018-12-03" (T.new "3")]+                                         [T.new "1", (T.due .~ textToTime "2018-12-03") (T.new "3")]                                    , list3                                    ]))                          (changeList (ListIndex 1, TaskIndex 1) testLists (-1)))@@ -200,7 +203,7 @@                               , foldl'                                     (flip L.append)                                     (L.empty "List 3")-                                    [ T.setDue "2019-04-05" (T.new "01")+                                    [ (T.due .~ textToTime "2019-04-05") (T.new "01")                                     , T.new "10"                                     , T.new "11"                                     , T.new "Blah"@@ -222,9 +225,12 @@               (assertEqual                    "returns just due list"                    (fromList-                        [ ((ListIndex 1, TaskIndex 2), T.setDue "2018-12-03" (T.new "3"))-                        , ((ListIndex 2, TaskIndex 0), T.setDue "2019-04-05" (T.new "01"))-                        , ((ListIndex 0, TaskIndex 1), T.setDue "2019-08-14" (T.new "Two"))+                        [ ( (ListIndex 1, TaskIndex 2)+                          , (T.due .~ textToTime "2018-12-03") (T.new "3"))+                        , ( (ListIndex 2, TaskIndex 0)+                          , (T.due .~ textToTime "2019-04-05") (T.new "01"))+                        , ( (ListIndex 0, TaskIndex 1)+                          , (T.due .~ textToTime "2019-08-14") (T.new "Two"))                         ])                    (due testLists))         ]

@@ -12,8 +12,9 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Time (fromGregorianValid)+import Data.Time.Calendar (fromGregorianValid) +import           Data.Taskell.Date          (Due (DueDate)) import qualified Data.Taskell.Subtask       as ST (name, new) import           Data.Taskell.Task.Internal @@ -196,6 +197,7 @@                     (assertEqual                          "Returns False"                          False-                         (isBlank (Task "" Nothing empty (fromGregorianValid 2018 05 18))))+                         (isBlank+                              (Task "" Nothing empty (DueDate <$> (fromGregorianValid 2018 05 18)))))               ]         ]

@@ -0,0 +1,98 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Events.State.HistoryTest+    ( test_history+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Events.State.History+import Events.State.Types++make :: [Integer] -> Integer -> [Integer] -> History Integer+make = History++testHistory :: History Integer+testHistory = make empty 0 empty++-- tests+test_history :: TestTree+test_history =+    testGroup+        "Events.State.History"+        [ testGroup+              "undo"+              [ testCase "empty" (assertEqual "Nothing changes" testHistory (undo testHistory))+              , testCase+                    "one undo"+                    (assertEqual "Goes back" (make empty 0 [1]) (undo $ make [0] 1 empty))+              , testCase+                    "two undo"+                    (assertEqual+                         "Goes back"+                         (make empty 0 [1, 2])+                         (undo . undo $ make [1, 0] 2 empty))+              , testCase+                    "three undo"+                    (assertEqual+                         "Goes back"+                         (make empty 0 [1, 2, 3])+                         (undo . undo . undo $ make [2, 1, 0] 3 empty))+              ]+        , testGroup+              "redo"+              [ testCase "empty" (assertEqual "Nothing changes" testHistory (redo testHistory))+              , testCase+                    "one redo"+                    (assertEqual "Goes forward" (make [0] 1 empty) (redo $ make empty 0 [1]))+              , testCase+                    "two redo"+                    (assertEqual+                         "Goes forward"+                         (make [1, 0] 2 empty)+                         (redo . redo $ make empty 0 [1, 2]))+              , testCase+                    "three redo"+                    (assertEqual+                         "Goes forward"+                         (make [2, 1, 0] 3 empty)+                         (redo . redo . redo $ make empty 0 [1, 2, 3]))+              ]+        , testGroup+              "mix"+              [ testCase+                    "empty"+                    (assertEqual+                         "Nothing changes"+                         testHistory+                         (undo . redo . undo . redo . undo $ testHistory))+              , testCase+                    "redo undo"+                    (assertEqual+                         "Nothing changes"+                         (make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10])+                         (undo . redo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))+              , testCase+                    "undo redo"+                    (assertEqual+                         "Nothing changes"+                         (make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10])+                         (redo . undo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))+              ]+        , testGroup+              "store"+              [ testCase+                    "empty"+                    (assertEqual "Stores current value" (make [0] 0 empty) (store testHistory))+              , testCase+                    "undo store redo"+                    (assertEqual+                         "Clears redo"+                         (make [4, 3, 2, 1, 0] 4 empty)+                         (redo . store . undo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))+              ]+        ]

@@ -1,5 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}  module Events.StateTest     ( test_state@@ -13,6 +14,7 @@ import Control.Lens ((&), (.~), (^.))  import Data.Time.Clock (secondsToDiffTime)+import Data.Time.Zones (utcTZ)  import qualified Data.Sequence           as S (lookup) import qualified Data.Taskell.List       as L (append, empty)@@ -20,7 +22,7 @@ import           Events.State import           Events.State.Types import           Events.State.Types.Mode-import           Types                   (ListIndex (..), TaskIndex (..))+import           Types                   (ListIndex (ListIndex), TaskIndex (TaskIndex))  mockTime :: UTCTime mockTime = UTCTime (ModifiedJulianDay 20) (secondsToDiffTime 0)@@ -29,39 +31,42 @@ testState =     State     { _mode = Normal-    , _lists = empty-    , _history = []-    , _current = (ListIndex 0, TaskIndex 0)+    , _history = fresh empty     , _path = "test.md"     , _io = Nothing     , _height = 0     , _searchTerm = Nothing     , _time = mockTime+    , _timeZone = utcTZ     }  moveToState :: State moveToState =     State     { _mode = Modal MoveTo-    , _lists =-          fromList-              [ L.empty "List 1"-              , L.empty "List 2"-              , L.empty "List 3"-              , L.empty "List 4"-              , L.append (T.new "Test Item") (L.empty "List 5")-              , L.empty "List 6"-              , L.empty "List 7"-              , L.empty "List 8"-              , L.empty "List 9"-              ]-    , _history = []-    , _current = (ListIndex 4, TaskIndex 0)+    , _history =+          History+          { _past = empty+          , _present =+                ( (ListIndex 4, TaskIndex 0)+                , [ L.empty "List 1"+                  , L.empty "List 2"+                  , L.empty "List 3"+                  , L.empty "List 4"+                  , L.append (T.new "Test Item") (L.empty "List 5")+                  , L.empty "List 6"+                  , L.empty "List 7"+                  , L.empty "List 8"+                  , L.empty "List 9"+                  ])+          , _future = empty+          }     , _path = "test.md"     , _io = Nothing     , _height = 0     , _searchTerm = Nothing     , _time = mockTime+    , _timeZone = utcTZ     }  -- tests

@@ -42,6 +42,7 @@ iniResult =     [ (BChar 'q', A.Quit)     , (BChar 'u', A.Undo)+    , (BChar 'r', A.Redo)     , (BChar '/', A.Search)     , (BChar '?', A.Help)     , (BChar '!', A.Due)@@ -49,7 +50,7 @@     , (BChar 'j', A.Next)     , (BChar 'h', A.Left)     , (BChar 'l', A.Right)-    , (BChar 'g', A.Bottom)+    , (BChar 'G', A.Bottom)     , (BChar 'a', A.New)     , (BChar 'O', A.NewAbove)     , (BChar 'o', A.NewBelow)@@ -61,11 +62,12 @@     , (BChar 'D', A.Delete)     , (BKey "Enter", A.Detail)     , (BChar '@', A.DueDate)+    , (BKey "Backspace", A.ClearDate)     , (BChar 'K', A.MoveUp)     , (BChar 'J', A.MoveDown)     , (BChar 'H', A.MoveLeft)     , (BChar 'L', A.MoveRight)-    , (BKey "Space", A.MoveRight)+    , (BKey "Space", A.Complete)     , (BChar 'm', A.MoveMenu)     , (BChar 'N', A.ListNew)     , (BChar 'E', A.ListEdit)

@@ -21,6 +21,7 @@ notFullResult =     [ (BChar 'œ', A.Quit)     , (BChar 'U', A.Undo)+    , (BChar 'r', A.Redo)     , (BChar '/', A.Search)     , (BChar '!', A.Due)     , (BChar '?', A.Help)

@@ -14,6 +14,7 @@ import Control.Lens ((.~))  import Data.Time.Clock (secondsToDiffTime)+import Data.Time.Zones (utcTZ)  import Data.Taskell.Lists.Internal (initial) import Events.Actions.Types        as A@@ -31,7 +32,7 @@ tester actions ev state = lookup ev actions >>= ($ state)  cleanState :: State-cleanState = create mockTime "taskell.md" initial+cleanState = create utcTZ mockTime "taskell.md" initial  basicBindings :: Bindings basicBindings = [(BChar 'q', A.Quit)]

@@ -11,12 +11,20 @@ import Test.Tasty.ExpectedFailure (ignoreTest) import Test.Tasty.HUnit +import Control.Lens         ((&), (.~))+import Control.Monad.Reader (runReader)++import Data.Time.Zones     (utcTZ)+import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel)++import           Data.Taskell.Date    (textToTime)+import qualified Data.Taskell.List    as L (append, empty) import           Data.Taskell.Lists   (Lists, appendToLast, newList) import qualified Data.Taskell.Subtask as ST (new)-import           Data.Taskell.Task    (Task, addSubtask, new, setDescription, setDue)+import           Data.Taskell.Task    (Task, addSubtask, due, new, setDescription) import qualified IO.Config            as C (defaultConfig) import           IO.Config.Markdown   (Config (..), defaultConfig)-import           IO.Markdown.Internal (listStringify, parse, start)+import           IO.Markdown.Internal (MarkdownInfo (MarkdownInfo), parse, start, stringify)  -- alternative markdown configs alternativeConfig :: Config@@ -27,6 +35,7 @@     , descriptionOutput = ">"     , dueOutput = "@"     , subtaskOutput = "-"+    , localTimes = True     }  -- useful records@@ -36,12 +45,20 @@ list :: Lists list = newList "Test" empty +lists :: Lists+lists = fromList [L.append task (L.empty "To Do"), L.append (new "Fish") (L.empty "Done")]+ listWithItem :: Lists listWithItem = appendToLast task list  makeSubTask :: Text -> Bool -> Lists makeSubTask t b = appendToLast (addSubtask (ST.new t b) task) list +makeSubTasks :: [Text] -> Bool -> Lists+makeSubTasks ts b = appendToLast (foldr addSubtask task subtasks) list+  where+    subtasks = flip ST.new b <$> ts+ taskWithSummary :: Task taskWithSummary = setDescription "Summary" task @@ -55,11 +72,28 @@ listWithMultiLineSummaryItem = appendToLast taskWithMultiLineSummary list  taskWithDueDate :: Task-taskWithDueDate = setDue "2018-04-12" task+taskWithDueDate = task & due .~ textToTime "2018-04-12"  listWithDueDateItem :: Lists listWithDueDateItem = appendToLast taskWithDueDate list +taskWithDueTime :: Task+taskWithDueTime = task & due .~ textToTime "2018-04-12 12:00 UTC"++listWithDueTimeItem :: Lists+listWithDueTimeItem = appendToLast taskWithDueTime list++-- reader+defaultReader :: MarkdownInfo+defaultReader = MarkdownInfo utcTZ defaultConfig++alternativeReader :: MarkdownInfo+alternativeReader = MarkdownInfo utcTZ alternativeConfig++-- simplify tests+stringify' :: MarkdownInfo -> Lists -> Text+stringify' md ls = runReader (stringify ls) md+ -- tests test_markdown :: TestTree test_markdown =@@ -239,35 +273,57 @@               [ testGroup                     "Default Format"                     [ testCase+                          "Standard lists"+                          (assertEqual+                               "Markdown formatted output"+                               "## To Do\n\n- Test Item\n\n## Done\n\n- Fish\n"+                               (stringify' defaultReader lists))+                    , testCase                           "Standard list"                           (assertEqual                                "Markdown formatted output"                                "## Test\n\n- Test Item\n"-                               (foldl' (listStringify defaultConfig) "" listWithItem))+                               (stringify' defaultReader listWithItem))                     , testCase                           "Standard list with summary"                           (assertEqual                                "Markdown formatted output"                                "## Test\n\n- Test Item\n    > Summary\n"-                               (foldl' (listStringify defaultConfig) "" listWithSummaryItem))+                               (stringify' defaultReader listWithSummaryItem))                     , testCase                           "Standard list with date"                           (assertEqual                                "Markdown formatted output"                                "## Test\n\n- Test Item\n    @ 2018-04-12\n"-                               (foldl' (listStringify defaultConfig) "" listWithDueDateItem))+                               (stringify' defaultReader listWithDueDateItem))                     , testCase+                          "Standard list with date - timezone"+                          (assertEqual+                               "Use UTC timezone"+                               "## Test\n\n- Test Item\n    @ 2018-04-12 12:00 UTC\n"+                               (stringify'+                                    (MarkdownInfo (tzByLabel America__New_York) defaultConfig)+                                    listWithDueTimeItem))+                    , testCase                           "Standard list with sub-task"                           (assertEqual                                "Markdown formatted output"                                "## Test\n\n- Test Item\n    * [x] Blah\n"-                               (foldl' (listStringify defaultConfig) "" (makeSubTask "Blah" True)))+                               (stringify' defaultReader (makeSubTask "Blah" True)))                     , testCase+                          "Standard list with sub-tasks"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    * [x] Blah\n    * [x] Cow\n    * [x] Spoon\n"+                               (stringify'+                                    defaultReader+                                    (makeSubTasks ["Spoon", "Cow", "Blah"] True)))+                    , testCase                           "Standard list with multi-line summary"                           (assertEqual                                "Markdown formatted output"                                "## Test\n\n- Test Item\n    > Summary Line 1\n    > Summary Line 2\n"-                               (foldl' (listStringify defaultConfig) "" listWithMultiLineSummaryItem))+                               (stringify' defaultReader listWithMultiLineSummaryItem))                     ]               , testGroup                     "Alternative Format"@@ -276,13 +332,21 @@                           (assertEqual                                "Markdown formatted output"                                "## Test\n\n### Test Item\n"-                               (foldl' (listStringify alternativeConfig) "" listWithItem))+                               (stringify' alternativeReader listWithItem))                     , testCase                           "Standard list with sub-task"                           (assertEqual                                "Markdown formatted output"-                               "## Test\n\n- Test Item\n    * [ ] Blah\n"-                               (foldl' (listStringify defaultConfig) "" (makeSubTask "Blah" False)))+                               "## Test\n\n### Test Item\n- [ ] Blah\n"+                               (stringify' alternativeReader (makeSubTask "Blah" False)))+                    , testCase+                          "Standard list with date - timezone"+                          (assertEqual+                               "Uses local timezone"+                               "## Test\n\n### Test Item\n@ 2018-04-12 08:00 EDT\n"+                               (stringify'+                                    (MarkdownInfo (tzByLabel America__New_York) alternativeConfig)+                                    listWithDueTimeItem))                     ]               ]         ]

@@ -13,9 +13,8 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Aeson          (decodeStrict)-import Data.FileEmbed      (embedFile)-import Data.Time.LocalTime (getCurrentTimeZone)+import Data.Aeson     (decodeStrict)+import Data.FileEmbed (embedFile)  import IO.HTTP.Trello.ChecklistItem (ChecklistItem, checkItems, checklistItemToSubTask) import IO.HTTP.Trello.List          (List, listToList)@@ -27,19 +26,17 @@ checklistJson = (^. checkItems) <$> decodeStrict $(embedFile "test/IO/data/trello-checklists.json")  -- tests-test_trello :: IO TestTree-test_trello = do-    tz <- getCurrentTimeZone-    return $-        testGroup-            "IO.Trello"-            [ testCase-                  "Lists"-                  (assertEqual "Parses list JSON" (Just 5) (length . (listToList tz <$>) <$> json))-            , testCase-                  "Checklists"-                  (assertEqual-                       "Parses checklist JSON"-                       (Just 5)-                       (length . (checklistItemToSubTask <$>) <$> checklistJson))-            ]+test_trello :: TestTree+test_trello =+    testGroup+        "IO.Trello"+        [ testCase+              "Lists"+              (assertEqual "Parses list JSON" (Just 5) (length . (listToList <$>) <$> json))+        , testCase+              "Checklists"+              (assertEqual+                   "Parses checklist JSON"+                   (Just 5)+                   (length . (checklistItemToSubTask <$>) <$> checklistJson))+        ]