{-# 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) -- 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 taskCreatedAt :: UTCTime, taskUpdatedAt :: UTCTime } deriving (Show, Eq, Generic) data TaskType = Epic | WorkTask deriving (Show, Eq, Generic) data Status = Open | InProgress | Review | 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) 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 -- 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" pure <| case (customPath, testMode) of (Just path, _) -> path (_, Just "1") -> ".tasks/tasks-test.jsonl" _ -> ".tasks/tasks.jsonl" -- 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 -- Generate a short ID using base62 encoding of timestamp 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 = 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" toBase62 n = reverse <| go n where alphabet = ['0' .. '9'] ++ ['a' .. 'z'] ++ ['A' .. 'Z'] go 0 = [] go x = let (q, r) = x `divMod` 62 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 = 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 -> migrateOldTask line -- Migrate old task format (with taskProject field or missing priority) to new format migrateOldTask :: Text -> Maybe Task migrateOldTask 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 old taskDependencies (could be [Text] or [Dependency]) oldDeps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Text] newDeps = maybe [] (map (\tid -> Dependency {depId = tid, depType = Blocks})) oldDeps -- taskProject is ignored in new format (use epics instead) taskType' = WorkTask -- Old tasks become WorkTask by default taskParent' = Nothing 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 = newDeps, taskCreatedAt = created, taskUpdatedAt = updated } _ -> Nothing -- Save a single task (append to JSONL) saveTask :: Task -> IO () saveTask 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] -> IO Task createTask title taskType parent namespace priority deps = do tid <- maybe generateId generateChildId parent now <- getCurrentTime let task = Task { taskId = tid, taskTitle = title, taskType = taskType, taskParent = parent, taskNamespace = namespace, taskStatus = Open, taskPriority = priority, taskDependencies = deps, taskCreatedAt = now, taskUpdatedAt = now } saveTask task pure task -- Update task status updateTaskStatus :: Text -> Status -> IO () updateTaskStatus tid newStatus = do tasks <- loadTasks now <- getCurrentTime let updatedTasks = map updateIfMatch tasks updateIfMatch t = if taskId t == tid then t {taskStatus = newStatus, taskUpdatedAt = now} else t -- Rewrite the entire file (simple approach for MVP) tasksFile <- getTasksFilePath TIO.writeFile tasksFile "" traverse_ saveTask updatedTasks -- 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 let openTasks = filter (\t -> taskStatus t /= Done) 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 = 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 filter (\t -> taskId t == tid) tasks of [] -> pure [] (task : _) -> pure <| collectDeps tasks task where collectDeps :: [Task] -> Task -> [Task] collectDeps allTasks task = let depIds = map depId (taskDependencies task) deps = filter (\t -> taskId t `elem` depIds) allTasks in task : concatMap (collectDeps allTasks) deps -- Show dependency tree for a task showDependencyTree :: Text -> IO () showDependencyTree tid = do tasks <- loadTasks case filter (\t -> taskId t == tid) tasks of [] -> putText "Task not found" (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 -> taskId t `elem` 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 filter (\t -> taskId t == tid) tasks of [] -> pure [] (task : _) -> pure <| collectChildren tasks task where collectChildren :: [Task] -> Task -> [Task] collectChildren allTasks task = let children = filter (\t -> taskParent t == Just (taskId task)) 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 filter (\t -> taskId t == tid) tasks of [] -> putText "Task not found" (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 (\t -> taskParent t == Just (taskId task)) 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 -> "[?]" Done -> "[✓]" nsStr = case taskNamespace task of Nothing -> "" Just ns -> "[" <> ns <> "] " -- 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 putText <| prefix <> taskId task <> " " <> statusStr <> " " <> nsStr <> truncatedTitle -- 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 (\child -> taskParent child == Just (taskId t)) 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 <> "]" putText <| taskId t <> " [" <> T.pack (show (taskType t)) <> "] [" <> T.pack (show (taskStatus t)) <> "]" <> progressInfo <> " " <> taskTitle t <> parentInfo <> namespaceInfo -- 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 (\child -> taskParent child == Just (taskId t)) 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) 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)) <> "]" -- Export tasks: Consolidate JSONL file (remove duplicates, keep latest version) exportTasks :: IO () exportTasks = do tasks <- loadTasks -- Rewrite the entire file with deduplicated tasks tasksFile <- getTasksFilePath TIO.writeFile tasksFile "" traverse_ saveTask tasks -- Task statistics data TaskStats = TaskStats { totalTasks :: Int, openTasks :: Int, inProgressTasks :: Int, reviewTasks :: 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 :: IO TaskStats getTaskStats = do tasks <- loadTasks ready <- getReadyTasks let 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 done = length <| filter (\t -> taskStatus t == Done) tasks epics = length <| filter (\t -> taskType t == Epic) tasks readyCount = length ready 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, doneTasks = done, totalEpics = epics, readyTasks = readyCount, blockedTasks = blockedCount, tasksByPriority = byPriority, tasksByNamespace = byNamespace } -- Show task statistics (human-readable) showTaskStats :: IO () showTaskStats = do stats <- getTaskStats putText "" putText "Task Statistics" 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 <| " 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 = 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 = mapMaybe decodeTask importLines -- Load existing tasks existingTasks <- loadTasks -- 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 -> taskId t `notElem` 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_ saveTask 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 filter (\t -> taskId t == taskId existing) imported of [] -> existing -- No imported version, keep existing (importedTask : _) -> -- Use imported version if it's newer (based on updatedAt) if taskUpdatedAt importedTask > taskUpdatedAt existing then importedTask else existing