#!/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 [...] jr work [] [--engine=ENGINE] jr prompt jr web [--port=PORT] jr review [] [--auto] jr loop [--delay=SECONDS] jr facts list [--project=PROJECT] [--json] jr facts show [--json] jr facts add [--files=FILES] [--task=TASK] [--confidence=CONF] [--json] jr facts delete [--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 ) 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 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 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" ]