diff options
Diffstat (limited to 'Omni/Task/Core.hs')
| -rw-r--r-- | Omni/Task/Core.hs | 122 |
1 files changed, 96 insertions, 26 deletions
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index c548f6c..1eb820f 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -42,7 +42,7 @@ data Task = Task data TaskType = Epic | WorkTask | HumanTask deriving (Show, Eq, Generic) -data Status = Open | InProgress | Review | Done +data Status = Open | InProgress | Review | Approved | Done deriving (Show, Eq, Generic) -- Priority levels (matching beads convention) @@ -96,12 +96,28 @@ instance FromJSON Task -- | Case-insensitive ID comparison matchesId :: Text -> Text -> Bool -matchesId id1 id2 = T.toLower id1 == T.toLower id2 +matchesId id1 id2 = normalizeId id1 == normalizeId id2 + +-- | Normalize ID to lowercase +normalizeId :: Text -> Text +normalizeId = T.toLower -- | Find a task by ID (case-insensitive) findTask :: Text -> [Task] -> Maybe Task findTask tid = List.find (\t -> matchesId (taskId t) tid) +-- | Normalize task IDs (self, parent, dependencies) to lowercase +normalizeTask :: Task -> Task +normalizeTask t = + t + { taskId = normalizeId (taskId t), + taskParent = fmap normalizeId (taskParent t), + taskDependencies = map normalizeDependency (taskDependencies t) + } + +normalizeDependency :: Dependency -> Dependency +normalizeDependency d = d {depId = normalizeId (depId d)} + instance ToJSON TaskProgress instance FromJSON TaskProgress @@ -176,7 +192,7 @@ withTaskReadLock action = action ) --- Generate a short ID using base62 encoding of timestamp +-- Generate a short ID using base36 encoding of timestamp (lowercase) generateId :: IO Text generateId = do now <- getCurrentTime @@ -188,7 +204,7 @@ generateId = do -- 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 + encoded = toBase36 totalMicros pure <| "t-" <> T.pack encoded -- Generate a child ID based on parent ID (e.g. "t-abc.1", "t-abc.1.2") @@ -197,7 +213,7 @@ generateChildId :: Text -> IO Text generateChildId parentId = withTaskReadLock <| do tasks <- loadTasksInternal - pure <| computeNextChildId tasks parentId + pure <| computeNextChildId tasks (normalizeId parentId) computeNextChildId :: [Task] -> Text -> Text computeNextChildId tasks parentId = @@ -220,15 +236,15 @@ getSuffix parent childId = else Nothing else Nothing --- Convert number to base62 (0-9, a-z, A-Z) -toBase62 :: Integer -> String -toBase62 0 = "0" -toBase62 n = reverse <| go n +-- Convert number to base36 (0-9, a-z) +toBase36 :: Integer -> String +toBase36 0 = "0" +toBase36 n = reverse <| go n where - alphabet = ['0' .. '9'] ++ ['a' .. 'z'] ++ ['A' .. 'Z'] + alphabet = ['0' .. '9'] ++ ['a' .. 'z'] go 0 = [] go x = - let (q, r) = x `divMod` 62 + let (q, r) = x `divMod` 36 idx = fromIntegral r char = case drop idx alphabet of (c : _) -> c @@ -319,22 +335,25 @@ saveTaskInternal task = do createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> Maybe Text -> IO Task createTask title taskType parent namespace priority deps description = withTaskWriteLock <| do - tid <- case parent of - Nothing -> generateId + let parent' = fmap normalizeId parent + deps' = map normalizeDependency deps + + tid <- case parent' of + Nothing -> generateUniqueId Just pid -> do tasks <- loadTasksInternal pure <| computeNextChildId tasks pid now <- getCurrentTime let task = Task - { taskId = tid, + { taskId = normalizeId tid, taskTitle = title, taskType = taskType, - taskParent = parent, + taskParent = parent', taskNamespace = namespace, taskStatus = Open, taskPriority = priority, - taskDependencies = deps, + taskDependencies = deps', taskDescription = description, taskCreatedAt = now, taskUpdatedAt = now @@ -342,22 +361,62 @@ createTask title taskType parent namespace priority deps description = saveTaskInternal task pure task +-- Generate a unique ID (checking against existing tasks) +generateUniqueId :: IO Text +generateUniqueId = do + tasks <- loadTasksInternal + go tasks + where + go tasks = do + tid <- generateId + case findTask tid tasks of + Nothing -> pure tid + Just _ -> go tasks -- Retry if collision (case-insensitive) + -- Update task status -updateTaskStatus :: Text -> Status -> IO () -updateTaskStatus tid newStatus = +updateTaskStatus :: Text -> Status -> [Dependency] -> IO () +updateTaskStatus tid newStatus newDeps = withTaskWriteLock <| do tasks <- loadTasksInternal now <- getCurrentTime let updatedTasks = map updateIfMatch tasks updateIfMatch t = if matchesId (taskId t) tid - then t {taskStatus = newStatus, taskUpdatedAt = now} + then t {taskStatus = newStatus, taskUpdatedAt = now, taskDependencies = if null newDeps then taskDependencies t else newDeps} else t -- Rewrite the entire file (simple approach for MVP) tasksFile <- getTasksFilePath TIO.writeFile tasksFile "" traverse_ saveTaskInternal updatedTasks +-- Edit a task by applying a modification function +editTask :: Text -> (Task -> Task) -> IO Task +editTask tid modifyFn = + withTaskWriteLock <| do + tasks <- loadTasksInternal + now <- getCurrentTime + + -- Find the task first to ensure it exists + case findTask tid tasks of + Nothing -> panic "Task not found" + Just original -> do + let modified = modifyFn original + -- Only update timestamp if something actually changed + -- But for simplicity, we always update it if the user explicitly ran 'edit' + finalTask = modified {taskUpdatedAt = now} + + updateIfMatch t = + if matchesId (taskId t) tid + then finalTask + else t + updatedTasks = map updateIfMatch tasks + + -- Rewrite the entire file + tasksFile <- getTasksFilePath + TIO.writeFile tasksFile "" + traverse_ saveTaskInternal updatedTasks + pure finalTask + -- List tasks, optionally filtered by type, parent, status, or namespace listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task] listTasks maybeType maybeParent maybeStatus maybeNamespace = do @@ -395,9 +454,12 @@ getReadyTasks = do -- Only Blocks and ParentChild dependencies block ready work blockingDepIds task = [depId dep | dep <- taskDependencies task, depType dep `elem` [Blocks, ParentChild]] isReady task = - not (isParent (taskId task)) + taskType task + /= Epic + && not (isParent (taskId task)) && all (`elem` doneIds) (blockingDepIds task) - && taskType task /= HumanTask + && taskType task + /= HumanTask pure <| filter isReady openTasks -- Get dependency tree for a task (returns tasks) @@ -416,12 +478,13 @@ getDependencyTree tid = do -- Get task progress getTaskProgress :: Text -> IO TaskProgress -getTaskProgress tid = do +getTaskProgress tidRaw = do + let tid = normalizeId tidRaw tasks <- loadTasks -- Verify task exists (optional, but good for error handling) - case filter (\t -> taskId t == tid) tasks of - [] -> panic "Task not found" - _ -> do + case findTask tid tasks of + Nothing -> panic "Task not found" + Just _ -> do let children = filter (\child -> taskParent child == Just tid) tasks total = length children completed = length <| filter (\child -> taskStatus child == Done) children @@ -519,6 +582,7 @@ showTaskTree maybeId = do Open -> "[ ]" InProgress -> "[~]" Review -> "[?]" + Approved -> "[+]" Done -> "[✓]" coloredStatusStr = case taskType task of @@ -527,6 +591,7 @@ showTaskTree maybeId = do Open -> bold statusStr InProgress -> yellow statusStr Review -> magenta statusStr + Approved -> green statusStr Done -> green statusStr nsStr = case taskNamespace task of @@ -586,6 +651,7 @@ printTask t = do Open -> bold s InProgress -> yellow s Review -> magenta s + Approved -> green s Done -> green s coloredTitle = if taskType t == Epic then bold (taskTitle t) else taskTitle t @@ -696,6 +762,7 @@ data TaskStats = TaskStats openTasks :: Int, inProgressTasks :: Int, reviewTasks :: Int, + approvedTasks :: Int, doneTasks :: Int, totalEpics :: Int, readyTasks :: Int, @@ -731,6 +798,7 @@ getTaskStats maybeEpicId = do open = length <| filter (\t -> taskStatus t == Open) tasks inProg = length <| filter (\t -> taskStatus t == InProgress) tasks review = length <| filter (\t -> taskStatus t == Review) tasks + approved = length <| filter (\t -> taskStatus t == Approved) tasks done = length <| filter (\t -> taskStatus t == Done) tasks epics = length <| filter (\t -> taskType t == Epic) tasks readyCount' = readyCount @@ -753,6 +821,7 @@ getTaskStats maybeEpicId = do openTasks = open, inProgressTasks = inProg, reviewTasks = review, + approvedTasks = approved, doneTasks = done, totalEpics = epics, readyTasks = readyCount', @@ -780,6 +849,7 @@ showTaskStats maybeEpicId = do putText <| " Open: " <> T.pack (show (openTasks stats)) putText <| " In Progress: " <> T.pack (show (inProgressTasks stats)) putText <| " Review: " <> T.pack (show (reviewTasks stats)) + putText <| " Approved: " <> T.pack (show (approvedTasks stats)) putText <| " Done: " <> T.pack (show (doneTasks stats)) putText "" putText <| "Epics: " <> T.pack (show (totalEpics stats)) @@ -816,7 +886,7 @@ importTasks filePath = -- Load tasks from import file content <- TIO.readFile filePath let importLines = T.lines content - importedTasks = mapMaybe decodeTask importLines + importedTasks = map normalizeTask (mapMaybe decodeTask importLines) -- Load existing tasks existingTasks <- loadTasksInternal |