path: root/Omni/Task/Core.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Omni.Task.Core where

import Alpha
import Data.Aeson (FromJSON, ToJSON, decode, encode)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Types (parseMaybe)
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time (UTCTime, diffTimeToPicoseconds, getCurrentTime, utctDay, utctDayTime)
import Data.Time.Calendar (toModifiedJulianDay)
import GHC.Generics ()
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.Environment (lookupEnv)
import System.IO (SeekMode (AbsoluteSeek))
import qualified System.IO as IO
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.IO (LockRequest (..), closeFd, handleToFd, waitToSetLock)

-- Core data types
data Task = Task
  { taskId :: Text,
    taskTitle :: Text,
    taskType :: TaskType,
    taskParent :: Maybe Text, -- Parent epic ID
    taskNamespace :: Maybe Text, -- Optional namespace (e.g., "Omni/Task", "Biz/Cloud")
    taskStatus :: Status,
    taskPriority :: Priority, -- Priority level (0-4)
    taskDependencies :: [Dependency], -- List of dependencies with types
    taskDescription :: Maybe Text, -- Optional detailed description
    taskCreatedAt :: UTCTime,
    taskUpdatedAt :: UTCTime
  }
  deriving (Show, Eq, Generic)

data TaskType = Epic | WorkTask | HumanTask
  deriving (Show, Eq, Generic)

data Status = Open | InProgress | Review | Done
  deriving (Show, Eq, Generic)

-- Priority levels (matching beads convention)
data Priority = P0 | P1 | P2 | P3 | P4
  deriving (Show, Eq, Ord, Generic)

data Dependency = Dependency
  { depId :: Text, -- ID of the task this depends on
    depType :: DependencyType -- Type of dependency relationship
  }
  deriving (Show, Eq, Generic)

data DependencyType
  = Blocks -- Hard dependency, blocks ready work queue
  | DiscoveredFrom -- Work discovered during other work
  | ParentChild -- Epic/subtask relationship
  | Related -- Soft relationship, doesn't block
  deriving (Show, Eq, Generic)

data TaskProgress = TaskProgress
  { progressTaskId :: Text,
    progressTotal :: Int,
    progressCompleted :: Int,
    progressPercentage :: Int
  }
  deriving (Show, Eq, Generic)

instance ToJSON TaskType

instance FromJSON TaskType

instance ToJSON Status

instance FromJSON Status

instance ToJSON Priority

instance FromJSON Priority

instance ToJSON DependencyType

instance FromJSON DependencyType

instance ToJSON Dependency

instance FromJSON Dependency

instance ToJSON Task

instance FromJSON Task

-- | Case-insensitive ID comparison
matchesId :: Text -> Text -> Bool
matchesId id1 id2 = T.toLower id1 == T.toLower id2

-- | Find a task by ID (case-insensitive)
findTask :: Text -> [Task] -> Maybe Task
findTask tid = List.find (\t -> matchesId (taskId t) tid)

instance ToJSON TaskProgress

instance FromJSON TaskProgress

-- Get the tasks database file path (use test file if TASK_TEST_MODE is set)
getTasksFilePath :: IO FilePath
getTasksFilePath = do
  customPath <- lookupEnv "TASK_DB_PATH"
  testMode <- lookupEnv "TASK_TEST_MODE"
  let path = case (customPath, testMode) of
        (Just p, _) -> p
        (_, Just "1") -> ".tasks/tasks-test.jsonl"
        _ -> ".tasks/tasks.jsonl"
  pure path

-- Initialize the task database
initTaskDb :: IO ()
initTaskDb = do
  createDirectoryIfMissing True ".tasks"
  tasksFile <- getTasksFilePath
  exists <- doesFileExist tasksFile
  unless exists <| do
    TIO.writeFile tasksFile ""
    putText <| "Initialized task database at " <> T.pack tasksFile

-- Lock for in-process thread safety
taskLock :: MVar ()
taskLock = unsafePerformIO (newMVar ())
{-# NOINLINE taskLock #-}

-- Execute action with write lock (exclusive)
withTaskWriteLock :: IO a -> IO a
withTaskWriteLock action =
  withMVar taskLock <| \_ -> do
    -- In test mode, we rely on MVar for thread safety to avoid GHC "resource busy" errors
    -- when mixing openFd (flock) and standard IO in threaded tests.
    testMode <- lookupEnv "TASK_TEST_MODE"
    case testMode of
      Just "1" -> action
      _ -> do
        tasksFile <- getTasksFilePath
        let lockFile = tasksFile <> ".lock"
        bracket
          ( do
              h <- IO.openFile lockFile IO.ReadWriteMode
              handleToFd h
          )
          closeFd
          ( \fd -> do
              waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0)
              action
          )

-- Execute action with read lock (shared)
withTaskReadLock :: IO a -> IO a
withTaskReadLock action =
  withMVar taskLock <| \_ -> do
    testMode <- lookupEnv "TASK_TEST_MODE"
    case testMode of
      Just "1" -> action
      _ -> do
        tasksFile <- getTasksFilePath
        let lockFile = tasksFile <> ".lock"
        bracket
          ( do
              h <- IO.openFile lockFile IO.ReadWriteMode
              handleToFd h
          )
          closeFd
          ( \fd -> do
              waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0)
              action
          )

-- Generate a short ID using base62 encoding of timestamp
generateId :: IO Text
generateId = do
  now <- getCurrentTime
  -- Convert current time to microseconds since epoch (using MJD)
  let day = utctDay now
      dayTime = utctDayTime now
      mjd = toModifiedJulianDay day
      micros = diffTimeToPicoseconds dayTime `div` 1000000
      -- Combine MJD and micros to ensure uniqueness across days.
      -- Multiplier 10^11 (100,000 seconds) is safe for any day length.
      totalMicros = (mjd * 100000000000) + micros
      encoded = toBase62 totalMicros
  pure <| "t-" <> T.pack encoded

-- Generate a child ID based on parent ID (e.g. "t-abc.1", "t-abc.1.2")
-- Finds the next available sequential suffix among existing children.
generateChildId :: Text -> IO Text
generateChildId parentId =
  withTaskReadLock <| do
    tasks <- loadTasksInternal
    pure <| computeNextChildId tasks parentId

computeNextChildId :: [Task] -> Text -> Text
computeNextChildId tasks parentId =
  -- Find the max suffix among ALL tasks that look like children (to avoid ID collisions)
  -- We check all tasks, not just those with taskParent set, because we want to ensure
  -- ID uniqueness even if the parent link is missing.
  let suffixes = mapMaybe (getSuffix parentId <. taskId) tasks
      nextSuffix = case suffixes of
        [] -> 1
        s -> maximum s + 1
   in parentId <> "." <> T.pack (show nextSuffix)

getSuffix :: Text -> Text -> Maybe Int
getSuffix parent childId =
  if parent `T.isPrefixOf` childId && T.length childId > T.length parent
    then
      let rest = T.drop (T.length parent) childId
       in if T.head rest == '.'
            then readMaybe (T.unpack (T.tail rest))
            else Nothing
    else Nothing

-- Convert number to base62 (0-9, a-z, A-Z)
toBase62 :: Integer -> String
toBase62 0 = "0"
toBase62 n = reverse <| go n
  where
    alphabet = ['0' .. '9'] ++ ['a' .. 'z'] ++ ['A' .. 'Z']
    go 0 = []
    go x =
      let (q, r) = x `divMod` 62
          idx = fromIntegral r
          char = case drop idx alphabet of
            (c : _) -> c
            [] -> '0' -- Fallback (should never happen)
       in char : go q

-- Load all tasks from JSONL file (with migration support)
loadTasks :: IO [Task]
loadTasks = withTaskReadLock loadTasksInternal

loadTasksInternal :: IO [Task]
loadTasksInternal = do
  tasksFile <- getTasksFilePath
  exists <- doesFileExist tasksFile
  if exists
    then do
      content <- TIO.readFile tasksFile
      let taskLines = T.lines content
      pure <| mapMaybe decodeTask taskLines
    else pure []
  where
    decodeTask :: Text -> Maybe Task
    decodeTask line =
      if T.null line
        then Nothing
        else case decode (BLC.pack <| T.unpack line) of
          Just task -> Just task
          Nothing -> migrateTask line

    -- Migrate old task formats to new format
    migrateTask :: Text -> Maybe Task
    migrateTask line = case Aeson.decode (BLC.pack <| T.unpack line) :: Maybe Aeson.Object of
      Nothing -> Nothing
      Just obj ->
        let taskId' = KM.lookup "taskId" obj +> parseMaybe Aeson.parseJSON
            taskTitle' = KM.lookup "taskTitle" obj +> parseMaybe Aeson.parseJSON
            taskStatus' = KM.lookup "taskStatus" obj +> parseMaybe Aeson.parseJSON
            taskCreatedAt' = KM.lookup "taskCreatedAt" obj +> parseMaybe Aeson.parseJSON
            taskUpdatedAt' = KM.lookup "taskUpdatedAt" obj +> parseMaybe Aeson.parseJSON

            -- Extract taskDescription (new field)
            taskDescription' = KM.lookup "taskDescription" obj +> parseMaybe Aeson.parseJSON

            -- Extract dependencies (handle V1 [Dependency] and V0 [Text])
            v1Deps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Dependency]
            v0Deps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Text]
            finalDeps = case v1Deps of
              Just ds -> ds
              Nothing -> case v0Deps of
                Just ts -> map (\tid -> Dependency {depId = tid, depType = Blocks}) ts
                Nothing -> []

            -- taskProject is ignored in new format (use epics instead)
            taskType' = fromMaybe WorkTask (KM.lookup "taskType" obj +> parseMaybe Aeson.parseJSON)
            taskParent' = KM.lookup "taskParent" obj +> parseMaybe Aeson.parseJSON
            taskNamespace' = KM.lookup "taskNamespace" obj +> parseMaybe Aeson.parseJSON
            -- Default priority to P2 (medium) for old tasks
            taskPriority' = fromMaybe P2 (KM.lookup "taskPriority" obj +> parseMaybe Aeson.parseJSON)
         in case (taskId', taskTitle', taskStatus', taskCreatedAt', taskUpdatedAt') of
              (Just tid, Just title, Just status, Just created, Just updated) ->
                Just
                  Task
                    { taskId = tid,
                      taskTitle = title,
                      taskType = taskType',
                      taskParent = taskParent',
                      taskNamespace = taskNamespace',
                      taskStatus = status,
                      taskPriority = taskPriority',
                      taskDependencies = finalDeps,
                      taskDescription = taskDescription',
                      taskCreatedAt = created,
                      taskUpdatedAt = updated
                    }
              _ -> Nothing

-- Save a single task (append to JSONL)
saveTask :: Task -> IO ()
saveTask = withTaskWriteLock <. saveTaskInternal

saveTaskInternal :: Task -> IO ()
saveTaskInternal task = do
  tasksFile <- getTasksFilePath
  let json = encode task
  BLC.appendFile tasksFile (json <> "\n")

-- Create a new task
createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> Maybe Text -> IO Task
createTask title taskType parent namespace priority deps description =
  withTaskWriteLock <| do
    tid <- case parent of
      Nothing -> generateId
      Just pid -> do
        tasks <- loadTasksInternal
        pure <| computeNextChildId tasks pid
    now <- getCurrentTime
    let task =
          Task
            { taskId = tid,
              taskTitle = title,
              taskType = taskType,
              taskParent = parent,
              taskNamespace = namespace,
              taskStatus = Open,
              taskPriority = priority,
              taskDependencies = deps,
              taskDescription = description,
              taskCreatedAt = now,
              taskUpdatedAt = now
            }
    saveTaskInternal task
    pure task

-- Update task status
updateTaskStatus :: Text -> Status -> IO ()
updateTaskStatus tid newStatus =
  withTaskWriteLock <| do
    tasks <- loadTasksInternal
    now <- getCurrentTime
    let updatedTasks = map updateIfMatch tasks
        updateIfMatch t =
          if matchesId (taskId t) tid
            then t {taskStatus = newStatus, taskUpdatedAt = now}
            else t
    -- Rewrite the entire file (simple approach for MVP)
    tasksFile <- getTasksFilePath
    TIO.writeFile tasksFile ""
    traverse_ saveTaskInternal updatedTasks

-- List tasks, optionally filtered by type, parent, status, or namespace
listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task]
listTasks maybeType maybeParent maybeStatus maybeNamespace = do
  tasks <- loadTasks
  let filtered =
        tasks
          |> filterByType maybeType
          |> filterByParent maybeParent
          |> filterByStatus maybeStatus
          |> filterByNamespace maybeNamespace
  pure filtered
  where
    filterByType Nothing ts = ts
    filterByType (Just typ) ts = filter (\t -> taskType t == typ) ts
    filterByParent Nothing ts = ts
    filterByParent (Just pid) ts = filter (\t -> taskParent t == Just pid) ts
    filterByStatus Nothing ts = ts
    filterByStatus (Just status) ts = filter (\t -> taskStatus t == status) ts
    filterByNamespace Nothing ts = ts
    filterByNamespace (Just ns) ts = filter (\t -> taskNamespace t == Just ns) ts

-- Get ready tasks (not blocked by dependencies and not a parent)
getReadyTasks :: IO [Task]
getReadyTasks = do
  allTasks <- loadTasks
  -- Only Open or InProgress tasks are considered ready for work.
  -- Review tasks are waiting for review, and Done tasks are complete.
  let openTasks = filter (\t -> taskStatus t == Open || taskStatus t == InProgress) allTasks
      doneIds = map taskId <| filter (\t -> taskStatus t == Done) allTasks

      -- Find all tasks that act as parents
      parentIds = mapMaybe taskParent allTasks
      isParent tid = tid `elem` parentIds

      -- Only Blocks and ParentChild dependencies block ready work
      blockingDepIds task = [depId dep | dep <- taskDependencies task, depType dep `elem` [Blocks, ParentChild]]
      isReady task =
        not (isParent (taskId task))
          && all (`elem` doneIds) (blockingDepIds task)
          && taskType task /= HumanTask
  pure <| filter isReady openTasks

-- Get dependency tree for a task (returns tasks)
getDependencyTree :: Text -> IO [Task]
getDependencyTree tid = do
  tasks <- loadTasks
  case findTask tid tasks of
    Nothing -> pure []
    Just task -> pure <| collectDeps tasks task
  where
    collectDeps :: [Task] -> Task -> [Task]
    collectDeps allTasks task =
      let depIds = map depId (taskDependencies task)
          deps = filter (\t -> any (matchesId (taskId t)) depIds) allTasks
       in task : concatMap (collectDeps allTasks) deps

-- Get task progress
getTaskProgress :: Text -> IO TaskProgress
getTaskProgress tid = do
  tasks <- loadTasks
  -- Verify task exists (optional, but good for error handling)
  case filter (\t -> taskId t == tid) tasks of
    [] -> panic "Task not found"
    _ -> do
      let children = filter (\child -> taskParent child == Just tid) tasks
          total = length children
          completed = length <| filter (\child -> taskStatus child == Done) children
          percentage = if total == 0 then 0 else (completed * 100) `div` total
      pure
        TaskProgress
          { progressTaskId = tid,
            progressTotal = total,
            progressCompleted = completed,
            progressPercentage = percentage
          }

-- Show task progress
showTaskProgress :: Text -> IO ()
showTaskProgress tid = do
  progress <- getTaskProgress tid
  putText <| "Progress for " <> tid <> ": " <> T.pack (show (progressCompleted progress)) <> "/" <> T.pack (show (progressTotal progress)) <> " (" <> T.pack (show (progressPercentage progress)) <> "%)"

-- Show dependency tree for a task
showDependencyTree :: Text -> IO ()
showDependencyTree tid = do
  tasks <- loadTasks
  case findTask tid tasks of
    Nothing -> putText "Task not found"
    Just task -> printTree tasks task 0
  where
    printTree :: [Task] -> Task -> Int -> IO ()
    printTree allTasks task indent = do
      putText <| T.pack (replicate (indent * 2) ' ') <> taskId task <> ": " <> taskTitle task
      let depIds = map depId (taskDependencies task)
          deps = filter (\t -> any (matchesId (taskId t)) depIds) allTasks
      traverse_ (\dep -> printTree allTasks dep (indent + 1)) deps

-- Get task tree (returns tasks hierarchically)
getTaskTree :: Maybe Text -> IO [Task]
getTaskTree maybeId = do
  tasks <- loadTasks
  case maybeId of
    Nothing -> do
      -- Return all epics with their children
      let epics = filter (\t -> taskType t == Epic) tasks
       in pure <| concatMap (collectChildren tasks) epics
    Just tid -> do
      -- Return specific task/epic with its children
      case findTask tid tasks of
        Nothing -> pure []
        Just task -> pure <| collectChildren tasks task
  where
    collectChildren :: [Task] -> Task -> [Task]
    collectChildren allTasks task =
      let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks
       in task : concatMap (collectChildren allTasks) children

-- Show task tree (epic with children, or all epics if no ID given)
showTaskTree :: Maybe Text -> IO ()
showTaskTree maybeId = do
  tasks <- loadTasks
  case maybeId of
    Nothing -> do
      -- Show all epics with their children
      let epics = filter (\t -> taskType t == Epic) tasks
      if null epics
        then putText "No epics found"
        else traverse_ (printEpicTree tasks) epics
    Just tid -> do
      -- Show specific task/epic with its children
      case findTask tid tasks of
        Nothing -> putText "Task not found"
        Just task -> printEpicTree tasks task
  where
    printEpicTree :: [Task] -> Task -> IO ()
    printEpicTree allTasks task = printTreeNode allTasks task 0

    printTreeNode :: [Task] -> Task -> Int -> IO ()
    printTreeNode allTasks task indent = printTreeNode' allTasks task indent []

    printTreeNode' :: [Task] -> Task -> Int -> [Bool] -> IO ()
    printTreeNode' allTasks task indent ancestry = do
      let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks
          -- Build tree prefix using box-drawing characters
          prefix =
            if indent == 0
              then ""
              else
                let ancestorPrefixes = map (\hasMore -> if hasMore then "│   " else "    ") (List.init ancestry)
                    myPrefix = if List.last ancestry then "├── " else "└── "
                 in T.pack <| concat ancestorPrefixes ++ myPrefix
          -- For epics, show progress count [completed/total]; for tasks, show status checkbox
          statusStr = case taskType task of
            Epic ->
              let total = length children
                  completed = length <| filter (\t -> taskStatus t == Done) children
               in "[" <> T.pack (show completed) <> "/" <> T.pack (show total) <> "]"
            _ -> case taskStatus task of
              Open -> "[ ]"
              InProgress -> "[~]"
              Review -> "[?]"
              Done -> "[✓]"

          coloredStatusStr = case taskType task of
            Epic -> magenta statusStr
            _ -> case taskStatus task of
              Open -> bold statusStr
              InProgress -> yellow statusStr
              Review -> magenta statusStr
              Done -> green statusStr

          nsStr = case taskNamespace task of
            Nothing -> ""
            Just ns -> "[" <> ns <> "] "

          coloredNsStr = case taskNamespace task of
            Nothing -> ""
            Just _ -> gray nsStr

          -- Calculate available width for title (80 cols - prefix - id - labels)
          usedWidth = T.length prefix + T.length (taskId task) + T.length statusStr + T.length nsStr + 2
          availableWidth = max 20 (80 - usedWidth)
          truncatedTitle =
            if T.length (taskTitle task) > availableWidth
              then T.take (availableWidth - 3) (taskTitle task) <> "..."
              else taskTitle task

          coloredTitle = if taskType task == Epic then bold truncatedTitle else truncatedTitle

      putText <| prefix <> cyan (taskId task) <> " " <> coloredStatusStr <> " " <> coloredNsStr <> coloredTitle

      -- Print children with updated ancestry
      let indexedChildren = zip [1 ..] children
          totalChildren = length children
      traverse_
        ( \(idx, child) ->
            let hasMoreSiblings = idx < totalChildren
             in printTreeNode' allTasks child (indent + 1) (ancestry ++ [hasMoreSiblings])
        )
        indexedChildren

-- Helper to print a task
printTask :: Task -> IO ()
printTask t = do
  tasks <- loadTasks
  let progressInfo =
        if taskType t == Epic
          then
            let children = filter (maybe False (`matchesId` taskId t) <. taskParent) tasks
                total = length children
                completed = length <| filter (\child -> taskStatus child == Done) children
             in " [" <> T.pack (show completed) <> "/" <> T.pack (show total) <> "]"
          else ""

      parentInfo = case taskParent t of
        Nothing -> ""
        Just p -> " (parent: " <> p <> ")"

      namespaceInfo = case taskNamespace t of
        Nothing -> ""
        Just ns -> " [" <> ns <> "]"

      coloredStatus =
        let s = "[" <> T.pack (show (taskStatus t)) <> "]"
         in case taskStatus t of
              Open -> bold s
              InProgress -> yellow s
              Review -> magenta s
              Done -> green s

      coloredTitle = if taskType t == Epic then bold (taskTitle t) else taskTitle t

      coloredProgress = if taskType t == Epic then magenta progressInfo else progressInfo

      coloredNamespace = case taskNamespace t of
        Nothing -> ""
        Just _ -> gray namespaceInfo

      coloredParent = case taskParent t of
        Nothing -> ""
        Just _ -> gray parentInfo

  putText
    <| cyan (taskId t)
    <> " ["
    <> T.pack (show (taskType t))
    <> "] "
    <> coloredStatus
    <> coloredProgress
    <> " "
    <> coloredTitle
    <> coloredParent
    <> coloredNamespace

-- Show detailed task information (human-readable)
showTaskDetailed :: Task -> IO ()
showTaskDetailed t = do
  tasks <- loadTasks
  putText ""
  putText <| "Task: " <> taskId t
  putText ""
  putText <| "Title:      " <> taskTitle t
  putText <| "Type:       " <> T.pack (show (taskType t))
  putText <| "Status:     " <> T.pack (show (taskStatus t))
  putText <| "Priority:   " <> T.pack (show (taskPriority t)) <> priorityDesc

  -- Show epic progress if this is an epic
  when (taskType t == Epic) <| do
    let children = filter (maybe False (`matchesId` taskId t) <. taskParent) tasks
        total = length children
        completed = length <| filter (\child -> taskStatus child == Done) children
        percentage = if total == 0 then 0 else (completed * 100) `div` total
    putText <| "Progress:   " <> T.pack (show completed) <> "/" <> T.pack (show total) <> " (" <> T.pack (show percentage) <> "%)"

  case taskParent t of
    Nothing -> pure ()
    Just p -> putText <| "Parent:     " <> p
  case taskNamespace t of
    Nothing -> pure ()
    Just ns -> putText <| "Namespace:  " <> ns
  putText <| "Created:    " <> T.pack (show (taskCreatedAt t))
  putText <| "Updated:    " <> T.pack (show (taskUpdatedAt t))

  -- Show dependencies
  unless (null (taskDependencies t)) <| do
    putText ""
    putText "Dependencies:"
    traverse_ printDependency (taskDependencies t)

  -- Show description
  case taskDescription t of
    Nothing -> pure ()
    Just desc -> do
      putText ""
      putText "Description:"
      -- Indent description for better readability
      let indented = T.unlines <| map ("  " <>) (T.lines desc)
      putText indented

  putText ""
  where
    priorityDesc = case taskPriority t of
      P0 -> " (Critical)"
      P1 -> " (High)"
      P2 -> " (Medium)"
      P3 -> " (Low)"
      P4 -> " (Backlog)"

    printDependency dep =
      putText <| "  - " <> depId dep <> " [" <> T.pack (show (depType dep)) <> "]"

-- ANSI Colors
red, green, yellow, blue, magenta, cyan, gray, bold :: Text -> Text
red t = "\ESC[31m" <> t <> "\ESC[0m"
green t = "\ESC[32m" <> t <> "\ESC[0m"
yellow t = "\ESC[33m" <> t <> "\ESC[0m"
blue t = "\ESC[34m" <> t <> "\ESC[0m"
magenta t = "\ESC[35m" <> t <> "\ESC[0m"
cyan t = "\ESC[36m" <> t <> "\ESC[0m"
gray t = "\ESC[90m" <> t <> "\ESC[0m"
bold t = "\ESC[1m" <> t <> "\ESC[0m"

-- Export tasks: Consolidate JSONL file (remove duplicates, keep latest version)
exportTasks :: IO ()
exportTasks =
  withTaskWriteLock <| do
    tasks <- loadTasksInternal
    -- Rewrite the entire file with deduplicated tasks
    tasksFile <- getTasksFilePath
    TIO.writeFile tasksFile ""
    traverse_ saveTaskInternal tasks

-- Task statistics
data TaskStats = TaskStats
  { totalTasks :: Int,
    openTasks :: Int,
    inProgressTasks :: Int,
    reviewTasks :: Int,
    doneTasks :: Int,
    totalEpics :: Int,
    readyTasks :: Int,
    blockedTasks :: Int,
    tasksByPriority :: [(Priority, Int)],
    tasksByNamespace :: [(Text, Int)]
  }
  deriving (Show, Eq, Generic)

instance ToJSON TaskStats

instance FromJSON TaskStats

-- Get task statistics
getTaskStats :: Maybe Text -> IO TaskStats
getTaskStats maybeEpicId = do
  allTasks <- loadTasks

  targetTasks <- case maybeEpicId of
    Nothing -> pure allTasks
    Just epicId ->
      case findTask epicId allTasks of
        Nothing -> panic "Epic not found"
        Just task -> pure <| getAllDescendants allTasks (taskId task)

  globalReady <- getReadyTasks
  let readyIds = map taskId globalReady
      -- Filter ready tasks to only include those in our target set
      readyCount = length <| filter (\t -> taskId t `elem` readyIds) targetTasks

      tasks = targetTasks
      total = length tasks
      open = length <| filter (\t -> taskStatus t == Open) tasks
      inProg = length <| filter (\t -> taskStatus t == InProgress) tasks
      review = length <| filter (\t -> taskStatus t == Review) tasks
      done = length <| filter (\t -> taskStatus t == Done) tasks
      epics = length <| filter (\t -> taskType t == Epic) tasks
      readyCount' = readyCount
      blockedCount = total - readyCount' - done
      -- Count tasks by priority
      byPriority =
        [ (P0, length <| filter (\t -> taskPriority t == P0) tasks),
          (P1, length <| filter (\t -> taskPriority t == P1) tasks),
          (P2, length <| filter (\t -> taskPriority t == P2) tasks),
          (P3, length <| filter (\t -> taskPriority t == P3) tasks),
          (P4, length <| filter (\t -> taskPriority t == P4) tasks)
        ]
      -- Count tasks by namespace
      namespaces = mapMaybe taskNamespace tasks
      uniqueNs = List.nub namespaces
      byNamespace = map (\ns -> (ns, length <| filter (\t -> taskNamespace t == Just ns) tasks)) uniqueNs
  pure
    TaskStats
      { totalTasks = total,
        openTasks = open,
        inProgressTasks = inProg,
        reviewTasks = review,
        doneTasks = done,
        totalEpics = epics,
        readyTasks = readyCount',
        blockedTasks = blockedCount,
        tasksByPriority = byPriority,
        tasksByNamespace = byNamespace
      }

-- Helper to get all descendants of a task (recursive)
getAllDescendants :: [Task] -> Text -> [Task]
getAllDescendants allTasks parentId =
  let children = filter (maybe False (`matchesId` parentId) <. taskParent) allTasks
   in children ++ concatMap (getAllDescendants allTasks <. taskId) children

-- Show task statistics (human-readable)
showTaskStats :: Maybe Text -> IO ()
showTaskStats maybeEpicId = do
  stats <- getTaskStats maybeEpicId
  putText ""
  case maybeEpicId of
    Nothing -> putText "Task Statistics"
    Just epicId -> putText <| "Task Statistics for Epic " <> epicId
  putText ""
  putText <| "Total tasks:       " <> T.pack (show (totalTasks stats))
  putText <| "  Open:            " <> T.pack (show (openTasks stats))
  putText <| "  In Progress:     " <> T.pack (show (inProgressTasks stats))
  putText <| "  Review:          " <> T.pack (show (reviewTasks stats))
  putText <| "  Done:            " <> T.pack (show (doneTasks stats))
  putText ""
  putText <| "Epics:             " <> T.pack (show (totalEpics stats))
  putText ""
  putText <| "Ready to work:     " <> T.pack (show (readyTasks stats))
  putText <| "Blocked:           " <> T.pack (show (blockedTasks stats))
  putText ""
  putText "By Priority:"
  traverse_ printPriority (tasksByPriority stats)
  unless (null (tasksByNamespace stats)) <| do
    putText ""
    putText "By Namespace:"
    traverse_ printNamespace (tasksByNamespace stats)
  putText ""
  where
    printPriority (p, count) =
      let label = case p of
            P0 -> "P0 (Critical)"
            P1 -> "P1 (High)"
            P2 -> "P2 (Medium)"
            P3 -> "P3 (Low)"
            P4 -> "P4 (Backlog)"
       in putText <| "  " <> T.pack (show count) <> " " <> label
    printNamespace (ns, count) =
      putText <| "  " <> T.pack (show count) <> " " <> ns

-- Import tasks: Read from another JSONL file and merge with existing tasks
importTasks :: FilePath -> IO ()
importTasks filePath =
  withTaskWriteLock <| do
    exists <- doesFileExist filePath
    unless exists <| panic (T.pack filePath <> " does not exist")

    -- Load tasks from import file
    content <- TIO.readFile filePath
    let importLines = T.lines content
        importedTasks = mapMaybe decodeTask importLines

    -- Load existing tasks
    existingTasks <- loadTasksInternal

    -- Create a map of existing task IDs for quick lookup
    let existingIds = map taskId existingTasks
        -- Filter to only new tasks (not already in our database)
        newTasks = filter (\t -> not (any (`matchesId` taskId t) existingIds)) importedTasks
        -- For tasks that exist, update them with imported data
        updatedTasks = map (updateWithImported importedTasks) existingTasks
        -- Combine: updated existing tasks + new tasks
        allTasks = updatedTasks ++ newTasks

    -- Rewrite tasks.jsonl with merged data
    tasksFile <- getTasksFilePath
    TIO.writeFile tasksFile ""
    traverse_ saveTaskInternal allTasks
  where
    decodeTask :: Text -> Maybe Task
    decodeTask line =
      if T.null line
        then Nothing
        else decode (BLC.pack <| T.unpack line)

    -- Update an existing task if there's a newer version in imported tasks
    updateWithImported :: [Task] -> Task -> Task
    updateWithImported imported existing =
      case findTask (taskId existing) imported of
        Nothing -> existing -- No imported version, keep existing
        Just importedTask ->
          -- Use imported version if it's newer (based on updatedAt)
          if taskUpdatedAt importedTask > taskUpdatedAt existing
            then importedTask
            else existing