Feat: Support the full ISO8601 durations syntax everywhere

ad-si · Apr 11, 2020 · 8df1c65 · 8df1c65
1 parent 2ee1c21
commit 8df1c65
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 43 deletions.
diff --git a/tasklite-core/app/Main.hs b/tasklite-core/app/Main.hs
@@ -18,7 +18,7 @@ import Data.String (fromString)
 import qualified Data.Text as T
 import Data.Text.Prettyprint.Doc hiding ((<>))
 import Data.Text.Prettyprint.Doc.Render.Terminal
-import qualified Data.Time.ISO8601.Duration as ISO8601
+import qualified Data.Time.ISO8601.Duration as Iso
 import Data.Version (showVersion)
 import Data.Yaml (decodeFileEither, prettyPrintParseException)
 import GHC.IO.Encoding (setLocaleEncoding, utf8)
@@ -59,16 +59,16 @@ data Command
   {- Modify -}
   | ReadyOn DateTime [IdText]
   | WaitTasks [IdText]
-  | WaitFor Duration [IdText]
+  | WaitFor Iso.Duration [IdText]
   | ReviewTasks [IdText]
-  | ReviewTasksIn Duration [IdText]
+  | ReviewTasksIn Iso.Duration [IdText]
   | DoTasks [IdText]
   | DoOneTask IdText (Maybe [Text])
   | EndTasks [IdText]
   | TrashTasks [IdText]
   | DeleteTasks [IdText]
-  | RepeatTasks Duration [IdText]
-  | RecurTasks ISO8601.Duration [IdText]
+  | RepeatTasks Iso.Duration [IdText]
+  | RecurTasks Iso.Duration [IdText]
   | BoostTasks [IdText]
   | HushTasks [IdText]
   -- | Modify [IdText] Text -- DSL for modifying a task
@@ -236,17 +236,10 @@ unset_sec    = ("{{unset_sec}}", "Unset Commands")
 utils_sec    = ("{{utils_sec}}", "Utils")
 
 
-parseDurationInDays :: [Char] -> Maybe Duration
-parseDurationInDays =
-  (fmap (\days -> mempty
-    { durationMinutes = Minutes $ round ((days :: Float) * 1440)}))
-  . readMaybe
-
-
-parseDurationString :: [Char] -> Either [Char] ISO8601.Duration
+parseDurationString :: [Char] -> Either [Char] Iso.Duration
 parseDurationString text = text
   & fromString
-  & ISO8601.parseDuration
+  & Iso.parseDuration
 
 
 commandParser :: Config -> Parser Command
@@ -281,22 +274,22 @@ commandParser conf =
         "Mark a task as waiting (e.g. for feedback) and review it in 3 days")
 
     <> command "waitfor" (toParserInfo (WaitFor
-      <$> argument (maybeReader parseDurationInDays)
-            (metavar "NUM_OF_DAYS" <> help "Duration in days \
-              \(supports fractional values)")
+      <$> argument (eitherReader parseDurationString)
+            (metavar "DURATION"
+            <> help "ISO8601 duration (e.g. P1DT5H for 1 day and 5 hours)")
       <*> some (strArgument idsVar))
-        "Wait x days until it's ready for review")
+        "Wait DURATION until it's ready for review")
 
     <> command "review" (toParserInfo (ReviewTasks
         <$> some (strArgument idsVar))
         "Finish review and set new review date in 3 days")
 
     <> command "reviewin" (toParserInfo (ReviewTasksIn
-      <$> argument (maybeReader parseDurationInDays)
-            (metavar "NUM_OF_DAYS" <> help "Duration in days \
-              \(supports fractional values)")
+      <$> argument (eitherReader parseDurationString)
+            (metavar "DURATION"
+            <> help "ISO8601 duration (e.g. P1DT5H for 1 day and 5 hours)")
       <*> some (strArgument idsVar))
-        "Finish review and set new review date in x days")
+        "Finish review and set new review date in DURATION")
 
     <> command "do" (toParserInfo (DoOneTask
         <$> strArgument idsVar
@@ -325,9 +318,9 @@ commandParser conf =
         "Delete a task from the database (Attention: Irreversible)")
 
     <> command "repeat" (toParserInfo (RepeatTasks
-      <$> argument (maybeReader parseDurationInDays)
-            (metavar "NUM_OF_DAYS" <> help "Number of days \
-              \(supports fractional values)")
+      <$> argument (eitherReader parseDurationString)
+            (metavar "DURATION"
+            <> help "ISO8601 duration (e.g. P1DT5H for 1 day and 5 hours)")
       <*> some (strArgument idsVar))
         "Repeat a task x days after its due UTC or after it gets closed \
         \(whichever occurs later)")
@@ -831,7 +824,7 @@ executeCLiCommand conf now connection cmd =
     prettyUlid ulid = pretty $ fmap
       (T.pack . timePrint (toFormat ("YYYY-MM-DD H:MI:S.ms" :: [Char])))
       (ulidTextToDateTime ulid)
-    days3 = mempty {durationHours = 72}
+    days3 = Iso.DurationDate (Iso.DurDateDay (Iso.DurDay 3) Nothing)
 
   in case cmd of
     ListAll -> listAll conf now connection

diff --git a/tasklite-core/source/Lib.hs b/tasklite-core/source/Lib.hs
@@ -8,7 +8,7 @@ import Protolude as P
 
 import Data.Hourglass
 import Data.Text as T
-import qualified Data.Time.ISO8601.Duration as Iso8601
+import qualified Data.Time.ISO8601.Duration as Iso
 import Data.ULID
 import Data.Coerce
 import Data.Yaml as Yaml
@@ -339,15 +339,18 @@ setReadyUtc conf connection datetime ids = do
   pure $ vsep docs
 
 
-waitFor :: Config -> Connection -> Duration -> [Text] -> IO (Doc AnsiStyle)
+waitFor
+  :: Config -> Connection -> Iso.Duration -> [Text] -> IO (Doc AnsiStyle)
 waitFor conf connection duration ids = do
   docs <- forM ids $ \idSubstr ->
     execWithTask conf connection idSubstr $ \task -> do
       now <- timeCurrentP
       let
         taskUlid@(TaskUlid idText) = primaryKey task
         nowAsText = (pack . timePrint (utcFormat conf)) now
-        threeDays = (pack . timePrint (utcFormat conf)) (now `timeAdd` duration)
+        threeDays = (pack . timePrint (utcFormat conf))
+          (utcTimeToDateTime $ Iso.addDuration duration $
+            dateTimeToUtcTime $ timeFromElapsedP now)
         prettyBody = dquotes (pretty $ Task.body task)
         prettyId = dquotes (pretty idText)
 
@@ -373,18 +376,21 @@ waitFor conf connection duration ids = do
 
 waitTasks :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
 waitTasks conf connection =
-  waitFor conf connection $ mempty { durationHours = 72 }
+  waitFor conf connection $
+    Iso.DurationDate (Iso.DurDateDay (Iso.DurDay 3) Nothing)
 
 
 reviewTasksIn :: Config -> Connection
-  -> Duration -> [Text] -> IO (Doc AnsiStyle)
-reviewTasksIn conf connection days ids = do
+  -> Iso.Duration -> [Text] -> IO (Doc AnsiStyle)
+reviewTasksIn conf connection duration ids = do
   docs <- forM ids $ \idSubstr -> do
     execWithTask conf connection idSubstr $ \task -> do
       now <- timeCurrentP
       let
         taskUlid@(TaskUlid idText) = primaryKey task
-        xDays = (pack . timePrint (utcFormat conf)) (now `timeAdd` days)
+        xDays = (pack . timePrint (utcFormat conf))
+          (utcTimeToDateTime $ Iso.addDuration duration $
+            dateTimeToUtcTime $ timeFromElapsedP now)
         prettyBody = dquotes (pretty $ Task.body task)
         prettyId = dquotes (pretty idText)
         warningStart = "⚠️  Task" <+> prettyBody <+> "with id" <+> prettyId
@@ -498,14 +504,14 @@ createNextRecurrence conf connection task = do
     isoDurEither =
       durTextEither
       <&> encodeUtf8
-      >>= Iso8601.parseDuration
+      >>= Iso.parseDuration
 
     showEither e = e
       & (either (const Nothing) Just)
       <&> utcTimeToDateTime
       <&> showDateTime
 
-    nextDueMb = liftA2 Iso8601.addDuration isoDurEither
+    nextDueMb = liftA2 Iso.addDuration isoDurEither
       (maybeToEither "Task has no due UTC" (dueUtcMb <&> dateTimeToUtcTime))
 
   runBeamSqlite connection $ do
@@ -519,13 +525,13 @@ createNextRecurrence conf connection task = do
         , Task.due_utc = val_ $ nextDueMb & showEither
 
         , Task.awake_utc = val_ $
-            (liftA2 Iso8601.addDuration isoDurEither
+            (liftA2 Iso.addDuration isoDurEither
               (maybeToEither "Task has no awake UTC"
                 ((Task.awake_utc task) >>= parseUtc <&> dateTimeToUtcTime)))
             & showEither
 
         , Task.ready_utc = val_ $
-            (liftA2 Iso8601.addDuration isoDurEither
+            (liftA2 Iso.addDuration isoDurEither
               (maybeToEither "Task has no ready UTC"
                 ((Task.ready_utc task) >>= parseUtc <&> dateTimeToUtcTime)))
             & showEither
@@ -661,9 +667,9 @@ durationToIso dur =
 
 
 repeatTasks ::
-  Config -> Connection -> Duration -> [IdText] -> IO (Doc AnsiStyle)
+  Config -> Connection -> Iso.Duration -> [IdText] -> IO (Doc AnsiStyle)
 repeatTasks conf connection duration ids = do
-  let durIso = durationToIso duration
+  let durationIsoText = decodeUtf8 $ Iso.formatDuration duration
 
   docs <- forM ids $ \idSubstr ->
     execWithTask conf connection idSubstr $ \task -> do
@@ -677,28 +683,29 @@ repeatTasks conf connection duration ids = do
       runBeamSqlite connection $ runUpdate $
         update (_tldbTasks taskLiteDb)
           (\task_ -> mconcat
-            [ (Task.repetition_duration task_) <-. val_ (Just durIso)
+            [ (Task.repetition_duration task_) <-. val_ (Just durationIsoText)
             , (Task.group_ulid task_) <-. val_ (Just groupUlid)
             ])
           (\task_ -> primaryKey task_ ==. val_ taskUlid)
 
       pure $ "📅 Set repeat duration of task" <+> prettyBody
         <+> "with id" <+> prettyId
-        <+> "to" <+> dquotes (pretty $ durIso)
+        <+> "to" <+> dquotes (pretty $ durationIsoText)
 
   pure $ vsep docs
 
 
 recurTasks ::
-  Config -> Connection -> Iso8601.Duration -> [IdText] -> IO (Doc AnsiStyle)
+  Config -> Connection -> Iso.Duration -> [IdText] -> IO (Doc AnsiStyle)
 recurTasks conf connection duration ids = do
+  let durationIsoText = decodeUtf8 $ Iso.formatDuration duration
+
   docs <- forM ids $ \idSubstr ->
     execWithTask conf connection idSubstr $ \task -> do
       let
         taskUlid@(TaskUlid idText) = primaryKey task
         prettyBody = dquotes (pretty $ Task.body task)
         prettyId = dquotes (pretty idText)
-        durationIsoText = decodeUtf8 $ Iso8601.formatDuration duration
 
       groupUlid <- formatUlid getULID