{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Omni.Task.Core where import Alpha import Data.Aeson (FromJSON, ToJSON, decode, encode) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Types (parseMaybe) 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, utctDay, utctDayTime) import Data.Time.Calendar (toModifiedJulianDay) import GHC.Generics () import System.Directory (createDirectoryIfMissing, doesFileExist) import System.Environment (lookupEnv) import System.IO (SeekMode (AbsoluteSeek)) import qualified System.IO as IO import System.IO.Unsafe (unsafePerformIO) import System.Posix.IO (LockRequest (..), closeFd, handleToFd, waitToSetLock) -- Core data types data Task = Task { taskId :: Text, taskTitle :: Text, taskType :: TaskType, taskParent :: Maybe Text, -- Parent epic ID taskNamespace :: Maybe Text, -- Optional namespace (e.g., "Omni/Task", "Biz/Cloud") taskStatus :: Status, taskPriority :: Priority, -- Priority level (0-4) taskDependencies :: [Dependency], -- List of dependencies with types taskDescription :: Maybe Text, -- Optional detailed description taskCreatedAt :: UTCTime, taskUpdatedAt :: UTCTime } deriving (Show, Eq, Generic) data TaskType = Epic | WorkTask deriving (Show, Eq, Generic) data Status = Open | InProgress | Review | Approved | Done deriving (Show, Eq, Generic) -- Priority levels (matching beads convention) data Priority = P0 | P1 | P2 | P3 | P4 deriving (Show, Eq, Ord, Generic) data Dependency = Dependency { depId :: Text, -- ID of the task this depends on depType :: DependencyType -- Type of dependency relationship } deriving (Show, Eq, Generic) data DependencyType = Blocks -- Hard dependency, blocks ready work queue | DiscoveredFrom -- Work discovered during other work | ParentChild -- Epic/subtask relationship | Related -- Soft relationship, doesn't block deriving (Show, Eq, Generic) data TaskProgress = TaskProgress { progressTaskId :: Text, progressTotal :: Int, progressCompleted :: Int, progressPercentage :: Int } deriving (Show, Eq, Generic) instance ToJSON TaskType instance FromJSON TaskType instance ToJSON Status instance FromJSON Status instance ToJSON Priority instance FromJSON Priority instance ToJSON DependencyType instance FromJSON DependencyType instance ToJSON Dependency instance FromJSON Dependency instance ToJSON Task instance FromJSON Task -- | Case-insensitive ID comparison matchesId :: Text -> Text -> Bool 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 -- Get the tasks database file path (use test file if TASK_TEST_MODE is set) getTasksFilePath :: IO FilePath getTasksFilePath = do customPath <- lookupEnv "TASK_DB_PATH" testMode <- lookupEnv "TASK_TEST_MODE" let path = case (customPath, testMode) of (Just p, _) -> p (_, Just "1") -> ".tasks/tasks-test.jsonl" _ -> ".tasks/tasks.jsonl" pure path -- Initialize the task database initTaskDb :: IO () initTaskDb = do createDirectoryIfMissing True ".tasks" tasksFile <- getTasksFilePath exists <- doesFileExist tasksFile unless exists <| do TIO.writeFile tasksFile "" putText <| "Initialized task database at " <> T.pack tasksFile -- Lock for in-process thread safety taskLock :: MVar () taskLock = unsafePerformIO (newMVar ()) {-# NOINLINE taskLock #-} -- Execute action with write lock (exclusive) withTaskWriteLock :: IO a -> IO a withTaskWriteLock action = withMVar taskLock <| \_ -> do -- In test mode, we rely on MVar for thread safety to avoid GHC "resource busy" errors -- when mixing openFd (flock) and standard IO in threaded tests. testMode <- lookupEnv "TASK_TEST_MODE" case testMode of Just "1" -> action _ -> do tasksFile <- getTasksFilePath let lockFile = tasksFile <> ".lock" bracket ( do h <- IO.openFile lockFile IO.ReadWriteMode handleToFd h ) closeFd ( \fd -> do waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0) action ) -- Execute action with read lock (shared) withTaskReadLock :: IO a -> IO a withTaskReadLock action = withMVar taskLock <| \_ -> do testMode <- lookupEnv "TASK_TEST_MODE" case testMode of Just "1" -> action _ -> do tasksFile <- getTasksFilePath let lockFile = tasksFile <> ".lock" bracket ( do h <- IO.openFile lockFile IO.ReadWriteMode handleToFd h ) closeFd ( \fd -> do waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0) action ) -- Generate a short ID using base36 encoding of timestamp (lowercase) generateId :: IO Text generateId = do now <- getCurrentTime -- 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 = toBase36 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 = withTaskReadLock <| do tasks <- loadTasksInternal pure <| computeNextChildId tasks (normalizeId parentId) computeNextChildId :: [Task] -> Text -> Text computeNextChildId tasks parentId = -- 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 in 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 base36 (0-9, a-z) toBase36 :: Integer -> String toBase36 0 = "0" toBase36 n = reverse <| go n where alphabet = ['0' .. '9'] ++ ['a' .. 'z'] go 0 = [] go x = let (q, r) = x `divMod` 36 idx = fromIntegral r char = case drop idx alphabet of (c : _) -> c [] -> '0' -- Fallback (should never happen) in char : go q -- Load all tasks from JSONL file (with migration support) loadTasks :: IO [Task] loadTasks = withTaskReadLock loadTasksInternal loadTasksInternal :: IO [Task] loadTasksInternal = do tasksFile <- getTasksFilePath exists <- doesFileExist tasksFile if exists then do content <- TIO.readFile tasksFile let taskLines = T.lines content pure <| mapMaybe decodeTask taskLines else pure [] where decodeTask :: Text -> Maybe Task decodeTask line = if T.null line then Nothing else case decode (BLC.pack <| T.unpack line) of Just task -> Just task Nothing -> migrateTask line -- Migrate old task formats to new format migrateTask :: Text -> Maybe Task migrateTask line = case Aeson.decode (BLC.pack <| T.unpack line) :: Maybe Aeson.Object of Nothing -> Nothing Just obj -> let taskId' = KM.lookup "taskId" obj +> parseMaybe Aeson.parseJSON taskTitle' = KM.lookup "taskTitle" obj +> parseMaybe Aeson.parseJSON taskStatus' = KM.lookup "taskStatus" obj +> parseMaybe Aeson.parseJSON taskCreatedAt' = KM.lookup "taskCreatedAt" obj +> parseMaybe Aeson.parseJSON taskUpdatedAt' = KM.lookup "taskUpdatedAt" obj +> parseMaybe Aeson.parseJSON -- Extract taskDescription (new field) taskDescription' = KM.lookup "taskDescription" obj +> parseMaybe Aeson.parseJSON -- Extract dependencies (handle V1 [Dependency] and V0 [Text]) v1Deps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Dependency] v0Deps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Text] finalDeps = case v1Deps of Just ds -> ds Nothing -> case v0Deps of Just ts -> map (\tid -> Dependency {depId = tid, depType = Blocks}) ts Nothing -> [] -- taskProject is ignored in new format (use epics instead) taskType' = fromMaybe WorkTask (KM.lookup "taskType" obj +> parseMaybe Aeson.parseJSON) taskParent' = KM.lookup "taskParent" obj +> parseMaybe Aeson.parseJSON taskNamespace' = KM.lookup "taskNamespace" obj +> parseMaybe Aeson.parseJSON -- Default priority to P2 (medium) for old tasks taskPriority' = fromMaybe P2 (KM.lookup "taskPriority" obj +> parseMaybe Aeson.parseJSON) in case (taskId', taskTitle', taskStatus', taskCreatedAt', taskUpdatedAt') of (Just tid, Just title, Just status, Just created, Just updated) -> Just Task { taskId = tid, taskTitle = title, taskType = taskType', taskParent = taskParent', taskNamespace = taskNamespace', taskStatus = status, taskPriority = taskPriority', taskDependencies = finalDeps, taskDescription = taskDescription', taskCreatedAt = created, taskUpdatedAt = updated } _ -> Nothing -- Save a single task (append to JSONL) saveTask :: Task -> IO () saveTask = withTaskWriteLock <. saveTaskInternal saveTaskInternal :: Task -> IO () saveTaskInternal task = do tasksFile <- getTasksFilePath let json = encode task BLC.appendFile tasksFile (json <> "\n") -- Create a new task createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> Maybe Text -> IO Task createTask title taskType parent namespace priority deps description = withTaskWriteLock <| do 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 = normalizeId tid, taskTitle = title, taskType = taskType, taskParent = parent', taskNamespace = namespace, taskStatus = Open, taskPriority = priority, taskDependencies = deps', taskDescription = description, taskCreatedAt = now, taskUpdatedAt = now } 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 -> [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, 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 tasks <- loadTasks let filtered = tasks |> filterByType maybeType |> filterByParent maybeParent |> filterByStatus maybeStatus |> filterByNamespace maybeNamespace pure filtered where filterByType Nothing ts = ts filterByType (Just typ) ts = filter (\t -> taskType t == typ) ts filterByParent Nothing ts = ts filterByParent (Just pid) ts = filter (\t -> taskParent t == Just pid) ts filterByStatus Nothing ts = ts filterByStatus (Just status) ts = filter (\t -> taskStatus t == status) ts filterByNamespace Nothing ts = ts filterByNamespace (Just ns) ts = filter (\t -> taskNamespace t == Just ns) ts -- Get ready tasks (not blocked by dependencies and not a parent) getReadyTasks :: IO [Task] getReadyTasks = do allTasks <- loadTasks -- Only Open or InProgress tasks are considered ready for work. -- Review tasks are waiting for review, and Done tasks are complete. let openTasks = filter (\t -> taskStatus t == Open || taskStatus t == InProgress) allTasks doneIds = map taskId <| filter (\t -> taskStatus t == Done) allTasks -- Find all tasks that act as parents parentIds = mapMaybe taskParent allTasks isParent tid = tid `elem` parentIds -- Only Blocks and ParentChild dependencies block ready work blockingDepIds task = [depId dep | dep <- taskDependencies task, depType dep `elem` [Blocks, ParentChild]] isReady task = taskType task /= Epic && not (isParent (taskId task)) && all (`elem` doneIds) (blockingDepIds task) pure <| filter isReady openTasks -- Get dependency tree for a task (returns tasks) getDependencyTree :: Text -> IO [Task] getDependencyTree tid = do tasks <- loadTasks case findTask tid tasks of Nothing -> pure [] Just task -> pure <| collectDeps tasks task where collectDeps :: [Task] -> Task -> [Task] collectDeps allTasks task = let depIds = map depId (taskDependencies task) deps = filter (\t -> any (matchesId (taskId t)) depIds) allTasks in task : concatMap (collectDeps allTasks) deps -- Get task progress getTaskProgress :: Text -> IO TaskProgress getTaskProgress tidRaw = do let tid = normalizeId tidRaw tasks <- loadTasks -- Verify task exists (optional, but good for error handling) 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 percentage = if total == 0 then 0 else (completed * 100) `div` total pure TaskProgress { progressTaskId = tid, progressTotal = total, progressCompleted = completed, progressPercentage = percentage } -- Show task progress showTaskProgress :: Text -> IO () showTaskProgress tid = do progress <- getTaskProgress tid putText <| "Progress for " <> tid <> ": " <> T.pack (show (progressCompleted progress)) <> "/" <> T.pack (show (progressTotal progress)) <> " (" <> T.pack (show (progressPercentage progress)) <> "%)" -- Show dependency tree for a task showDependencyTree :: Text -> IO () showDependencyTree tid = do tasks <- loadTasks case findTask tid tasks of Nothing -> putText "Task not found" Just task -> printTree tasks task 0 where printTree :: [Task] -> Task -> Int -> IO () printTree allTasks task indent = do putText <| T.pack (replicate (indent * 2) ' ') <> taskId task <> ": " <> taskTitle task let depIds = map depId (taskDependencies task) deps = filter (\t -> any (matchesId (taskId t)) depIds) allTasks traverse_ (\dep -> printTree allTasks dep (indent + 1)) deps -- Get task tree (returns tasks hierarchically) getTaskTree :: Maybe Text -> IO [Task] getTaskTree maybeId = do tasks <- loadTasks case maybeId of Nothing -> do -- Return all epics with their children let epics = filter (\t -> taskType t == Epic) tasks in pure <| concatMap (collectChildren tasks) epics Just tid -> do -- Return specific task/epic with its children case findTask tid tasks of Nothing -> pure [] Just task -> pure <| collectChildren tasks task where collectChildren :: [Task] -> Task -> [Task] collectChildren allTasks task = let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks in task : concatMap (collectChildren allTasks) children -- Show task tree (epic with children, or all epics if no ID given) showTaskTree :: Maybe Text -> IO () showTaskTree maybeId = do tasks <- loadTasks case maybeId of Nothing -> do -- Show all epics with their children let epics = filter (\t -> taskType t == Epic) tasks if null epics then putText "No epics found" else traverse_ (printEpicTree tasks) epics Just tid -> do -- Show specific task/epic with its children case findTask tid tasks of Nothing -> putText "Task not found" Just task -> printEpicTree tasks task where printEpicTree :: [Task] -> Task -> IO () printEpicTree allTasks task = printTreeNode allTasks task 0 printTreeNode :: [Task] -> Task -> Int -> IO () printTreeNode allTasks task indent = printTreeNode' allTasks task indent [] printTreeNode' :: [Task] -> Task -> Int -> [Bool] -> IO () printTreeNode' allTasks task indent ancestry = do let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks -- Build tree prefix using box-drawing characters prefix = if indent == 0 then "" else let ancestorPrefixes = map (\hasMore -> if hasMore then "│ " else " ") (List.init ancestry) myPrefix = if List.last ancestry then "├── " else "└── " in T.pack <| concat ancestorPrefixes ++ myPrefix -- For epics, show progress count [completed/total]; for tasks, show status checkbox statusStr = case taskType task of Epic -> let total = length children completed = length <| filter (\t -> taskStatus t == Done) children in "[" <> T.pack (show completed) <> "/" <> T.pack (show total) <> "]" WorkTask -> case taskStatus task of Open -> "[ ]" InProgress -> "[~]" Review -> "[?]" Approved -> "[+]" Done -> "[✓]" coloredStatusStr = case taskType task of Epic -> magenta statusStr WorkTask -> case taskStatus task of Open -> bold statusStr InProgress -> yellow statusStr Review -> magenta statusStr Approved -> green statusStr Done -> green statusStr nsStr = case taskNamespace task of Nothing -> "" Just ns -> "[" <> ns <> "] " coloredNsStr = case taskNamespace task of Nothing -> "" Just _ -> gray nsStr -- Calculate available width for title (80 cols - prefix - id - labels) usedWidth = T.length prefix + T.length (taskId task) + T.length statusStr + T.length nsStr + 2 availableWidth = max 20 (80 - usedWidth) truncatedTitle = if T.length (taskTitle task) > availableWidth then T.take (availableWidth - 3) (taskTitle task) <> "..." else taskTitle task coloredTitle = if taskType task == Epic then bold truncatedTitle else truncatedTitle putText <| prefix <> cyan (taskId task) <> " " <> coloredStatusStr <> " " <> coloredNsStr <> coloredTitle -- Print children with updated ancestry let indexedChildren = zip [1 ..] children totalChildren = length children traverse_ ( \(idx, child) -> let hasMoreSiblings = idx < totalChildren in printTreeNode' allTasks child (indent + 1) (ancestry ++ [hasMoreSiblings]) ) indexedChildren -- Helper to print a task printTask :: Task -> IO () printTask t = do tasks <- loadTasks let progressInfo = if taskType t == Epic then let children = filter (maybe False (`matchesId` taskId t) <. taskParent) tasks total = length children completed = length <| filter (\child -> taskStatus child == Done) children in " [" <> T.pack (show completed) <> "/" <> T.pack (show total) <> "]" else "" parentInfo = case taskParent t of Nothing -> "" Just p -> " (parent: " <> p <> ")" namespaceInfo = case taskNamespace t of Nothing -> "" Just ns -> " [" <> ns <> "]" coloredStatus = let s = "[" <> T.pack (show (taskStatus t)) <> "]" in case taskStatus t of 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 coloredProgress = if taskType t == Epic then magenta progressInfo else progressInfo coloredNamespace = case taskNamespace t of Nothing -> "" Just _ -> gray namespaceInfo coloredParent = case taskParent t of Nothing -> "" Just _ -> gray parentInfo putText <| cyan (taskId t) <> " [" <> T.pack (show (taskType t)) <> "] " <> coloredStatus <> coloredProgress <> " " <> coloredTitle <> coloredParent <> coloredNamespace -- Show detailed task information (human-readable) showTaskDetailed :: Task -> IO () showTaskDetailed t = do tasks <- loadTasks putText "" putText <| "Task: " <> taskId t putText "" putText <| "Title: " <> taskTitle t putText <| "Type: " <> T.pack (show (taskType t)) putText <| "Status: " <> T.pack (show (taskStatus t)) putText <| "Priority: " <> T.pack (show (taskPriority t)) <> priorityDesc -- Show epic progress if this is an epic when (taskType t == Epic) <| do let children = filter (maybe False (`matchesId` taskId t) <. taskParent) tasks total = length children completed = length <| filter (\child -> taskStatus child == Done) children percentage = if total == 0 then 0 else (completed * 100) `div` total putText <| "Progress: " <> T.pack (show completed) <> "/" <> T.pack (show total) <> " (" <> T.pack (show percentage) <> "%)" case taskParent t of Nothing -> pure () Just p -> putText <| "Parent: " <> p case taskNamespace t of Nothing -> pure () Just ns -> putText <| "Namespace: " <> ns putText <| "Created: " <> T.pack (show (taskCreatedAt t)) putText <| "Updated: " <> T.pack (show (taskUpdatedAt t)) -- Show dependencies unless (null (taskDependencies t)) <| do putText "" putText "Dependencies:" traverse_ printDependency (taskDependencies t) -- Show description case taskDescription t of Nothing -> pure () Just desc -> do putText "" putText "Description:" -- Indent description for better readability let indented = T.unlines <| map (" " <>) (T.lines desc) putText indented putText "" where priorityDesc = case taskPriority t of P0 -> " (Critical)" P1 -> " (High)" P2 -> " (Medium)" P3 -> " (Low)" P4 -> " (Backlog)" printDependency dep = putText <| " - " <> depId dep <> " [" <> T.pack (show (depType dep)) <> "]" -- ANSI Colors red, green, yellow, blue, magenta, cyan, gray, bold :: Text -> Text red t = "\ESC[31m" <> t <> "\ESC[0m" green t = "\ESC[32m" <> t <> "\ESC[0m" yellow t = "\ESC[33m" <> t <> "\ESC[0m" blue t = "\ESC[34m" <> t <> "\ESC[0m" magenta t = "\ESC[35m" <> t <> "\ESC[0m" cyan t = "\ESC[36m" <> t <> "\ESC[0m" gray t = "\ESC[90m" <> t <> "\ESC[0m" bold t = "\ESC[1m" <> t <> "\ESC[0m" -- Export tasks: Consolidate JSONL file (remove duplicates, keep latest version) exportTasks :: IO () exportTasks = withTaskWriteLock <| do tasks <- loadTasksInternal -- Rewrite the entire file with deduplicated tasks tasksFile <- getTasksFilePath TIO.writeFile tasksFile "" traverse_ saveTaskInternal tasks -- Task statistics data TaskStats = TaskStats { totalTasks :: Int, openTasks :: Int, inProgressTasks :: Int, reviewTasks :: Int, approvedTasks :: Int, doneTasks :: Int, totalEpics :: Int, readyTasks :: Int, blockedTasks :: Int, tasksByPriority :: [(Priority, Int)], tasksByNamespace :: [(Text, Int)] } deriving (Show, Eq, Generic) instance ToJSON TaskStats instance FromJSON TaskStats -- Get task statistics getTaskStats :: Maybe Text -> IO TaskStats getTaskStats maybeEpicId = do allTasks <- loadTasks targetTasks <- case maybeEpicId of Nothing -> pure allTasks Just epicId -> case findTask epicId allTasks of Nothing -> panic "Epic not found" Just task -> pure <| getAllDescendants allTasks (taskId task) globalReady <- getReadyTasks let readyIds = map taskId globalReady -- Filter ready tasks to only include those in our target set readyCount = length <| filter (\t -> taskId t `elem` readyIds) targetTasks tasks = targetTasks total = length tasks 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 blockedCount = total - readyCount' - done -- Count tasks by priority byPriority = [ (P0, length <| filter (\t -> taskPriority t == P0) tasks), (P1, length <| filter (\t -> taskPriority t == P1) tasks), (P2, length <| filter (\t -> taskPriority t == P2) tasks), (P3, length <| filter (\t -> taskPriority t == P3) tasks), (P4, length <| filter (\t -> taskPriority t == P4) tasks) ] -- Count tasks by namespace namespaces = mapMaybe taskNamespace tasks uniqueNs = List.nub namespaces byNamespace = map (\ns -> (ns, length <| filter (\t -> taskNamespace t == Just ns) tasks)) uniqueNs pure TaskStats { totalTasks = total, openTasks = open, inProgressTasks = inProg, reviewTasks = review, approvedTasks = approved, doneTasks = done, totalEpics = epics, readyTasks = readyCount', blockedTasks = blockedCount, tasksByPriority = byPriority, tasksByNamespace = byNamespace } -- Helper to get all descendants of a task (recursive) getAllDescendants :: [Task] -> Text -> [Task] getAllDescendants allTasks parentId = let children = filter (maybe False (`matchesId` parentId) <. taskParent) allTasks in children ++ concatMap (getAllDescendants allTasks <. taskId) children -- Show task statistics (human-readable) showTaskStats :: Maybe Text -> IO () showTaskStats maybeEpicId = do stats <- getTaskStats maybeEpicId putText "" case maybeEpicId of Nothing -> putText "Task Statistics" Just epicId -> putText <| "Task Statistics for Epic " <> epicId putText "" putText <| "Total tasks: " <> T.pack (show (totalTasks stats)) 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)) putText "" putText <| "Ready to work: " <> T.pack (show (readyTasks stats)) putText <| "Blocked: " <> T.pack (show (blockedTasks stats)) putText "" putText "By Priority:" traverse_ printPriority (tasksByPriority stats) unless (null (tasksByNamespace stats)) <| do putText "" putText "By Namespace:" traverse_ printNamespace (tasksByNamespace stats) putText "" where printPriority (p, count) = let label = case p of P0 -> "P0 (Critical)" P1 -> "P1 (High)" P2 -> "P2 (Medium)" P3 -> "P3 (Low)" P4 -> "P4 (Backlog)" in putText <| " " <> T.pack (show count) <> " " <> label printNamespace (ns, count) = putText <| " " <> T.pack (show count) <> " " <> ns -- Import tasks: Read from another JSONL file and merge with existing tasks importTasks :: FilePath -> IO () importTasks filePath = withTaskWriteLock <| do exists <- doesFileExist filePath unless exists <| panic (T.pack filePath <> " does not exist") -- Load tasks from import file content <- TIO.readFile filePath let importLines = T.lines content importedTasks = map normalizeTask (mapMaybe decodeTask importLines) -- Load existing tasks existingTasks <- loadTasksInternal -- Create a map of existing task IDs for quick lookup let existingIds = map taskId existingTasks -- Filter to only new tasks (not already in our database) newTasks = filter (\t -> not (any (`matchesId` taskId t) existingIds)) importedTasks -- For tasks that exist, update them with imported data updatedTasks = map (updateWithImported importedTasks) existingTasks -- Combine: updated existing tasks + new tasks allTasks = updatedTasks ++ newTasks -- Rewrite tasks.jsonl with merged data tasksFile <- getTasksFilePath TIO.writeFile tasksFile "" traverse_ saveTaskInternal allTasks where decodeTask :: Text -> Maybe Task decodeTask line = if T.null line then Nothing else decode (BLC.pack <| T.unpack line) -- Update an existing task if there's a newer version in imported tasks updateWithImported :: [Task] -> Task -> Task updateWithImported imported existing = case findTask (taskId existing) imported of Nothing -> existing -- No imported version, keep existing Just importedTask -> -- Use imported version if it's newer (based on updatedAt) if taskUpdatedAt importedTask > taskUpdatedAt existing then importedTask else existing