diff options
Diffstat (limited to 'Omni/Task')
| -rw-r--r-- | Omni/Task/Core.hs | 1567 | ||||
| -rw-r--r-- | Omni/Task/DESIGN.md | 232 | ||||
| -rw-r--r-- | Omni/Task/MigrationTest.hs | 42 | ||||
| -rw-r--r-- | Omni/Task/README.md | 376 | ||||
| -rw-r--r-- | Omni/Task/RaceTest.hs | 58 |
5 files changed, 2275 insertions, 0 deletions
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs new file mode 100644 index 0000000..c930b2c --- /dev/null +++ b/Omni/Task/Core.hs @@ -0,0 +1,1567 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- : dep http-api-data +module Omni.Task.Core where + +import Alpha +import Data.Aeson (FromJSON, ToJSON, decode, encode) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy.Char8 as BLC +import qualified Data.List as List +import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Data.Time (UTCTime, diffUTCTime, getCurrentTime) +import qualified Database.SQLite.Simple as SQL +import qualified Database.SQLite.Simple.FromField as SQL +import qualified Database.SQLite.Simple.Ok as SQLOk +import qualified Database.SQLite.Simple.ToField as SQL +import GHC.Generics () +import System.Directory (XdgDirectory (..), createDirectoryIfMissing, doesFileExist, getXdgDirectory) +import System.Environment (lookupEnv) +import System.FilePath (takeDirectory, (</>)) +import System.IO.Unsafe (unsafePerformIO) +import Web.HttpApiData (FromHttpApiData (..)) + +-- 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) + taskComplexity :: Maybe Int, -- Complexity 1-5 for model selection + taskDependencies :: [Dependency], -- List of dependencies with types + taskDescription :: Text, -- Required description + taskComments :: [Comment], -- Timestamped comments for extra context + taskCreatedAt :: UTCTime, + taskUpdatedAt :: UTCTime + } + deriving (Show, Eq, Generic) + +data TaskType = Epic | WorkTask | HumanTask + deriving (Show, Eq, Read, Generic) + +data Status = Draft | Open | InProgress | Review | Approved | Done + deriving (Show, Eq, Read, Generic) + +-- Priority levels (matching beads convention) +data Priority = P0 | P1 | P2 | P3 | P4 + deriving (Show, Eq, Ord, Read, 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, Read, Generic) + +data TaskProgress = TaskProgress + { progressTaskId :: Text, + progressTotal :: Int, + progressCompleted :: Int, + progressPercentage :: Int + } + deriving (Show, Eq, Generic) + +data EpicForReview = EpicForReview + { epicTask :: Task, + epicTotal :: Int, + epicCompleted :: Int + } + deriving (Show, Eq, Generic) + +data HumanActionItems = HumanActionItems + { failedTasks :: [Task], + epicsInReview :: [EpicForReview], + humanTasks :: [Task] + } + deriving (Show, Eq, Generic) + +data AggregatedMetrics = AggregatedMetrics + { aggTotalCostCents :: Int, + aggTotalDurationSeconds :: Int, + aggCompletedTasks :: Int, + aggTotalTokens :: Int + } + deriving (Show, Eq, Generic) + +-- Retry context for tasks that failed due to merge conflicts +data RetryContext = RetryContext + { retryTaskId :: Text, + retryOriginalCommit :: Text, + retryConflictFiles :: [Text], + retryAttempt :: Int, + retryReason :: Text, -- "merge_conflict" | "ci_failure" | "rejected" + retryNotes :: Maybe Text -- Human notes/guidance for intervention + } + deriving (Show, Eq, Generic) + +-- Activity stage for task_activity tracking +data ActivityStage = Claiming | Running | Reviewing | Retrying | Completed | Failed + deriving (Show, Eq, Read, Generic) + +-- Task activity log entry +data TaskActivity = TaskActivity + { activityId :: Maybe Int, -- NULL for new entries, set by DB + activityTaskId :: Text, + activityTimestamp :: UTCTime, + activityStage :: ActivityStage, + activityMessage :: Maybe Text, + activityMetadata :: Maybe Text, -- JSON for extra data + activityThreadUrl :: Maybe Text, -- Link to agent session (unused with native Engine) + activityStartedAt :: Maybe UTCTime, -- When work started + activityCompletedAt :: Maybe UTCTime, -- When work completed + activityCostCents :: Maybe Int, -- API cost in cents + activityTokensUsed :: Maybe Int -- Total tokens used + } + deriving (Show, Eq, Generic) + +-- Fact for knowledge base +data Fact = Fact + { factId :: Maybe Int, + factProject :: Text, + factContent :: Text, + factRelatedFiles :: [Text], + factSourceTask :: Maybe Text, + factConfidence :: Double, + factCreatedAt :: UTCTime + } + deriving (Show, Eq, Generic) + +-- Comment for task notes/context +data Comment = Comment + { commentText :: Text, + commentCreatedAt :: UTCTime + } + 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 + +instance ToJSON TaskProgress + +instance FromJSON TaskProgress + +instance ToJSON AggregatedMetrics + +instance FromJSON AggregatedMetrics + +instance ToJSON RetryContext + +instance FromJSON RetryContext + +instance ToJSON ActivityStage + +instance FromJSON ActivityStage + +instance ToJSON TaskActivity + +instance FromJSON TaskActivity + +instance ToJSON Fact + +instance FromJSON Fact + +instance ToJSON Comment + +instance FromJSON Comment + +-- HTTP API Instances (for Servant query params) + +instance FromHttpApiData Status where + parseQueryParam t + | T.null t = Left "No status provided" + | otherwise = case readMaybe (T.unpack t) of + Just s -> Right s + Nothing -> Left ("Invalid status: " <> t) + +instance FromHttpApiData Priority where + parseQueryParam t + | T.null t = Left "No priority provided" + | otherwise = case readMaybe (T.unpack t) of + Just p -> Right p + Nothing -> Left ("Invalid priority: " <> t) + +-- SQLite Instances + +instance SQL.FromField TaskType where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case readMaybe t of + Just x -> pure x + Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid TaskType" + +instance SQL.ToField TaskType where + toField x = SQL.toField (show x :: String) + +instance SQL.FromField Status where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case readMaybe t of + Just x -> pure x + Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid Status" + +instance SQL.ToField Status where + toField x = SQL.toField (show x :: String) + +instance SQL.FromField Priority where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case readMaybe t of + Just x -> pure x + Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid Priority" + +instance SQL.ToField Priority where + toField x = SQL.toField (show x :: String) + +instance SQL.FromField ActivityStage where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case readMaybe t of + Just x -> pure x + Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid ActivityStage" + +instance SQL.ToField ActivityStage where + toField x = SQL.toField (show x :: String) + +-- Store dependencies as JSON text +instance SQL.FromField [Dependency] where + fromField f = do + mt <- SQL.fromField f :: SQLOk.Ok (Maybe String) + case mt of + Nothing -> pure [] + Just t -> case Aeson.decode (BLC.pack t) of + Just x -> pure x + Nothing -> pure [] + +instance SQL.ToField [Dependency] where + toField deps = SQL.toField (BLC.unpack (encode deps)) + +-- Store comments as JSON text +instance SQL.FromField [Comment] where + fromField f = do + mt <- SQL.fromField f :: SQLOk.Ok (Maybe String) + case mt of + Nothing -> pure [] + Just t -> case Aeson.decode (BLC.pack t) of + Just x -> pure x + Nothing -> pure [] + +instance SQL.ToField [Comment] where + toField comments = SQL.toField (BLC.unpack (encode comments)) + +instance SQL.FromRow Task where + fromRow = + Task + </ SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field -- complexity + <*> SQL.field + <*> (fromMaybe "" </ SQL.field) -- Handle NULL description from legacy data + <*> SQL.field -- comments + <*> SQL.field + <*> SQL.field + +instance SQL.ToRow Task where + toRow t = + [ SQL.toField (taskId t), + SQL.toField (taskTitle t), + SQL.toField (taskType t), + SQL.toField (taskParent t), + SQL.toField (taskNamespace t), + SQL.toField (taskStatus t), + SQL.toField (taskPriority t), + SQL.toField (taskComplexity t), + SQL.toField (taskDependencies t), + SQL.toField (taskDescription t), + SQL.toField (taskComments t), + SQL.toField (taskCreatedAt t), + SQL.toField (taskUpdatedAt t) + ] + +instance SQL.FromRow TaskActivity where + fromRow = + TaskActivity + </ SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + +instance SQL.ToRow TaskActivity where + toRow a = + [ SQL.toField (activityId a), + SQL.toField (activityTaskId a), + SQL.toField (activityTimestamp a), + SQL.toField (activityStage a), + SQL.toField (activityMessage a), + SQL.toField (activityMetadata a), + SQL.toField (activityThreadUrl a), + SQL.toField (activityStartedAt a), + SQL.toField (activityCompletedAt a), + SQL.toField (activityCostCents a), + SQL.toField (activityTokensUsed a) + ] + +instance SQL.FromRow Fact where + fromRow = do + fid <- SQL.field + proj <- SQL.field + content <- SQL.field + (relatedFilesJson :: String) <- SQL.field + sourceTask <- SQL.field + confidence <- SQL.field + createdAt <- SQL.field + let relatedFiles = fromMaybe [] (decode (BLC.pack relatedFilesJson)) + pure + Fact + { factId = fid, + factProject = proj, + factContent = content, + factRelatedFiles = relatedFiles, + factSourceTask = sourceTask, + factConfidence = confidence, + factCreatedAt = createdAt + } + +instance SQL.ToRow Fact where + toRow f = + [ SQL.toField (factId f), + SQL.toField (factProject f), + SQL.toField (factContent f), + SQL.toField (BLC.unpack (encode (factRelatedFiles f))), + SQL.toField (factSourceTask f), + SQL.toField (factConfidence f), + SQL.toField (factCreatedAt f) + ] + +-- | 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)} + +-- Lock for application-level thread safety (Read-Calc-Write cycles) +taskLock :: MVar () +taskLock = unsafePerformIO (newMVar ()) +{-# NOINLINE taskLock #-} + +withTaskLock :: IO a -> IO a +withTaskLock action = withMVar taskLock (const action) + +-- Get the tasks database file path +getTasksDbPath :: IO FilePath +getTasksDbPath = do + customPath <- lookupEnv "TASK_DB_PATH" + testMode <- lookupEnv "TASK_TEST_MODE" + case (testMode, customPath) of + (Just "1", _) -> pure "_/tmp/tasks-test.db" + (_, Just p) -> pure p + _ -> do + xdgData <- getXdgDirectory XdgData "jr" + pure (xdgData </> "jr.db") + +-- DB Helper +withDb :: (SQL.Connection -> IO a) -> IO a +withDb action = do + dbPath <- getTasksDbPath + SQL.withConnection dbPath <| \conn -> do + SQL.execute_ conn "PRAGMA busy_timeout = 5000" + action conn + +-- Initialize the task database +initTaskDb :: IO () +initTaskDb = do + dbPath <- getTasksDbPath + createDirectoryIfMissing True (takeDirectory dbPath) + withDb <| \conn -> do + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS tasks (\ + \ id TEXT PRIMARY KEY, \ + \ title TEXT NOT NULL, \ + \ type TEXT NOT NULL, \ + \ parent TEXT, \ + \ namespace TEXT, \ + \ status TEXT NOT NULL, \ + \ priority TEXT NOT NULL, \ + \ complexity INTEGER, \ + \ dependencies TEXT NOT NULL, \ + \ description TEXT, \ + \ comments TEXT NOT NULL DEFAULT '[]', \ + \ created_at TIMESTAMP NOT NULL, \ + \ updated_at TIMESTAMP NOT NULL \ + \)" + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS id_counter (\ + \ id INTEGER PRIMARY KEY CHECK (id = 1), \ + \ counter INTEGER NOT NULL DEFAULT 0 \ + \)" + SQL.execute_ + conn + "INSERT OR IGNORE INTO id_counter (id, counter) VALUES (1, 0)" + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS retry_context (\ + \ task_id TEXT PRIMARY KEY, \ + \ original_commit TEXT NOT NULL, \ + \ conflict_files TEXT NOT NULL, \ + \ attempt INTEGER NOT NULL DEFAULT 1, \ + \ reason TEXT NOT NULL \ + \)" + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS task_activity (\ + \ id INTEGER PRIMARY KEY AUTOINCREMENT, \ + \ task_id TEXT NOT NULL, \ + \ timestamp DATETIME DEFAULT CURRENT_TIMESTAMP, \ + \ stage TEXT NOT NULL, \ + \ message TEXT, \ + \ metadata TEXT, \ + \ amp_thread_url TEXT, \ + \ started_at DATETIME, \ + \ completed_at DATETIME, \ + \ cost_cents INTEGER, \ + \ tokens_used INTEGER, \ + \ FOREIGN KEY (task_id) REFERENCES tasks(id) \ + \)" + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS facts (\ + \ id INTEGER PRIMARY KEY AUTOINCREMENT, \ + \ project TEXT NOT NULL, \ + \ fact TEXT NOT NULL, \ + \ related_files TEXT NOT NULL, \ + \ source_task TEXT, \ + \ confidence REAL NOT NULL, \ + \ created_at DATETIME DEFAULT CURRENT_TIMESTAMP \ + \)" + runMigrations conn + +-- | Run schema migrations to add missing columns to existing tables +runMigrations :: SQL.Connection -> IO () +runMigrations conn = do + migrateTable conn "task_activity" taskActivityColumns + migrateTable conn "tasks" tasksColumns + migrateTable conn "retry_context" retryContextColumns + migrateTable conn "facts" factsColumns + +-- | Expected columns for task_activity table (name, type, nullable) +taskActivityColumns :: [(Text, Text)] +taskActivityColumns = + [ ("id", "INTEGER"), + ("task_id", "TEXT"), + ("timestamp", "DATETIME"), + ("stage", "TEXT"), + ("message", "TEXT"), + ("metadata", "TEXT"), + ("amp_thread_url", "TEXT"), + ("started_at", "DATETIME"), + ("completed_at", "DATETIME"), + ("cost_cents", "INTEGER"), + ("tokens_used", "INTEGER") + ] + +-- | Expected columns for tasks table +tasksColumns :: [(Text, Text)] +tasksColumns = + [ ("id", "TEXT"), + ("title", "TEXT"), + ("type", "TEXT"), + ("parent", "TEXT"), + ("namespace", "TEXT"), + ("status", "TEXT"), + ("priority", "TEXT"), + ("complexity", "INTEGER"), + ("dependencies", "TEXT"), + ("description", "TEXT"), + ("comments", "TEXT"), + ("created_at", "TIMESTAMP"), + ("updated_at", "TIMESTAMP") + ] + +-- | Expected columns for retry_context table +retryContextColumns :: [(Text, Text)] +retryContextColumns = + [ ("task_id", "TEXT"), + ("original_commit", "TEXT"), + ("conflict_files", "TEXT"), + ("attempt", "INTEGER"), + ("reason", "TEXT"), + ("notes", "TEXT") + ] + +-- | Expected columns for facts table +factsColumns :: [(Text, Text)] +factsColumns = + [ ("id", "INTEGER"), + ("project", "TEXT"), + ("fact", "TEXT"), + ("related_files", "TEXT"), + ("source_task", "TEXT"), + ("confidence", "REAL"), + ("created_at", "DATETIME") + ] + +-- | Migrate a table by adding any missing columns +migrateTable :: SQL.Connection -> Text -> [(Text, Text)] -> IO () +migrateTable conn tableName expectedCols = do + existingCols <- getTableColumns conn tableName + let missingCols = filter (\(name, _) -> name `notElem` existingCols) expectedCols + traverse_ (addColumn conn tableName) missingCols + +-- | Get list of column names for a table using PRAGMA table_info +getTableColumns :: SQL.Connection -> Text -> IO [Text] +getTableColumns conn tableName = do + let query = SQL.Query <| "PRAGMA table_info(" <> tableName <> ")" + rows <- SQL.query_ conn query :: IO [(Int, Text, Text, Int, Maybe Text, Int)] + pure [colName | (_, colName, _, _, _, _) <- rows] + +-- | Add a column to a table +addColumn :: SQL.Connection -> Text -> (Text, Text) -> IO () +addColumn conn tableName (colName, colType) = do + let sql = "ALTER TABLE " <> tableName <> " ADD COLUMN " <> colName <> " " <> colType + SQL.execute_ conn (SQL.Query sql) + +-- Generate a sequential task ID (t-1, t-2, t-3, ...) +generateId :: IO Text +generateId = do + counter <- getNextCounter + pure <| "t-" <> T.pack (show counter) + +-- Get the next counter value (atomically increments) +getNextCounter :: IO Int +getNextCounter = + withDb <| \conn -> do + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS id_counter (\ + \ id INTEGER PRIMARY KEY CHECK (id = 1), \ + \ counter INTEGER NOT NULL DEFAULT 0 \ + \)" + SQL.execute_ conn "INSERT OR IGNORE INTO id_counter (id, counter) VALUES (1, 0)" + SQL.execute_ conn "UPDATE id_counter SET counter = counter + 1 WHERE id = 1" + [SQL.Only c] <- SQL.query_ conn "SELECT counter FROM id_counter WHERE id = 1" :: IO [SQL.Only Int] + pure c + +-- Generate a child ID based on parent ID +generateChildId :: Text -> IO Text +generateChildId parentId = do + tasks <- loadTasks + pure <| computeNextChildId tasks (normalizeId parentId) + +computeNextChildId :: [Task] -> Text -> Text +computeNextChildId tasks parentId = + 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 + +-- Load all tasks from DB +loadTasks :: IO [Task] +loadTasks = + withDb <| \conn -> do + SQL.query_ conn "SELECT id, title, type, parent, namespace, status, priority, complexity, dependencies, description, comments, created_at, updated_at FROM tasks" + +-- Save a single task (UPSERT) +saveTask :: Task -> IO () +saveTask task = + withDb <| \conn -> do + SQL.execute + conn + "INSERT OR REPLACE INTO tasks \ + \ (id, title, type, parent, namespace, status, priority, complexity, dependencies, description, comments, created_at, updated_at) \ + \ VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + task + +-- Create a new task +createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> Maybe Int -> [Dependency] -> Text -> IO Task +createTask title taskType parent namespace priority complexity deps description = + withTaskLock <| do + let parent' = fmap normalizeId parent + deps' = map normalizeDependency deps + + tid <- case parent' of + Nothing -> generateUniqueId + Just pid -> do + tasks <- loadTasks + pure <| computeNextChildId tasks pid + now <- getCurrentTime + let task = + Task + { taskId = normalizeId tid, + taskTitle = title, + taskType = taskType, + taskParent = parent', + taskNamespace = namespace, + taskStatus = Open, + taskPriority = priority, + taskComplexity = complexity, + taskDependencies = deps', + taskDescription = description, + taskComments = [], + taskCreatedAt = now, + taskUpdatedAt = now + } + saveTask task + pure task + +-- Generate a unique ID +generateUniqueId :: IO Text +generateUniqueId = do + -- We can query DB directly to check existence + go + where + go = do + tid <- generateId + exists <- + withDb <| \conn -> do + [SQL.Only c] <- SQL.query conn "SELECT COUNT(*) FROM tasks WHERE id = ?" (SQL.Only tid) :: IO [SQL.Only Int] + pure (c > 0) + if exists then go else pure tid + +-- Update task status +updateTaskStatus :: Text -> Status -> [Dependency] -> IO () +updateTaskStatus tid newStatus newDeps = + withTaskLock + <| withDb + <| \conn -> do + now <- getCurrentTime + -- If newDeps is empty, we need to preserve existing deps. + -- If newDeps is NOT empty, we replace them. + -- This logic is slightly tricky in SQL. We fetch first. + rows <- SQL.query conn "SELECT dependencies FROM tasks WHERE id = ?" (SQL.Only tid) :: IO [SQL.Only [Dependency]] + case rows of + [] -> pure () -- Task not found + (SQL.Only existingDeps : _) -> do + let finalDeps = if null newDeps then existingDeps else newDeps + SQL.execute + conn + "UPDATE tasks SET status = ?, updated_at = ?, dependencies = ? WHERE id = ?" + (newStatus, now, finalDeps, tid) + +-- Edit a task +editTask :: Text -> (Task -> Task) -> IO Task +editTask tid modifyFn = + withTaskLock <| do + tasks <- loadTasks + case findTask tid tasks of + Nothing -> panic "Task not found" + Just original -> do + now <- getCurrentTime + let modified = modifyFn original + finalTask = modified {taskUpdatedAt = now} + saveTask finalTask + pure finalTask + +-- Delete a task +deleteTask :: Text -> IO () +deleteTask tid = + withDb <| \conn -> + SQL.execute conn "DELETE FROM tasks WHERE id = ?" (SQL.Only tid) + +-- Add a comment to a task +addComment :: Text -> Text -> IO Task +addComment tid commentText = + withTaskLock <| do + tasks <- loadTasks + case findTask tid tasks of + Nothing -> panic "Task not found" + Just task -> do + now <- getCurrentTime + let newComment = Comment {commentText = commentText, commentCreatedAt = now} + updatedTask = task {taskComments = taskComments task ++ [newComment], taskUpdatedAt = now} + saveTask updatedTask + pure updatedTask + +-- List tasks +listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task] +listTasks maybeType maybeParent maybeStatus maybeNamespace = do + -- Implementing specific filters in SQL would be more efficient, but for MVP and API compat: + 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 +getReadyTasks :: IO [Task] +getReadyTasks = do + allTasks <- loadTasks + retryContexts <- getAllRetryContexts + let openTasks = filter (\t -> taskStatus t `elem` [Open, InProgress]) allTasks + doneIds = map taskId <| filter (\t -> taskStatus t == Done) allTasks + + parentIds = mapMaybe taskParent allTasks + isParent tid = tid `elem` parentIds + + -- Tasks with retry_attempt >= 3 need human intervention + needsInterventionIds = [retryTaskId ctx | ctx <- retryContexts, retryAttempt ctx >= 3] + + 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) + && taskType task + /= HumanTask + && taskId task + `notElem` needsInterventionIds + pure <| filter isReady openTasks + +-- Get dependency tree +getDependencyTree :: Text -> IO [Task] +getDependencyTree tid = do + tasks <- loadTasks + case findTask tid tasks of + Nothing -> pure [] + Just task -> pure <| collectDeps tasks task + where + 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 + -- Could be SQL optimized + tasks <- loadTasks + 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 + } + +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)) <> "%)" + +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 + +getTaskTree :: Maybe Text -> IO [Task] +getTaskTree maybeId = do + tasks <- loadTasks + case maybeId of + Nothing -> do + let epics = filter (\t -> taskType t == Epic) tasks + in pure <| concatMap (collectChildren tasks) epics + Just tid -> do + case findTask tid tasks of + Nothing -> pure [] + Just task -> pure <| collectChildren tasks task + where + collectChildren allTasks task = + let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks + in task : concatMap (collectChildren allTasks) children + +showTaskTree :: Maybe Text -> IO () +showTaskTree maybeId = do + tasks <- loadTasks + case maybeId of + Nothing -> do + let epics = filter (\t -> taskType t == Epic) tasks + if null epics + then putText "No epics found" + else traverse_ (printEpicTree tasks) epics + Just tid -> do + case findTask tid tasks of + Nothing -> putText "Task not found" + Just task -> printEpicTree tasks task + where + printEpicTree allTasks task = printTreeNode allTasks task (0 :: Int) + + printTreeNode allTasks task indent = printTreeNode' allTasks task indent [] + + printTreeNode' allTasks task indent ancestry = do + let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks + 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 + 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) <> "]" + _ -> case taskStatus task of + Draft -> "[.]" + Open -> "[ ]" + InProgress -> "[~]" + Review -> "[?]" + Approved -> "[+]" + Done -> "[✓]" + + coloredStatusStr = case taskType task of + Epic -> magenta statusStr + _ -> case taskStatus task of + Draft -> gray statusStr + 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 + + 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 + + let indexedChildren = zip [1 ..] children + totalChildren = length children + traverse_ + ( \(idx, child) -> + let hasMoreSiblings = idx < totalChildren + in printTreeNode' allTasks child (indent + 1) (ancestry ++ [hasMoreSiblings]) + ) + indexedChildren + +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 + Draft -> gray s + 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 + +showTaskDetailed :: Task -> IO () +showTaskDetailed t = do + tasks <- loadTasks + putText "" + putText <| "Title: " <> taskTitle t <> " (ID: " <> taskId t <> ")" + putText <| "Type: " <> T.pack (show (taskType t)) + putText <| "Status: " <> T.pack (show (taskStatus t)) + putText <| "Priority: " <> T.pack (show (taskPriority t)) <> priorityDesc + + 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)) + + unless (null (taskDependencies t)) <| do + putText "" + putText "Dependencies:" + traverse_ printDependency (taskDependencies t) + + unless (T.null (taskDescription t)) <| do + putText "" + putText "Description:" + let indented = T.unlines <| map (" " <>) (T.lines (taskDescription t)) + putText indented + + unless (null (taskComments t)) <| do + putText "" + putText "Comments:" + traverse_ printComment (taskComments 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)) <> "]" + + printComment c = + putText <| " [" <> T.pack (show (commentCreatedAt c)) <> "] " <> commentText c + +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: Dump SQLite to JSONL +exportTasks :: Maybe FilePath -> IO () +exportTasks maybePath = do + tasks <- loadTasks + case maybePath of + Just path -> do + TIO.writeFile path "" + traverse_ (saveTaskToJsonl path) tasks + Nothing -> + -- Stream to stdout + traverse_ (BLC.putStrLn <. encode) tasks + +saveTaskToJsonl :: FilePath -> Task -> IO () +saveTaskToJsonl path task = do + let json = encode task + BLC.appendFile path (json <> "\n") + +data TaskStats = TaskStats + { totalTasks :: Int, + draftTasks :: 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 + +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 + readyCount = length <| filter (\t -> taskId t `elem` readyIds) targetTasks + + tasks = targetTasks + total = length tasks + draft = length <| filter (\t -> taskStatus t == Draft) 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 - draft + 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) + ] + 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, + draftTasks = draft, + openTasks = open, + inProgressTasks = inProg, + reviewTasks = review, + approvedTasks = approved, + doneTasks = done, + totalEpics = epics, + readyTasks = readyCount', + blockedTasks = blockedCount, + tasksByPriority = byPriority, + tasksByNamespace = byNamespace + } + +getAllDescendants :: [Task] -> Text -> [Task] +getAllDescendants allTasks parentId = + let children = filter (maybe False (`matchesId` parentId) <. taskParent) allTasks + in children ++ concatMap (getAllDescendants allTasks <. taskId) children + +computeTaskStatsFromList :: [Task] -> TaskStats +computeTaskStatsFromList tasks = + let total = length tasks + draft = length [t | t <- tasks, taskStatus t == Draft] + open = length [t | t <- tasks, taskStatus t == Open] + inProg = length [t | t <- tasks, taskStatus t == InProgress] + review = length [t | t <- tasks, taskStatus t == Review] + approved = length [t | t <- tasks, taskStatus t == Approved] + done = length [t | t <- tasks, taskStatus t == Done] + epics = length [t | t <- tasks, taskType t == Epic] + readyCount = open + inProg + blockedCount = 0 + byPriority = + [ (P0, length [t | t <- tasks, taskPriority t == P0]), + (P1, length [t | t <- tasks, taskPriority t == P1]), + (P2, length [t | t <- tasks, taskPriority t == P2]), + (P3, length [t | t <- tasks, taskPriority t == P3]), + (P4, length [t | t <- tasks, taskPriority t == P4]) + ] + namespaces = mapMaybe taskNamespace tasks + uniqueNs = List.nub namespaces + byNamespace = [(ns, length [t | t <- tasks, taskNamespace t == Just ns]) | ns <- uniqueNs] + in TaskStats + { totalTasks = total, + draftTasks = draft, + openTasks = open, + inProgressTasks = inProg, + reviewTasks = review, + approvedTasks = approved, + doneTasks = done, + totalEpics = epics, + readyTasks = readyCount, + blockedTasks = blockedCount, + tasksByPriority = byPriority, + tasksByNamespace = byNamespace + } + +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 <| " Draft: " <> T.pack (show (draftTasks 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 JSONL and insert/update DB +importTasks :: FilePath -> IO () +importTasks filePath = do + exists <- doesFileExist filePath + unless exists <| panic (T.pack filePath <> " does not exist") + + content <- TIO.readFile filePath + let importLines = T.lines content + importedTasks = map normalizeTask (mapMaybe decodeTask importLines) + + -- Save all imported tasks (UPSERT logic handles updates) + traverse_ saveTask importedTasks + where + decodeTask :: Text -> Maybe Task + decodeTask line = + if T.null line + then Nothing + else decode (BLC.pack <| T.unpack line) + +-- Retry context management + +-- | Get retry context for a task (if any) +getRetryContext :: Text -> IO (Maybe RetryContext) +getRetryContext tid = + withDb <| \conn -> do + rows <- + SQL.query + conn + "SELECT task_id, original_commit, conflict_files, attempt, reason, notes FROM retry_context WHERE task_id = ?" + (SQL.Only tid) :: + IO [(Text, Text, Text, Int, Text, Maybe Text)] + case rows of + [] -> pure Nothing + ((taskId', commit, filesJson, attempt, reason, notes) : _) -> + let files = fromMaybe [] (decode (BLC.pack <| T.unpack filesJson)) + in pure + <| Just + RetryContext + { retryTaskId = taskId', + retryOriginalCommit = commit, + retryConflictFiles = files, + retryAttempt = attempt, + retryReason = reason, + retryNotes = notes + } + +-- | Set retry context for a task (upsert) +setRetryContext :: RetryContext -> IO () +setRetryContext ctx = + withDb <| \conn -> do + let filesJson = T.pack <| BLC.unpack <| encode (retryConflictFiles ctx) + SQL.execute + conn + "INSERT OR REPLACE INTO retry_context (task_id, original_commit, conflict_files, attempt, reason, notes) VALUES (?, ?, ?, ?, ?, ?)" + (retryTaskId ctx, retryOriginalCommit ctx, filesJson, retryAttempt ctx, retryReason ctx, retryNotes ctx) + +-- | Clear retry context for a task (on successful merge) +clearRetryContext :: Text -> IO () +clearRetryContext tid = + withDb <| \conn -> + SQL.execute conn "DELETE FROM retry_context WHERE task_id = ?" (SQL.Only tid) + +-- | Increment retry attempt and return new count +incrementRetryAttempt :: Text -> IO Int +incrementRetryAttempt tid = do + maybeCtx <- getRetryContext tid + case maybeCtx of + Nothing -> pure 1 + Just ctx -> do + let newAttempt = retryAttempt ctx + 1 + setRetryContext ctx {retryAttempt = newAttempt} + pure newAttempt + +-- | Log activity to the task_activity table +logActivity :: Text -> ActivityStage -> Maybe Text -> IO () +logActivity tid stage metadata = + withDb <| \conn -> + SQL.execute + conn + "INSERT INTO task_activity (task_id, stage, message, metadata) VALUES (?, ?, ?, ?)" + (tid, show stage :: String, Nothing :: Maybe Text, metadata) + +-- | Log activity with worker metrics (amp thread URL, timing, cost) +logActivityWithMetrics :: Text -> ActivityStage -> Maybe Text -> Maybe Text -> Maybe UTCTime -> Maybe UTCTime -> Maybe Int -> Maybe Int -> IO Int +logActivityWithMetrics tid stage metadata ampUrl startedAt completedAt costCents tokens = + withDb <| \conn -> do + SQL.execute + conn + "INSERT INTO task_activity (task_id, stage, message, metadata, amp_thread_url, started_at, completed_at, cost_cents, tokens_used) \ + \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)" + (tid, show stage :: String, Nothing :: Maybe Text, metadata, ampUrl, startedAt, completedAt, costCents, tokens) + [SQL.Only actId] <- SQL.query_ conn "SELECT last_insert_rowid()" :: IO [SQL.Only Int] + pure actId + +-- | Update an existing activity record with metrics +updateActivityMetrics :: Int -> Maybe Text -> Maybe UTCTime -> Maybe Int -> Maybe Int -> IO () +updateActivityMetrics actId ampUrl completedAt costCents tokens = + withDb <| \conn -> + SQL.execute + conn + "UPDATE task_activity SET amp_thread_url = COALESCE(?, amp_thread_url), \ + \completed_at = COALESCE(?, completed_at), \ + \cost_cents = COALESCE(?, cost_cents), \ + \tokens_used = COALESCE(?, tokens_used) \ + \WHERE id = ?" + (ampUrl, completedAt, costCents, tokens, actId) + +-- | Get all activities for a task, ordered by timestamp descending +getActivitiesForTask :: Text -> IO [TaskActivity] +getActivitiesForTask tid = + withDb <| \conn -> + SQL.query + conn + "SELECT id, task_id, timestamp, stage, message, metadata, \ + \amp_thread_url, started_at, completed_at, cost_cents, tokens_used \ + \FROM task_activity WHERE task_id = ? ORDER BY timestamp DESC" + (SQL.Only tid) + +-- | Get the most recent running activity for a task (for metrics display) +getLatestRunningActivity :: Text -> IO (Maybe TaskActivity) +getLatestRunningActivity tid = do + activities <- getActivitiesForTask tid + pure <| List.find (\a -> activityStage a == Running) activities + +-- | Get aggregated metrics for all descendants of an epic +getAggregatedMetrics :: Text -> IO AggregatedMetrics +getAggregatedMetrics epicId = do + allTasks <- loadTasks + let descendants = getAllDescendants allTasks epicId + descendantIds = map taskId descendants + completedCount = length [t | t <- descendants, taskStatus t == Done] + activities <- concat </ traverse getActivitiesForTask descendantIds + let totalCost = sum [c | act <- activities, Just c <- [activityCostCents act]] + totalTokens = sum [t | act <- activities, Just t <- [activityTokensUsed act]] + totalDuration = sum [calcDuration act | act <- activities] + pure + AggregatedMetrics + { aggTotalCostCents = totalCost, + aggTotalDurationSeconds = totalDuration, + aggCompletedTasks = completedCount, + aggTotalTokens = totalTokens + } + where + calcDuration act = case (activityStartedAt act, activityCompletedAt act) of + (Just start, Just end) -> floor (diffUTCTime end start) + _ -> 0 + +-- | Get aggregated metrics for all tasks globally (not scoped to an epic) +getGlobalAggregatedMetrics :: IO AggregatedMetrics +getGlobalAggregatedMetrics = do + allTasks <- loadTasks + let completedCount = length [t | t <- allTasks, taskStatus t == Done] + taskIds = map taskId allTasks + activities <- concat </ traverse getActivitiesForTask taskIds + let totalCost = sum [c | act <- activities, Just c <- [activityCostCents act]] + totalTokens = sum [t | act <- activities, Just t <- [activityTokensUsed act]] + totalDuration = sum [calcDuration act | act <- activities] + pure + AggregatedMetrics + { aggTotalCostCents = totalCost, + aggTotalDurationSeconds = totalDuration, + aggCompletedTasks = completedCount, + aggTotalTokens = totalTokens + } + where + calcDuration act = case (activityStartedAt act, activityCompletedAt act) of + (Just start, Just end) -> floor (diffUTCTime end start) + _ -> 0 + +-- | Get tasks with unmet blocking dependencies (not ready, not done) +getBlockedTasks :: IO [Task] +getBlockedTasks = do + allTasks <- loadTasks + readyTasks <- getReadyTasks + let readyIds = map taskId readyTasks + doneIds = [taskId t | t <- allTasks, taskStatus t == Done] + isBlocked task = + taskStatus task + `elem` [Open, InProgress] + && taskId task + `notElem` readyIds + && taskId task + `notElem` doneIds + pure [t | t <- allTasks, isBlocked t] + +-- | Count how many tasks are transitively blocked by this task +getBlockingImpact :: [Task] -> Task -> Int +getBlockingImpact allTasks task = + length (getTransitiveDependents allTasks (taskId task)) + +-- | Get all tasks that depend on this task (directly or transitively) +-- Uses a Set to track visited nodes and avoid infinite loops from circular deps +getTransitiveDependents :: [Task] -> Text -> [Task] +getTransitiveDependents allTasks tid = go Set.empty [tid] + where + go :: Set.Set Text -> [Text] -> [Task] + go _ [] = [] + go visited (current : rest) + | Set.member current visited = go visited rest + | otherwise = + let directDeps = [t | t <- allTasks, dependsOnTask current t] + newIds = [taskId t | t <- directDeps, not (Set.member (taskId t) visited)] + visited' = Set.insert current visited + in directDeps ++ go visited' (newIds ++ rest) + +-- | Check if task depends on given ID with Blocks dependency type +dependsOnTask :: Text -> Task -> Bool +dependsOnTask tid task = + any (\d -> matchesId (depId d) tid && depType d == Blocks) (taskDependencies task) + +-- | Get tasks that have failed 3+ times and need human intervention +getInterventionTasks :: IO [Task] +getInterventionTasks = do + allTasks <- loadTasks + retryContexts <- getAllRetryContexts + let highRetryIds = [retryTaskId ctx | ctx <- retryContexts, retryAttempt ctx >= 3] + pure [t | t <- allTasks, taskId t `elem` highRetryIds] + +-- | Get all items needing human action +getHumanActionItems :: IO HumanActionItems +getHumanActionItems = do + allTasks <- loadTasks + retryContexts <- getAllRetryContexts + let highRetryIds = [retryTaskId ctx | ctx <- retryContexts, retryAttempt ctx >= 3] + failed = [t | t <- allTasks, taskId t `elem` highRetryIds] + epics = [t | t <- allTasks, taskType t == Epic, taskStatus t /= Done] + epicsReady = + [ EpicForReview + { epicTask = e, + epicTotal = total, + epicCompleted = completed + } + | e <- epics, + let children = [c | c <- allTasks, taskParent c == Just (taskId e)], + let total = length children, + total > 0, + let completed = length [c | c <- children, taskStatus c == Done], + completed == total + ] + human = [t | t <- allTasks, taskType t == HumanTask, taskStatus t == Open] + pure + HumanActionItems + { failedTasks = failed, + epicsInReview = epicsReady, + humanTasks = human + } + +-- | Get all retry contexts from the database +getAllRetryContexts :: IO [RetryContext] +getAllRetryContexts = + withDb <| \conn -> do + rows <- + SQL.query_ + conn + "SELECT task_id, original_commit, conflict_files, attempt, reason, notes FROM retry_context" :: + IO [(Text, Text, Text, Int, Text, Maybe Text)] + pure + [ RetryContext + { retryTaskId = tid, + retryOriginalCommit = commit, + retryConflictFiles = fromMaybe [] (decode (BLC.pack (T.unpack filesJson))), + retryAttempt = attempt, + retryReason = reason, + retryNotes = notes + } + | (tid, commit, filesJson, attempt, reason, notes) <- rows + ] + +-- | Update just the notes field for a retry context +updateRetryNotes :: Text -> Text -> IO () +updateRetryNotes tid notes = do + maybeCtx <- getRetryContext tid + case maybeCtx of + Nothing -> + setRetryContext + RetryContext + { retryTaskId = tid, + retryOriginalCommit = "", + retryConflictFiles = [], + retryAttempt = 0, + retryReason = "", + retryNotes = Just notes + } + Just ctx -> + setRetryContext ctx {retryNotes = Just notes} + +-- Fact management + +-- | Save a fact to the database +saveFact :: Fact -> IO Int +saveFact f = + withDb <| \conn -> do + let filesJson = T.pack <| BLC.unpack <| encode (factRelatedFiles f) + SQL.execute + conn + "INSERT INTO facts (project, fact, related_files, source_task, confidence, created_at) \ + \VALUES (?, ?, ?, ?, ?, ?)" + (factProject f, factContent f, filesJson, factSourceTask f, factConfidence f, factCreatedAt f) + [SQL.Only factIdVal] <- SQL.query_ conn "SELECT last_insert_rowid()" :: IO [SQL.Only Int] + pure factIdVal + +-- | Load all facts from the database +loadFacts :: IO [Fact] +loadFacts = + withDb <| \conn -> + SQL.query_ + conn + "SELECT id, project, fact, related_files, source_task, confidence, created_at FROM facts" + +-- | Get facts for a specific project +getFactsForProject :: Text -> IO [Fact] +getFactsForProject proj = + withDb <| \conn -> + SQL.query + conn + "SELECT id, project, fact, related_files, source_task, confidence, created_at \ + \FROM facts WHERE project = ? ORDER BY confidence DESC" + (SQL.Only proj) + +-- | Get facts related to a specific file +getFactsForFile :: Text -> IO [Fact] +getFactsForFile filePath = + withDb <| \conn -> + SQL.query + conn + "SELECT id, project, fact, related_files, source_task, confidence, created_at \ + \FROM facts WHERE related_files LIKE ? ORDER BY confidence DESC" + (SQL.Only ("%" <> filePath <> "%")) + +-- | Delete a fact by ID +deleteFact :: Int -> IO () +deleteFact fid = + withDb <| \conn -> + SQL.execute conn "DELETE FROM facts WHERE id = ?" (SQL.Only fid) diff --git a/Omni/Task/DESIGN.md b/Omni/Task/DESIGN.md new file mode 100644 index 0000000..0dbf3b5 --- /dev/null +++ b/Omni/Task/DESIGN.md @@ -0,0 +1,232 @@ +# Task Manager Improvement Plan + +Based on beads project planning patterns, here are proposed improvements for Omni/Task.hs. + +## Current State + +**What we have:** +- ✅ Basic CRUD operations (create, list, update, ready) +- ✅ Dependency tracking (--deps for blocking) +- ✅ JSONL storage with git sync +- ✅ Short base62 task IDs +- ✅ Optional namespace field +- ✅ Project field for grouping +- ✅ Three status levels (open, in-progress, done) + +**What we're missing:** +- ❌ Multiple dependency types (blocks, discovered-from, parent-child, related) +- ❌ Hierarchical task IDs (parent.1, parent.2) +- ❌ Task types (epic vs task) - epics will replace "project" +- ❌ Dependency tree visualization +- ❌ Work discovery tracking +- ❌ Epic/child task relationships + +## Proposed Improvements (Priority Order) + +### Phase 1: Core Features (High Priority) + +#### 1.1 Add Task Types (Epic vs Task) +```haskell +data TaskType = Epic | Task + deriving (Show, Eq, Generic) +``` + +**Benefits:** +- Epics are containers for related tasks (replace "project" concept) +- Tasks are the actual work items +- Simple two-level hierarchy +- Epic-based planning support + +**Schema Changes:** +- Replace `taskProject :: Text` with `taskType :: TaskType` +- Add `taskParent :: Maybe Text` for parent epic +- Epics can contain tasks or other epics (for nested structure) + +**Commands:** +```bash +# Create an epic (container) +task create "User Authentication System" --type=epic + +# Create tasks within an epic +task create "Design API" --type=task --parent=t-abc123 +task create "Implement JWT" --type=task --parent=t-abc123 + +# Create a sub-epic (optional, for complex projects) +task create "OAuth Integration" --type=epic --parent=t-abc123 +``` + +#### 1.2 Enhanced Dependency Types +```haskell +data DependencyType = Blocks | DiscoveredFrom | ParentChild | Related + deriving (Show, Eq, Generic) +``` + +**Benefits:** +- Track work discovery context +- Maintain audit trail +- Support epic hierarchies + +**Commands:** +```bash +task create "Fix bug" project --discovered-from=t-abc123 +task create "Subtask 1" project --parent=t-epic-id +task dep add t-123 t-124 --type=related +``` + +### Phase 2: Hierarchical Tasks (Medium Priority) + +#### 2.1 Parent-Child Task IDs +**Pattern:** `t-abc123.1`, `t-abc123.2`, `t-abc123.3` + +**Benefits:** +- Human-friendly sequential IDs under epic +- Natural work breakdown +- Up to 3 levels of nesting + +**Schema Changes:** +```haskell +data Task = Task + { ... + taskParent :: Maybe Text -- Parent task ID + ... + } + +-- New table for child counters +CREATE TABLE child_counters ( + parent_id TEXT PRIMARY KEY, + last_child INTEGER NOT NULL DEFAULT 0, + FOREIGN KEY (parent_id) REFERENCES tasks(id) ON DELETE CASCADE +); +``` + +**Commands:** +```bash +task create "Design auth API" project --parent=t-abc123 +# Creates: t-abc123.1 + +task create "Implement JWT" project --parent=t-abc123 +# Creates: t-abc123.2 +``` + +#### 2.2 Dependency Tree Visualization +```bash +task tree t-epic-id +# Shows: +# t-abc123 [Epic] User Authentication System +# t-abc123.1 [Task] Design auth API +# t-abc123.2 [Task] Implement JWT +# t-abc123.2.1 [Task] Add token generation +# t-abc123.2.2 [Task] Add token validation +# t-abc123.3 [Task] Add password hashing +``` + +### Phase 3: Project Management (Lower Priority) + +#### 3.1 Task Filtering and Queries +```bash +task list --type=epic +task list --status=open +task list --parent=t-epic-id # List all children +``` + +#### 3.2 Epic Statistics +```bash +task stats # Overall stats +task stats --epic=t-abc123 # Epic-specific +task progress t-epic-id # Epic completion % +``` + +#### 3.3 Discovered Work Tracking +```bash +task create "Found memory leak" project --discovered-from=t-abc123 +# Automatically links context +# Shows in dependency tree as "discovered during t-abc123" +``` + +## Implementation Strategy + +### Milestone 1: Type System Foundations +- [ ] Add TaskType enum (Epic | Task) +- [ ] Add DependencyType enum +- [ ] Update Task data structure (replace project with type and parent) +- [ ] Update CLI commands +- [ ] Update tests +- [ ] Update AGENTS.md +- [ ] Migration: existing tasks default to type=Task, project becomes epic name + +### Milestone 2: Enhanced Dependencies +- [ ] Add `discovered-from` support +- [ ] Add `related` dependency type +- [ ] Track dependency metadata (who, when, why) +- [ ] Update ready work algorithm to respect dependency types + +### Milestone 3: Hierarchical Structure +- [ ] Add parent field to Task +- [ ] Implement child ID generation (t-abc123.1) +- [ ] Add child_counters table/storage +- [ ] Update createTask to handle --parent flag +- [ ] Implement parent-child dependency creation + +### Milestone 4: Visualization & Reporting +- [ ] Implement `task tree` command +- [ ] Implement `task stats` command +- [ ] Implement `task progress` for epics +- [ ] Add filtering by type, priority +- [ ] Improve task list display with colors/formatting + +## Open Questions + +1. **Storage Format**: Should we keep JSONL or move to SQLite like beads? + - JSONL: Simple, git-friendly, human-readable + - SQLite: Fast queries, complex relationships, beads-compatible + - **Recommendation**: Start with JSONL, can add SQLite later for caching + +2. **Child Counter Storage**: Where to store child counters? + - Option A: Separate .tasks/counters.jsonl file + - Option B: In-memory during session, persist to JSONL + - Option C: Add SQLite just for this + - **Recommendation**: Option A - separate JSONL file + +3. **Dependency Storage**: How to store complex dependencies? + - Current: List of text IDs in task + - Beads: Separate dependencies table + - **Recommendation**: Add dependencies field with type info: + ```haskell + data Dependency = Dependency + { depId :: Text + , depType :: DependencyType + } + ``` + +4. **Backward Compatibility**: How to handle existing tasks? + - Add sensible defaults (type=Task, priority=Medium) + - Migration script or auto-upgrade on load? + - **Recommendation**: Auto-upgrade with defaults on import + +## Benefits Summary + +**For AI Agents:** +- Better work discovery and context tracking +- Clearer project structure +- Easier to understand what work is related +- Natural way to break down large tasks + +**For Humans:** +- Epic-based planning for large features +- Priority-driven work queue +- Visual dependency trees +- Better project tracking and reporting + +**For Collaboration:** +- Discovered work maintains context +- Related work is easily found +- Epic structure provides clear organization +- Dependency tracking prevents duplicate work + +## Next Steps + +1. Create tasks for each milestone +2. Start with Milestone 1 (Type System Foundations) +3. Get feedback on hierarchical ID format +4. Implement incrementally, test thoroughly +5. Update AGENTS.md with new patterns diff --git a/Omni/Task/MigrationTest.hs b/Omni/Task/MigrationTest.hs new file mode 100644 index 0000000..f16f782 --- /dev/null +++ b/Omni/Task/MigrationTest.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Omni.Task.MigrationTest where + +import Alpha +import qualified Data.Set as Set +import Omni.Task.Core +import qualified Omni.Test as Test +import System.Directory (doesFileExist, removeFile) +import System.Environment (setEnv) + +test :: Test.Tree +test = Test.group "Omni.Task.Migration" [migrationStartupTest] + +migrationStartupTest :: Test.Tree +migrationStartupTest = + Test.unit "database initializes with schema migrations" <| do + setEnv "TASK_TEST_MODE" "1" + + let testFile = "_/tmp/tasks-test.db" + exists <- doesFileExist testFile + when exists <| removeFile testFile + + initTaskDb + + withDb <| \conn -> do + tasksCols <- getTableColumns conn "tasks" + activityCols <- getTableColumns conn "task_activity" + retryCols <- getTableColumns conn "retry_context" + + Set.fromList ["id", "title", "status"] + `Set.isSubsetOf` Set.fromList tasksCols + Test.@?= True + Set.fromList ["id", "task_id", "stage"] + `Set.isSubsetOf` Set.fromList activityCols + Test.@?= True + Set.fromList ["task_id", "attempt", "reason"] + `Set.isSubsetOf` Set.fromList retryCols + Test.@?= True + + removeFile testFile diff --git a/Omni/Task/README.md b/Omni/Task/README.md new file mode 100644 index 0000000..463c9e5 --- /dev/null +++ b/Omni/Task/README.md @@ -0,0 +1,376 @@ +# Task Manager for AI Agents + +The task manager is a dependency-aware issue tracker inspired by beads. It uses: +- **Storage**: SQLite database (`~/.cache/omni/tasks/tasks.db`) +- **Dependencies**: Tasks can block other tasks +- **Ready work detection**: Automatically finds unblocked tasks + +**IMPORTANT**: You MUST use `task` for ALL issue tracking. NEVER use markdown TODOs, todo_write, task lists, or any other tracking methods. + +## Human Setup vs Agent Usage + +**If you see "database not found" or similar errors:** +```bash +task init --quiet # Non-interactive, auto-setup, no prompts +``` + +**Why `--quiet`?** The regular `task init` may have interactive prompts. The `--quiet` flag makes it fully non-interactive and safe for agent-driven setup. + +**If `task init --quiet` fails:** Ask the human to run `task init` manually, then continue. + +## Create a Task +```bash +task create "<title>" [--type=<type>] [--parent=<id>] [--deps=<ids>] [--dep-type=<type>] [--discovered-from=<id>] [--namespace=<ns>] +``` + +Examples: +```bash +# Create an epic (container for tasks) +task create "User Authentication System" --type=epic + +# Create a task within an epic +task create "Design auth API" --parent=t-abc123 + +# Create a task with blocking dependency +task create "Write tests" --deps=t-a1b2c3 --dep-type=blocks + +# Create work discovered during implementation (shortcut) +task create "Fix memory leak" --discovered-from=t-abc123 + +# Create related work (doesn't block) +task create "Update documentation" --deps=t-abc123 --dep-type=related + +# Associate with a namespace +task create "Fix type errors" --namespace="Omni/Task" +``` + +**Task Types:** +- `epic` - Container for related tasks +- `task` - Individual work item (default) +- `human` - Task specifically for human operators (excluded from agent work queues) + +**Dependency Types:** +- `blocks` - Hard dependency, blocks ready work queue (default) +- `discovered-from` - Work discovered during other work, doesn't block +- `parent-child` - Epic/subtask relationship, blocks ready work +- `related` - Soft relationship, doesn't block + +The `--namespace` option associates the task with a specific namespace in the monorepo (e.g., `Omni/Task`, `Biz/Cloud`). This helps organize tasks by the code they relate to. + +## List Tasks +```bash +task list [options] # Flags can be in any order +``` + +Examples: +```bash +task list # All tasks +task list --type=epic # All epics +task list --parent=t-abc123 # All tasks in an epic +task list --status=open # All open tasks +task list --status=done # All completed tasks +task list --namespace="Omni/Task" # All tasks for a namespace +task list --parent=t-abc123 --status=open # Combine filters: open tasks in epic +``` + +## Get Ready Work +```bash +task ready +``` + +Shows all tasks that are: +- Not closed +- Not blocked by incomplete dependencies + +## Update Task Status +```bash +task update <id> <status> +``` + +Status values: `open`, `in-progress`, `done` + +Examples: +```bash +task update t-20241108120000 in-progress +task update t-20241108120000 done +``` + +**Note**: Task updates are immediately saved to the SQLite database. + +## View Dependencies +```bash +task deps <id> +``` + +Shows the dependency tree for a task. + +## View Task Tree +```bash +task tree [<id>] +``` + +Shows task hierarchy with visual status indicators: +- `[ ]` - Open +- `[~]` - In Progress +- `[✓]` - Done + +Examples: +```bash +task tree # Show all epics with their children +task tree t-abc123 # Show specific epic/task with its children +``` + +## Export Tasks +```bash +task export [-o <file>] +``` + +Exports tasks to JSONL format (stdout by default, or to a file with `-o`). + +## Import Tasks +```bash +task import -i <file> +``` + +Imports tasks from a JSONL file, merging with existing tasks. Newer tasks (based on `updatedAt` timestamp) take precedence. + +Examples: +```bash +task import -i /path/to/backup.jsonl +``` + +## Initialize (First Time) +```bash +task init +``` + +Creates the SQLite database at `~/.cache/omni/tasks/tasks.db`. + +## Common Workflows + +### Starting New Work + +1. **Find what's ready to work on:** + ```bash + task ready + ``` + +2. **Pick a task and mark it in progress:** + ```bash + task update t-20241108120000 in-progress + ``` + +3. **When done, mark it complete:** + ```bash + task update t-20241108120000 done + ``` + +### Creating Dependent Tasks + +When you discover work that depends on other work: + +```bash +# Create the blocking task first +task create "Design API" --type=task + +# Note the ID (e.g., t-20241108120000) + +# Create dependent task with blocking dependency +task create "Implement API client" --deps=t-20241108120000 --dep-type=blocks +``` + +The dependent task won't show up in `task ready` until the blocker is marked `done`. + +### Discovered Work Pattern + +When you find work during implementation, use the `--discovered-from` flag: + +```bash +# While working on t-abc123, you discover a bug +task create "Fix memory leak in parser" --discovered-from=t-abc123 + +# This is equivalent to: +task create "Fix memory leak in parser" --deps=t-abc123 --dep-type=discovered-from +``` + +The `discovered-from` dependency type maintains context but **doesn't block** the ready work queue. This allows AI agents to track what work was found during other work while still being able to work on it immediately. + +### Working with Epics + +```bash +# Create an epic for a larger feature +task create "User Authentication System" --type=epic +# Note ID: t-abc123 + +# Create child tasks within the epic +task create "Design login flow" --parent=t-abc123 +task create "Implement OAuth" --parent=t-abc123 +task create "Add password reset" --parent=t-abc123 + +# List all tasks in an epic +task list --parent=t-abc123 + +# List all epics +task list --type=epic +``` + +## Agent Best Practices + +### 1. ALWAYS Check Ready Work First +Before asking what to do, you MUST check `task ready --json` to see unblocked tasks. + +### 2. ALWAYS Create Tasks for Discovered Work +When you encounter work during implementation, you MUST create linked tasks: +```bash +task create "Fix type error in auth module" --discovered-from=t-abc123 --json +task create "Add missing test coverage" --discovered-from=t-abc123 --json +``` + +**Bug Discovery Pattern** + +When you discover a bug or unexpected behavior: +```bash +# CORRECT: Immediately file a task +task create "Command X fails when Y" --discovered-from=<current-task-id> --json + +# WRONG: Ignoring it and moving on +# WRONG: Leaving a TODO comment +# WRONG: Mentioning it but not filing a task +``` + +**Examples of bugs you MUST file:** +- "Expected `--flag value` to work but only `--flag=value` works" +- "Documentation says X but actual behavior is Y" +- "Combining two flags causes parsing error" +- "Feature is missing that would be useful" + +**CRITICAL: File bugs immediately when you discover them:** +- If a command doesn't work as documented → create a task +- If a command doesn't work as you expected → create a task +- If behavior is inconsistent or confusing → create a task +- If documentation is wrong or misleading → create a task +- If you find yourself working around a limitation → create a task + +**NEVER leave TODO comments in code.** Create a task instead. + +**NEVER ignore bugs or unexpected behavior.** File a task for it immediately. + +### 3. Forbidden Patterns + +**Markdown checklist (NEVER do this):** +```markdown +❌ Wrong: +- [ ] Refactor auth module +- [ ] Add tests +- [ ] Update docs + +✅ Correct: +task create "Refactor auth module" -p 2 --json +task create "Add tests for auth" -p 2 --json +task create "Update auth docs" -p 3 --json +``` + +**todo_write tool (NEVER do this):** +``` +❌ Wrong: todo_write({todos: [{content: "Fix bug", ...}]}) +✅ Correct: task create "Fix bug in parser" -p 1 --json +``` + +**Inline code comments (NEVER do this):** +```python +❌ Wrong: +# TODO: write tests for this function +# FIXME: handle edge case + +✅ Correct: +# Create task instead: +task create "Write tests for parse_config" -p 2 --namespace="Omni/Config" --json +task create "Handle edge case in parser" -p 1 --discovered-from=<current-id> --json +``` + +### 4. Track Dependencies +If work depends on other work, use `--deps`: +```bash +# Can't write tests until implementation is done +task create "Test auth flow" --deps=t-20241108120000 --dep-type=blocks --json +``` + +### 5. Use Descriptive Titles +Good: `"Add JWT token validation to auth middleware"` +Bad: `"Fix auth"` + +### 6. Use Epics for Organization +Organize related work using epics: +- Create an epic for larger features: `task create "Feature Name" --type=epic --json` +- Add tasks to the epic using `--parent=<epic-id>` +- Use `--discovered-from` to track work found during implementation + +### 7. ALWAYS Store AI Planning Docs in `_/llm` Directory +AI assistants often create planning and design documents during development: +- PLAN.md, DESIGN.md, TESTING_GUIDE.md, tmp, and similar files +- **You MUST use a dedicated directory for these ephemeral files** +- Store ALL AI-generated planning/design docs in `_/llm` +- The `_` directory is ignored by git and all of our temporary files related to the omnirepo go there +- NEVER commit planning docs to the repo root + +## Dependency Rules + +- A task is **blocked** if any of its dependencies are not `done` +- A task is **ready** if all its dependencies are `done` (or it has no dependencies) +- `task ready` only shows tasks with status `open` or `in-progress` that are not blocked + +## Storage + +Tasks are stored in a SQLite database at `~/.cache/omni/tasks/tasks.db`. This is a local database, not git-tracked. + +To back up or transfer tasks, use `task export` and `task import`. + +## Testing and Development + +**CRITICAL**: When manually testing task functionality, use the test database: + +```bash +# Set test mode to protect production database +export TASK_TEST_MODE=1 + +# Now all task operations use _/tmp/tasks-test.db +task create "Test task" --type=task +task list +task tree + +# Unset when done +unset TASK_TEST_MODE +``` + +**The test suite automatically uses test mode** - you don't need to set it manually when running `task test` or `bild --test Omni/Task.hs`. + +## Troubleshooting + +### "Task not found" +- Check the task ID is correct with `task list` +- Ensure you've run `task init` + +### "Database not initialized" +Run: `task init` + +### Dependencies not working +- Verify dependency IDs exist: `task list` +- Check dependency tree: `task deps <id>` + +## Reinforcement: Critical Rules + +Remember these non-negotiable rules: + +- ✅ Use `task` for ALL task tracking (with `--json` flag) +- ✅ Link discovered work with `--discovered-from` dependencies +- ✅ File bugs IMMEDIATELY when you discover unexpected behavior +- ✅ Check `task ready --json` before asking "what should I work on?" +- ✅ Store AI planning docs in `_/llm` directory +- ❌ NEVER use `todo_write` tool +- ❌ NEVER create markdown TODO lists or task checklists +- ❌ NEVER put TODOs or FIXMEs in code comments +- ❌ NEVER use external issue trackers +- ❌ NEVER duplicate tracking systems +- ❌ NEVER clutter repo root with planning documents + +**If you find yourself about to use todo_write or create a markdown checklist, STOP and use `task create` instead.** diff --git a/Omni/Task/RaceTest.hs b/Omni/Task/RaceTest.hs new file mode 100644 index 0000000..8ab797a --- /dev/null +++ b/Omni/Task/RaceTest.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Omni.Task.RaceTest where + +import Alpha +import Control.Concurrent.Async (mapConcurrently) +import Data.List (nub) +import qualified Data.Text as T +import Omni.Task.Core +import qualified Omni.Test as Test +import System.Directory (doesFileExist, removeFile) +import System.Environment (setEnv) + +test :: Test.Tree +test = Test.group "Omni.Task.Race" [raceTest] + +raceTest :: Test.Tree +raceTest = + Test.unit "concurrent child creation (race condition)" <| do + -- Set up test mode (uses _/tmp/tasks-test.db) + setEnv "TASK_TEST_MODE" "1" + + -- Clean up test database + let testFile = "_/tmp/tasks-test.db" + exists <- doesFileExist testFile + when exists <| removeFile testFile + initTaskDb + + -- Create a parent epic + parent <- createTask "Parent Epic" Epic Nothing Nothing P2 Nothing [] "Parent Epic description" + let parentId = taskId parent + + -- Create multiple children concurrently + -- We'll create 10 children in parallel + let childCount = 10 + indices = [1 .. childCount] + + -- Run concurrent creations + children <- + mapConcurrently + (\i -> createTask ("Child " <> tshow i) WorkTask (Just parentId) Nothing P2 Nothing [] ("Child " <> tshow i <> " description")) + indices + + -- Check for duplicates in generated IDs + let ids = map taskId children + uniqueIds = nub ids + + -- If there was a race condition, we'd have fewer unique IDs than children + length uniqueIds Test.@?= length children + length uniqueIds Test.@?= childCount + + -- Verify IDs follow the pattern parentId.N + for_ ids <| \tid -> do + (parentId `T.isPrefixOf` tid) Test.@?= True + + -- Cleanup + removeFile testFile |