summaryrefslogtreecommitdiff
path: root/Omni/Jr.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr.hs')
-rwxr-xr-xOmni/Jr.hs762
1 files changed, 762 insertions, 0 deletions
diff --git a/Omni/Jr.hs b/Omni/Jr.hs
new file mode 100755
index 0000000..0690970
--- /dev/null
+++ b/Omni/Jr.hs
@@ -0,0 +1,762 @@
+#!/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.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.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>]
+ 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
+ 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]
+ --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 "work" = do
+ -- Always run in current directory
+ let path = "."
+
+ -- Infer name from current directory
+ 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 = path,
+ AgentCore.workerQuiet = False -- Show ANSI status bar for manual work
+ }
+
+ 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
+ }
+ 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.updateTaskStatus tid TaskCore.Open []
+ 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
+
+ if attempt > 3
+ then do
+ putText "[review] Task has failed 3 times. Needs human intervention."
+ TaskCore.updateTaskStatus tid TaskCore.Open []
+ 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.updateTaskStatus tid TaskCore.Open []
+ 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.clearRetryContext tid
+ TaskCore.updateTaskStatus tid TaskCore.Done []
+ putText ("[review] Task " <> tid <> " -> Done")
+ 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
+
+ if attempt > 3
+ then do
+ putText "[review] Task has failed 3 times. Needs human intervention."
+ TaskCore.updateTaskStatus tid TaskCore.Open []
+ 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.updateTaskStatus tid TaskCore.Open []
+ 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.clearRetryContext tid
+ TaskCore.updateTaskStatus tid TaskCore.Done []
+ putText ("Task " <> tid <> " marked as Done.")
+ 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
+ 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.updateTaskStatus tid TaskCore.Open []
+ 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
+
+-- | 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.updateTaskStatus parentId TaskCore.Review []
+ putText ("[review] Epic " <> parentId <> " -> Review")
+ 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"
+ ]
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-15 06:37:01 +0000