Feat: Add support for recurring tasks

Author: ad-si

docs-source/concepts.md

@@ -72,6 +72,9 @@ State\Field |`group_ulid`|`repetition_duration`|`recurrence_duration`
 `Recurring` | ✅         | ❌                  | ✅
 `Frozen`    | ✅         | ❌                  | ❌
 
+A task is either recurring or repeating,
+but can't be both at the same time.
+
 
 ## Priority
 

stack.yaml

@@ -9,6 +9,7 @@ packages:
 extra-deps:
   - gi-gtk-declarative-0.4.2
   - gi-gtk-declarative-app-simple-0.4.1
+  - iso8601-duration-0.1.1.0
   - portable-lines-0.1
   - ulid-0.3.0.0
   - github: JakeWheat/simple-sql-parser

stack.yaml.lock

@@ -18,6 +18,13 @@ packages:
       sha256: 3e2ca55f6838ad1fb9e54c4b7a0ec91fb78321a77d6cf27cc59d10750b8da39f
   original:
     hackage: gi-gtk-declarative-app-simple-0.4.1
+- completed:
+    hackage: iso8601-duration-0.1.1.0@sha256:0e9e7531e71b693c20115198186a0280aa3631dc29da226e84e55f0984bec1af,2210
+    pantry-tree:
+      size: 569
+      sha256: 183be7ad7fded29b7dbf94bd57a58755abeab8f1d1d237ac47f95543a84a8ae7
+  original:
+    hackage: iso8601-duration-0.1.1.0
 - completed:
     hackage: portable-lines-0.1@sha256:21c3b905888a4b43f957cd8e8cdf2af00942bb161aa19a6b20db18b661de0510,1552
     pantry-tree:

tasklite-core/app/Main.hs

@@ -18,6 +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 Data.Version (showVersion)
 import Data.Yaml (decodeFileEither, prettyPrintParseException)
 import GHC.IO.Encoding (setLocaleEncoding, utf8)
@@ -67,6 +68,7 @@ data Command
   | TrashTasks [IdText]
   | DeleteTasks [IdText]
   | RepeatTasks Duration [IdText]
+  | RecurTasks ISO8601.Duration [IdText]
   | BoostTasks [IdText]
   | HushTasks [IdText]
   -- | Modify [IdText] Text -- DSL for modifying a task
@@ -240,6 +242,12 @@ parseDurationInDays =
   . readMaybe
 
 
+parseDurationString :: [Char] -> Either [Char] ISO8601.Duration
+parseDurationString text = text
+  & fromString
+  & ISO8601.parseDuration
+
+
 commandParser :: Config -> Parser Command
 commandParser conf =
   let
@@ -323,6 +331,13 @@ commandParser conf =
         "Repeat a task x days after its due UTC or after it gets closed \
         \(whichever occurs later)")
 
+    <> command "recur" (toParserInfo (RecurTasks
+      <$> argument (eitherReader parseDurationString)
+            (metavar "DURATION" <> help "ISO8601 duration \
+              \(e.g. P1DT5H for 1 day and 5 hours)")
+      <*> some (strArgument idsVar))
+        "Recur a task DURATION after its due UTC")
+
     <> command "duplicate" (toParserInfo
         (Duplicate <$> some (strArgument idsVar))
         "Duplicates a task (and resets the closed and due UTC fields)")
@@ -863,6 +878,7 @@ executeCLiCommand conf now connection cmd =
     TrashTasks ids -> trashTasks conf connection ids
     DeleteTasks ids -> deleteTasks conf connection ids
     RepeatTasks duration ids -> repeatTasks conf connection duration ids
+    RecurTasks duration ids -> recurTasks conf connection duration ids
     BoostTasks ids -> adjustPriority conf 1 ids
     HushTasks ids -> adjustPriority conf (-1) ids
     Start ids -> startTasks conf connection ids

tasklite-core/package.yaml

@@ -35,6 +35,7 @@ dependencies:
   - hourglass
   - hsemail
   - huzzy
+  - iso8601-duration
   - optparse-applicative
   - parsec
   - portable-lines

tasklite-core/source/ImportExport.hs

@@ -17,8 +17,6 @@ import qualified Data.Text as T
 import qualified Data.Text.Lazy.Encoding as TL
 import Data.Text.Prettyprint.Doc hiding ((<>))
 import Data.Text.Prettyprint.Doc.Render.Terminal
-import Data.Time.LocalTime (zonedTimeToUTC)
-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
 import Data.ULID
 import qualified Data.Vector as V
 import Data.Yaml as Yaml
@@ -331,13 +329,7 @@ emailToImportTask email@(Message headerFields msgBody) =
       case headerValue of
         Email.Date emailDate ->
           let
-            utc = emailDate
-              & zonedTimeToUTC
-              & utcTimeToPOSIXSeconds
-              & toRational
-              & rationalToElapsedP
-              & timeFromElapsedP
-              :: DateTime
+            utc = zonedTimeToDateTime emailDate
             Right ulidGenerated =
               (ulidFromInteger . abs . toInteger . hash) $ (show email :: Text)
             ulidCombined = setDateTime ulidGenerated utc

tasklite-core/source/Lib.hs

@@ -8,6 +8,7 @@ import Protolude as P
 
 import Data.Hourglass
 import Data.Text as T
+import qualified Data.Time.ISO8601.Duration as Iso8601
 import Data.ULID
 import Data.Coerce
 import Data.Yaml as Yaml
@@ -421,6 +422,133 @@ parseIsoDuration isoDuration =
   else Nothing
 
 
+createNextRepetition
+  :: Config -> Connection -> Task -> IO (Maybe (Doc ann))
+createNextRepetition conf connection task = do
+  newUlidText <- formatUlid getULID
+  let
+    taskUlid = primaryKey task
+    nowMaybe = ulidTextToDateTime newUlidText
+    dueUtcMb = (Task.due_utc task) >>= parseUtc
+    showDateTime = pack . timePrint (utcFormat conf)
+    repIsoDur = (Task.repetition_duration task) >>= parseIsoDuration
+    nextDueMb = liftA2 timeAdd
+      (if nowMaybe < dueUtcMb then dueUtcMb else nowMaybe)
+      repIsoDur
+
+  -- TODO: Investigate why this isn't working and replace afterwards
+  -- runBeamSqlite connection $ runInsert $
+  --   insert (_tldbTasks taskLiteDb) $
+  --   insertValues [ task
+  --     { Task.ulid = val_ newUlidText
+  --     , Task.due_utc = nowMaybe + (Task.repetition_duration task)
+  --     }
+  --   ]
+
+  runBeamSqlite connection $ do
+    runInsert $ insert (_tldbTasks taskLiteDb) $ insertFrom $ do
+      originalTask <- filter_
+        (\theTask -> primaryKey theTask ==. val_ taskUlid)
+        (all_ $ _tldbTasks taskLiteDb)
+
+      pure originalTask
+        { Task.ulid = val_ newUlidText
+        , Task.due_utc = val_ $ fmap showDateTime nextDueMb
+        , Task.awake_utc = val_ $
+            fmap showDateTime $ liftA2 timeAdd
+              ((Task.awake_utc task) >>= parseUtc)
+              repIsoDur
+        , Task.ready_utc = val_ $
+            fmap showDateTime $ liftA2 timeAdd
+              ((Task.ready_utc task) >>= parseUtc)
+              repIsoDur
+        }
+
+    -- Duplicate tags
+    tags <- runSelectReturningList $ select $
+      filter_ (\tag -> TaskToTag.task_ulid tag ==. val_ taskUlid) $
+      all_ (_tldbTaskToTag taskLiteDb)
+
+    liftIO $ insertTags
+      connection
+      Nothing
+      (TaskUlid newUlidText)
+      (fmap TaskToTag.tag tags)
+
+  liftIO $ pure $ Just $ "➡️  Created next task"
+    <+> dquotes (pretty $ Task.body task)
+    <+> "in repetition series" <+> dquotes (pretty $ Task.group_ulid task)
+    <+> "with id" <+> dquotes (pretty newUlidText)
+
+
+createNextRecurrence
+  :: Config -> Connection -> Task -> IO (Maybe (Doc ann))
+createNextRecurrence conf connection task = do
+  newUlidText <- formatUlid getULID
+  let
+    taskUlid = primaryKey task
+    dueUtcMb = (Task.due_utc task) >>= parseUtc
+
+    showDateTime :: DateTime -> Text
+    showDateTime = pack . timePrint (utcFormat conf)
+
+    durTextEither = maybeToEither
+                        "Task has no recurrence duration"
+                        (Task.recurrence_duration task)
+    isoDurEither =
+      durTextEither
+      <&> encodeUtf8
+      >>= Iso8601.parseDuration
+
+    showEither e = e
+      & (either (const Nothing) Just)
+      <&> utcTimeToDateTime
+      <&> showDateTime
+
+    nextDueMb = liftA2 Iso8601.addDuration isoDurEither
+      (maybeToEither "Task has no due UTC" (dueUtcMb <&> dateTimeToUtcTime))
+
+  runBeamSqlite connection $ do
+    runInsert $ insert (_tldbTasks taskLiteDb) $ insertFrom $ do
+      originalTask <- filter_
+        (\theTask -> primaryKey theTask ==. val_ taskUlid)
+        (all_ $ _tldbTasks taskLiteDb)
+
+      pure originalTask
+        { Task.ulid = val_ newUlidText
+        , Task.due_utc = val_ $ nextDueMb & showEither
+
+        , Task.awake_utc = val_ $
+            (liftA2 Iso8601.addDuration isoDurEither
+              (maybeToEither "Task has no awake UTC"
+                ((Task.awake_utc task) >>= parseUtc <&> dateTimeToUtcTime)))
+            & showEither
+
+        , Task.ready_utc = val_ $
+            (liftA2 Iso8601.addDuration isoDurEither
+              (maybeToEither "Task has no ready UTC"
+                ((Task.ready_utc task) >>= parseUtc <&> dateTimeToUtcTime)))
+            & showEither
+
+        }
+
+    -- Duplicate tags
+    tags <- runSelectReturningList $ select $
+      filter_ (\tag -> TaskToTag.task_ulid tag ==. val_ taskUlid) $
+      all_ (_tldbTaskToTag taskLiteDb)
+
+    liftIO $ insertTags
+      connection
+      Nothing
+      (TaskUlid newUlidText)
+      (fmap TaskToTag.tag tags)
+
+  liftIO $ pure $ Just $ "➡️  Created next task"
+    <+> dquotes (pretty $ Task.body task)
+    <+> "in recurrence series" <+> dquotes (pretty $ Task.group_ulid task)
+    <+> "with id" <+> dquotes (pretty newUlidText)
+
+
 doTasks :: Config -> Connection -> Maybe [Text] -> [Text] -> IO (Doc AnsiStyle)
 doTasks conf connection noteWordsMaybe ids = do
   docs <- forM ids $ \idSubstr -> do
@@ -432,61 +560,12 @@ doTasks conf connection noteWordsMaybe ids = do
       then pure $ "⚠️  Task" <+> dquotes (pretty idText) <+> "is already done"
       else do
         logMessageMaybe <-
-          if Task.repetition_duration task == Nothing
-          then pure Nothing
-          else do
-            newUlid <- formatUlid getULID
-            let
-              nowMaybe = ulidTextToDateTime newUlid
-              dueUtc = (Task.due_utc task) >>= parseUtc
-              showDateTime = pack . timePrint (utcFormat conf)
-              nextDue = liftA2 timeAdd
-                (if nowMaybe < dueUtc then dueUtc else nowMaybe)
-                ((Task.repetition_duration task) >>= parseIsoDuration)
-
-            -- TODO: Investigate why this isn't working and replace afterwards
-            -- runBeamSqlite connection $ runInsert $
-            --   insert (_tldbTasks taskLiteDb) $
-            --   insertValues [ task
-            --     { Task.ulid = val_ newUlid
-            --     , Task.due_utc = nowMaybe + (Task.repetition_duration task)
-            --     }
-            --   ]
-
-            runBeamSqlite connection $ do
-              runInsert $ insert (_tldbTasks taskLiteDb) $ insertFrom $ do
-                originalTask <- filter_
-                  (\theTask -> primaryKey theTask ==. val_ taskUlid)
-                  (all_ $ _tldbTasks taskLiteDb)
-
-                pure originalTask
-                  { Task.ulid = val_ newUlid
-                  , Task.due_utc = val_ $ fmap showDateTime nextDue
-                  , Task.awake_utc = val_ $
-                      fmap showDateTime $ liftA2 timeAdd
-                        ((Task.awake_utc task) >>= parseUtc)
-                        ((Task.repetition_duration task) >>= parseIsoDuration)
-                  , Task.ready_utc = val_ $
-                      fmap showDateTime $ liftA2 timeAdd
-                        ((Task.ready_utc task) >>= parseUtc)
-                        ((Task.repetition_duration task) >>= parseIsoDuration)
-                  }
-
-              -- Duplicate tags
-              tags <- runSelectReturningList $ select $
-                filter_ (\tag -> TaskToTag.task_ulid tag ==. val_ taskUlid) $
-                all_ (_tldbTaskToTag taskLiteDb)
-
-              liftIO $ insertTags
-                connection
-                Nothing
-                (TaskUlid newUlid)
-                (fmap TaskToTag.tag tags)
-
-            liftIO $ pure $ Just $ "➡️  Created next task"
-              <+> dquotes (pretty $ Task.body task)
-              <+> "in repetition series"
-              <+> dquotes (pretty $ Task.group_ulid task)
+          if Task.repetition_duration task /= Nothing
+          then createNextRepetition conf connection task
+          else
+            if Task.recurrence_duration task /= Nothing
+            then createNextRecurrence conf connection task
+            else pure Nothing
 
         noteMessageMaybe <- case noteWordsMaybe of
           Nothing -> pure Nothing
@@ -610,6 +689,34 @@ repeatTasks conf connection duration ids = do
   pure $ vsep docs
 
 
+recurTasks ::
+  Config -> Connection -> Iso8601.Duration -> [IdText] -> IO (Doc AnsiStyle)
+recurTasks conf connection duration ids = do
+  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
+
+      runBeamSqlite connection $ runUpdate $
+        update (_tldbTasks taskLiteDb)
+          (\task_ -> mconcat
+            [ (Task.recurrence_duration task_) <-. val_ (Just durationIsoText)
+            , (Task.group_ulid task_) <-. val_ (Just groupUlid)
+            ])
+          (\task_ -> primaryKey task_ ==. val_ taskUlid)
+
+      pure $ "📅 Set recurrence duration of task" <+> prettyBody
+        <+> "with id" <+> prettyId
+        <+> "to" <+> dquotes (pretty $ durationIsoText)
+
+  pure $ vsep docs
+
+
 adjustPriority :: Config -> Float -> [IdText] -> IO (Doc AnsiStyle)
 adjustPriority conf adjustment ids  = do
   dbPath <- getDbPath conf