diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Agent.hs | 122 | ||||
| -rw-r--r-- | Omni/Agent/Core.hs | 1 | ||||
| -rw-r--r-- | Omni/Agent/DESIGN.md | 2 | ||||
| -rw-r--r-- | Omni/Agent/Git.hs | 60 | ||||
| -rw-r--r-- | Omni/Agent/Log.hs | 115 | ||||
| -rw-r--r-- | Omni/Agent/LogTest.hs | 124 | ||||
| -rw-r--r-- | Omni/Agent/Worker.hs | 56 | ||||
| -rwxr-xr-x | Omni/Agent/harvest-tasks.sh | 62 | ||||
| -rwxr-xr-x | Omni/Agent/merge-tasks.sh | 30 | ||||
| -rwxr-xr-x | Omni/Agent/monitor-worker.sh | 47 | ||||
| -rwxr-xr-x | Omni/Agent/monitor.sh | 68 | ||||
| -rwxr-xr-x | Omni/Agent/setup-worker.sh | 31 | ||||
| -rwxr-xr-x | Omni/Agent/start-worker.sh | 6 | ||||
| -rwxr-xr-x | Omni/Agent/sync-tasks.sh | 46 | ||||
| -rwxr-xr-x | Omni/Bild/Audit.py | 176 | ||||
| -rw-r--r-- | Omni/Bild/README.md | 40 | ||||
| -rw-r--r-- | Omni/Ci.hs | 191 | ||||
| -rwxr-xr-x | Omni/Ci.sh | 65 | ||||
| -rw-r--r-- | Omni/Ide/README.md | 143 | ||||
| -rwxr-xr-x | Omni/Ide/hooks/post-checkout | 4 | ||||
| -rw-r--r-- | Omni/Task.hs | 253 | ||||
| -rw-r--r-- | Omni/Task/Core.hs | 127 | ||||
| -rw-r--r-- | Omni/Task/README.md | 416 | ||||
| -rw-r--r-- | Omni/Task/RaceTest.hs | 3 |
24 files changed, 1674 insertions, 514 deletions
diff --git a/Omni/Agent.hs b/Omni/Agent.hs index d53bccd..d94949c 100644 --- a/Omni/Agent.hs +++ b/Omni/Agent.hs @@ -9,11 +9,21 @@ module Omni.Agent 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 Log import qualified Omni.Agent.Worker as Worker import qualified Omni.Cli as Cli +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 qualified System.Environment as Env +import qualified System.Exit as Exit +import System.FilePath ((</>)) +import qualified System.IO as IO +import qualified System.IO.Temp as Temp main :: IO () main = Cli.main plan @@ -34,6 +44,9 @@ agent Usage: agent start <name> [--path=<path>] + agent harvest [--path=<path>] + agent merge-driver <ours> <theirs> + agent setup <name> agent test agent --help @@ -60,10 +73,105 @@ move args } Worker.start worker + | args `Cli.has` Cli.command "harvest" = harvest args + | args `Cli.has` Cli.command "merge-driver" = mergeDriver args + | args `Cli.has` Cli.command "setup" = setup args | otherwise = putStrLn (Cli.usage help) +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 + +harvest :: Cli.Arguments -> IO () +harvest args = do + let path = Cli.getArgWithDefault args "." (Cli.longOption "path") + putText "Harvesting task updates from workers..." + + branches <- Git.listBranches path "omni-worker-*" + if null branches + then putText "No worker branches found." + else do + updated <- foldlM (processBranch path) False branches + when updated <| do + -- Consolidate + Directory.setCurrentDirectory path + TaskCore.exportTasks + + -- Commit if changed + Git.commit path "task: harvest updates from workers" + putText "Success: Task database updated and committed." + +processBranch :: FilePath -> Bool -> Text -> IO Bool +processBranch repo updated branch = do + putText <| "Checking " <> branch <> "..." + maybeContent <- Git.showFile repo branch ".tasks/tasks.jsonl" + case maybeContent of + Nothing -> do + putText <| " Warning: Could not read .tasks/tasks.jsonl from " <> branch + pure updated + Just content -> do + -- Write to temp file + Temp.withSystemTempFile "worker-tasks.jsonl" <| \tempPath h -> do + TIO.hPutStr h content + IO.hClose h + -- Import + -- We need to ensure we are in the repo directory for TaskCore to find .tasks/tasks.jsonl + Directory.setCurrentDirectory repo + TaskCore.importTasks tempPath + putText <| " Imported tasks from " <> branch + pure True + +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) + Env.setEnv "TASK_DB_PATH" ours + TaskCore.importTasks theirs + Exit.exitSuccess + +setup :: Cli.Arguments -> IO () +setup args = do + nameStr <- getArgOrExit args (Cli.argument "name") + let name = Text.pack nameStr + root <- Git.getRepoRoot "." + let worktreePath = root <> "/../" <> nameStr + + putText <| "Creating worktree '" <> Text.pack worktreePath <> "' on branch '" <> name <> "' (from live)..." + + -- git worktree add -b <name> <path> live + Git.runGit root ["worktree", "add", "-b", nameStr, worktreePath, "live"] + + -- Copy .envrc.local if exists + let envrc = root </> ".envrc.local" + exists <- Directory.doesFileExist envrc + when exists <| do + putText "Copying .envrc.local..." + Directory.copyFile envrc (worktreePath </> ".envrc.local") + + -- Config git + Git.runGit worktreePath ["config", "user.name", "Omni Worker"] + Git.runGit worktreePath ["config", "user.email", "bot@omni.agent"] + + putText <| "Worker setup complete at " <> Text.pack worktreePath + test :: Test.Tree -test = Test.group "Omni.Agent" [unitTests] +test = Test.group "Omni.Agent" [unitTests, logTests] + +logTests :: Test.Tree +logTests = + Test.group + "Log tests" + [ Test.unit "Log.emptyStatus" <| do + let s = Log.emptyStatus "worker-1" + Log.statusWorker s Test.@?= "worker-1" + Log.statusFiles s Test.@?= 0 + ] unitTests :: Test.Tree unitTests = @@ -73,5 +181,15 @@ unitTests = let result = Docopt.parseArgs help ["start", "worker-1"] case result of Left err -> Test.assertFailure <| "Failed to parse 'start': " <> show err - Right args -> args `Cli.has` Cli.command "start" Test.@?= True + Right args -> args `Cli.has` Cli.command "start" Test.@?= True, + Test.unit "can parse harvest command" <| do + let result = Docopt.parseArgs help ["harvest"] + case result of + Left err -> Test.assertFailure <| "Failed to parse 'harvest': " <> show err + Right args -> args `Cli.has` Cli.command "harvest" Test.@?= True, + Test.unit "can parse setup command" <| do + let result = Docopt.parseArgs help ["setup", "worker-2"] + case result of + Left err -> Test.assertFailure <| "Failed to parse 'setup': " <> show err + Right args -> args `Cli.has` Cli.command "setup" Test.@?= True ] diff --git a/Omni/Agent/Core.hs b/Omni/Agent/Core.hs index 2d09e39..a2594d6 100644 --- a/Omni/Agent/Core.hs +++ b/Omni/Agent/Core.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} --- : out omni-agent-core module Omni.Agent.Core where import Alpha diff --git a/Omni/Agent/DESIGN.md b/Omni/Agent/DESIGN.md index 2d1e6e3..3ff00fc 100644 --- a/Omni/Agent/DESIGN.md +++ b/Omni/Agent/DESIGN.md @@ -72,7 +72,7 @@ The Haskell implementation should replicate the logic of `start-worker.sh` but w ### 4.3 Logging - Continue writing raw Amp logs to `_/llm/amp.log` in the worker directory. -- `agent log` reads this file and applies the filtering logic (currently in `monitor-worker.sh` jq script) using Haskell (Aeson). +- `agent log` reads this file and applies the filtering logic (currently in `monitor.sh` jq script) using Haskell (Aeson). - **UI Design**: - **Two-line Status**: The CLI should maintain two reserved lines at the bottom (or top) of the output for each worker: - **Line 1 (Meta)**: `[Worker: omni-worker-1] Task: t-123 | Files: 3 | Credits: $0.45 | Time: 05:23` diff --git a/Omni/Agent/Git.hs b/Omni/Agent/Git.hs index a2009b2..4c06cf6 100644 --- a/Omni/Agent/Git.hs +++ b/Omni/Agent/Git.hs @@ -13,6 +13,10 @@ module Omni.Agent.Git getCurrentBranch, branchExists, isMerged, + listBranches, + showFile, + getRepoRoot, + runGit, main, test, ) @@ -25,7 +29,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 +152,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 @@ -214,3 +203,30 @@ isMerged repo branch target = do let cmd = (Process.proc "git" ["merge-base", "--is-ancestor", Text.unpack branch, Text.unpack target]) {Process.cwd = Just repo} (code, _, _) <- Process.readCreateProcessWithExitCode cmd "" pure (code == Exit.ExitSuccess) + +listBranches :: FilePath -> Text -> IO [Text] +listBranches repo pat = do + let cmd = (Process.proc "git" ["branch", "--list", Text.unpack pat, "--format=%(refname:short)"]) {Process.cwd = Just repo} + (code, out, _) <- Process.readCreateProcessWithExitCode cmd "" + case code of + Exit.ExitSuccess -> pure <| filter (not <. Text.null) (Text.lines (Text.pack out)) + _ -> panic "git branch list failed" + +showFile :: FilePath -> Text -> FilePath -> IO (Maybe Text) +showFile repo branch path = do + let cmd = (Process.proc "git" ["show", Text.unpack branch <> ":" <> path]) {Process.cwd = Just repo} + (code, out, _) <- Process.readCreateProcessWithExitCode cmd "" + case code of + Exit.ExitSuccess -> pure <| Just (Text.pack out) + _ -> pure Nothing + +getRepoRoot :: FilePath -> IO FilePath +getRepoRoot dir = do + let cmd = (Process.proc "git" ["rev-parse", "--show-toplevel"]) {Process.cwd = Just dir} + (code, out, _) <- Process.readCreateProcessWithExitCode cmd "" + case code of + Exit.ExitSuccess -> pure <| strip out + _ -> panic "git rev-parse failed" + +runGit :: FilePath -> [String] -> IO () +runGit = git diff --git a/Omni/Agent/Log.hs b/Omni/Agent/Log.hs index afaf1da..71a7aca 100644 --- a/Omni/Agent/Log.hs +++ b/Omni/Agent/Log.hs @@ -2,11 +2,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} --- : out omni-agent-log +-- | Status of the agent for the UI module Omni.Agent.Log where import Alpha +import Data.Aeson ((.:), (.:?)) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as BL import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as TE import qualified Data.Text.IO as TIO import qualified System.Console.ANSI as ANSI import qualified System.IO as IO @@ -16,6 +21,7 @@ import System.IO.Unsafe (unsafePerformIO) data Status = Status { statusWorker :: Text, statusTask :: Maybe Text, + statusThread :: Maybe Text, statusFiles :: Int, statusCredits :: Double, statusTime :: Text, -- formatted time string @@ -28,6 +34,7 @@ emptyStatus workerName = Status { statusWorker = workerName, statusTask = Nothing, + statusThread = Nothing, statusFiles = 0, statusCredits = 0.0, statusTime = "00:00", @@ -44,10 +51,13 @@ init :: Text -> IO () init workerName = do IO.hSetBuffering IO.stderr IO.LineBuffering writeIORef currentStatus (emptyStatus workerName) - -- Reserve 2 lines at bottom + -- Reserve 5 lines at bottom + IO.hPutStrLn IO.stderr "" + IO.hPutStrLn IO.stderr "" + IO.hPutStrLn IO.stderr "" IO.hPutStrLn IO.stderr "" IO.hPutStrLn IO.stderr "" - ANSI.hCursorUp IO.stderr 2 + ANSI.hCursorUp IO.stderr 5 -- | Update the status update :: (Status -> Status) -> IO () @@ -66,7 +76,13 @@ log msg = do 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 +91,90 @@ 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 five status lines 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 statusThread + -- Line 1: Worker | Thread + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr ("[Worker: " <> statusWorker <> "] Thread: " <> threadStr) + + -- Line 2: Task + ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr - TIO.hPutStr IO.stderr meta + TIO.hPutStr IO.stderr ("Task: " <> taskStr) - -- Line 2: Activity - -- [14:05:22] > Thinking... + -- Line 3: Files | Credits + ANSI.hCursorDown IO.stderr 1 + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr ("Files: " <> tshow statusFiles <> " | Credits: $" <> tshow statusCredits) + + -- Line 4: Time + ANSI.hCursorDown IO.stderr 1 + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr ("Time: " <> statusTime) + + -- 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 + ANSI.hCursorUp IO.stderr 4 IO.hFlush IO.stderr + +-- | Log Entry from JSON +data LogEntry = LogEntry + { leMessage :: Text, + leThreadId :: Maybe Text, + leCredits :: Maybe Double, + leTotalCredits :: Maybe Double, + leTimestamp :: Maybe Text + } + deriving (Show, Eq) + +instance Aeson.FromJSON LogEntry where + parseJSON = + Aeson.withObject "LogEntry" <| \v -> + (LogEntry </ (v .: "message")) + <*> v + .:? "threadId" + <*> v + .:? "credits" + <*> v + .:? "totalCredits" + <*> v + .:? "timestamp" + +-- | Parse a log line and update status +processLogLine :: Text -> IO () +processLogLine line = do + let bs = BL.fromStrict <| TE.encodeUtf8 line + case Aeson.decode bs of + Just entry -> update (updateFromEntry entry) + Nothing -> pure () -- Ignore invalid JSON + +updateFromEntry :: LogEntry -> Status -> Status +updateFromEntry LogEntry {..} s = + s + { statusThread = leThreadId <|> statusThread s, + statusCredits = fromMaybe (statusCredits s) (leTotalCredits <|> leCredits), + statusTime = maybe (statusTime s) formatTime leTimestamp + } + +formatTime :: Text -> Text +formatTime ts = + -- "2025-11-22T21:24:02.512Z" -> "21:24" + case Text.splitOn "T" ts of + [_, time] -> case Text.splitOn ":" time of + (h : m : _) -> h <> ":" <> m + _ -> ts + _ -> ts diff --git a/Omni/Agent/LogTest.hs b/Omni/Agent/LogTest.hs deleted file mode 100644 index 518147e..0000000 --- a/Omni/Agent/LogTest.hs +++ /dev/null @@ -1,124 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NoImplicitPrelude #-} - --- : out agent-log-test -module Omni.Agent.LogTest where - -import Alpha -import qualified Data.Set as Set -import Omni.Agent.Log -import qualified Omni.Test as Test - -main :: IO () -main = Test.run tests - -tests :: Test.Tree -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 - ] - -testParse :: IO () -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)", - leLevel = Nothing, - leToolName = Nothing, - leBatches = Just [["grep"]], - leMethod = Nothing, - lePath = Nothing, - leTimestamp = Nothing - } - parseLine json @?= Just expected - -testFormat :: IO () -testFormat = do - let entry = - LogEntry - { leMessage = "executing 1 tools in 1 batch(es)", - leLevel = Nothing, - leToolName = Nothing, - leBatches = Just [["grep"]], - leMethod = Nothing, - lePath = Nothing, - leTimestamp = Nothing - } - format entry @?= Just "🤖 THOUGHT: Planning tool execution (grep)" - - let entry2 = - LogEntry - { leMessage = "some random log", - leLevel = Nothing, - leToolName = Nothing, - leBatches = Nothing, - leMethod = Nothing, - lePath = Nothing, - leTimestamp = Nothing - } - format entry2 @?= Nothing - - let entry3 = - LogEntry - { leMessage = "some error", - leLevel = Just "error", - leToolName = Nothing, - leBatches = Nothing, - leMethod = Nothing, - lePath = Nothing, - leTimestamp = 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..." - -(@?=) :: (Eq a, Show a) => a -> a -> IO () -(@?=) = (Test.@?=) diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs index 01099a0..a29feb4 100644 --- a/Omni/Agent/Worker.hs +++ b/Omni/Agent/Worker.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} --- : out omni-agent-worker 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 +13,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 +59,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) @@ -94,7 +95,7 @@ processTask worker task = 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. @@ -111,12 +112,11 @@ 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..." @@ -143,6 +143,12 @@ runAmp repo task = do <> fromMaybe "root" (TaskCore.taskNamespace task) <> "'.\n" + let logFile = repo </> "_/llm/amp.log" + + -- Remove old log file + exists <- Directory.doesFileExist logFile + when exists (Directory.removeFile logFile) + Directory.createDirectoryIfMissing True (repo </> "_/llm") -- Assume amp is in PATH @@ -150,7 +156,12 @@ runAmp repo task = do let cp = (Process.proc "amp" args) {Process.cwd = Just repo} (_, _, _, ph) <- Process.createProcess cp - Process.waitForProcess ph + + tid <- forkIO <| monitorLog logFile ph + + exitCode <- Process.waitForProcess ph + killThread tid + pure exitCode formatTask :: TaskCore.Task -> Text formatTask t = @@ -182,6 +193,37 @@ formatTask t = where formatDep dep = " - " <> TaskCore.depId dep <> " [" <> Text.pack (show (TaskCore.depType dep)) <> "]" +monitorLog :: FilePath -> Process.ProcessHandle -> IO () +monitorLog path ph = do + waitForFile path + IO.withFile path IO.ReadMode <| \h -> do + IO.hSetBuffering h IO.LineBuffering + go h + where + go h = do + eof <- IO.hIsEOF h + if eof + then do + mExit <- Process.getProcessExitCode ph + case mExit of + Nothing -> do + threadDelay 100000 -- 0.1s + go h + Just _ -> pure () + else do + line <- TIO.hGetLine h + AgentLog.processLogLine line + go h + +waitForFile :: FilePath -> IO () +waitForFile path = do + exists <- Directory.doesFileExist path + if exists + then pure () + else do + threadDelay 100000 + waitForFile path + findBaseBranch :: FilePath -> TaskCore.Task -> IO Text findBaseBranch repo task = do let deps = TaskCore.taskDependencies task diff --git a/Omni/Agent/harvest-tasks.sh b/Omni/Agent/harvest-tasks.sh deleted file mode 100755 index 44c2322..0000000 --- a/Omni/Agent/harvest-tasks.sh +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/env bash -set -e - -# Omni/Agent/harvest-tasks.sh -# Imports task updates from all worker branches into the current branch (usually live). - -REPO_ROOT="$(git rev-parse --show-toplevel)" -cd "$REPO_ROOT" - -echo "Harvesting task updates from workers..." - -# Find all worker branches (assuming naming convention omni-worker-*) -# We filter for local branches -WORKER_BRANCHES=$(git branch --list "omni-worker-*" --format="%(refname:short)") - -if [ -z "$WORKER_BRANCHES" ]; then - echo "No worker branches found." - exit 0 -fi - -UPDATED=0 - -for branch in $WORKER_BRANCHES; do - echo "Checking $branch..." - - # Extract tasks.jsonl from the worker branch - if git show "$branch:.tasks/tasks.jsonl" > .tasks/worker-tasks.jsonl 2>/dev/null; then - # Import into current DB - # The import command handles deduplication and timestamp conflict resolution - if "$REPO_ROOT/_/bin/task" import -i .tasks/worker-tasks.jsonl >/dev/null; then - echo " Imported tasks from $branch" - UPDATED=1 - fi - else - echo " Warning: Could not read .tasks/tasks.jsonl from $branch" - fi -done - -rm -f .tasks/worker-tasks.jsonl - -if [ "$UPDATED" -eq 1 ]; then - # Consolidate - "$REPO_ROOT/_/bin/task" export --flush - - # Commit if there are changes - if [[ -n $(git status --porcelain .tasks/tasks.jsonl) ]]; then - git add .tasks/tasks.jsonl - - LAST_MSG=$(git log -1 --pretty=%s) - if [[ "$LAST_MSG" == "task: harvest updates from workers" ]]; then - echo "Squashing with previous harvest commit..." - git commit --amend --no-edit - else - git commit -m "task: harvest updates from workers" - fi - echo "Success: Task database updated and committed." - else - echo "No effective changes found." - fi -else - echo "No updates found." -fi diff --git a/Omni/Agent/merge-tasks.sh b/Omni/Agent/merge-tasks.sh deleted file mode 100755 index 833afcf..0000000 --- a/Omni/Agent/merge-tasks.sh +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/env bash -# Omni/Ide/merge-tasks.sh -# Git merge driver for .tasks/tasks.jsonl -# Usage: merge-tasks.sh %O %A %B -# %O = ancestor, %A = current (ours), %B = other (theirs) - -# ANCESTOR="$1" (unused) -OURS="$2" -THEIRS="$3" - -# We want to merge THEIRS into OURS using the task tool's import logic. -REPO_ROOT="$(git rev-parse --show-toplevel)" -TASK_BIN="$REPO_ROOT/_/bin/task" - -# If binary doesn't exist, try to build it? Or just fail safely. -if [ ! -x "$TASK_BIN" ]; then - # Try to find it in the build output if _/bin isn't populated - # But for now, let's just fail if not found, forcing manual merge - exit 1 -fi - -# Use the task tool to merge -# We tell it that the DB is the 'OURS' file -# And we import the 'THEIRS' file -export TASK_DB_PATH="$OURS" -if "$TASK_BIN" import -i "$THEIRS" >/dev/null 2>&1; then - exit 0 -else - exit 1 -fi diff --git a/Omni/Agent/monitor-worker.sh b/Omni/Agent/monitor-worker.sh deleted file mode 100755 index 2638e2d..0000000 --- a/Omni/Agent/monitor-worker.sh +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/env bash -set -e - -# Omni/Agent/monitor-worker.sh -# Monitors the worker agent's activity by filtering the debug log. -# Usage: ./Omni/Agent/monitor-worker.sh [worker-directory-name] - -WORKER_NAME="${1:-omni-worker-1}" -REPO_ROOT="$(git rev-parse --show-toplevel)" -WORKER_PATH="$REPO_ROOT/../$WORKER_NAME" -LOG_FILE="$WORKER_PATH/_/llm/amp.log" - -if [ ! -f "$LOG_FILE" ]; then - echo "Waiting for log file at $LOG_FILE..." - while [ ! -f "$LOG_FILE" ]; do sleep 1; done -fi - -echo "Monitoring Worker Agent in '$WORKER_PATH'..." -echo "Press Ctrl+C to stop." -echo "------------------------------------------------" - -# Tail the log and use jq to parse/filter relevant events -# We handle JSON parse errors gracefully (in case of partial writes) -tail -f "$LOG_FILE" | grep --line-buffered "^{" | jq -R -r ' -try ( - fromjson | - if .message == "executing 1 tools in 1 batch(es)" then - "🤖 THOUGHT: Planning tool execution (" + (.batches[0][0] // "unknown") + ")" - elif .message == "Tool Bash - checking permissions" then - empty - elif .message == "Tool Bash permitted - action: allow" then - "🔧 TOOL: Bash command executed" - elif .toolName != null and .message == "Processing tool completion for ledger" then - "✅ TOOL: " + .toolName + " completed" - elif .message == "ide-fs" and .method == "readFile" then - "📂 READ: " + .path - elif .message == "System prompt build complete (no changes)" then - "🧠 THINKING..." - elif .message == "System prompt build complete (first build)" then - "🚀 STARTING new task context" - elif .level == "error" then - "❌ ERROR: " + .message - else - empty - end -) catch empty -' diff --git a/Omni/Agent/monitor.sh b/Omni/Agent/monitor.sh index 1626354..e57611f 100755 --- a/Omni/Agent/monitor.sh +++ b/Omni/Agent/monitor.sh @@ -1,29 +1,75 @@ #!/usr/bin/env bash # Omni/Agent/monitor.sh # Monitor the logs of a worker agent -# Usage: ./Omni/Agent/monitor.sh [worker-name] +# Usage: ./Omni/Agent/monitor.sh [--raw] [worker-name] + +set -e + +RAW_MODE=false +WORKER="omni-worker-1" + +# Parse arguments +while [[ "$#" -gt 0 ]]; do + case $1 in + --raw) RAW_MODE=true ;; + *) WORKER="$1" ;; + esac + shift +done -WORKER="${1:-omni-worker-1}" REPO_ROOT="$(git rev-parse --show-toplevel)" WORKER_DIR="$REPO_ROOT/../$WORKER" +LOG_FILE="$WORKER_DIR/_/llm/amp.log" if [ ! -d "$WORKER_DIR" ]; then echo "Error: Worker directory '$WORKER_DIR' not found." - echo "Usage: $0 [worker-name]" + echo "Usage: $0 [--raw] [worker-name]" exit 1 fi -LOG_FILE="$WORKER_DIR/_/llm/amp.log" - echo "Monitoring worker: $WORKER" echo "Watching log: $LOG_FILE" +if [ "$RAW_MODE" = true ]; then + echo "Mode: RAW output" +else + echo "Mode: FORMATTED output" +fi echo "---------------------------------------------------" # Wait for log file to appear -while [ ! -f "$LOG_FILE" ]; do - echo "Waiting for log file to be created..." - sleep 2 -done +if [ ! -f "$LOG_FILE" ]; then + echo "Waiting for log file at $LOG_FILE..." + while [ ! -f "$LOG_FILE" ]; do + sleep 1 + done +fi -# Tail the log file -tail -f "$LOG_FILE" +if [ "$RAW_MODE" = true ]; then + tail -f "$LOG_FILE" +else + # Tail the log and use jq to parse/filter relevant events + tail -f "$LOG_FILE" | grep --line-buffered "^{" | jq -R -r ' + try ( + fromjson | + if .message == "executing 1 tools in 1 batch(es)" then + "🤖 THOUGHT: Planning tool execution (" + (.batches[0][0] // "unknown") + ")" + elif .message == "Tool Bash - checking permissions" then + empty + elif .message == "Tool Bash permitted - action: allow" then + "🔧 TOOL: Bash command executed" + elif .toolName != null and .message == "Processing tool completion for ledger" then + "✅ TOOL: " + .toolName + " completed" + elif .message == "ide-fs" and .method == "readFile" then + "📂 READ: " + .path + elif .message == "System prompt build complete (no changes)" then + "🧠 THINKING..." + elif .message == "System prompt build complete (first build)" then + "🚀 STARTING new task context" + elif .level == "error" then + "❌ ERROR: " + .message + else + empty + end + ) catch empty + ' +fi diff --git a/Omni/Agent/setup-worker.sh b/Omni/Agent/setup-worker.sh deleted file mode 100755 index 42b7fc9..0000000 --- a/Omni/Agent/setup-worker.sh +++ /dev/null @@ -1,31 +0,0 @@ -#!/usr/bin/env bash -set -e - -if [ -z "$1" ]; then - echo "Usage: $0 <worker-name>" - echo "Example: $0 omni-worker-1" - exit 1 -fi - -WORKER_NAME="$1" -REPO_ROOT="$(git rev-parse --show-toplevel)" -WORKTREE_PATH="$REPO_ROOT/../$WORKER_NAME" - -# We create a new branch for the worker based on 'live' -# This avoids the "branch already checked out" error if 'live' is checked out elsewhere -BRANCH_NAME="${WORKER_NAME}" -echo "Creating worktree '$WORKTREE_PATH' on branch '$BRANCH_NAME' (from live)..." -git worktree add -b "$BRANCH_NAME" "$WORKTREE_PATH" live - -# Copy .envrc.local if it exists (user-specific config) -if [ -f "$REPO_ROOT/.envrc.local" ]; then - echo "Copying .envrc.local..." - cp "$REPO_ROOT/.envrc.local" "$WORKTREE_PATH/" -fi - -# Configure git identity for the worker -echo "Configuring git identity for worker..." -git -C "$WORKTREE_PATH" config user.name "Omni Worker" -git -C "$WORKTREE_PATH" config user.email "bot@omni.agent" - -echo "Worker setup complete at $WORKTREE_PATH" diff --git a/Omni/Agent/start-worker.sh b/Omni/Agent/start-worker.sh index 310ca56..457c83c 100755 --- a/Omni/Agent/start-worker.sh +++ b/Omni/Agent/start-worker.sh @@ -37,6 +37,12 @@ fi # Ensure worker has local task and agent binaries mkdir -p "$WORKER_PATH/_/bin" +echo "Syncing worker repo..." +if ! (cd "$WORKER_PATH" && git sync); then + echo "Error: Failed to run 'git sync' in worker directory." + exit 1 +fi + echo "Building 'task' in worker..." if ! (cd "$WORKER_PATH" && bild Omni/Task.hs); then echo "Error: Failed to build 'task' in worker directory." diff --git a/Omni/Agent/sync-tasks.sh b/Omni/Agent/sync-tasks.sh deleted file mode 100755 index f4669b7..0000000 --- a/Omni/Agent/sync-tasks.sh +++ /dev/null @@ -1,46 +0,0 @@ -#!/usr/bin/env bash -set -e - -# Omni/Ide/sync-tasks.sh -# Synchronizes the task database with the live branch safely. -# Usage: sync-tasks.sh [--commit] - -COMMIT=0 -if [[ "$1" == "--commit" ]]; then - COMMIT=1 -fi - -REPO_ROOT="$(git rev-parse --show-toplevel)" -cd "$REPO_ROOT" - -echo "Syncing tasks..." - -# 1. Import latest tasks from 'live' branch -# We use git show to get the file content from the reference branch without checking it out -mkdir -p .tasks -git show live:.tasks/tasks.jsonl > .tasks/live-tasks.jsonl - -# 2. Merge logic: Import live tasks into our local DB -# The 'task import' command uses timestamps to resolve conflicts (last write wins) -if [ -s .tasks/live-tasks.jsonl ]; then - echo "Importing tasks from live branch..." - "$REPO_ROOT/_/bin/task" import -i .tasks/live-tasks.jsonl -fi - -# 3. Clean up -rm .tasks/live-tasks.jsonl - -# 4. Export current state to ensure it's clean/deduplicated -"$REPO_ROOT/_/bin/task" export --flush - -# 5. Commit changes to .tasks/tasks.jsonl if requested and there are changes -if [[ "$COMMIT" -eq 1 ]]; then - if [[ -n $(git status --porcelain .tasks/tasks.jsonl) ]]; then - echo "Committing task updates..." - git add .tasks/tasks.jsonl - git commit -m "task: sync database" || true - echo "Task updates committed to current branch." - else - echo "No task changes to commit." - fi -fi 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/Bild/README.md b/Omni/Bild/README.md new file mode 100644 index 0000000..e1c026c --- /dev/null +++ b/Omni/Bild/README.md @@ -0,0 +1,40 @@ +# Bild + +`bild` is the universal build tool. It can build and test everything in the repo. + +Examples: +```bash +bild --test Omni/Bild.hs # Build and test a namespace +bild --time 0 Omni/Cloud.nix # Build with no timeout +bild --plan Omni/Test.hs # Analyze build without building +``` + +When the executable is built, the output will go to `_/bin`. Example: + +```bash +# build the example executable +bild Omni/Bild/Example.py +# run the executable +_/bin/example +``` + +## Adding New Dependencies + +### Python Packages + +To add a new Python package as a dependency: + +1. Add the package name to `Omni/Bild/Deps/Python.nix` (alphabetically sorted) +2. Use it in your Python file with `# : dep <package-name>` comment at the top +3. Run `bild <yourfile.py>` to build with the new dependency + +Example: +```python +# : out myapp +# : dep stripe +# : dep pytest +import stripe +``` + +The package name must match the nixpkgs python package name (usually the PyPI name). +Check available packages: `nix-env -qaP -A nixpkgs.python3Packages | grep <name>` diff --git a/Omni/Ci.hs b/Omni/Ci.hs new file mode 100644 index 0000000..aff5c7b --- /dev/null +++ b/Omni/Ci.hs @@ -0,0 +1,191 @@ +#!/usr/bin/env run.sh +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | A robust CI program replacing Omni/Ci.sh +-- +-- : out ci +module Omni.Ci (main) where + +import Alpha +import qualified Data.Text as Text +import qualified Omni.Cli as Cli +import qualified Omni.Log as Log +import qualified Omni.Test as Test +import qualified System.Directory as Dir +import qualified System.Environment as Environment +import qualified System.Exit as Exit +import System.FilePath ((</>)) +import qualified System.Process as Process + +main :: IO () +main = Cli.main <| Cli.Plan help move test pure + +help :: Cli.Docopt +help = + [Cli.docopt| +omni-ci - Continuous Integration + +Usage: + ci test + ci [options] + +Options: + -h, --help Print this info +|] + +test :: Test.Tree +test = + Test.group + "Omni.Ci" + [ Test.unit "placeholder test" <| do + True Test.@=? True + ] + +move :: Cli.Arguments -> IO () +move _ = do + -- 1. Check for dirty worktree + status <- readProcess "git" ["status", "-s"] "" + unless (Text.null status) <| do + Log.fail ["ci", "dirty worktree"] + Exit.exitWith (Exit.ExitFailure 1) + + -- 2. Setup environment + -- We need to ensure timeout is disabled for CI builds + -- Equivalent to: BILD_ARGS="--time 0 ${BILD_ARGS:-""}" + currentBildArgs <- Environment.lookupEnv "BILD_ARGS" + let bildArgs = "--time 0 " <> fromMaybe "" currentBildArgs + Environment.setEnv "BILD_ARGS" bildArgs + + -- 3. Get user info + at <- readProcess "date" ["-R"] "" |> fmap chomp + user <- readProcess "git" ["config", "--get", "user.name"] "" |> fmap chomp + mail <- readProcess "git" ["config", "--get", "user.email"] "" |> fmap chomp + + -- 4. Check existing git notes + -- commit=$(git notes --ref=ci show HEAD || true) + (exitCode, noteContent, _) <- Process.readProcessWithExitCode "git" ["notes", "--ref=ci", "show", "HEAD"] "" + + let alreadyGood = case exitCode of + Exit.ExitSuccess -> + let content = Text.pack noteContent + in ("Lint-is: good" `Text.isInfixOf` content) && ("Test-is: good" `Text.isInfixOf` content) + _ -> False + + when alreadyGood <| do + Log.pass ["ci", "already verified"] + Exit.exitSuccess + + -- 5. Run Lint + coderoot <- getCoderoot + let runlint = coderoot </> "_/bin/lint" + + lintExists <- Dir.doesFileExist runlint + unless lintExists <| do + Log.info ["ci", "building lint"] + callProcess "bild" [coderoot </> "Omni/Lint.hs"] + + Log.info ["ci", "running lint"] + -- if "$runlint" "${CODEROOT:?}"/**/* + -- We need to expand **/* which shell does. + -- Since we are in Haskell, we can just pass "." or call git ls-files or similar. + -- Omni/Ci.sh used "${CODEROOT:?}"/**/* which relies on bash globbing. + -- Omni/Lint.hs recursively checks if passed directory or uses git diff if no args. + -- But Omni/Ci.sh passes **/*. + -- Let's try passing the root directory or just run it without args? + -- Omni/Lint.hs says: + -- "case Cli.getAllArgs args (Cli.argument "file") of [] -> changedFiles ..." + -- So if we pass nothing, it only checks changed files. + -- The CI script explicitly passed everything. + -- We can replicate "everything" by passing the coderoot, assuming Lint handles directories recursively? + -- Omni/Lint.hs: "traverse Directory.makeAbsolute /> map (Namespace.fromPath root) ... filter (not <. Namespace.isCab)" + -- It seems it expects files. + -- We can use `git ls-files` to get all files. + allFiles <- + readProcess "git" ["ls-files"] "" + /> lines + /> map Text.unpack + /> filter (not <. null) + + -- We can't pass all files as arguments if there are too many (ARG_MAX). + -- But wait, Omni/Lint.hs takes arguments. + -- If we want to check everything, maybe we should implement a "check all" mode in Lint or pass chunks. + -- However, looking at Omni/Ci.sh: `"$runlint" "${CODEROOT:?}"/**/*` + -- This globbing is handled by the shell. It might be huge. + -- If I run `lint` with `.` it might work if Lint supports directories. + -- Omni/Lint.hs: "files |> ... filterM Directory.doesFileExist" + -- It seems it filters for files. + -- If I pass a directory, `doesFileExist` will return False. + -- So I must pass files. + + -- Let's pass all files from git ls-files. + -- But we must be careful about ARG_MAX. + -- For now, let's try passing them. If it fails, we might need to batch. + + lintResult <- do + -- We run lint on all files. + -- Note: calling callProcess with huge list might fail. + -- Let's see if we can avoid passing all files if Lint supports it. + -- Omni/Lint.hs doesn't seem to support directory recursion on its own if passed a dir, + -- it treats args as file paths. + + -- We will try to run it. + (exitCodeLint, _, _) <- Process.readProcessWithExitCode runlint allFiles "" + pure <| case exitCodeLint of + Exit.ExitSuccess -> "good" + _ -> "fail" + + -- 6. Run Tests + -- if bild "${BILD_ARGS:-""}" --test "${CODEROOT:?}"/**/* + Log.info ["ci", "running tests"] + + testResult <- do + -- similarly, bild takes targets. + -- bild "${CODEROOT:?}"/**/* + -- We can pass namespaces. + -- Let's try passing all files again. + -- bild handles namespaces. + (exitCodeTest, _, _) <- Process.readProcessWithExitCode "bild" ("--test" : allFiles) "" + pure <| case exitCodeTest of + Exit.ExitSuccess -> "good" + _ -> "fail" + + -- 7. Create Note + let noteMsg = + Text.unlines + [ "Lint-is: " <> lintResult, + "Test-is: " <> testResult, + "Test-by: " <> user <> " <" <> mail <> ">", + "Test-at: " <> at + ] + + -- 8. Append Note + callProcess "git" ["notes", "--ref=ci", "append", "-m", Text.unpack noteMsg] + + -- 9. Exit + if lintResult == "good" && testResult == "good" + then Exit.exitSuccess + else do + Log.fail ["ci", "verification failed"] + Exit.exitWith (Exit.ExitFailure 1) + +-- Helpers + +readProcess :: FilePath -> [String] -> String -> IO Text +readProcess cmd args input = do + out <- Process.readProcess cmd args input + pure (Text.pack out) + +callProcess :: FilePath -> [String] -> IO () +callProcess cmd args = do + Process.callProcess cmd args + +getCoderoot :: IO FilePath +getCoderoot = do + mEnvRoot <- Environment.lookupEnv "CODEROOT" + case mEnvRoot of + Just envRoot -> pure envRoot + Nothing -> panic "CODEROOT not set" -- Simplified for now diff --git a/Omni/Ci.sh b/Omni/Ci.sh deleted file mode 100755 index a749b7a..0000000 --- a/Omni/Ci.sh +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/env bash -# -# A simple ci that saves its results in a git note, formatted according to -# RFC-2822, more or less. -# -# To run this manually, exec the script. It will by default run the tests for -# HEAD, whatever you currently have checked out. -# -# It would be cool to use a zero-knowledge proof mechanism here to prove that -# so-and-so ran the tests, but I'll have to research how to do that. -# -# ensure we don't exit on bild failure, only on CI script error - set +e - set -u -## - [[ -n $(git status -s) ]] && { echo fail: dirty worktree; exit 1; } -## -## disable timeout for ci builds - BILD_ARGS="--time 0 ${BILD_ARGS:-""}" -## - at=$(date -R) - user=$(git config --get user.name) - mail=$(git config --get user.email) -## - commit=$(git notes --ref=ci show HEAD || true) - if [[ -n "$commit" ]] - then - if grep -q "Lint-is: good" <<< "$commit" - then - exit 0 - fi - if grep -q "Test-is: good" <<< "$commit" - then - exit 0 - fi - fi -## - runlint="$CODEROOT"/_/bin/lint - [[ ! -f "$runlint" ]] && bild "${BILD_ARGS:-""}" "${CODEROOT:?}"/Omni/Lint.hs - if "$runlint" "${CODEROOT:?}"/**/* - then - lint_result="good" - else - lint_result="fail" - fi -## - if bild "${BILD_ARGS:-""}" --test "${CODEROOT:?}"/**/* - then - test_result="good" - else - test_result="fail" - fi -## - read -r -d '' note <<EOF -Lint-is: $lint_result -Test-is: $test_result -Test-by: $user <$mail> -Test-at: $at -EOF -## - git notes --ref=ci append -m "$note" -## -# exit 1 if failure - [[ ! "$lint_result" == "fail" && ! "$test_result" == "fail" ]] -## diff --git a/Omni/Ide/README.md b/Omni/Ide/README.md new file mode 100644 index 0000000..7511090 --- /dev/null +++ b/Omni/Ide/README.md @@ -0,0 +1,143 @@ +# Development Tools and Workflow + +## Tools + +### run.sh + +`run.sh` is a convenience wrapper that builds (if needed) and runs a namespace. + +Examples: +```bash +Omni/Ide/run.sh Omni/Task.hs # Build and run task manager +Omni/Ide/run.sh Biz/PodcastItLater/Web.py # Build and run web server +``` + +This script will: +1. Check if the binary exists in `_/bin/` +2. Build it if it doesn't exist (exits on build failure) +3. Execute the binary with any additional arguments + +### lint + +Universal lint and formatting tool. Errors if lints fail or code is not formatted properly. + +Examples: +```bash +lint Omni/Cli.hs # Lint a namespace +lint --fix **/*.py # Lint and fix all Python files +``` + +### repl.sh + +Like `nix-shell` but specific to this repo. Analyzes the namespace, pulls dependencies, and starts a shell or repl. + +Examples: +```bash +repl.sh Omni/Bild.hs # Start Haskell repl with namespace loaded +repl.sh --bash Omni/Log.py # Start bash shell for namespace +``` + +### typecheck.sh + +Like `lint` but only runs type checkers. Currently just supports Python with `mypy`, but eventually will support everything that `bild` supports. + +Examples: +```bash +typecheck.sh Omni/Bild/Example.py # Run the typechecker and report any errors +``` + +### Test Commands + +Run tests: +```bash +bild --test Omni/Task.hs # Build and test a namespace +``` + +The convention for all programs in the omnirepo is to run their tests if the first argument is `test`. So for example: + +```bash +# this will build a the latest executable and then run tests +bild --test Omni/Task.hs + +# this will just run the tests from the existing executable +_/bin/task test +``` + +## Git Workflow + +### Use git-branchless + +This repository uses **git-branchless** for a patch-based workflow instead of traditional branch-based git. + +Key concepts: +- Work with **patches** (commits) directly rather than branches +- Use **stacking** to organize related changes +- Leverage **smartlog** to visualize commit history + +### Common git-branchless Commands + +**View commit graph:** +```bash +git smartlog +``` + +**Create a new commit:** +```bash +# Make your changes +git add . +git commit -m "Your commit message" +``` + +**Amend the current commit:** +```bash +# Make additional changes +git add . +git amend +``` + +**Move/restack commits:** +```bash +git move -s <source> -d <destination> +git restack +``` + +### When to Record Changes in Git + +**DO record in git:** +- Completed features or bug fixes +- Working code that passes tests and linting +- Significant milestones in task completion + +**DO NOT record in git:** +- Work in progress (unless specifically requested) +- Broken or untested code +- Temporary debugging changes + +**NEVER do these git operations without explicit user request:** +- ❌ `git push` - NEVER push to remote unless explicitly asked +- ❌ `git pull` - NEVER pull from remote unless explicitly asked +- ❌ Force pushes or destructive operations +- ❌ Branch deletion or remote branch operations + +**Why:** The user maintains control over when code is shared with collaborators. Always ask before syncing with remote repositories. + +### Workflow Best Practices + +1. **Make small, focused commits** - Each commit should represent one logical change +2. **Write descriptive commit messages** - Explain what and why, not just what +3. **Rebase and clean up history** - Use `git commit --amend` and `git restack` to keep history clean +4. **Test before committing** - Run `bild --test` and `lint` on affected namespaces + +### Required Checks Before Completing Tasks + +After completing a task, **always** run these commands for the namespace(s) you modified: + +```bash +# Run tests +bild --test Omni/YourNamespace.hs + +# Run linter +lint Omni/YourNamespace.hs +``` + +**Fix all reported errors** related to your changes before marking the task as complete. This ensures code quality and prevents breaking the build for other contributors. diff --git a/Omni/Ide/hooks/post-checkout b/Omni/Ide/hooks/post-checkout index 3fe14b5..7c8bcb9 100755 --- a/Omni/Ide/hooks/post-checkout +++ b/Omni/Ide/hooks/post-checkout @@ -15,6 +15,10 @@ then MakeTags "${changed[@]}" fi +# Configure git merge driver for tasks +git config merge.agent.name "Agent Merge Driver" || true +git config merge.agent.driver "agent merge-driver %A %B" || true + # Task manager: Import tasks after branch switch if [ -f .tasks/tasks.jsonl ]; then task import -i .tasks/tasks.jsonl 2>/dev/null || true diff --git a/Omni/Task.hs b/Omni/Task.hs index 36b318b..653e5fe 100644 --- a/Omni/Task.hs +++ b/Omni/Task.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NoImplicitPrelude #-} -- : out task +-- : modified by benign worker module Omni.Task where import Alpha @@ -20,6 +21,7 @@ import System.Directory (doesFileExist, removeFile) import System.Environment (setEnv) import System.Process (callCommand) import qualified Test.Tasty as Tasty +import Prelude (read) main :: IO () main = Cli.main plan @@ -41,10 +43,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] @@ -58,6 +61,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 @@ -73,13 +77,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, task, or human (default: 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 + --status=<status> Filter by status: open, in-progress, review, approved, 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 @@ -91,7 +96,7 @@ Options: Arguments: <title> Task title <id> Task ID - <status> Task status (open, in-progress, review, done) + <status> Task status (open, in-progress, review, approved, done) <file> JSONL file to import |] @@ -112,14 +117,18 @@ move args | args `Cli.has` Cli.command "init" = do let quiet = args `Cli.has` Cli.longOption "quiet" initTaskDb - unless quiet <| putText "Task database initialized. Use 'task create' to add tasks." + callCommand "git config commit.template .gitmessage" + callCommand "git config merge.agent.name 'Agent Merge Driver' || true" + callCommand "git config merge.agent.driver 'agent merge-driver %A %B' || true" + unless quiet <| putText "Task database initialized and configured. Use 'task create' to add tasks." | args `Cli.has` Cli.command "create" = do title <- getArgText args "title" taskType <- case Cli.getArg args (Cli.longOption "type") of Nothing -> pure WorkTask Just "epic" -> pure Epic Just "task" -> pure WorkTask - Just other -> panic <| "Invalid task type: " <> T.pack other <> ". Use: epic or task" + Just "human" -> pure HumanTask + Just other -> panic <| "Invalid task type: " <> T.pack other <> ". Use: epic, task, or human" parent <- case Cli.getArg args (Cli.longOption "parent") of Nothing -> pure Nothing Just p -> pure <| Just (T.pack p) @@ -169,11 +178,77 @@ 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 Just "epic" -> pure <| Just Epic Just "task" -> pure <| Just WorkTask + Just "human" -> pure <| Just HumanTask Just other -> panic <| "Invalid task type: " <> T.pack other maybeParent <- case Cli.getArg args (Cli.longOption "parent") of Nothing -> pure Nothing @@ -183,8 +258,9 @@ move args Just "open" -> pure <| Just Open Just "in-progress" -> pure <| Just InProgress Just "review" -> pure <| Just Review + Just "approved" -> pure <| Just Approved Just "done" -> pure <| Just Done - Just other -> panic <| "Invalid status: " <> T.pack other <> ". Use: open, in-progress, review, or done" + Just other -> panic <| "Invalid status: " <> T.pack other <> ". Use: open, in-progress, review, approved, or done" maybeNamespace <- case Cli.getArg args (Cli.longOption "namespace") of Nothing -> pure Nothing Just ns -> do @@ -205,22 +281,40 @@ 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 + "approved" -> Approved "done" -> Done - _ -> panic "Invalid status. Use: open, in-progress, review, or done" - updateTaskStatus tid newStatus + _ -> panic "Invalid status. Use: open, in-progress, review, approved, or done" + + updateTaskStatus tid newStatus deps if isJsonMode args then outputSuccess <| "Updated task " <> tid else do @@ -313,6 +407,13 @@ unitTests = taskStatus task Test.@?= Open taskPriority task Test.@?= P2 null (taskDependencies task) Test.@?= True, + Test.unit "can create human task" <| do + task <- createTask "Human Task" HumanTask Nothing Nothing P2 [] Nothing + taskType task Test.@?= HumanTask, + Test.unit "ready tasks exclude human tasks" <| do + task <- createTask "Human Task" HumanTask Nothing Nothing P2 [] Nothing + ready <- getReadyTasks + (taskId task `notElem` map taskId ready) Test.@?= True, Test.unit "can create task with description" <| do task <- createTask "Test task" WorkTask Nothing Nothing P2 [] (Just "My description") taskDescription task Test.@?= Just "My description", @@ -343,6 +444,10 @@ unitTests = -- Both should be ready since Related doesn't block (taskId task1 `elem` map taskId ready) Test.@?= True (taskId task2 `elem` map taskId ready) Test.@?= True, + Test.unit "ready tasks exclude epics" <| do + epic <- createTask "Epic task" Epic Nothing Nothing P2 [] Nothing + ready <- getReadyTasks + (taskId epic `notElem` map taskId ready) Test.@?= True, Test.unit "child task gets sequential ID" <| do parent <- createTask "Parent" Epic Nothing Nothing P2 [] Nothing child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 [] Nothing @@ -385,6 +490,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 @@ -397,7 +515,84 @@ unitTests = Test.unit "namespace normalization handles .hs suffix" <| do let ns = "Omni/Task.hs" validNs = Namespace.fromHaskellModule ns - Namespace.toPath validNs Test.@?= "Omni/Task.hs" + 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" + let task = Task lowerId "Lower" 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 lowerId tasks of + 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", + 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: + -- let foundUpper = List.find (\t -> taskId t == upperId) tasks + -- 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 @@ -452,6 +647,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 @@ -471,6 +681,13 @@ cliTests = Right args -> do args `Cli.has` Cli.command "list" Test.@?= True Cli.getArg args (Cli.longOption "status") Test.@?= Just "open", + Test.unit "list with --status=approved filter" <| do + let result = Docopt.parseArgs help ["list", "--status=approved"] + case result of + Left err -> Test.assertFailure <| "Failed to parse 'list --status=approved': " <> show err + Right args -> do + args `Cli.has` Cli.command "list" Test.@?= True + Cli.getArg args (Cli.longOption "status") Test.@?= Just "approved", Test.unit "ready command" <| do let result = Docopt.parseArgs help ["ready"] case result of @@ -491,6 +708,14 @@ cliTests = args `Cli.has` Cli.command "update" Test.@?= True Cli.getArg args (Cli.argument "id") Test.@?= Just "t-abc123" Cli.getArg args (Cli.argument "status") Test.@?= Just "done", + Test.unit "update command with approved" <| do + let result = Docopt.parseArgs help ["update", "t-abc123", "approved"] + case result of + Left err -> Test.assertFailure <| "Failed to parse 'update ... approved': " <> show err + Right args -> do + args `Cli.has` Cli.command "update" Test.@?= True + Cli.getArg args (Cli.argument "id") Test.@?= Just "t-abc123" + Cli.getArg args (Cli.argument "status") Test.@?= Just "approved", Test.unit "update with --json flag" <| do let result = Docopt.parseArgs help ["update", "t-abc123", "done", "--json"] case result of diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index bab1912..1eb820f 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -39,10 +39,10 @@ data Task = Task } deriving (Show, Eq, Generic) -data TaskType = Epic | WorkTask +data TaskType = Epic | WorkTask | HumanTask deriving (Show, Eq, Generic) -data Status = Open | InProgress | Review | Done +data Status = Open | InProgress | Review | Approved | Done deriving (Show, Eq, Generic) -- Priority levels (matching beads convention) @@ -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 @@ -176,7 +192,7 @@ withTaskReadLock action = action ) --- Generate a short ID using base62 encoding of timestamp +-- Generate a short ID using base36 encoding of timestamp (lowercase) generateId :: IO Text generateId = do now <- getCurrentTime @@ -188,7 +204,7 @@ generateId = do -- Combine MJD and micros to ensure uniqueness across days. -- Multiplier 10^11 (100,000 seconds) is safe for any day length. totalMicros = (mjd * 100000000000) + micros - encoded = toBase62 totalMicros + encoded = toBase36 totalMicros pure <| "t-" <> T.pack encoded -- Generate a child ID based on parent ID (e.g. "t-abc.1", "t-abc.1.2") @@ -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 = @@ -220,15 +236,15 @@ getSuffix parent childId = else Nothing else Nothing --- Convert number to base62 (0-9, a-z, A-Z) -toBase62 :: Integer -> String -toBase62 0 = "0" -toBase62 n = reverse <| go n +-- Convert number to base36 (0-9, a-z) +toBase36 :: Integer -> String +toBase36 0 = "0" +toBase36 n = reverse <| go n where - alphabet = ['0' .. '9'] ++ ['a' .. 'z'] ++ ['A' .. 'Z'] + alphabet = ['0' .. '9'] ++ ['a' .. 'z'] go 0 = [] go x = - let (q, r) = x `divMod` 62 + let (q, r) = x `divMod` 36 idx = fromIntegral r char = case drop idx alphabet of (c : _) -> c @@ -319,22 +335,25 @@ 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 - Nothing -> generateId + let parent' = fmap normalizeId parent + deps' = map normalizeDependency deps + + tid <- case parent' of + Nothing -> generateUniqueId Just pid -> do tasks <- loadTasksInternal pure <| computeNextChildId tasks pid 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 @@ -342,22 +361,62 @@ createTask title taskType parent namespace priority deps description = saveTaskInternal task pure task +-- Generate a unique ID (checking against existing tasks) +generateUniqueId :: IO Text +generateUniqueId = do + tasks <- loadTasksInternal + go tasks + where + go tasks = do + tid <- generateId + case findTask tid tasks of + Nothing -> pure tid + 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 @@ -395,8 +454,12 @@ getReadyTasks = do -- Only Blocks and ParentChild dependencies block ready work blockingDepIds task = [depId dep | dep <- taskDependencies task, depType dep `elem` [Blocks, ParentChild]] isReady task = - not (isParent (taskId task)) + taskType task + /= Epic + && not (isParent (taskId task)) && all (`elem` doneIds) (blockingDepIds task) + && taskType task + /= HumanTask pure <| filter isReady openTasks -- Get dependency tree for a task (returns tasks) @@ -415,12 +478,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 @@ -514,18 +578,20 @@ showTaskTree maybeId = do let total = length children completed = length <| filter (\t -> taskStatus t == Done) children in "[" <> T.pack (show completed) <> "/" <> T.pack (show total) <> "]" - WorkTask -> case taskStatus task of + _ -> case taskStatus task of Open -> "[ ]" InProgress -> "[~]" Review -> "[?]" + Approved -> "[+]" Done -> "[✓]" coloredStatusStr = case taskType task of Epic -> magenta statusStr - WorkTask -> case taskStatus task of + _ -> case taskStatus task of Open -> bold statusStr InProgress -> yellow statusStr Review -> magenta statusStr + Approved -> green statusStr Done -> green statusStr nsStr = case taskNamespace task of @@ -585,6 +651,7 @@ printTask t = do Open -> bold s InProgress -> yellow s Review -> magenta s + Approved -> green s Done -> green s coloredTitle = if taskType t == Epic then bold (taskTitle t) else taskTitle t @@ -695,6 +762,7 @@ data TaskStats = TaskStats openTasks :: Int, inProgressTasks :: Int, reviewTasks :: Int, + approvedTasks :: Int, doneTasks :: Int, totalEpics :: Int, readyTasks :: Int, @@ -730,6 +798,7 @@ getTaskStats maybeEpicId = do open = length <| filter (\t -> taskStatus t == Open) tasks inProg = length <| filter (\t -> taskStatus t == InProgress) tasks review = length <| filter (\t -> taskStatus t == Review) tasks + approved = length <| filter (\t -> taskStatus t == Approved) tasks done = length <| filter (\t -> taskStatus t == Done) tasks epics = length <| filter (\t -> taskType t == Epic) tasks readyCount' = readyCount @@ -752,6 +821,7 @@ getTaskStats maybeEpicId = do openTasks = open, inProgressTasks = inProg, reviewTasks = review, + approvedTasks = approved, doneTasks = done, totalEpics = epics, readyTasks = readyCount', @@ -779,6 +849,7 @@ showTaskStats maybeEpicId = do putText <| " Open: " <> T.pack (show (openTasks stats)) putText <| " In Progress: " <> T.pack (show (inProgressTasks stats)) putText <| " Review: " <> T.pack (show (reviewTasks stats)) + putText <| " Approved: " <> T.pack (show (approvedTasks stats)) putText <| " Done: " <> T.pack (show (doneTasks stats)) putText "" putText <| "Epics: " <> T.pack (show (totalEpics stats)) @@ -815,7 +886,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 diff --git a/Omni/Task/README.md b/Omni/Task/README.md new file mode 100644 index 0000000..d52efba --- /dev/null +++ b/Omni/Task/README.md @@ -0,0 +1,416 @@ +# Task Manager for AI Agents + +The task manager is a dependency-aware issue tracker inspired by beads. It uses: +- **Storage**: Local JSONL file (`.tasks/tasks.jsonl`) +- **Sync**: Git-tracked (automatically synced across machines) +- **Dependencies**: Tasks can block other tasks +- **Ready work detection**: Automatically finds unblocked tasks + +**IMPORTANT**: You MUST use `task` for ALL issue tracking. NEVER use markdown TODOs, todo_write, task lists, or any other tracking methods. + +## Human Setup vs Agent Usage + +**If you see "database not found" or similar errors:** +```bash +task init --quiet # Non-interactive, auto-setup, no prompts +``` + +**Why `--quiet`?** The regular `task init` may have interactive prompts. The `--quiet` flag makes it fully non-interactive and safe for agent-driven setup. + +**If `task init --quiet` fails:** Ask the human to run `task init` manually, then continue. + +## Create a Task +```bash +task create "<title>" [--type=<type>] [--parent=<id>] [--deps=<ids>] [--dep-type=<type>] [--discovered-from=<id>] [--namespace=<ns>] +``` + +Examples: +```bash +# Create an epic (container for tasks) +task create "User Authentication System" --type=epic + +# Create a task within an epic +task create "Design auth API" --parent=t-abc123 + +# Create a task with blocking dependency +task create "Write tests" --deps=t-a1b2c3 --dep-type=blocks + +# Create work discovered during implementation (shortcut) +task create "Fix memory leak" --discovered-from=t-abc123 + +# Create related work (doesn't block) +task create "Update documentation" --deps=t-abc123 --dep-type=related + +# Associate with a namespace +task create "Fix type errors" --namespace="Omni/Task" +``` + +**Task Types:** +- `epic` - Container for related tasks +- `task` - Individual work item (default) +- `human` - Task specifically for human operators (excluded from agent work queues) + +**Dependency Types:** +- `blocks` - Hard dependency, blocks ready work queue (default) +- `discovered-from` - Work discovered during other work, doesn't block +- `parent-child` - Epic/subtask relationship, blocks ready work +- `related` - Soft relationship, doesn't block + +The `--namespace` option associates the task with a specific namespace in the monorepo (e.g., `Omni/Task`, `Biz/Cloud`). This helps organize tasks by the code they relate to. + +## List Tasks +```bash +task list [options] # Flags can be in any order +``` + +Examples: +```bash +task list # All tasks +task list --type=epic # All epics +task list --parent=t-abc123 # All tasks in an epic +task list --status=open # All open tasks +task list --status=done # All completed tasks +task list --namespace="Omni/Task" # All tasks for a namespace +task list --parent=t-abc123 --status=open # Combine filters: open tasks in epic +``` + +## Get Ready Work +```bash +task ready +``` + +Shows all tasks that are: +- Not closed +- Not blocked by incomplete dependencies + +## Update Task Status +```bash +task update <id> <status> +``` + +Status values: `open`, `in-progress`, `done` + +Examples: +```bash +task update t-20241108120000 in-progress +task update t-20241108120000 done +``` + +**Note**: Task updates modify `.tasks/tasks.jsonl` but don't auto-commit. The pre-commit hook will automatically export and stage task changes on your next `git commit`. + +## View Dependencies +```bash +task deps <id> +``` + +Shows the dependency tree for a task. + +## View Task Tree +```bash +task tree [<id>] +``` + +Shows task hierarchy with visual status indicators: +- `[ ]` - Open +- `[~]` - In Progress +- `[✓]` - Done + +Examples: +```bash +task tree # Show all epics with their children +task tree t-abc123 # Show specific epic/task with its children +``` + +## Export Tasks +```bash +task export [--flush] +``` + +Consolidates and exports tasks to `.tasks/tasks.jsonl`, removing duplicates. The `--flush` flag forces immediate export (used by git hooks). + +## Import Tasks +```bash +task import -i <file> +``` + +Imports tasks from a JSONL file, merging with existing tasks. Newer tasks (based on `updatedAt` timestamp) take precedence. + +Examples: +```bash +task import -i .tasks/tasks.jsonl +task import -i /path/to/backup.jsonl +``` + +## Initialize (First Time) +```bash +task init --quiet # Non-interactive (recommended for agents) +# OR +task init # Interactive (for humans) +``` + +Creates `.tasks/` directory and `tasks.jsonl` file. + +**Agents MUST use `--quiet` flag** to avoid interactive prompts. + +## Common Workflows + +### Starting New Work + +1. **Find what's ready to work on:** + ```bash + task ready + ``` + +2. **Pick a task and mark it in progress:** + ```bash + task update t-20241108120000 in-progress + ``` + +3. **When done, mark it complete:** + ```bash + task update t-20241108120000 done + ``` + +### Creating Dependent Tasks + +When you discover work that depends on other work: + +```bash +# Create the blocking task first +task create "Design API" --type=task + +# Note the ID (e.g., t-20241108120000) + +# Create dependent task with blocking dependency +task create "Implement API client" --deps=t-20241108120000 --dep-type=blocks +``` + +The dependent task won't show up in `task ready` until the blocker is marked `done`. + +### Discovered Work Pattern + +When you find work during implementation, use the `--discovered-from` flag: + +```bash +# While working on t-abc123, you discover a bug +task create "Fix memory leak in parser" --discovered-from=t-abc123 + +# This is equivalent to: +task create "Fix memory leak in parser" --deps=t-abc123 --dep-type=discovered-from +``` + +The `discovered-from` dependency type maintains context but **doesn't block** the ready work queue. This allows AI agents to track what work was found during other work while still being able to work on it immediately. + +### Working with Epics + +```bash +# Create an epic for a larger feature +task create "User Authentication System" --type=epic +# Note ID: t-abc123 + +# Create child tasks within the epic +task create "Design login flow" --parent=t-abc123 +task create "Implement OAuth" --parent=t-abc123 +task create "Add password reset" --parent=t-abc123 + +# List all tasks in an epic +task list --parent=t-abc123 + +# List all epics +task list --type=epic +``` + +## Agent Best Practices + +### 1. ALWAYS Check Ready Work First +Before asking what to do, you MUST check `task ready --json` to see unblocked tasks. + +### 2. ALWAYS Create Tasks for Discovered Work +When you encounter work during implementation, you MUST create linked tasks: +```bash +task create "Fix type error in auth module" --discovered-from=t-abc123 --json +task create "Add missing test coverage" --discovered-from=t-abc123 --json +``` + +**Bug Discovery Pattern** + +When you discover a bug or unexpected behavior: +```bash +# CORRECT: Immediately file a task +task create "Command X fails when Y" --discovered-from=<current-task-id> --json + +# WRONG: Ignoring it and moving on +# WRONG: Leaving a TODO comment +# WRONG: Mentioning it but not filing a task +``` + +**Examples of bugs you MUST file:** +- "Expected `--flag value` to work but only `--flag=value` works" +- "Documentation says X but actual behavior is Y" +- "Combining two flags causes parsing error" +- "Feature is missing that would be useful" + +**CRITICAL: File bugs immediately when you discover them:** +- If a command doesn't work as documented → create a task +- If a command doesn't work as you expected → create a task +- If behavior is inconsistent or confusing → create a task +- If documentation is wrong or misleading → create a task +- If you find yourself working around a limitation → create a task + +**NEVER leave TODO comments in code.** Create a task instead. + +**NEVER ignore bugs or unexpected behavior.** File a task for it immediately. + +### 3. Forbidden Patterns + +**Markdown checklist (NEVER do this):** +```markdown +❌ Wrong: +- [ ] Refactor auth module +- [ ] Add tests +- [ ] Update docs + +✅ Correct: +task create "Refactor auth module" -p 2 --json +task create "Add tests for auth" -p 2 --json +task create "Update auth docs" -p 3 --json +``` + +**todo_write tool (NEVER do this):** +``` +❌ Wrong: todo_write({todos: [{content: "Fix bug", ...}]}) +✅ Correct: task create "Fix bug in parser" -p 1 --json +``` + +**Inline code comments (NEVER do this):** +```python +❌ Wrong: +# TODO: write tests for this function +# FIXME: handle edge case + +✅ Correct: +# Create task instead: +task create "Write tests for parse_config" -p 2 --namespace="Omni/Config" --json +task create "Handle edge case in parser" -p 1 --discovered-from=<current-id> --json +``` + +### 4. Track Dependencies +If work depends on other work, use `--deps`: +```bash +# Can't write tests until implementation is done +task create "Test auth flow" --deps=t-20241108120000 --dep-type=blocks --json +``` + +### 5. Use Descriptive Titles +Good: `"Add JWT token validation to auth middleware"` +Bad: `"Fix auth"` + +### 6. Use Epics for Organization +Organize related work using epics: +- Create an epic for larger features: `task create "Feature Name" --type=epic --json` +- Add tasks to the epic using `--parent=<epic-id>` +- Use `--discovered-from` to track work found during implementation + +### 7. ALWAYS Store AI Planning Docs in `_/llm` Directory +AI assistants often create planning and design documents during development: +- PLAN.md, DESIGN.md, TESTING_GUIDE.md, tmp, and similar files +- **You MUST use a dedicated directory for these ephemeral files** +- Store ALL AI-generated planning/design docs in `_/llm` +- The `_` directory is ignored by git and all of our temporary files related to the omnirepo go there +- NEVER commit planning docs to the repo root + +## Dependency Rules + +- A task is **blocked** if any of its dependencies are not `done` +- A task is **ready** if all its dependencies are `done` (or it has no dependencies) +- `task ready` only shows tasks with status `open` or `in-progress` that are not blocked + +## File Structure + +``` +.tasks/ +├── tasks.jsonl # Git-tracked, production database +├── tasks-test.jsonl # Test database (not tracked, auto-created) + +Omni/Ide/hooks/ +├── pre-commit # Exports tasks before commit (auto-stages tasks.jsonl) +├── post-checkout # Imports tasks after branch switch +└── ... # Other git hooks +``` + +Each line in `tasks.jsonl` is a JSON object representing a task. + +**Git Hooks**: This repository uses hooks from `Omni/Ide/hooks/` (configured via `core.hooksPath`). Do NOT add hooks to `.git/hooks/` - they won't be version controlled and may cause confusion. + +## Testing and Development + +**CRITICAL**: When manually testing task functionality (like tree visualization, flag ordering, etc.), you MUST use the test database: + +```bash +# Set test mode to protect production database +export TASK_TEST_MODE=1 + +# Now all task operations use .tasks/tasks-test.jsonl +task create "Test task" --type=task +task list +task tree + +# Unset when done +unset TASK_TEST_MODE +``` + +**The test suite automatically uses test mode** - you don't need to set it manually when running `task test` or `bild --test Omni/Task.hs`. + +**NEVER run manual tests against the production database** (`.tasks/tasks.jsonl`). This pollutes it with test data that must be manually cleaned up. Always use `TASK_TEST_MODE=1` for experimentation. + +## Integration with Git + +The `.tasks/tasks.jsonl` file is git-tracked. When you: +- Create/update tasks locally +- Commit and push +- Other machines/agents get the updates on `git pull` + +**Important**: Add to `.gitignore`: +``` +.tasks/*.db +.tasks/*.db-journal +.tasks/*.sock +``` + +But **do** track: +``` +!.tasks/ +!.tasks/tasks.jsonl +``` + +## Troubleshooting + +### "Task not found" +- Check the task ID is correct with `task list` +- Ensure you've run `task init` + +### "Database not initialized" +Run: `task init` + +### Dependencies not working +- Verify dependency IDs exist: `task list` +- Check dependency tree: `task deps <id>` + +## Reinforcement: Critical Rules + +Remember these non-negotiable rules: + +- ✅ Use `task` for ALL task tracking (with `--json` flag) +- ✅ Link discovered work with `--discovered-from` dependencies +- ✅ File bugs IMMEDIATELY when you discover unexpected behavior +- ✅ Check `task ready --json` before asking "what should I work on?" +- ✅ Store AI planning docs in `_/llm` directory +- ✅ Run `task sync` at end of every session (commits locally, does NOT push) +- ❌ NEVER use `todo_write` tool +- ❌ NEVER create markdown TODO lists or task checklists +- ❌ NEVER put TODOs or FIXMEs in code comments +- ❌ NEVER use external issue trackers +- ❌ NEVER duplicate tracking systems +- ❌ NEVER clutter repo root with planning documents + +**If you find yourself about to use todo_write or create a markdown checklist, STOP and use `task create` instead.** diff --git a/Omni/Task/RaceTest.hs b/Omni/Task/RaceTest.hs index cfadaca..0cd6464 100644 --- a/Omni/Task/RaceTest.hs +++ b/Omni/Task/RaceTest.hs @@ -54,3 +54,6 @@ raceTest = -- Verify IDs follow the pattern parentId.N for_ ids <| \tid -> do (parentId `T.isPrefixOf` tid) Test.@?= True + + -- Cleanup + removeFile testFile |
