summaryrefslogtreecommitdiff
path: root/Omni
diff options
context:
space:
mode:
Diffstat (limited to 'Omni')
-rw-r--r--Omni/Agent.hs122
-rw-r--r--Omni/Agent/Core.hs1
-rw-r--r--Omni/Agent/DESIGN.md2
-rw-r--r--Omni/Agent/Git.hs60
-rw-r--r--Omni/Agent/Log.hs115
-rw-r--r--Omni/Agent/LogTest.hs124
-rw-r--r--Omni/Agent/Worker.hs56
-rwxr-xr-xOmni/Agent/harvest-tasks.sh62
-rwxr-xr-xOmni/Agent/merge-tasks.sh30
-rwxr-xr-xOmni/Agent/monitor-worker.sh47
-rwxr-xr-xOmni/Agent/monitor.sh68
-rwxr-xr-xOmni/Agent/setup-worker.sh31
-rwxr-xr-xOmni/Agent/start-worker.sh6
-rwxr-xr-xOmni/Agent/sync-tasks.sh46
-rwxr-xr-xOmni/Bild/Audit.py176
-rw-r--r--Omni/Bild/README.md40
-rw-r--r--Omni/Ci.hs191
-rwxr-xr-xOmni/Ci.sh65
-rw-r--r--Omni/Ide/README.md143
-rwxr-xr-xOmni/Ide/hooks/post-checkout4
-rw-r--r--Omni/Task.hs253
-rw-r--r--Omni/Task/Core.hs127
-rw-r--r--Omni/Task/README.md416
-rw-r--r--Omni/Task/RaceTest.hs3
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