path: root/Omni/Task/Core.hs

{-# 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)