path: root/Omni/Jr.hs

#!/usr/bin/env run.sh
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- : out jr
-- : dep sqlite-simple
-- : dep warp
-- : dep servant-server
-- : dep lucid
-- : dep servant-lucid
module Omni.Jr where

import Alpha
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Omni.Agent.Core as AgentCore
import qualified Omni.Agent.Engine as Engine
import qualified Omni.Agent.Worker as AgentWorker
import qualified Omni.Cli as Cli
import qualified Omni.Fact as Fact
import qualified Omni.Jr.Web as Web
import qualified Omni.Task as Task
import qualified Omni.Task.Core as TaskCore
import qualified Omni.Test as Test
import qualified System.Console.Docopt as Docopt
import qualified System.Directory as Directory
import System.Environment (withArgs)
import qualified System.Environment as Env
import qualified System.Exit as Exit
import System.FilePath (takeFileName)
import qualified System.IO as IO
import qualified System.Process as Process

main :: IO ()
main = Cli.main plan

plan :: Cli.Plan ()
plan =
  Cli.Plan
    { Cli.help = help,
      Cli.move = move,
      Cli.test = test,
      Cli.tidy = \_ -> pure ()
    }

help :: Cli.Docopt
help =
  [Cli.docopt|
jr

Usage:
  jr task [<args>...]
  jr work [<task-id>] [--engine=ENGINE]
  jr prompt <task-id>
  jr web [--port=PORT]
  jr review [<task-id>] [--auto]
  jr loop [--delay=SECONDS]
  jr facts list [--project=PROJECT] [--json]
  jr facts show <fact-id> [--json]
  jr facts add <project> <content> [--files=FILES] [--task=TASK] [--confidence=CONF] [--json]
  jr facts delete <fact-id> [--json]
  jr test
  jr (-h | --help)

Commands:
  task          Manage tasks
  work          Start a worker agent on a task
  prompt        Show the system prompt that would be sent to the agent
  web           Start the web UI server
  review        Review a completed task (show diff, accept/reject)
  loop          Run autonomous work+review loop
  facts         Manage knowledge base facts

Options:
  -h --help           Show this help
  --port=PORT         Port for web server [default: 8080]
  --engine=ENGINE     LLM engine: openrouter, ollama, amp [default: openrouter]
  --auto              Auto-review: accept if tests pass, reject if they fail
  --delay=SECONDS     Delay between loop iterations [default: 5]
  --project=PROJECT   Filter facts by project
  --files=FILES       Comma-separated list of related files
  --task=TASK         Source task ID
  --confidence=CONF   Confidence level 0.0-1.0 [default: 0.8]
  --json              Output in JSON format
|]

move :: Cli.Arguments -> IO ()
move args
  | args `Cli.has` Cli.command "task" = do
      let extraArgs = Cli.getAllArgs args (Cli.argument "args")
      withArgs extraArgs Task.main
  | args `Cli.has` Cli.command "web" = do
      let port = case Cli.getArg args (Cli.longOption "port") of
            Just p -> fromMaybe Web.defaultPort (readMaybe p)
            Nothing -> Web.defaultPort
      Web.run port
  | args `Cli.has` Cli.command "prompt" = do
      case Cli.getArg args (Cli.argument "task-id") of
        Nothing -> do
          IO.hPutStrLn IO.stderr "Error: task-id is required"
          Exit.exitFailure
        Just tidStr -> do
          let tid = Text.pack tidStr
          tasks <- TaskCore.loadTasks
          case TaskCore.findTask tid tasks of
            Nothing -> do
              IO.hPutStrLn IO.stderr ("Error: task not found: " <> tidStr)
              Exit.exitFailure
            Just task -> do
              prompt <- AgentWorker.buildFullPrompt task
              putText prompt
  | args `Cli.has` Cli.command "work" = do
      -- Always run in current directory
      let path = "."

      -- Infer name from current directory
      absPath <- Directory.getCurrentDirectory
      let name = Text.pack (takeFileName absPath)

      -- Parse engine flag
      let engineType = case Cli.getArg args (Cli.longOption "engine") of
            Just "ollama" -> AgentCore.EngineOllama
            Just "amp" -> AgentCore.EngineAmp
            _ -> AgentCore.EngineOpenRouter

      let worker =
            AgentCore.Worker
              { AgentCore.workerName = name,
                AgentCore.workerPid = Nothing,
                AgentCore.workerStatus = AgentCore.Idle,
                AgentCore.workerPath = path,
                AgentCore.workerQuiet = False, -- Show ANSI status bar for manual work
                AgentCore.workerEngine = engineType
              }

      let taskId = fmap Text.pack (Cli.getArg args (Cli.argument "task-id"))

      AgentWorker.start worker taskId
  | args `Cli.has` Cli.command "review" = do
      let autoMode = args `Cli.has` Cli.longOption "auto"
      case Cli.getArg args (Cli.argument "task-id") of
        Just tidStr -> reviewTask (Text.pack tidStr) autoMode
        Nothing -> do
          -- Find tasks in Review status
          tasks <- TaskCore.loadTasks
          let reviewTasks = filter (\t -> TaskCore.taskStatus t == TaskCore.Review) tasks
          case reviewTasks of
            [] -> putText "No tasks in Review status."
            (t : _) -> reviewTask (TaskCore.taskId t) autoMode
  | args `Cli.has` Cli.command "loop" = do
      let delay = case Cli.getArg args (Cli.longOption "delay") of
            Just d -> fromMaybe 5 (readMaybe d)
            Nothing -> 5
      runLoop delay
  | args `Cli.has` Cli.command "facts" = handleFacts args
  | otherwise = putText (str <| Docopt.usage help)

-- | Run the autonomous loop: work -> review -> repeat
runLoop :: Int -> IO ()
runLoop delaySec = do
  putText "[loop] Starting autonomous jr loop..."
  putText ("[loop] Delay between iterations: " <> tshow delaySec <> "s")
  go
  where
    go = do
      -- First check for tasks to review (prioritize finishing work)
      reviewResult <- reviewPending
      if reviewResult
        then do
          -- Reviewed something, continue loop immediately
          threadDelay (delaySec * 1000000)
          go
        else do
          -- No reviews, check for ready work
          readyTasks <- TaskCore.getReadyTasks
          case readyTasks of
            [] -> do
              putText "[loop] No ready tasks, no pending reviews."
            (task : _) -> do
              putText ""
              putText ("[loop] === Working on: " <> TaskCore.taskId task <> " ===")
              -- Run worker (this blocks until the engine completes)
              absPath <- Directory.getCurrentDirectory
              let name = Text.pack (takeFileName absPath)
              let worker =
                    AgentCore.Worker
                      { AgentCore.workerName = name,
                        AgentCore.workerPid = Nothing,
                        AgentCore.workerStatus = AgentCore.Idle,
                        AgentCore.workerPath = ".",
                        AgentCore.workerQuiet = True, -- No ANSI status bar in loop mode
                        AgentCore.workerEngine = AgentCore.EngineOpenRouter -- Default for loop
                      }
              putText "[loop] Starting worker..."
              AgentWorker.start worker (Just (TaskCore.taskId task))
              putText "[loop] Worker finished."

          -- Delay and loop
          putText ("[loop] Sleeping " <> tshow delaySec <> "s...")
          threadDelay (delaySec * 1000000)
          go

    -- Returns True if a task was reviewed, False otherwise
    reviewPending :: IO Bool
    reviewPending = do
      tasks <- TaskCore.loadTasks
      let reviewTasks = filter (\t -> TaskCore.taskStatus t == TaskCore.Review) tasks
      case reviewTasks of
        [] -> pure False
        (t : _) -> do
          putText ""
          putText ("[loop] === Reviewing: " <> TaskCore.taskId t <> " ===")
          tryAutoReview (TaskCore.taskId t)
          pure True

    -- Auto-review that doesn't exit on missing commit
    tryAutoReview :: Text -> IO ()
    tryAutoReview tid = do
      tasks <- TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> do
          putText ("[review] Task " <> tid <> " not found.")
        Just task -> do
          let grepArg = "--grep=" <> Text.unpack tid
          (code, shaOut, _) <-
            Process.readProcessWithExitCode
              "git"
              ["log", "--pretty=format:%H", "-n", "1", grepArg]
              ""

          if code /= Exit.ExitSuccess || null shaOut
            then do
              putText "[review] No commit found for this task."
              putText "[review] Resetting to Open for retry."
              TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
            else do
              let commitSha = case List.lines shaOut of
                    (x : _) -> x
                    [] -> ""

              -- Check for merge conflicts
              conflictResult <- checkMergeConflict commitSha
              case conflictResult of
                Just conflictFiles -> do
                  putText "[review] MERGE CONFLICT DETECTED"
                  traverse_ (\f -> putText ("  - " <> f)) conflictFiles
                  handleConflict tid conflictFiles commitSha
                Nothing -> do
                  autoReview tid task commitSha

-- | Handle merge conflict during review (Gerrit-style: provide rich context)
handleConflict :: Text -> [Text] -> String -> IO ()
handleConflict tid conflictFiles commitSha = do
  maybeCtx <- TaskCore.getRetryContext tid
  let attempt = maybe 1 (\c -> TaskCore.retryAttempt c + 1) maybeCtx

  let conflictComment = buildConflictComment commitSha conflictFiles attempt
  _ <- TaskCore.addComment tid conflictComment TaskCore.Junior

  if attempt > 3
    then do
      putText "[review] Task has failed 3 times. Needs human intervention."
      TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
    else do
      conflictDetails <- gatherConflictContext commitSha conflictFiles
      maybeExistingCtx <- TaskCore.getRetryContext tid
      let currentReason = "attempt " <> tshow attempt <> ":\n" <> conflictDetails
      let accumulatedReason = case maybeExistingCtx of
            Nothing -> currentReason
            Just ctx -> TaskCore.retryReason ctx <> "\n\n" <> currentReason
      TaskCore.setRetryContext
        TaskCore.RetryContext
          { TaskCore.retryTaskId = tid,
            TaskCore.retryOriginalCommit = Text.pack commitSha,
            TaskCore.retryConflictFiles = conflictFiles,
            TaskCore.retryAttempt = attempt,
            TaskCore.retryReason = accumulatedReason,
            TaskCore.retryNotes = maybeExistingCtx +> TaskCore.retryNotes
          }
      TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
      putText ("[review] Task " <> tid <> " returned to queue (attempt " <> tshow attempt <> "/3).")

-- | Build a review comment for merge conflicts
buildConflictComment :: String -> [Text] -> Int -> Text
buildConflictComment commitSha conflictFiles attempt =
  Text.unlines
    [ "## Auto-Review: Merge Conflict",
      "",
      "**Commit:** " <> Text.pack (take 8 commitSha),
      "**Result:** ✗ MERGE CONFLICT",
      "**Attempt:** " <> tshow attempt <> "/3",
      "",
      "### Conflicting Files",
      Text.unlines (map ("- " <>) conflictFiles),
      "Task returned to queue for conflict resolution."
    ]

-- | Gather Gerrit-style conflict context for the coder
gatherConflictContext :: String -> [Text] -> IO Text
gatherConflictContext commitSha conflictFiles = do
  commitInfo <- getCommitInfo commitSha
  currentHeadInfo <- getCurrentHeadInfo
  fileDiffs <- traverse (getFileConflictInfo commitSha <. Text.unpack) conflictFiles

  pure
    <| Text.unlines
      [ "MERGE CONFLICT - Your changes could not be cleanly applied",
        "",
        "== Your Commit ==",
        commitInfo,
        "",
        "== Current HEAD ==",
        currentHeadInfo,
        "",
        "== Conflicting Files ==",
        Text.unlines fileDiffs,
        "",
        "== Resolution Instructions ==",
        "1. The codebase has been updated since your work",
        "2. Review the current state of conflicting files",
        "3. Re-implement your changes on top of the current code",
        "4. Ensure your changes still make sense given the updates"
      ]

-- | Get info about the commit that caused the conflict
getCommitInfo :: String -> IO Text
getCommitInfo sha = do
  (_, out, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "-1", "--format=%h %s%n%b", sha]
      ""
  pure <| Text.pack out

-- | Get info about current HEAD
getCurrentHeadInfo :: IO Text
getCurrentHeadInfo = do
  (_, out, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "-1", "--format=%h %s (%cr)"]
      ""
  pure <| Text.pack out

-- | Get file-level conflict context showing what changed in both branches
getFileConflictInfo :: String -> FilePath -> IO Text
getFileConflictInfo commitSha filePath = do
  yourChanges <- getYourChangesToFile commitSha filePath
  recentChanges <- getRecentChangesToFile filePath
  pure
    <| Text.unlines
      [ "--- " <> Text.pack filePath <> " ---",
        "",
        "Your changes to this file:",
        yourChanges,
        "",
        "Recent changes by others:",
        recentChanges
      ]

-- | Get a summary of changes in a specific commit to a file
getYourChangesToFile :: String -> FilePath -> IO Text
getYourChangesToFile commitSha filePath = do
  (code, out, _) <-
    Process.readProcessWithExitCode
      "git"
      ["show", "--stat", commitSha, "--", filePath]
      ""
  case code of
    Exit.ExitSuccess -> pure <| Text.pack (take 500 out)
    Exit.ExitFailure _ -> pure "(unable to get diff)"

-- | Get recent changes to a file (last few commits)
getRecentChangesToFile :: FilePath -> IO Text
getRecentChangesToFile filePath = do
  (code, out, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "-3", "--oneline", "--", filePath]
      ""
  case code of
    Exit.ExitSuccess -> pure <| Text.pack out
    Exit.ExitFailure _ -> pure "(unable to get history)"

-- | Interactive review command (jr review <task-id>)
reviewTask :: Text -> Bool -> IO ()
reviewTask tid autoMode = do
  tasks <- TaskCore.loadTasks
  case TaskCore.findTask tid tasks of
    Nothing -> do
      putText ("Task " <> tid <> " not found.")
      Exit.exitFailure
    Just task -> do
      unless autoMode <| TaskCore.showTaskDetailed task

      let grepArg = "--grep=" <> Text.unpack tid
      (code, shaOut, _) <-
        Process.readProcessWithExitCode
          "git"
          ["log", "--pretty=format:%H", "-n", "1", grepArg]
          ""

      when (code /= Exit.ExitSuccess || null shaOut) <| do
        putText "\nNo commit found for this task."
        putText "The worker may not have completed yet, or the commit message doesn't include the task ID."
        Exit.exitFailure

      let commitSha = case List.lines shaOut of
            (x : _) -> x
            [] -> ""

      -- Check for merge conflicts before showing diff
      conflictResult <- checkMergeConflict commitSha
      case conflictResult of
        Just conflictFiles -> do
          putText "\n=== MERGE CONFLICT DETECTED ==="
          traverse_ (\f -> putText ("  - " <> f)) conflictFiles
          handleConflict tid conflictFiles commitSha
        Nothing -> do
          if autoMode
            then autoReview tid task commitSha
            else interactiveReview tid task commitSha

-- | Auto-review: run tests on namespace, accept if pass, reject if fail
autoReview :: Text -> TaskCore.Task -> String -> IO ()
autoReview tid task commitSha = do
  putText "[review] Running automated review..."
  putText ("[review] Commit: " <> Text.pack (take 8 commitSha))

  let namespace = fromMaybe "." (TaskCore.taskNamespace task)
  let testTarget = Text.unpack namespace

  putText ("[review] Testing: " <> Text.pack testTarget)

  (testCode, testOut, testErr) <-
    Process.readProcessWithExitCode
      "bild"
      ["--test", testTarget]
      ""

  case testCode of
    Exit.ExitSuccess -> do
      putText "[review] ✓ Tests passed."
      let reviewComment = buildReviewComment commitSha testTarget True testOut testErr
      _ <- TaskCore.addComment tid reviewComment TaskCore.Junior
      TaskCore.clearRetryContext tid
      TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.System
      putText ("[review] Task " <> tid <> " -> Done")
      addCompletionSummary tid commitSha
      extractFacts tid commitSha
      checkEpicCompletion task
    Exit.ExitFailure code -> do
      putText ("[review] ✗ Tests failed (exit " <> tshow code <> ")")
      let reason = "Test failure:\n" <> Text.pack testOut <> Text.pack testErr

      maybeCtx <- TaskCore.getRetryContext tid
      let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx

      let reviewComment = buildReviewComment commitSha testTarget False testOut testErr
      _ <- TaskCore.addComment tid reviewComment TaskCore.Junior

      if attempt > 3
        then do
          putText "[review] Task has failed 3 times. Needs human intervention."
          TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
        else do
          let currentReason = "attempt " <> tshow attempt <> ": " <> reason
          let accumulatedReason = case maybeCtx of
                Nothing -> currentReason
                Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
          TaskCore.setRetryContext
            TaskCore.RetryContext
              { TaskCore.retryTaskId = tid,
                TaskCore.retryOriginalCommit = Text.pack commitSha,
                TaskCore.retryConflictFiles = [],
                TaskCore.retryAttempt = attempt,
                TaskCore.retryReason = accumulatedReason,
                TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
              }
          TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
          putText ("[review] Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).")

-- | Build a review comment summarizing what was tested and the result
buildReviewComment :: String -> String -> Bool -> String -> String -> Text
buildReviewComment commitSha testTarget passed testOut testErr =
  Text.unlines
    [ "## Auto-Review",
      "",
      "**Commit:** " <> Text.pack (take 8 commitSha),
      "**Test target:** " <> Text.pack testTarget,
      "**Result:** " <> if passed then "✓ PASSED" else "✗ FAILED",
      "",
      if passed
        then "All tests passed. Task accepted."
        else
          Text.unlines
            [ "### Test Output",
              "```",
              Text.pack (truncateOutput 1000 (testOut ++ testErr)),
              "```",
              "",
              "Task rejected and returned to queue for retry."
            ]
    ]

-- | Truncate output to a maximum number of characters
truncateOutput :: Int -> String -> String
truncateOutput maxLen s
  | length s <= maxLen = s
  | otherwise = take maxLen s ++ "\n... (truncated)"

-- | Interactive review with user prompts
interactiveReview :: Text -> TaskCore.Task -> String -> IO ()
interactiveReview tid task commitSha = do
  putText "\n=== Diff for this task ===\n"
  _ <- Process.rawSystem "git" ["show", commitSha]

  putText "\n[a]ccept / [r]eject / [s]kip? "
  IO.hFlush IO.stdout
  choice <- getLine

  case Text.toLower choice of
    c
      | "a" `Text.isPrefixOf` c -> do
          let acceptComment = buildHumanReviewComment commitSha True Nothing
          _ <- TaskCore.addComment tid acceptComment TaskCore.Human
          TaskCore.clearRetryContext tid
          TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.Human
          putText ("Task " <> tid <> " marked as Done.")
          addCompletionSummary tid commitSha
          extractFacts tid commitSha
          checkEpicCompletion task
      | "r" `Text.isPrefixOf` c -> do
          putText "Enter rejection reason: "
          IO.hFlush IO.stdout
          reason <- getLine
          let rejectComment = buildHumanReviewComment commitSha False (Just reason)
          _ <- TaskCore.addComment tid rejectComment TaskCore.Human
          maybeCtx <- TaskCore.getRetryContext tid
          let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
          let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> reason
          let accumulatedReason = case maybeCtx of
                Nothing -> currentReason
                Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
          TaskCore.setRetryContext
            TaskCore.RetryContext
              { TaskCore.retryTaskId = tid,
                TaskCore.retryOriginalCommit = Text.pack commitSha,
                TaskCore.retryConflictFiles = [],
                TaskCore.retryAttempt = attempt,
                TaskCore.retryReason = accumulatedReason,
                TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
              }
          TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
          putText ("Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).")
      | otherwise -> putText "Skipped; no status change."

-- | Build a human review comment
buildHumanReviewComment :: String -> Bool -> Maybe Text -> Text
buildHumanReviewComment commitSha accepted maybeReason =
  Text.unlines
    [ "## Human Review",
      "",
      "**Commit:** " <> Text.pack (take 8 commitSha),
      "**Result:** " <> if accepted then "✓ ACCEPTED" else "✗ REJECTED",
      case maybeReason of
        Just reason -> "**Reason:** " <> reason
        Nothing -> ""
    ]

-- | Check if a commit can be cleanly cherry-picked onto live
-- Returns Nothing if clean, Just [conflicting files] if conflict
checkMergeConflict :: String -> IO (Maybe [Text])
checkMergeConflict commitSha = do
  -- Save current state
  (_, _, _) <- Process.readProcessWithExitCode "git" ["branch", "--show-current"] ""
  (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] ""

  -- Try cherry-pick
  (cpCode, _, cpErr) <-
    Process.readProcessWithExitCode
      "git"
      ["cherry-pick", "--no-commit", commitSha]
      ""

  -- Always abort/reset regardless of result
  _ <- Process.readProcessWithExitCode "git" ["cherry-pick", "--abort"] ""
  _ <- Process.readProcessWithExitCode "git" ["reset", "--hard", List.head (List.lines origHead)] ""

  case cpCode of
    Exit.ExitSuccess -> pure Nothing
    Exit.ExitFailure _ -> do
      -- Parse conflict files from error message
      let errLines = Text.lines (Text.pack cpErr)
          conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
          -- Extract file names (rough parsing)
          files = mapMaybe extractConflictFile conflictLines
      pure (Just (if null files then ["(unknown files)"] else files))

extractConflictFile :: Text -> Maybe Text
extractConflictFile line =
  -- CONFLICT (content): Merge conflict in path/to/file.hs
  case Text.breakOn "Merge conflict in " line of
    (_, rest)
      | not (Text.null rest) -> Just (Text.strip (Text.drop 18 rest))
    _ -> case Text.breakOn "in " line of
      (_, rest)
        | not (Text.null rest) -> Just (Text.strip (Text.drop 3 rest))
      _ -> Nothing

-- | Generate and add a completion summary comment for a task
addCompletionSummary :: Text -> String -> IO ()
addCompletionSummary tid commitSha = do
  -- Get the diff and commit message for this commit
  (diffCode, diffOut, _) <- Process.readProcessWithExitCode "git" ["show", "--stat", commitSha] ""
  (msgCode, msgOut, _) <- Process.readProcessWithExitCode "git" ["log", "-1", "--format=%B", commitSha] ""

  when (diffCode == Exit.ExitSuccess && msgCode == Exit.ExitSuccess) <| do
    -- Get list of modified files
    (filesCode, filesOut, _) <- Process.readProcessWithExitCode "git" ["diff-tree", "--no-commit-id", "--name-only", "-r", commitSha] ""

    let files = if filesCode == Exit.ExitSuccess then List.lines filesOut else []
        commitMessage = Text.pack msgOut
        diffSummary = Text.pack diffOut

    -- Build prompt for llm
    let prompt = buildCompletionPrompt tid commitMessage diffSummary files

    -- Try to get API key
    maybeApiKey <- Env.lookupEnv "OPENROUTER_API_KEY"
    case maybeApiKey of
      Nothing -> do
        putText "[review] Warning: OPENROUTER_API_KEY not set, skipping completion summary"
      Just apiKey -> do
        -- Call LLM via Engine.chat
        let llm = Engine.defaultLLM {Engine.llmApiKey = Text.pack apiKey}
            messages = [Engine.Message Engine.User prompt Nothing Nothing]

        result <- Engine.chat llm [] messages
        case result of
          Left err -> do
            putText ("[review] Failed to generate completion summary: " <> err)
          Right msg -> do
            let summary = Text.strip (Engine.msgContent msg)
            unless (Text.null summary) <| do
              _ <- TaskCore.addComment tid ("## Completion Summary\n\n" <> summary) TaskCore.Junior
              putText "[review] Added completion summary comment"

-- | Build prompt for LLM to generate completion summary
buildCompletionPrompt :: Text -> Text -> Text -> [String] -> Text
buildCompletionPrompt tid commitMessage diffSummary files =
  Text.unlines
    [ "Generate a concise completion summary for this task. The summary should be 2-4 sentences.",
      "",
      "Task ID: " <> tid,
      "",
      "Commit Message:",
      commitMessage,
      "",
      "Files Modified (" <> tshow (length files) <> "):",
      Text.unlines (map Text.pack (take 10 files)),
      if length files > 10 then "... and " <> tshow (length files - 10) <> " more files" else "",
      "",
      "Diff Summary:",
      diffSummary,
      "",
      "Write a brief summary that includes:",
      "- What was accomplished (from the commit message and changes)",
      "- Key files that were modified (mention 2-3 most important ones)",
      "",
      "Keep it professional and concise. Do NOT include markdown headers or formatting.",
      "Just return the plain summary text."
    ]

-- | Extract facts from completed task
extractFacts :: Text -> String -> IO ()
extractFacts tid commitSha = do
  -- Get the diff for this commit
  (_, diffOut, _) <- Process.readProcessWithExitCode "git" ["show", "--stat", commitSha] ""

  -- Get task context
  tasks <- TaskCore.loadTasks
  case TaskCore.findTask tid tasks of
    Nothing -> pure ()
    Just task -> do
      let prompt = buildFactExtractionPrompt task diffOut

      -- Try to get API key
      maybeApiKey <- Env.lookupEnv "OPENROUTER_API_KEY"
      case maybeApiKey of
        Nothing -> do
          putText "[facts] Warning: OPENROUTER_API_KEY not set, skipping fact extraction"
        Just apiKey -> do
          -- Call LLM via Engine.chat
          let llm = Engine.defaultLLM {Engine.llmApiKey = Text.pack apiKey}
              messages = [Engine.Message Engine.User prompt Nothing Nothing]

          result <- Engine.chat llm [] messages
          case result of
            Left err -> do
              putText ("[facts] Failed to extract facts: " <> err)
            Right msg -> do
              parseFacts tid (Text.unpack (Engine.msgContent msg))

-- | Build prompt for LLM to extract facts from completed task
buildFactExtractionPrompt :: TaskCore.Task -> String -> Text
buildFactExtractionPrompt task diffSummary =
  Text.unlines
    [ "You just completed the following task:",
      "",
      "Task: " <> TaskCore.taskId task,
      "Title: " <> TaskCore.taskTitle task,
      "Description: " <> TaskCore.taskDescription task,
      "",
      "Diff summary:",
      Text.pack diffSummary,
      "",
      "List any facts you learned about this codebase that would be useful for future tasks.",
      "Each fact should be on its own line, starting with 'FACT: '.",
      "Include the relevant file paths in brackets after each fact.",
      "Example: FACT: The Alpha module re-exports common Prelude functions [Alpha.hs]",
      "If you didn't learn anything notable, respond with 'NO_FACTS'."
    ]

-- | Parse facts from LLM output and add them to the knowledge base
parseFacts :: Text -> String -> IO ()
parseFacts tid output = do
  let outputLines = Text.lines (Text.pack output)
      factLines = filter (Text.isPrefixOf "FACT: ") outputLines
  traverse_ (addFactFromLine tid) factLines

-- | Parse a single fact line and add it to the knowledge base
addFactFromLine :: Text -> Text -> IO ()
addFactFromLine tid line = do
  let content = Text.drop 6 line -- Remove "FACT: "
      (factText, filesRaw) = Text.breakOn " [" content
      files = parseFiles filesRaw
  _ <- Fact.createFact "Omni" factText files (Just tid) 0.7 -- Lower initial confidence
  putText ("[facts] Added: " <> factText)

-- | Parse file list from brackets [file1, file2, ...]
parseFiles :: Text -> [Text]
parseFiles raw
  | Text.null raw = []
  | not ("[" `Text.isInfixOf` raw) = []
  | otherwise =
      let stripped = Text.strip (Text.dropWhile (/= '[') raw)
          inner = Text.dropEnd 1 (Text.drop 1 stripped) -- Remove [ and ]
          trimmed = Text.strip inner
       in if Text.null trimmed
            then []
            else map Text.strip (Text.splitOn "," inner)

-- | Generate a summary comment for an epic when all children are complete
generateEpicSummary :: Text -> TaskCore.Task -> [TaskCore.Task] -> IO ()
generateEpicSummary epicId epic children = do
  putText "[epic] Generating summary for completed epic..."

  -- Try to get API key
  maybeApiKey <- Env.lookupEnv "OPENROUTER_API_KEY"
  case maybeApiKey of
    Nothing -> do
      putText "[epic] Warning: OPENROUTER_API_KEY not set, skipping summary generation"
      pure ()
    Just apiKey -> do
      -- Build the prompt for LLM
      prompt <- buildEpicSummaryPrompt epic children

      -- Call LLM
      let llm = Engine.defaultLLM {Engine.llmApiKey = Text.pack apiKey}
          messages = [Engine.Message Engine.User prompt Nothing Nothing]

      result <- Engine.chat llm [] messages
      case result of
        Left err -> do
          putText ("[epic] Failed to generate summary: " <> err)
        Right msg -> do
          let summary = Engine.msgContent msg
          _ <- TaskCore.addComment epicId summary TaskCore.Junior
          putText "[epic] Summary comment added to epic"

-- | Build a prompt for the LLM to summarize an epic
buildEpicSummaryPrompt :: TaskCore.Task -> [TaskCore.Task] -> IO Text
buildEpicSummaryPrompt epic children = do
  -- Get commit info for each child task
  childSummaries <- traverse summarizeChildTask children

  pure
    <| Text.unlines
      [ "Generate a concise summary comment for this completed epic.",
        "",
        "## Epic Information",
        "**Title:** " <> TaskCore.taskTitle epic,
        "**Description:**",
        TaskCore.taskDescription epic,
        "",
        "## Completed Child Tasks (" <> tshow (length children) <> ")",
        Text.unlines childSummaries,
        "",
        "## Instructions",
        "Create a markdown summary that includes:",
        "1. A brief overview of what was accomplished",
        "2. List of completed tasks with their titles",
        "3. Key changes or files modified (if mentioned in task descriptions)",
        "4. Any notable patterns or themes across the work",
        "",
        "Format the summary as a markdown comment starting with '## Epic Summary'.",
        "Keep it concise but informative."
      ]

-- | Summarize a single child task for the epic summary
summarizeChildTask :: TaskCore.Task -> IO Text
summarizeChildTask task = do
  -- Try to get commit info
  let grepArg = "--grep=" <> Text.unpack (TaskCore.taskId task)
  (code, shaOut, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "--pretty=format:%h %s", "-n", "1", grepArg]
      ""

  let commitInfo =
        if code == Exit.ExitSuccess && not (null shaOut)
          then " [" <> Text.pack (take 80 shaOut) <> "]"
          else ""

  -- Get files changed in the commit
  filesInfo <- getCommitFiles (TaskCore.taskId task)

  pure <| "- **" <> TaskCore.taskId task <> "**: " <> TaskCore.taskTitle task <> commitInfo <> filesInfo

-- | Get files modified in a commit for a task
getCommitFiles :: Text -> IO Text
getCommitFiles taskId = do
  let grepArg = "--grep=" <> Text.unpack taskId
  (code, shaOut, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "--pretty=format:%H", "-n", "1", grepArg]
      ""

  if code /= Exit.ExitSuccess || null shaOut
    then pure ""
    else do
      let sha = List.head (List.lines shaOut)
      (fileCode, filesOut, _) <-
        Process.readProcessWithExitCode
          "git"
          ["diff-tree", "--no-commit-id", "--name-only", "-r", sha]
          ""
      if fileCode /= Exit.ExitSuccess || null filesOut
        then pure ""
        else do
          let files = List.lines filesOut
              fileList = List.take 3 files -- Limit to first 3 files
              moreCount = length files - 3
              filesText = Text.intercalate ", " (map Text.pack fileList)
              suffix = if moreCount > 0 then " (+" <> tshow moreCount <> " more)" else ""
          pure <| if null files then "" else " — " <> filesText <> suffix

-- | Check if all children of an epic are Done, and if so, transition epic to Review
checkEpicCompletion :: TaskCore.Task -> IO ()
checkEpicCompletion task =
  case TaskCore.taskParent task of
    Nothing -> pure ()
    Just parentId -> do
      tasks <- TaskCore.loadTasks
      case TaskCore.findTask parentId tasks of
        Nothing -> pure ()
        Just parentTask ->
          when (TaskCore.taskType parentTask == TaskCore.Epic) <| do
            let children = filter (hasParent parentId) tasks
                allDone = all (\t -> TaskCore.taskStatus t == TaskCore.Done) children
            when (allDone && not (null children)) <| do
              putText ("[review] All children of epic " <> parentId <> " are Done.")
              TaskCore.updateTaskStatusWithActor parentId TaskCore.Review [] TaskCore.System
              putText ("[review] Epic " <> parentId <> " -> Review")
              -- Generate summary comment for the epic
              generateEpicSummary parentId parentTask children
  where
    hasParent pid t = maybe False (TaskCore.matchesId pid) (TaskCore.taskParent t)

-- | Handle facts subcommands
handleFacts :: Cli.Arguments -> IO ()
handleFacts args
  | args `Cli.has` Cli.command "list" = do
      let maybeProject = Text.pack </ Cli.getArg args (Cli.longOption "project")
          jsonMode = args `Cli.has` Cli.longOption "json"
      facts <- maybe Fact.getAllFacts Fact.getFactsByProject maybeProject
      if jsonMode
        then BLC.putStrLn (Aeson.encode facts)
        else traverse_ printFact facts
  | args `Cli.has` Cli.command "show" = do
      let jsonMode = args `Cli.has` Cli.longOption "json"
      case Cli.getArg args (Cli.argument "fact-id") of
        Nothing -> putText "fact-id required"
        Just fidStr -> case readMaybe fidStr of
          Nothing -> putText "Invalid fact ID (must be integer)"
          Just fid -> do
            maybeFact <- Fact.getFact fid
            case maybeFact of
              Nothing -> putText "Fact not found"
              Just fact ->
                if jsonMode
                  then BLC.putStrLn (Aeson.encode fact)
                  else printFactDetailed fact
  | args `Cli.has` Cli.command "add" = do
      let jsonMode = args `Cli.has` Cli.longOption "json"
      case (Cli.getArg args (Cli.argument "project"), Cli.getArg args (Cli.argument "content")) of
        (Just proj, Just content) -> do
          let files = case Cli.getArg args (Cli.longOption "files") of
                Just f -> Text.splitOn "," (Text.pack f)
                Nothing -> []
              sourceTask = Text.pack </ Cli.getArg args (Cli.longOption "task")
              confidence = case Cli.getArg args (Cli.longOption "confidence") of
                Just c -> fromMaybe 0.8 (readMaybe c)
                Nothing -> 0.8
          factId <- Fact.createFact (Text.pack proj) (Text.pack content) files sourceTask confidence
          if jsonMode
            then BLC.putStrLn (Aeson.encode (Aeson.object ["id" Aeson..= factId, "success" Aeson..= True]))
            else putText ("Created fact: " <> tshow factId)
        _ -> putText "project and content required"
  | args `Cli.has` Cli.command "delete" = do
      let jsonMode = args `Cli.has` Cli.longOption "json"
      case Cli.getArg args (Cli.argument "fact-id") of
        Nothing -> putText "fact-id required"
        Just fidStr -> case readMaybe fidStr of
          Nothing -> putText "Invalid fact ID (must be integer)"
          Just fid -> do
            Fact.deleteFact fid
            if jsonMode
              then BLC.putStrLn (Aeson.encode (Aeson.object ["success" Aeson..= True, "message" Aeson..= ("Deleted fact " <> tshow fid)]))
              else putText ("Deleted fact: " <> tshow fid)
  | otherwise = putText "Unknown facts subcommand. Use: list, show, add, or delete"

-- | Print a fact in a compact format
printFact :: TaskCore.Fact -> IO ()
printFact fact = do
  let fid = maybe "?" tshow (TaskCore.factId fact)
      proj = TaskCore.factProject fact
      content = Text.take 60 (TaskCore.factContent fact)
      suffix = if Text.length (TaskCore.factContent fact) > 60 then "..." else ""
  putText (fid <> "\t" <> proj <> "\t" <> content <> suffix)

-- | Print a fact in detailed format
printFactDetailed :: TaskCore.Fact -> IO ()
printFactDetailed fact = do
  putText ("ID:         " <> maybe "?" tshow (TaskCore.factId fact))
  putText ("Project:    " <> TaskCore.factProject fact)
  putText ("Content:    " <> TaskCore.factContent fact)
  putText ("Files:      " <> Text.intercalate ", " (TaskCore.factRelatedFiles fact))
  putText ("Source:     " <> fromMaybe "-" (TaskCore.factSourceTask fact))
  putText ("Confidence: " <> tshow (TaskCore.factConfidence fact))
  putText ("Created:    " <> tshow (TaskCore.factCreatedAt fact))

test :: Test.Tree
test =
  Test.group
    "Omni.Jr"
    [ Test.unit "can run tests" <| True Test.@?= True,
      Test.unit "can parse task command" <| do
        let result = Docopt.parseArgs help ["task"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'task': " <> show err
          Right args -> args `Cli.has` Cli.command "task" Test.@?= True,
      Test.unit "can parse task command with args" <| do
        let result = Docopt.parseArgs help ["task", "list", "--json"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'task list --json': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "task" Test.@?= True
            Cli.getAllArgs args (Cli.argument "args") Test.@?= ["list", "--json"],
      Test.unit "can parse work command" <| do
        let result = Docopt.parseArgs help ["work"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'work': " <> show err
          Right args -> args `Cli.has` Cli.command "work" Test.@?= True,
      Test.unit "can parse work command with task id" <| do
        let result = Docopt.parseArgs help ["work", "t-123"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'work t-123': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "work" Test.@?= True
            Cli.getArg args (Cli.argument "task-id") Test.@?= Just "t-123",
      Test.unit "can parse facts list command" <| do
        let result = Docopt.parseArgs help ["facts", "list"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'facts list': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "facts" Test.@?= True
            args `Cli.has` Cli.command "list" Test.@?= True,
      Test.unit "can parse facts list with --project" <| do
        let result = Docopt.parseArgs help ["facts", "list", "--project=myproj"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'facts list --project': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "facts" Test.@?= True
            args `Cli.has` Cli.command "list" Test.@?= True
            Cli.getArg args (Cli.longOption "project") Test.@?= Just "myproj",
      Test.unit "can parse facts list with --json" <| do
        let result = Docopt.parseArgs help ["facts", "list", "--json"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'facts list --json': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "facts" Test.@?= True
            args `Cli.has` Cli.command "list" Test.@?= True
            args `Cli.has` Cli.longOption "json" Test.@?= True,
      Test.unit "can parse facts show command" <| do
        let result = Docopt.parseArgs help ["facts", "show", "42"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'facts show 42': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "facts" Test.@?= True
            args `Cli.has` Cli.command "show" Test.@?= True
            Cli.getArg args (Cli.argument "fact-id") Test.@?= Just "42",
      Test.unit "can parse facts add command" <| do
        let result = Docopt.parseArgs help ["facts", "add", "myproj", "This is a fact"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'facts add': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "facts" Test.@?= True
            args `Cli.has` Cli.command "add" Test.@?= True
            Cli.getArg args (Cli.argument "project") Test.@?= Just "myproj"
            Cli.getArg args (Cli.argument "content") Test.@?= Just "This is a fact",
      Test.unit "can parse facts add with options" <| do
        let result = Docopt.parseArgs help ["facts", "add", "myproj", "fact", "--files=a.hs,b.hs", "--task=t-123", "--confidence=0.9"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'facts add' with options: " <> show err
          Right args -> do
            args `Cli.has` Cli.command "facts" Test.@?= True
            args `Cli.has` Cli.command "add" Test.@?= True
            Cli.getArg args (Cli.longOption "files") Test.@?= Just "a.hs,b.hs"
            Cli.getArg args (Cli.longOption "task") Test.@?= Just "t-123"
            Cli.getArg args (Cli.longOption "confidence") Test.@?= Just "0.9",
      Test.unit "can parse facts delete command" <| do
        let result = Docopt.parseArgs help ["facts", "delete", "42"]
        case result of
          Left err -> Test.assertFailure <| "Failed to parse 'facts delete 42': " <> show err
          Right args -> do
            args `Cli.has` Cli.command "facts" Test.@?= True
            args `Cli.has` Cli.command "delete" Test.@?= True
            Cli.getArg args (Cli.argument "fact-id") Test.@?= Just "42"
    ]