diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Agent/Git.hs | 29 | ||||
| -rw-r--r-- | Omni/Agent/Log.hs | 157 | ||||
| -rw-r--r-- | Omni/Agent/LogTest.hs | 78 | ||||
| -rw-r--r-- | Omni/Agent/Worker.hs | 74 | ||||
| -rwxr-xr-x | Omni/Bild/Audit.py | 176 | ||||
| -rw-r--r-- | Omni/Task.hs | 184 | ||||
| -rw-r--r-- | Omni/Task/Core.hs | 76 |
7 files changed, 612 insertions, 162 deletions
diff --git a/Omni/Agent/Git.hs b/Omni/Agent/Git.hs index a2009b2..b1978f2 100644 --- a/Omni/Agent/Git.hs +++ b/Omni/Agent/Git.hs @@ -25,7 +25,6 @@ import Omni.Test ((@=?)) import qualified Omni.Test as Test import qualified System.Directory as Directory import qualified System.Exit as Exit -import System.FilePath ((</>)) import qualified System.IO.Temp as Temp import qualified System.Process as Process @@ -149,30 +148,16 @@ syncWithLive repo = do Log.info ["git", "syncing with live"] -- git repo ["fetch", "origin", "live"] -- Optional - -- Try rebase, if fail, abort - -- First, proactively cleanup any stale rebase state - cleanupStaleRebase repo - - let cmd = (Process.proc "git" ["rebase", "live"]) {Process.cwd = Just repo} - (code, _, err) <- Process.readCreateProcessWithExitCode cmd "" + -- Try sync (branchless sync), if fail, panic + -- This replaces manual rebase and handles stack movement + let cmd = (Process.proc "git" ["sync"]) {Process.cwd = Just repo} + (code, out, err) <- Process.readCreateProcessWithExitCode cmd "" case code of Exit.ExitSuccess -> pure () Exit.ExitFailure _ -> do - Log.warn ["rebase failed, aborting", Text.pack err] - cleanupStaleRebase repo - panic "Sync with live failed (rebase conflict)" - -cleanupStaleRebase :: FilePath -> IO () -cleanupStaleRebase repo = do - -- Check if a rebase is in progress - rebaseMerge <- Directory.doesDirectoryExist (repo </> ".git/rebase-merge") - rebaseApply <- Directory.doesDirectoryExist (repo </> ".git/rebase-apply") - - when (rebaseMerge || rebaseApply) <| do - Log.warn ["git", "detected stale rebase", "aborting"] - let abort = (Process.proc "git" ["rebase", "--abort"]) {Process.cwd = Just repo} - _ <- Process.readCreateProcessWithExitCode abort "" - pure () + Log.warn ["git sync failed", Text.pack err] + Log.info [Text.pack out] + panic "Sync with live failed (git sync)" commit :: FilePath -> Text -> IO () commit repo msg = do diff --git a/Omni/Agent/Log.hs b/Omni/Agent/Log.hs index afaf1da..dd66abc 100644 --- a/Omni/Agent/Log.hs +++ b/Omni/Agent/Log.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -6,16 +7,34 @@ module Omni.Agent.Log where import Alpha +import Data.Aeson (Value (..), decode) +import qualified Data.Aeson.KeyMap as KM +import qualified Data.ByteString.Lazy as BL import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef) +import qualified Data.Text.Encoding as TextEnc import qualified Data.Text.IO as TIO +import qualified Data.Vector as V import qualified System.Console.ANSI as ANSI import qualified System.IO as IO import System.IO.Unsafe (unsafePerformIO) +import Text.Printf (printf) + +-- | Parsed log entry +data LogEntry = LogEntry + { leMessage :: Maybe Text, + leLevel :: Maybe Text, + leToolName :: Maybe Text, + leBatches :: Maybe [[Text]], + leMethod :: Maybe Text, + lePath :: Maybe Text + } + deriving (Show, Eq) -- | Status of the agent for the UI data Status = Status { statusWorker :: Text, statusTask :: Maybe Text, + statusThreadId :: Maybe Text, statusFiles :: Int, statusCredits :: Double, statusTime :: Text, -- formatted time string @@ -28,6 +47,7 @@ emptyStatus workerName = Status { statusWorker = workerName, statusTask = Nothing, + statusThreadId = Nothing, statusFiles = 0, statusCredits = 0.0, statusTime = "00:00", @@ -44,10 +64,9 @@ init :: Text -> IO () init workerName = do IO.hSetBuffering IO.stderr IO.LineBuffering writeIORef currentStatus (emptyStatus workerName) - -- Reserve 2 lines at bottom - IO.hPutStrLn IO.stderr "" - IO.hPutStrLn IO.stderr "" - ANSI.hCursorUp IO.stderr 2 + -- Reserve 5 lines at bottom + replicateM_ 5 (IO.hPutStrLn IO.stderr "") + ANSI.hCursorUp IO.stderr 5 -- | Update the status update :: (Status -> Status) -> IO () @@ -59,14 +78,96 @@ update f = do updateActivity :: Text -> IO () updateActivity msg = update (\s -> s {statusActivity = msg}) +-- | Process a log line from the agent and update status if relevant +processLogLine :: Text -> IO () +processLogLine line = do + let entry = parseLine line + for_ (entry +> formatLogEntry) updateActivity + +-- | Parse a JSON log line into a LogEntry +parseLine :: Text -> Maybe LogEntry +parseLine line = do + let lbs = BL.fromStrict (TextEnc.encodeUtf8 line) + obj <- decode lbs + case obj of + Object o -> + Just + LogEntry + { leMessage = getString "message" o, + leLevel = getString "level" o, + leToolName = getString "toolName" o, + leBatches = getBatches o, + leMethod = getString "method" o, + lePath = getString "path" o + } + _ -> Nothing + where + getString k o = + case KM.lookup k o of + Just (String s) -> Just s + _ -> Nothing + + getBatches o = + case KM.lookup "batches" o of + Just (Array b) -> + Just + <| mapMaybe + ( \case + Array b0 -> + Just + <| mapMaybe + ( \case + String s -> Just s + _ -> Nothing + ) + (V.toList b0) + _ -> Nothing + ) + (V.toList b) + _ -> Nothing + +-- | Format a log entry into a user-friendly status message (NO EMOJIS) +formatLogEntry :: LogEntry -> Maybe Text +formatLogEntry LogEntry {..} = + case leMessage of + Just "executing 1 tools in 1 batch(es)" -> do + let tools = fromMaybe [] leBatches + let firstTool = case tools of + ((t : _) : _) -> t + _ -> "unknown" + Just ("THOUGHT: Planning tool execution (" <> firstTool <> ")") + Just "Tool Bash permitted - action: allow" -> + Just "TOOL: Bash command executed" + Just "Processing tool completion for ledger" + | isJust leToolName -> + Just ("TOOL: " <> fromMaybe "unknown" leToolName <> " completed") + Just "ide-fs" | leMethod == Just "readFile" -> + case lePath of + Just p -> Just ("READ: " <> p) + _ -> Nothing + Just "System prompt build complete (no changes)" -> + Just "THINKING..." + Just "System prompt build complete (first build)" -> + Just "STARTING new task context" + Just msg + | leLevel == Just "error" -> + Just ("ERROR: " <> msg) + _ -> Nothing + -- | Log a scrolling message (appears above status bars) log :: Text -> IO () log msg = do - -- Clear status bars + -- Clear status bars (5 lines) ANSI.hClearLine IO.stderr ANSI.hCursorDown IO.stderr 1 ANSI.hClearLine IO.stderr - ANSI.hCursorUp IO.stderr 1 + ANSI.hCursorDown IO.stderr 1 + ANSI.hClearLine IO.stderr + ANSI.hCursorDown IO.stderr 1 + ANSI.hClearLine IO.stderr + ANSI.hCursorDown IO.stderr 1 + ANSI.hClearLine IO.stderr + ANSI.hCursorUp IO.stderr 4 -- Print message (scrolls screen) TIO.hPutStrLn IO.stderr msg @@ -75,37 +176,43 @@ log msg = do -- (Since we scrolled, we are now on the line above where the first status line should be) render --- | Render the two status lines +-- | Render the 5 status lines (Vertical Layout) render :: IO () render = do Status {..} <- readIORef currentStatus - -- Line 1: Meta - -- [Worker: name] Task: t-123 | Files: 3 | Credits: $0.45 | Time: 05:23 let taskStr = maybe "None" identity statusTask - meta = - "[Worker: " - <> statusWorker - <> "] Task: " - <> taskStr - <> " | Files: " - <> tshow statusFiles - <> " | Credits: $" - <> tshow statusCredits - <> " | Time: " - <> statusTime + threadStr = maybe "None" identity statusThreadId + -- Line 1: Worker + Time + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr <| "Worker: " <> statusWorker <> " | Time: " <> statusTime + + -- Line 2: Task + ANSI.hCursorDown IO.stderr 1 + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr <| "Task: " <> taskStr + + -- Line 3: Thread + ANSI.hCursorDown IO.stderr 1 + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr <| "Thread: " <> threadStr + + -- Line 4: Credits + ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr - TIO.hPutStr IO.stderr meta + TIO.hPutStr IO.stderr <| "Credits: $" <> str (printf "%.2f" statusCredits :: String) - -- Line 2: Activity - -- [14:05:22] > Thinking... + -- Line 5: Activity ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr TIO.hPutStr IO.stderr ("> " <> statusActivity) - -- Return cursor to line 1 - ANSI.hCursorUp IO.stderr 1 + -- Return cursor to Line 1 + ANSI.hCursorUp IO.stderr 4 IO.hFlush IO.stderr diff --git a/Omni/Agent/LogTest.hs b/Omni/Agent/LogTest.hs index 518147e..97b558d 100644 --- a/Omni/Agent/LogTest.hs +++ b/Omni/Agent/LogTest.hs @@ -5,7 +5,6 @@ module Omni.Agent.LogTest where import Alpha -import qualified Data.Set as Set import Omni.Agent.Log import qualified Omni.Test as Test @@ -17,9 +16,7 @@ tests = Test.group "Omni.Agent.Log" [ Test.unit "Parse LogEntry" testParse, - Test.unit "Format LogEntry" testFormat, - Test.unit "Update Status" testUpdateStatus, - Test.unit "Render Status" testRenderStatus + Test.unit "Format LogEntry" testFormat ] testParse :: IO () @@ -27,13 +24,12 @@ testParse = do let json = "{\"message\": \"executing 1 tools in 1 batch(es)\", \"batches\": [[\"grep\"]]}" let expected = LogEntry - { leMessage = "executing 1 tools in 1 batch(es)", + { leMessage = Just "executing 1 tools in 1 batch(es)", leLevel = Nothing, leToolName = Nothing, leBatches = Just [["grep"]], leMethod = Nothing, - lePath = Nothing, - leTimestamp = Nothing + lePath = Nothing } parseLine json @?= Just expected @@ -41,84 +37,38 @@ testFormat :: IO () testFormat = do let entry = LogEntry - { leMessage = "executing 1 tools in 1 batch(es)", + { leMessage = Just "executing 1 tools in 1 batch(es)", leLevel = Nothing, leToolName = Nothing, leBatches = Just [["grep"]], leMethod = Nothing, - lePath = Nothing, - leTimestamp = Nothing + lePath = Nothing } - format entry @?= Just "🤖 THOUGHT: Planning tool execution (grep)" + -- Expect NO emoji + formatLogEntry entry @?= Just "THOUGHT: Planning tool execution (grep)" let entry2 = LogEntry - { leMessage = "some random log", + { leMessage = Just "some random log", leLevel = Nothing, leToolName = Nothing, leBatches = Nothing, leMethod = Nothing, - lePath = Nothing, - leTimestamp = Nothing + lePath = Nothing } - format entry2 @?= Nothing + formatLogEntry entry2 @?= Nothing let entry3 = LogEntry - { leMessage = "some error", + { leMessage = Just "some error", leLevel = Just "error", leToolName = Nothing, leBatches = Nothing, leMethod = Nothing, - lePath = Nothing, - leTimestamp = Nothing + lePath = Nothing } - format entry3 @?= Just "❌ ERROR: some error" - -testUpdateStatus :: IO () -testUpdateStatus = do - let s0 = initialStatus "worker-1" - let e1 = - LogEntry - { leMessage = "executing 1 tools in 1 batch(es)", - leLevel = Nothing, - leToolName = Nothing, - leBatches = Just [["grep"]], - leMethod = Nothing, - lePath = Nothing, - leTimestamp = Just "12:00:00" - } - let s1 = updateStatus e1 s0 - sLastActivity s1 @?= "🤖 THOUGHT: Planning tool execution (grep)" - sStartTime s1 @?= Just "12:00:00" - - let e2 = - LogEntry - { leMessage = "ide-fs", - leLevel = Nothing, - leToolName = Nothing, - leBatches = Nothing, - leMethod = Just "readFile", - lePath = Just "/path/to/file", - leTimestamp = Just "12:00:01" - } - let s2 = updateStatus e2 s1 - sLastActivity s2 @?= "📂 READ: /path/to/file" - Set.member "/path/to/file" (sFiles s2) @?= True - sStartTime s2 @?= Just "12:00:00" -- Should preserve start time - -testRenderStatus :: IO () -testRenderStatus = do - let s = - Status - { sWorkerName = "worker-1", - sTaskId = Just "t-123", - sFiles = Set.fromList ["file1", "file2"], - sStartTime = Just "12:00", - sLastActivity = "Running..." - } - let output = renderStatus s - output @?= "[Worker: worker-1] Task: t-123 | Files: 2\nRunning..." + -- Expect NO emoji + formatLogEntry entry3 @?= Just "ERROR: some error" (@?=) :: (Eq a, Show a) => a -> a -> IO () (@?=) = (Test.@?=) diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs index 01099a0..1cc0b8d 100644 --- a/Omni/Agent/Worker.hs +++ b/Omni/Agent/Worker.hs @@ -6,6 +6,7 @@ module Omni.Agent.Worker where import Alpha import qualified Data.Text as Text +import qualified Data.Text.IO as TIO import qualified Omni.Agent.Core as Core import qualified Omni.Agent.Git as Git import qualified Omni.Agent.Log as AgentLog @@ -13,6 +14,7 @@ import qualified Omni.Task.Core as TaskCore import qualified System.Directory as Directory import qualified System.Exit as Exit import System.FilePath ((</>)) +import qualified System.IO as IO import qualified System.Process as Process start :: Core.Worker -> IO () @@ -58,7 +60,7 @@ processTask worker task = do AgentLog.updateActivity ("Claiming task " <> tid) -- Claim task - TaskCore.updateTaskStatus tid TaskCore.InProgress + TaskCore.updateTaskStatus tid TaskCore.InProgress [] -- Commit claim locally Git.commit repo ("task: claim " <> tid) @@ -87,18 +89,20 @@ processTask worker task = do -- Run Amp AgentLog.updateActivity "Running Amp agent..." - exitCode <- runAmp repo task + (exitCode, output) <- runAmp repo task case exitCode of Exit.ExitSuccess -> do AgentLog.log "Agent finished successfully" -- Update status to Review (bundled with feature commit) - TaskCore.updateTaskStatus tid TaskCore.Review + TaskCore.updateTaskStatus tid TaskCore.Review [] -- Commit changes - -- We should check if there are changes, but 'git add .' is safe. - Git.commit repo ("feat: implement " <> tid) + -- We use the agent's output as the extended commit description + let summary = Text.strip output + let commitMsg = "feat: implement " <> tid <> "\n\n" <> summary + Git.commit repo commitMsg -- Submit for review AgentLog.updateActivity "Submitting for review..." @@ -111,18 +115,17 @@ processTask worker task = do Git.syncWithLive repo -- Update status to Review (for signaling) - TaskCore.updateTaskStatus tid TaskCore.Review + TaskCore.updateTaskStatus tid TaskCore.Review [] Git.commit repo ("task: review " <> tid) - + AgentLog.log ("[✓] Task " <> tid <> " completed") AgentLog.update (\s -> s {AgentLog.statusTask = Nothing}) - Exit.ExitFailure code -> do AgentLog.log ("Agent failed with code " <> tshow code) AgentLog.updateActivity "Agent failed, retrying..." threadDelay (10 * 1000000) -- Sleep 10s -runAmp :: FilePath -> TaskCore.Task -> IO Exit.ExitCode +runAmp :: FilePath -> TaskCore.Task -> IO (Exit.ExitCode, Text) runAmp repo task = do let prompt = "You are a Worker Agent.\n" @@ -134,7 +137,8 @@ runAmp repo task = do <> "3. Run tests to verify your work (e.g., 'bild --test Omni/Namespace').\n" <> "4. Fix any errors found during testing.\n" <> "5. Do NOT update the task status or manage git branches (the system handles that).\n" - <> "6. When finished and tested, exit.\n\n" + <> "6. Do NOT run 'git commit'. The system will commit your changes automatically.\n" + <> "7. When finished and tested, exit.\n\n" <> "Context:\n" <> "- You are working in '" <> Text.pack repo @@ -144,13 +148,37 @@ runAmp repo task = do <> "'.\n" Directory.createDirectoryIfMissing True (repo </> "_/llm") + let logPath = repo </> "_/llm/amp.log" + + -- Ensure log file is empty/exists + IO.writeFile logPath "" + + -- Read AGENTS.md + agentsMd <- + fmap (fromMaybe "") <| do + exists <- Directory.doesFileExist (repo </> "AGENTS.md") + if exists + then Just </ readFile (repo </> "AGENTS.md") + else pure Nothing + + let fullPrompt = + prompt + <> "\n\nREPOSITORY GUIDELINES (AGENTS.md):\n" + <> agentsMd + + -- Monitor log file + tidLog <- forkIO (monitorLog logPath) -- Assume amp is in PATH - let args = ["--log-level", "debug", "--log-file", "_/llm/amp.log", "--dangerously-allow-all", "-x", Text.unpack prompt] + let args = ["--log-level", "debug", "--log-file", "_/llm/amp.log", "--dangerously-allow-all", "-x", Text.unpack fullPrompt] let cp = (Process.proc "amp" args) {Process.cwd = Just repo} - (_, _, _, ph) <- Process.createProcess cp - Process.waitForProcess ph + (exitCode, out, _err) <- Process.readCreateProcessWithExitCode cp "" + + -- Cleanup + killThread tidLog + + pure (exitCode, Text.pack out) formatTask :: TaskCore.Task -> Text formatTask t = @@ -202,3 +230,23 @@ findBaseBranch repo task = do case candidates of (candidate : _) -> pure ("task/" <> TaskCore.depId candidate) [] -> pure "live" + +monitorLog :: FilePath -> IO () +monitorLog path = do + -- Wait for file to exist + waitForFile path + + IO.withFile path IO.ReadMode <| \h -> do + IO.hSetBuffering h IO.LineBuffering + forever <| do + eof <- IO.hIsEOF h + if eof + then threadDelay 100000 -- 0.1s + else do + line <- TIO.hGetLine h + AgentLog.processLogLine line + +waitForFile :: FilePath -> IO () +waitForFile p = do + e <- Directory.doesFileExist p + if e then pure () else threadDelay 100000 >> waitForFile p diff --git a/Omni/Bild/Audit.py b/Omni/Bild/Audit.py new file mode 100755 index 0000000..4df6c0b --- /dev/null +++ b/Omni/Bild/Audit.py @@ -0,0 +1,176 @@ +#!/usr/bin/env python3 +""" +Audit codebase builds. + +Iterates through every namespace in the project and runs 'bild'. +For every build failure encountered, it automatically creates a new task. +""" + +# : out bild-audit + +import argparse +import re +import shutil +import subprocess +import sys +from pathlib import Path + +# Extensions supported by bild (from Omni/Bild.hs and Omni/Namespace.hs) +EXTENSIONS = {".c", ".hs", ".lisp", ".nix", ".py", ".scm", ".rs", ".toml"} +MAX_TITLE_LENGTH = 50 + + +def strip_ansi(text: str) -> str: + """Strip ANSI escape codes from text.""" + ansi_escape = re.compile(r"\x1B(?:[@-Z\\-_]|\[[0-?]*[ -/]*[@-~])") + return ansi_escape.sub("", text) + + +def is_ignored(path: Path) -> bool: + """Check if a file is ignored by git.""" + res = subprocess.run( + ["git", "check-ignore", str(path)], + stdout=subprocess.DEVNULL, + stderr=subprocess.DEVNULL, + check=False, + ) + return res.returncode == 0 + + +def get_buildable_files(root_dir: str = ".") -> list[str]: + """Find all files that bild can build.""" + targets: list[str] = [] + + root = Path(root_dir) + if not root.exists(): + return [] + + for path in root.rglob("*"): + # Skip directories + if path.is_dir(): + continue + + # Skip hidden files/dirs and '_' dirs + parts = path.parts + if any(p.startswith(".") or p == "_" for p in parts): + continue + + if path.suffix in EXTENSIONS: + # Clean up path: keep it relative to cwd if possible + try: + # We want the path as a string, relative to current directory + # if possible + p_str = ( + str(path.relative_to(Path.cwd())) + if path.is_absolute() + else str(path) + ) + except ValueError: + p_str = str(path) + + if not is_ignored(Path(p_str)): + targets.append(p_str) + return targets + + +def run_bild(target: str) -> subprocess.CompletedProcess[str]: + """Run bild on the target.""" + # --time 0 disables timeout + # --loud enables output (which we capture) + cmd = ["bild", "--time", "0", "--loud", target] + return subprocess.run(cmd, capture_output=True, text=True, check=False) + + +def create_task( + target: str, + result: subprocess.CompletedProcess[str], + parent_id: str | None = None, +) -> None: + """Create a task for a build failure.""" + # Construct a descriptive title + # Try to get the last meaningful line of error output + lines = (result.stdout + result.stderr).strip().split("\n") + last_line = lines[-1] if lines else "Unknown error" + last_line = strip_ansi(last_line).strip() + + if len(last_line) > MAX_TITLE_LENGTH: + last_line = last_line[: MAX_TITLE_LENGTH - 3] + "..." + + title = f"Build failed: {target} - {last_line}" + + cmd = ["task", "create", title, "--priority", "2", "--json"] + + if parent_id: + cmd.append(f"--discovered-from={parent_id}") + + # Try to infer namespace + # e.g. Omni/Bild.hs -> Omni/Bild + ns = Path(target).parent + if str(ns) != ".": + cmd.append(f"--namespace={ns}") + + print(f"Creating task for {target}...") # noqa: T201 + proc = subprocess.run(cmd, capture_output=True, text=True, check=False) + + if proc.returncode != 0: + print(f"Error creating task: {proc.stderr}", file=sys.stderr) # noqa: T201 + else: + # task create --json returns the created task json + print(f"Task created: {proc.stdout.strip()}") # noqa: T201 + + +def main() -> None: + """Run the build audit.""" + parser = argparse.ArgumentParser(description="Audit codebase builds.") + parser.add_argument( + "--parent", + help="Parent task ID to link discovered tasks to", + ) + parser.add_argument( + "paths", + nargs="*", + default=["."], + help="Paths to search for targets", + ) + args = parser.parse_args() + + # Check if bild is available + if not shutil.which("bild"): + print( # noqa: T201 + "Warning: 'bild' command not found. Ensure it is in PATH.", + file=sys.stderr, + ) + + print(f"Scanning for targets in {args.paths}...") # noqa: T201 + targets: list[str] = [] + for path_str in args.paths: + path = Path(path_str) + if path.is_file(): + targets.append(str(path)) + else: + targets.extend(get_buildable_files(path_str)) + + # Remove duplicates + targets = sorted(set(targets)) + print(f"Found {len(targets)} targets.") # noqa: T201 + + failures = 0 + for target in targets: + res = run_bild(target) + + if res.returncode == 0: + print("OK") # noqa: T201 + else: + print("FAIL") # noqa: T201 + failures += 1 + create_task(target, res, args.parent) + + print(f"\nAudit complete. {failures} failures found.") # noqa: T201 + if failures > 0: + sys.exit(1) + else: + sys.exit(0) + + +if __name__ == "__main__": + main() diff --git a/Omni/Task.hs b/Omni/Task.hs index 81efa39..088352e 100644 --- a/Omni/Task.hs +++ b/Omni/Task.hs @@ -42,10 +42,11 @@ task Usage: task init [--quiet] task create <title> [options] + task edit <id> [options] task list [options] task ready [--json] task show <id> [--json] - task update <id> <status> [--json] + task update <id> <status> [options] task deps <id> [--json] task tree [<id>] [--json] task progress <id> [--json] @@ -59,6 +60,7 @@ Usage: Commands: init Initialize task database create Create a new task or epic + edit Edit an existing task list List all tasks ready Show ready tasks (not blocked) show Show detailed task information @@ -74,13 +76,14 @@ Commands: Options: -h --help Show this help - --type=<type> Task type: epic or task (default: task) + --title=<title> Task title + --type=<type> Task type: epic or task --parent=<id> Parent epic ID - --priority=<p> Priority: 0-4 (0=critical, 4=backlog, default: 2) - --status=<status> Filter by status: open, in-progress, review, done + --priority=<p> Priority: 0-4 (0=critical, 4=backlog) + --status=<status> Task status (open, in-progress, review, done) --epic=<id> Filter stats by epic (recursive) --deps=<ids> Comma-separated list of dependency IDs - --dep-type=<type> Dependency type: blocks, discovered-from, parent-child, related (default: blocks) + --dep-type=<type> Dependency type: blocks, discovered-from, parent-child, related --discovered-from=<id> Shortcut for --deps=<id> --dep-type=discovered-from --namespace=<ns> Optional namespace (e.g., Omni/Task, Biz/Cloud) --description=<desc> Task description @@ -170,6 +173,71 @@ move args if isJsonMode args then outputJson createdTask else putStrLn <| "Created task: " <> T.unpack (taskId createdTask) + | args `Cli.has` Cli.command "edit" = do + tid <- getArgText args "id" + + -- Parse optional edits + maybeTitle <- pure <| Cli.getArg args (Cli.longOption "title") + maybeType <- case Cli.getArg args (Cli.longOption "type") of + Nothing -> pure Nothing + Just "epic" -> pure <| Just Epic + Just "task" -> pure <| Just WorkTask + Just other -> panic <| "Invalid task type: " <> T.pack other <> ". Use: epic or task" + maybeParent <- pure <| fmap T.pack (Cli.getArg args (Cli.longOption "parent")) + maybePriority <- case Cli.getArg args (Cli.longOption "priority") of + Nothing -> pure Nothing + Just "0" -> pure <| Just P0 + Just "1" -> pure <| Just P1 + Just "2" -> pure <| Just P2 + Just "3" -> pure <| Just P3 + Just "4" -> pure <| Just P4 + Just other -> panic <| "Invalid priority: " <> T.pack other <> ". Use: 0-4" + maybeStatus <- case Cli.getArg args (Cli.longOption "status") of + Nothing -> pure Nothing + Just "open" -> pure <| Just Open + Just "in-progress" -> pure <| Just InProgress + Just "review" -> pure <| Just Review + Just "done" -> pure <| Just Done + Just other -> panic <| "Invalid status: " <> T.pack other <> ". Use: open, in-progress, review, or done" + maybeNamespace <- case Cli.getArg args (Cli.longOption "namespace") of + Nothing -> pure Nothing + Just ns -> do + let validNs = Namespace.fromHaskellModule ns + nsPath = T.pack <| Namespace.toPath validNs + pure <| Just nsPath + maybeDesc <- pure <| fmap T.pack (Cli.getArg args (Cli.longOption "description")) + + maybeDeps <- case Cli.getArg args (Cli.longOption "discovered-from") of + Just discoveredId -> pure <| Just [Dependency {depId = T.pack discoveredId, depType = DiscoveredFrom}] + Nothing -> case Cli.getArg args (Cli.longOption "deps") of + Nothing -> pure Nothing + Just depStr -> do + let ids = T.splitOn "," (T.pack depStr) + dtype <- case Cli.getArg args (Cli.longOption "dep-type") of + Nothing -> pure Blocks + Just "blocks" -> pure Blocks + Just "discovered-from" -> pure DiscoveredFrom + Just "parent-child" -> pure ParentChild + Just "related" -> pure Related + Just other -> panic <| "Invalid dependency type: " <> T.pack other + pure <| Just (map (\did -> Dependency {depId = did, depType = dtype}) ids) + + let modifyFn task = + task + { taskTitle = maybe (taskTitle task) T.pack maybeTitle, + taskType = fromMaybe (taskType task) maybeType, + taskParent = case maybeParent of Nothing -> taskParent task; Just p -> Just p, + taskNamespace = case maybeNamespace of Nothing -> taskNamespace task; Just ns -> Just ns, + taskStatus = fromMaybe (taskStatus task) maybeStatus, + taskPriority = fromMaybe (taskPriority task) maybePriority, + taskDescription = case maybeDesc of Nothing -> taskDescription task; Just d -> Just d, + taskDependencies = fromMaybe (taskDependencies task) maybeDeps + } + + updatedTask <- editTask tid modifyFn + if isJsonMode args + then outputJson updatedTask + else putStrLn <| "Updated task: " <> T.unpack (taskId updatedTask) | args `Cli.has` Cli.command "list" = do maybeType <- case Cli.getArg args (Cli.longOption "type") of Nothing -> pure Nothing @@ -206,22 +274,39 @@ move args | args `Cli.has` Cli.command "show" = do tid <- getArgText args "id" tasks <- loadTasks - case filter (\t -> taskId t == tid) tasks of - [] -> putText "Task not found" - (task : _) -> + case findTask tid tasks of + Nothing -> putText "Task not found" + Just task -> if isJsonMode args then outputJson task else showTaskDetailed task | args `Cli.has` Cli.command "update" = do tid <- getArgText args "id" statusStr <- getArgText args "status" + + -- Handle update dependencies + deps <- do + -- Parse --deps and --dep-type + ids <- case Cli.getArg args (Cli.longOption "deps") of + Nothing -> pure [] + Just depStr -> pure <| T.splitOn "," (T.pack depStr) + dtype <- case Cli.getArg args (Cli.longOption "dep-type") of + Nothing -> pure Blocks + Just "blocks" -> pure Blocks + Just "discovered-from" -> pure DiscoveredFrom + Just "parent-child" -> pure ParentChild + Just "related" -> pure Related + Just other -> panic <| "Invalid dependency type: " <> T.pack other <> ". Use: blocks, discovered-from, parent-child, or related" + pure (map (\d -> Dependency {depId = d, depType = dtype}) ids) + let newStatus = case statusStr of "open" -> Open "in-progress" -> InProgress "review" -> Review "done" -> Done _ -> panic "Invalid status. Use: open, in-progress, review, or done" - updateTaskStatus tid newStatus + + updateTaskStatus tid newStatus deps if isJsonMode args then outputSuccess <| "Updated task " <> tid else do @@ -386,6 +471,19 @@ unitTests = -- Create a new child, it should get .4, not .2 child4 <- createTask "Child 4" WorkTask (Just (taskId parent)) Nothing P2 [] Nothing taskId child4 Test.@?= taskId parent <> ".4", + Test.unit "can edit task" <| do + task <- createTask "Original Title" WorkTask Nothing Nothing P2 [] Nothing + let modifyFn t = t {taskTitle = "New Title", taskPriority = P0} + updated <- editTask (taskId task) modifyFn + taskTitle updated Test.@?= "New Title" + taskPriority updated Test.@?= P0 + -- Check persistence + tasks <- loadTasks + case findTask (taskId task) tasks of + Nothing -> Test.assertFailure "Could not reload task" + Just reloaded -> do + taskTitle reloaded Test.@?= "New Title" + taskPriority reloaded Test.@?= P0, Test.unit "task lookup is case insensitive" <| do task <- createTask "Case sensitive" WorkTask Nothing Nothing P2 [] Nothing let tid = taskId task @@ -399,6 +497,30 @@ unitTests = let ns = "Omni/Task.hs" validNs = Namespace.fromHaskellModule ns Namespace.toPath validNs Test.@?= "Omni/Task.hs", + Test.unit "generated IDs are lowercase" <| do + task <- createTask "Lowercase check" WorkTask Nothing Nothing P2 [] Nothing + let tid = taskId task + tid Test.@?= T.toLower tid + -- check it matches regex for base36 (t-[0-9a-z]+) + let isLowerBase36 = T.all (\c -> c `elem` ['0' .. '9'] ++ ['a' .. 'z'] || c == 't' || c == '-') tid + isLowerBase36 Test.@?= True, + Test.unit "dependencies are case insensitive" <| do + task1 <- createTask "Blocker" WorkTask Nothing Nothing P2 [] Nothing + let tid1 = taskId task1 + -- Use uppercase ID for dependency + upperTid1 = T.toUpper tid1 + dep = Dependency {depId = upperTid1, depType = Blocks} + task2 <- createTask "Blocked" WorkTask Nothing Nothing P2 [dep] Nothing + + -- task1 is Open, so task2 should NOT be ready + ready <- getReadyTasks + (taskId task2 `notElem` map taskId ready) Test.@?= True + + updateTaskStatus tid1 Done [] + + -- task2 should now be ready because dependency check normalizes IDs + ready2 <- getReadyTasks + (taskId task2 `elem` map taskId ready2) Test.@?= True, Test.unit "can create task with lowercase ID" <| do -- This verifies that lowercase IDs are accepted and not rejected let lowerId = "t-lowercase" @@ -409,31 +531,31 @@ unitTests = Just t -> taskId t Test.@?= lowerId Nothing -> Test.assertFailure "Should find task with lowercase ID", Test.unit "generateId produces valid ID" <| do - -- This verifies that generated IDs are valid and accepted - tid <- generateId - let task = Task tid "Auto" WorkTask Nothing Nothing Open P2 [] Nothing (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC") - saveTask task - tasks <- loadTasks - case findTask tid tasks of - Just _ -> pure () - Nothing -> Test.assertFailure "Should find generated task", + -- This verifies that generated IDs are valid and accepted + tid <- generateId + let task = Task tid "Auto" WorkTask Nothing Nothing Open P2 [] Nothing (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC") + saveTask task + tasks <- loadTasks + case findTask tid tasks of + Just _ -> pure () + Nothing -> Test.assertFailure "Should find generated task", Test.unit "lowercase ID does not clash with existing uppercase ID" <| do -- Setup: Create task with Uppercase ID let upperId = "t-UPPER" let task1 = Task upperId "Upper Task" WorkTask Nothing Nothing Open P2 [] Nothing (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC") saveTask task1 - + -- Action: Try to create task with Lowercase ID (same letters) -- Note: In the current implementation, saveTask blindly appends. -- Ideally, we should be checking for existence if we want to avoid clash. -- OR, we accept that they are the SAME task and this is an update? -- But if they are different tasks (different titles, created at different times), -- treating them as the same is dangerous. - + let lowerId = "t-upper" let task2 = Task lowerId "Lower Task" WorkTask Nothing Nothing Open P2 [] Nothing (read "2025-01-01 00:00:01 UTC") (read "2025-01-01 00:00:01 UTC") saveTask task2 - + tasks <- loadTasks -- What do we expect? -- If we expect them to be distinct: @@ -441,20 +563,19 @@ unitTests = -- let foundLower = List.find (\t -> taskId t == lowerId) tasks -- foundUpper /= Nothing -- foundLower /= Nothing - + -- BUT findTask uses case-insensitive search. -- So findTask upperId returns task1 (probably, as it's first). -- findTask lowerId returns task1. -- task2 is effectively hidden/lost to findTask. - + -- So, "do not clash" implies we shouldn't end up in this state. -- The test should probably fail if we have multiple tasks that match the same ID case-insensitively. - + let matches = filter (\t -> matchesId (taskId t) upperId) tasks length matches Test.@?= 2 ] - -- | Test CLI argument parsing to ensure docopt string matches actual usage cliTests :: Test.Tree cliTests = @@ -507,6 +628,21 @@ cliTests = Right args -> do args `Cli.has` Cli.command "create" Test.@?= True Cli.getArg args (Cli.longOption "priority") Test.@?= Just "1", + Test.unit "edit command" <| do + let result = Docopt.parseArgs help ["edit", "t-abc123"] + case result of + Left err -> Test.assertFailure <| "Failed to parse 'edit': " <> show err + Right args -> do + args `Cli.has` Cli.command "edit" Test.@?= True + Cli.getArg args (Cli.argument "id") Test.@?= Just "t-abc123", + Test.unit "edit with options" <| do + let result = Docopt.parseArgs help ["edit", "t-abc123", "--title=New Title", "--priority=0"] + case result of + Left err -> Test.assertFailure <| "Failed to parse 'edit' with options: " <> show err + Right args -> do + args `Cli.has` Cli.command "edit" Test.@?= True + Cli.getArg args (Cli.longOption "title") Test.@?= Just "New Title" + Cli.getArg args (Cli.longOption "priority") Test.@?= Just "0", Test.unit "list command" <| do let result = Docopt.parseArgs help ["list"] case result of diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index a2e76b6..3de42b2 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -96,12 +96,28 @@ instance FromJSON Task -- | Case-insensitive ID comparison matchesId :: Text -> Text -> Bool -matchesId id1 id2 = T.toLower id1 == T.toLower id2 +matchesId id1 id2 = normalizeId id1 == normalizeId id2 + +-- | Normalize ID to lowercase +normalizeId :: Text -> Text +normalizeId = T.toLower -- | Find a task by ID (case-insensitive) findTask :: Text -> [Task] -> Maybe Task findTask tid = List.find (\t -> matchesId (taskId t) tid) +-- | Normalize task IDs (self, parent, dependencies) to lowercase +normalizeTask :: Task -> Task +normalizeTask t = + t + { taskId = normalizeId (taskId t), + taskParent = fmap normalizeId (taskParent t), + taskDependencies = map normalizeDependency (taskDependencies t) + } + +normalizeDependency :: Dependency -> Dependency +normalizeDependency d = d {depId = normalizeId (depId d)} + instance ToJSON TaskProgress instance FromJSON TaskProgress @@ -197,7 +213,7 @@ generateChildId :: Text -> IO Text generateChildId parentId = withTaskReadLock <| do tasks <- loadTasksInternal - pure <| computeNextChildId tasks parentId + pure <| computeNextChildId tasks (normalizeId parentId) computeNextChildId :: [Task] -> Text -> Text computeNextChildId tasks parentId = @@ -319,7 +335,10 @@ saveTaskInternal task = do createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> Maybe Text -> IO Task createTask title taskType parent namespace priority deps description = withTaskWriteLock <| do - tid <- case parent of + let parent' = fmap normalizeId parent + deps' = map normalizeDependency deps + + tid <- case parent' of Nothing -> generateUniqueId Just pid -> do tasks <- loadTasksInternal @@ -327,14 +346,14 @@ createTask title taskType parent namespace priority deps description = now <- getCurrentTime let task = Task - { taskId = tid, + { taskId = normalizeId tid, taskTitle = title, taskType = taskType, - taskParent = parent, + taskParent = parent', taskNamespace = namespace, taskStatus = Open, taskPriority = priority, - taskDependencies = deps, + taskDependencies = deps', taskDescription = description, taskCreatedAt = now, taskUpdatedAt = now @@ -355,21 +374,49 @@ generateUniqueId = do Just _ -> go tasks -- Retry if collision (case-insensitive) -- Update task status -updateTaskStatus :: Text -> Status -> IO () -updateTaskStatus tid newStatus = +updateTaskStatus :: Text -> Status -> [Dependency] -> IO () +updateTaskStatus tid newStatus newDeps = withTaskWriteLock <| do tasks <- loadTasksInternal now <- getCurrentTime let updatedTasks = map updateIfMatch tasks updateIfMatch t = if matchesId (taskId t) tid - then t {taskStatus = newStatus, taskUpdatedAt = now} + then t {taskStatus = newStatus, taskUpdatedAt = now, taskDependencies = if null newDeps then taskDependencies t else newDeps} else t -- Rewrite the entire file (simple approach for MVP) tasksFile <- getTasksFilePath TIO.writeFile tasksFile "" traverse_ saveTaskInternal updatedTasks +-- Edit a task by applying a modification function +editTask :: Text -> (Task -> Task) -> IO Task +editTask tid modifyFn = + withTaskWriteLock <| do + tasks <- loadTasksInternal + now <- getCurrentTime + + -- Find the task first to ensure it exists + case findTask tid tasks of + Nothing -> panic "Task not found" + Just original -> do + let modified = modifyFn original + -- Only update timestamp if something actually changed + -- But for simplicity, we always update it if the user explicitly ran 'edit' + finalTask = modified {taskUpdatedAt = now} + + updateIfMatch t = + if matchesId (taskId t) tid + then finalTask + else t + updatedTasks = map updateIfMatch tasks + + -- Rewrite the entire file + tasksFile <- getTasksFilePath + TIO.writeFile tasksFile "" + traverse_ saveTaskInternal updatedTasks + pure finalTask + -- List tasks, optionally filtered by type, parent, status, or namespace listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task] listTasks maybeType maybeParent maybeStatus maybeNamespace = do @@ -427,12 +474,13 @@ getDependencyTree tid = do -- Get task progress getTaskProgress :: Text -> IO TaskProgress -getTaskProgress tid = do +getTaskProgress tidRaw = do + let tid = normalizeId tidRaw tasks <- loadTasks -- Verify task exists (optional, but good for error handling) - case filter (\t -> taskId t == tid) tasks of - [] -> panic "Task not found" - _ -> do + case findTask tid tasks of + Nothing -> panic "Task not found" + Just _ -> do let children = filter (\child -> taskParent child == Just tid) tasks total = length children completed = length <| filter (\child -> taskStatus child == Done) children @@ -827,7 +875,7 @@ importTasks filePath = -- Load tasks from import file content <- TIO.readFile filePath let importLines = T.lines content - importedTasks = mapMaybe decodeTask importLines + importedTasks = map normalizeTask (mapMaybe decodeTask importLines) -- Load existing tasks existingTasks <- loadTasksInternal |