{-# 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, utctDayTime) 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 | 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 testMode <- lookupEnv "TASK_TEST_MODE" pure <| case testMode of 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 midnight let dayTime = utctDayTime now microseconds = diffTimeToPicoseconds dayTime `div` 1000000 -- Convert to base62 for shorter IDs encoded = toBase62 (fromIntegral microseconds) pure <| "t-" <> T.pack encoded -- 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 <- generateId 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) getReadyTasks :: IO [Task] getReadyTasks = do allTasks <- loadTasks let openTasks = filter (\t -> taskStatus t /= Done) allTasks doneIds = map taskId <| filter (\t -> taskStatus t == Done) allTasks -- Only Blocks and ParentChild dependencies block ready work blockingDepIds task = [depId dep | dep <- taskDependencies task, depType dep `elem` [Blocks, ParentChild]] isReady 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 -> "[~]" 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 = putText <| taskId t <> " [" <> T.pack (show (taskType t)) <> "] [" <> T.pack (show (taskStatus t)) <> "] " <> taskTitle t <> parentInfo <> namespaceInfo where parentInfo = case taskParent t of Nothing -> "" Just p -> " (parent: " <> p <> ")" namespaceInfo = case taskNamespace t of Nothing -> "" Just ns -> " [" <> ns <> "]" -- Show detailed task information (human-readable) showTaskDetailed :: Task -> IO () showTaskDetailed t = do 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 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, 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 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, 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 <| " 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