diff --git a/docs-source/concepts.md b/docs-source/concepts.md index 99def65..6387e81 100644 --- a/docs-source/concepts.md +++ b/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 diff --git a/stack.yaml b/stack.yaml index c4ea599..d707673 100644 --- a/stack.yaml +++ b/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 diff --git a/stack.yaml.lock b/stack.yaml.lock index fafc983..521802d 100644 --- a/stack.yaml.lock +++ b/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: diff --git a/tasklite-core/app/Main.hs b/tasklite-core/app/Main.hs index 492ba88..aa051d9 100644 --- a/tasklite-core/app/Main.hs +++ b/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 diff --git a/tasklite-core/package.yaml b/tasklite-core/package.yaml index c9ea9da..e55a914 100644 --- a/tasklite-core/package.yaml +++ b/tasklite-core/package.yaml @@ -35,6 +35,7 @@ dependencies: - hourglass - hsemail - huzzy + - iso8601-duration - optparse-applicative - parsec - portable-lines diff --git a/tasklite-core/source/ImportExport.hs b/tasklite-core/source/ImportExport.hs index 75f6f34..fd287d7 100644 --- a/tasklite-core/source/ImportExport.hs +++ b/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 diff --git a/tasklite-core/source/Lib.hs b/tasklite-core/source/Lib.hs index 2b356fb..2f2c928 100644 --- a/tasklite-core/source/Lib.hs +++ b/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 diff --git a/tasklite-core/source/Utils.hs b/tasklite-core/source/Utils.hs index 1372a04..45e60cc 100644 --- a/tasklite-core/source/Utils.hs +++ b/tasklite-core/source/Utils.hs @@ -8,6 +8,8 @@ import Protolude as P import Data.Text as T import Data.Text.Prettyprint.Doc hiding ((<>)) +import Data.Time (addUTCTime, UTCTime, ZonedTime, zonedTimeToUTC) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Data.Hourglass import Data.ULID import Data.ULID.TimeStamp @@ -120,3 +122,37 @@ setDateTime ulid dateTime = ULID (toUlidTime dateTime) (random ulid) + + +-- | Currently not needed +-- addStartUtc :: DateTime -> Iso8601.Interval -> Iso8601.Interval +-- addStartUtc utc interval = case interval of +-- Iso8601.Interval (Iso8601.JustDuration duration) -> +-- Iso8601.Interval (Iso8601.StartDuration (dateTimeToUtcTime utc) duration) +-- _ -> interval + + +zonedTimeToDateTime :: ZonedTime -> DateTime +zonedTimeToDateTime zTime = zTime + & zonedTimeToUTC + & utcTimeToPOSIXSeconds + & toRational + & rationalToElapsedP + & timeFromElapsedP + + +utcTimeToDateTime :: UTCTime -> DateTime +utcTimeToDateTime utcTime = utcTime + & utcTimeToPOSIXSeconds + & toRational + & rationalToElapsedP + & timeFromElapsedP + + +dateTimeToUtcTime :: DateTime -> UTCTime +dateTimeToUtcTime dateTime = dateTime + & timeGetElapsedP + & elapsedPToRational + & fromRational + & flip addUTCTime (posixSecondsToUTCTime 0) +