summaryrefslogtreecommitdiff
path: root/Omni/Task/Core.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Task/Core.hs')
-rw-r--r--Omni/Task/Core.hs43
1 files changed, 36 insertions, 7 deletions
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index f7b7915..98ef6f9 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -13,7 +13,8 @@ import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
-import Data.Time (UTCTime, diffTimeToPicoseconds, getCurrentTime, utctDayTime)
+import Data.Time (UTCTime, diffTimeToPicoseconds, getCurrentTime, utctDayTime, utctDay)
+import Data.Time.Calendar (toModifiedJulianDay)
import GHC.Generics ()
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.Environment (lookupEnv)
@@ -104,13 +105,41 @@ initTaskDb = do
generateId :: IO Text
generateId = do
now <- getCurrentTime
- -- Convert current time to microseconds since midnight
- let dayTime = utctDayTime now
- microseconds = diffTimeToPicoseconds dayTime `div` 1000000
- -- Convert to base62 for shorter IDs
- encoded = toBase62 (fromIntegral microseconds)
+ -- Convert current time to microseconds since epoch (using MJD)
+ let day = utctDay now
+ dayTime = utctDayTime now
+ mjd = toModifiedJulianDay day
+ micros = diffTimeToPicoseconds dayTime `div` 1000000
+ -- Combine MJD and micros to ensure uniqueness across days.
+ -- Multiplier 10^11 (100,000 seconds) is safe for any day length.
+ totalMicros = (mjd * 100000000000) + micros
+ encoded = toBase62 totalMicros
pure <| "t-" <> T.pack encoded
+-- Generate a child ID based on parent ID (e.g. "t-abc.1", "t-abc.1.2")
+-- Finds the next available sequential suffix among existing children.
+generateChildId :: Text -> IO Text
+generateChildId parentId = do
+ tasks <- loadTasks
+ -- Find the max suffix among ALL tasks that look like children (to avoid ID collisions)
+ -- We check all tasks, not just those with taskParent set, because we want to ensure
+ -- ID uniqueness even if the parent link is missing.
+ let suffixes = mapMaybe (getSuffix parentId <. taskId) tasks
+ nextSuffix = case suffixes of
+ [] -> 1
+ s -> maximum s + 1
+ pure <| parentId <> "." <> T.pack (show nextSuffix)
+
+getSuffix :: Text -> Text -> Maybe Int
+getSuffix parent childId =
+ if parent `T.isPrefixOf` childId && T.length childId > T.length parent
+ then
+ let rest = T.drop (T.length parent) childId
+ in if T.head rest == '.'
+ then readMaybe (T.unpack (T.tail rest))
+ else Nothing
+ else Nothing
+
-- Convert number to base62 (0-9, a-z, A-Z)
toBase62 :: Integer -> String
toBase62 0 = "0"
@@ -192,7 +221,7 @@ saveTask task = do
-- Create a new task
createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> IO Task
createTask title taskType parent namespace priority deps = do
- tid <- generateId
+ tid <- maybe generateId generateChildId parent
now <- getCurrentTime
let task =
Task