Add --utc flag to set explicit closing timestamp on do/end commands

Author: ad-si

docs-source/changelog.md

@@ -11,6 +11,9 @@ This document lists all notable changes to the functionality of TaskLite.
 
 #### 💻 General
 
+- Add a `--utc` flag to `tl do`, `tl doonly`, `tl doall`, `tl end`, and
+    `tl endall` to set an explicit closing timestamp instead of the
+    current time (e.g. `tl do <id> --utc "2020-01-15 08:30:00"`).
 - Add task dependency support via `blocks` / `unblocks` subcommands
     and `blocks:<id>` / `blocked-by:<id>` body tokens for `tl add`
     ([#14](https://github.com/ad-si/TaskLite/issues/14)).

tasklite-core/source/Cli.hs

@@ -97,6 +97,7 @@ import Options.Applicative (
   maybeReader,
   metavar,
   noIntersperse,
+  option,
   parserFailure,
   progDesc,
   progDescDoc,
@@ -285,10 +286,10 @@ data Command
   | WaitFor Iso.Duration [IdText]
   | ReviewTasks [IdText]
   | ReviewTasksIn Iso.Duration [IdText]
-  | DoTasks [IdText]
-  | DoOneTask IdText (Maybe [Text])
-  | EndTasks [IdText]
-  | EndOneTask IdText (Maybe [Text])
+  | DoTasks (Maybe DateTime) [IdText]
+  | DoOneTask IdText (Maybe DateTime) (Maybe [Text])
+  | EndTasks (Maybe DateTime) [IdText]
+  | EndOneTask IdText (Maybe DateTime) (Maybe [Text])
   | TrashTasks [IdText]
   | DeleteTasks [IdText]
   | RepeatTasks Iso.Duration [IdText]
@@ -494,6 +495,18 @@ idsVar =
   metavar "TASK_ID ..." <> help "Ids of the tasks (Ulid)"
 
 
+-- | Optional `--utc` flag to set an explicit closing timestamp
+closedUtcOption :: Parser (Maybe DateTime)
+closedUtcOption =
+  optional $
+    option
+      (maybeReader (parseUtc . T.pack))
+      ( long "utc"
+          <> metavar "CLOSE_UTC"
+          <> help "Timestamp when the task was closed (instead of now)"
+      )
+
+
 -- | Help Sections
 basic_sec
   , shortcut_sec
@@ -589,24 +602,28 @@ commandParser conf =
 
     <> command "do" (toParserInfo (DoOneTask
         <$> strArgument idsVar
+        <*> closedUtcOption
         <*> optional (some (strArgument (metavar "CLOSING_NOTE"
               <> help "Final note to explain why and how it was done"))))
         "Mark a task as done and add optional closing note")
 
     <> command "doonly" (toParserInfo
-        (DoOneTask <$> strArgument idsVar <*> pure Nothing)
+        (DoOneTask <$> strArgument idsVar <*> closedUtcOption <*> pure Nothing)
         "Mark only one task as done")
 
-    <> command "doall" (toParserInfo (DoTasks <$> some (strArgument idsVar))
+    <> command "doall" (toParserInfo
+        (DoTasks <$> closedUtcOption <*> some (strArgument idsVar))
         "Mark one or more tasks as done")
 
     <> command "end" (toParserInfo (EndOneTask
         <$> strArgument idsVar
+        <*> closedUtcOption
         <*> optional (some (strArgument (metavar "CLOSING_NOTE"
               <> help "Final note to explain why and how it was closed"))))
         "Mark a task as obsolete and add optional closing note")
 
-    <> command "endall" (toParserInfo (EndTasks <$> some (strArgument idsVar))
+    <> command "endall" (toParserInfo
+        (EndTasks <$> closedUtcOption <*> some (strArgument idsVar))
         "Mark a task as obsolete")
 
     <> command "edit" (toParserInfo (EditTask <$> strArgument idVar)
@@ -1414,10 +1431,12 @@ executeCLiCommand config now connection progName args availableLinesMb = do
           let days3 = Iso.DurationDate (Iso.DurDateDay (Iso.DurDay 3) Nothing)
           in  reviewTasksIn conf connection days3 ids
         ReviewTasksIn days ids -> reviewTasksIn conf connection days ids
-        DoTasks ids -> doTasks conf connection Nothing ids
-        DoOneTask id noteWords -> doTasks conf connection noteWords [id]
-        EndTasks ids -> endTasks conf connection Nothing ids
-        EndOneTask id noteWords -> endTasks conf connection noteWords [id]
+        DoTasks utcMb ids -> doTasks conf connection utcMb Nothing ids
+        DoOneTask id utcMb noteWords ->
+          doTasks conf connection utcMb noteWords [id]
+        EndTasks utcMb ids -> endTasks conf connection utcMb Nothing ids
+        EndOneTask id utcMb noteWords ->
+          endTasks conf connection utcMb noteWords [id]
         EditTask id -> editTask conf connection id
         TrashTasks ids -> trashTasks conf connection ids
         DeleteTasks ids -> deleteTasks conf connection ids

tasklite-core/source/Lib.hs

@@ -855,6 +855,26 @@ setClosedWithState connection task theTaskState = do
     ]
 
 
+{-| Override the `closed_utc` set by the `set_closed_utc_after_update` trigger
+with an explicit timestamp (e.g. supplied via the `--utc` flag).
+Does nothing when no timestamp is given.
+-}
+overrideClosedUtc ::
+  Config -> Connection -> Maybe DateTime -> Task -> IO ()
+overrideClosedUtc conf connection closedUtcMaybe task =
+  forM_ closedUtcMaybe $ \closedUtc ->
+    executeNamed
+      connection
+      [sql|
+        UPDATE tasks
+        SET closed_utc = :closed_utc
+        WHERE ulid == :ulid
+      |]
+      [ ":closed_utc" := T.pack (timePrint conf.utcFormat closedUtc)
+      , ":ulid" := task.ulid
+      ]
+
+
 {-| Returns the ULID + body of every still-open task that blocks the given
 task via a `relation = 'blocks'` row in `task_to_task`. A blocker counts
 as open when its `closed_utc IS NULL`. Used to gate close actions.
@@ -1214,8 +1234,14 @@ createNextRecurrence conf connection task = do
           <+> dquotes (pretty newUlidText)
 
 
-doTasks :: Config -> Connection -> Maybe [Text] -> [Text] -> IO (Doc AnsiStyle)
-doTasks conf connection noteWordsMaybe ids = do
+doTasks ::
+  Config ->
+  Connection ->
+  Maybe DateTime ->
+  Maybe [Text] ->
+  [Text] ->
+  IO (Doc AnsiStyle)
+doTasks conf connection closedUtcMaybe noteWordsMaybe ids = do
   docs <- forM ids $ \idSubstr -> do
     execWithTask conf connection idSubstr $ \task -> do
       let
@@ -1250,6 +1276,7 @@ doTasks conf connection noteWordsMaybe ids = do
                     <&> Just
 
               setClosedWithState connection task $ Just Done
+              overrideClosedUtc conf connection closedUtcMaybe task
 
               pure $
                 fromMaybe "" (noteMessageMaybe <&> (<> hardline))
@@ -1263,8 +1290,14 @@ doTasks conf connection noteWordsMaybe ids = do
   pure $ vsep docs
 
 
-endTasks :: Config -> Connection -> Maybe [Text] -> [Text] -> IO (Doc AnsiStyle)
-endTasks conf connection noteWordsMaybe ids = do
+endTasks ::
+  Config ->
+  Connection ->
+  Maybe DateTime ->
+  Maybe [Text] ->
+  [Text] ->
+  IO (Doc AnsiStyle)
+endTasks conf connection closedUtcMaybe noteWordsMaybe ids = do
   docs <- forM ids $ \idSubstr -> do
     execWithTask conf connection idSubstr $ \task -> do
       let
@@ -1299,6 +1332,7 @@ endTasks conf connection noteWordsMaybe ids = do
                     <&> Just
 
               setClosedWithState connection task $ Just Obsolete
+              overrideClosedUtc conf connection closedUtcMaybe task
 
               pure $
                 fromMaybe "" (noteMessageMaybe <&> (<> hardline))

tasklite-core/test/LibSpec.hs

@@ -440,7 +440,7 @@ spec = do
       withMemoryDb conf $ \memConn -> do
         insertRecord "tasks" memConn exampleTask
         result <-
-          doTasks confWithPostModify memConn Nothing [exampleTask.ulid]
+          doTasks confWithPostModify memConn Nothing Nothing [exampleTask.ulid]
         unpack (show result) `shouldContain` "post-modify ran"
 
     it "fires post-modify hook on `tag`" $ do
@@ -498,7 +498,7 @@ spec = do
     it "completes it" $ do
       withMemoryDb conf $ \memConn -> do
         insertRecord "tasks" memConn exampleTask
-        doResult <- doTasks conf memConn Nothing [exampleTask.ulid]
+        doResult <- doTasks conf memConn Nothing Nothing [exampleTask.ulid]
         unpack (show doResult) `shouldStartWith` "✅ Finished task"
         tasks :: [Task] <- query_ memConn "SELECT * FROM tasks"
         case tasks of
@@ -507,12 +507,29 @@ spec = do
             updatedTask `shouldSatisfy` (\task -> isJust task.closed_utc)
           _ -> P.die "Found more than one task"
 
+    it "completes it with an explicit closed UTC via --utc" $ do
+      withMemoryDb conf $ \memConn -> do
+        insertRecord "tasks" memConn exampleTask
+        let utcTxt = "2020-01-15 08:30:00"
+        case parseUtc utcTxt of
+          Nothing -> P.die "Invalid UTC string"
+          Just utcStamp -> do
+            doResult <-
+              doTasks conf memConn (Just utcStamp) Nothing [exampleTask.ulid]
+            unpack (show doResult) `shouldStartWith` "✅ Finished task"
+            tasks :: [Task] <- query_ memConn "SELECT * FROM tasks"
+            case tasks of
+              [updatedTask] -> do
+                updatedTask.state `shouldBe` Just Done
+                updatedTask.closed_utc `shouldBe` Just "2020-01-15 08:30:00"
+              _ -> P.die "Found more than one task"
+
     it "refuses to complete a task with open blockers" $ do
       withMemoryDb conf $ \memConn -> do
         insertRecord "tasks" memConn task1
         insertRecord "tasks" memConn task2
         _ <- blockTasks conf memConn task1.ulid task2.ulid
-        result <- doTasks conf memConn Nothing [task2.ulid]
+        result <- doTasks conf memConn Nothing Nothing [task2.ulid]
         unpack (show result) `shouldContain` "is blocked by"
         -- The blocked task must remain open.
         tasks :: [Task] <-
@@ -524,7 +541,7 @@ spec = do
         insertRecord "tasks" memConn task1
         insertRecord "tasks" memConn task2
         _ <- blockTasks conf memConn task1.ulid task2.ulid
-        result <- endTasks conf memConn Nothing [task2.ulid]
+        result <- endTasks conf memConn Nothing Nothing [task2.ulid]
         unpack (show result) `shouldContain` "is blocked by"
 
     it "refuses to trash a task with open blockers" $ do
@@ -541,10 +558,10 @@ spec = do
         insertRecord "tasks" memConn task2
         _ <- blockTasks conf memConn task1.ulid task2.ulid
         -- Close the blocker first.
-        blockerResult <- doTasks conf memConn Nothing [task1.ulid]
+        blockerResult <- doTasks conf memConn Nothing Nothing [task1.ulid]
         unpack (show blockerResult) `shouldStartWith` "✅ Finished task"
         -- Now the originally-blocked task can be closed.
-        targetResult <- doTasks conf memConn Nothing [task2.ulid]
+        targetResult <- doTasks conf memConn Nothing Nothing [task2.ulid]
         unpack (show targetResult) `shouldStartWith` "✅ Finished task"
 
     it "deletes it" $ do