{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} -- : out jr -- : dep sqlite-simple module Omni.Jr where import Alpha 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.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 [] jr review jr merge-driver jr test jr (-h | --help) Commands: task Manage tasks work Start a worker agent on a task review Review a completed task (show diff, accept/reject) merge-driver Internal git merge driver Options: -h --help Show this help |] 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 "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 } let taskId = fmap Text.pack (Cli.getArg args (Cli.argument "task-id")) AgentWorker.start worker taskId | args `Cli.has` Cli.command "review" = do tidStr <- getArgOrExit args (Cli.argument "task-id") reviewTask (Text.pack tidStr) | args `Cli.has` Cli.command "merge-driver" = mergeDriver args | otherwise = putText (str <| Docopt.usage help) mergeDriver :: Cli.Arguments -> IO () mergeDriver args = do ours <- getArgOrExit args (Cli.argument "ours") theirs <- getArgOrExit args (Cli.argument "theirs") -- Set TASK_DB_PATH to ours (the file git provided as the current version) -- Since we are no longer using git-tracked tasks.jsonl, this merge driver logic needs rethinking. -- If the merge driver is called, it means git found a conflict in .tasks/tasks.jsonl, but we deleted it. -- So this code might be dead, or we might be dealing with legacy files during a rebase. -- For now, we'll keep the logic but be aware it's likely unused. Env.setEnv "TASK_DB_PATH" ours -- TaskCore.importTasks theirs -- Task.importTasks theirs -- We need to call task import via CLI or library. -- Omni.Task.importTasks IS NOT EXPOSED. -- But we can call Task.main withArgs ["import", "-i", theirs] Task.main Exit.exitSuccess getArgOrExit :: Cli.Arguments -> Docopt.Option -> IO String getArgOrExit args opt = case Cli.getArg args opt of Just val -> pure val Nothing -> do putText <| "Error: Missing required argument " <> Text.pack (show opt) Exit.exitFailure reviewTask :: Text -> IO () reviewTask tid = do tasks <- TaskCore.loadTasks case TaskCore.findTask tid tasks of Nothing -> do putText ("Task " <> tid <> " not found.") Exit.exitFailure Just task -> do 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 [] -> "" 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 TaskCore.updateTaskStatus tid TaskCore.Done [] putText ("Task " <> tid <> " marked as Done.") | "r" `Text.isPrefixOf` c -> do putText "Enter rejection reason: " IO.hFlush IO.stdout reason <- getLine TaskCore.updateTaskStatus tid TaskCore.Open [] putText ("Task " <> tid <> " reopened.") putText ("Reason: " <> reason) | otherwise -> putText "Skipped; no status change." test :: Test.Tree test = Test.group "Omni.Jr" [ Test.unit "can run tests" <| True Test.@?= True, 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" ]