{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} -- : out task -- : dep sqlite-simple -- : dep sqids -- : modified by benign worker module Omni.Task where import Alpha import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.Text as T import qualified Omni.Cli as Cli import qualified Omni.Namespace as Namespace import Omni.Task.Core import qualified Omni.Task.RaceTest as RaceTest import qualified Omni.Test as Test import qualified System.Console.Docopt as Docopt import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile) import System.Environment (setEnv) import qualified Test.Tasty as Tasty import Prelude (read) main :: IO () main = Cli.main plan plan :: Cli.Plan () plan = Cli.Plan { help = help, move = move, test = test, tidy = \_ -> pure () } help :: Cli.Docopt help = [Cli.docopt| task Usage: task init [--quiet] task create [options] task edit <id> [options] task delete <id> [--json] task list [options] task ready [--json] task show <id> [--json] task update <id> <status> [options] task deps <id> [--json] task tree [<id>] [--json] task progress <id> [--json] task stats [--epic=<id>] [--json] task export [-o <file>] task import -i <file> task test task (-h | --help) Commands: init Initialize task database create Create a new task or epic edit Edit an existing task delete Delete a task list List all tasks ready Show ready tasks (not blocked) show Show detailed task information update Update task status deps Show dependency tree tree Show task tree (epics with children, or all epics if no ID given) progress Show progress for an epic stats Show task statistics export Export tasks to JSONL import Import tasks from JSONL file test Run tests Options: -h --help Show this help --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, 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 --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 --db=<file> Path to SQLite database (overrides TASK_DB_PATH) --flush Force immediate export --json Output in JSON format (for agent use) --quiet Non-interactive mode (for agents) -i <file> Input file for import -o <file> Output file for export Arguments: <title> Task title <id> Task ID <status> Task status (open, in-progress, review, approved, done) <file> JSONL file to import |] -- Helper to check if JSON output is requested isJsonMode :: Cli.Arguments -> Bool isJsonMode args = args `Cli.has` Cli.longOption "json" -- Helper to output JSON outputJson :: (Aeson.ToJSON a) => a -> IO () outputJson val = BLC.putStrLn <| Aeson.encode val -- Helper for success message in JSON outputSuccess :: Text -> IO () outputSuccess msg = outputJson <| Aeson.object ["success" Aeson..= True, "message" Aeson..= msg] move :: Cli.Arguments -> IO () move args = do -- Handle --db flag globally for_ (Cli.getArg args (Cli.longOption "db")) (setEnv "TASK_DB_PATH") move' args move' :: Cli.Arguments -> IO () 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." | 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 "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) -- Handle --discovered-from as shortcut (depIds, depType) <- case Cli.getArg args (Cli.longOption "discovered-from") of Just discoveredId -> pure ([T.pack discoveredId], DiscoveredFrom) Nothing -> do -- Parse regular --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 (ids, dtype) let deps = map (\did -> Dependency {depId = did, depType = depType}) depIds -- Parse priority (default to P2 = medium) priority <- case Cli.getArg args (Cli.longOption "priority") of Nothing -> pure P2 Just "0" -> pure P0 Just "1" -> pure P1 Just "2" -> pure P2 Just "3" -> pure P3 Just "4" -> pure P4 Just other -> panic <| "Invalid priority: " <> T.pack other <> ". Use: 0-4" namespace <- case Cli.getArg args (Cli.longOption "namespace") of Nothing -> pure Nothing Just ns -> do -- Validate it's a proper namespace by parsing it let validNs = Namespace.fromHaskellModule ns nsPath = T.pack <| Namespace.toPath validNs pure <| Just nsPath description <- case Cli.getArg args (Cli.longOption "description") of Nothing -> pure Nothing Just d -> pure <| Just (T.pack d) createdTask <- createTask title taskType parent namespace priority deps description 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 "delete" = do tid <- getArgText args "id" deleteTask tid if isJsonMode args then outputSuccess ("Deleted task " <> tid) else putStrLn <| "Deleted task: " <> T.unpack tid | 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 Just p -> pure <| Just (T.pack p) 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 "approved" -> pure <| Just Approved Just "done" -> pure <| Just 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 let validNs = Namespace.fromHaskellModule ns nsPath = T.pack <| Namespace.toPath validNs pure <| Just nsPath tasks <- listTasks maybeType maybeParent maybeStatus maybeNamespace if isJsonMode args then outputJson tasks else traverse_ printTask tasks | args `Cli.has` Cli.command "ready" = do tasks <- getReadyTasks if isJsonMode args then outputJson tasks else do putText "Ready tasks:" traverse_ printTask tasks | args `Cli.has` Cli.command "show" = do tid <- getArgText args "id" tasks <- loadTasks 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, approved, or done" updateTaskStatus tid newStatus deps if isJsonMode args then outputSuccess <| "Updated task " <> tid else putStrLn <| "Updated task " <> T.unpack tid | args `Cli.has` Cli.command "deps" = do tid <- getArgText args "id" if isJsonMode args then do deps <- getDependencyTree tid outputJson deps else showDependencyTree tid | args `Cli.has` Cli.command "tree" = do maybeId <- case Cli.getArg args (Cli.argument "id") of Nothing -> pure Nothing Just idStr -> pure <| Just (T.pack idStr) if isJsonMode args then do tree <- getTaskTree maybeId outputJson tree else showTaskTree maybeId | args `Cli.has` Cli.command "progress" = do tid <- getArgText args "id" if isJsonMode args then do progress <- getTaskProgress tid outputJson progress else showTaskProgress tid | args `Cli.has` Cli.command "stats" = do maybeEpic <- case Cli.getArg args (Cli.longOption "epic") of Nothing -> pure Nothing Just e -> pure <| Just (T.pack e) if isJsonMode args then do stats <- getTaskStats maybeEpic outputJson stats else showTaskStats maybeEpic | args `Cli.has` Cli.command "export" = do file <- case Cli.getArg args (Cli.shortOption 'o') of Nothing -> pure Nothing Just f -> pure (Just f) exportTasks file case file of Just f -> putText <| "Exported tasks to " <> T.pack f Nothing -> pure () | args `Cli.has` Cli.command "import" = do -- Note: -i <file> means the value is stored in option 'i', not argument "file" file <- case Cli.getArg args (Cli.shortOption 'i') of Nothing -> panic "import requires -i <file>" Just f -> pure (T.pack f) importTasks (T.unpack file) putText <| "Imported tasks from " <> file | otherwise = putText (T.pack <| Cli.usage help) where getArgText :: Cli.Arguments -> String -> IO Text getArgText argz name = do maybeArg <- pure <| Cli.getArg argz (Cli.argument name) case maybeArg of Nothing -> panic (T.pack name <> " required") Just val -> pure (T.pack val) test :: Test.Tree test = Test.group "Omni.Task" [ unitTests, cliTests, Tasty.after Tasty.AllSucceed "Unit tests" RaceTest.test ] unitTests :: Test.Tree unitTests = Test.group "Unit tests" [ Test.unit "setup test database" <| do -- Set up test mode for all tests (uses _/tmp/tasks-test.db) setEnv "TASK_TEST_MODE" "1" -- Clean up test database before all tests let testFile = "_/tmp/tasks-test.db" createDirectoryIfMissing True "_/tmp" exists <- doesFileExist testFile when exists <| removeFile testFile initTaskDb True Test.@?= True, Test.unit "can create task" <| do task <- createTask "Test task" WorkTask Nothing Nothing P2 [] Nothing taskTitle task Test.@?= "Test task" taskType task Test.@?= WorkTask 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", Test.unit "can list tasks" <| do _ <- createTask "Test task for list" WorkTask Nothing Nothing P2 [] Nothing tasks <- listTasks Nothing Nothing Nothing Nothing not (null tasks) Test.@?= True, Test.unit "ready tasks exclude blocked ones" <| do task1 <- createTask "First task" WorkTask Nothing Nothing P2 [] Nothing let blockingDep = Dependency {depId = taskId task1, depType = Blocks} task2 <- createTask "Blocked task" WorkTask Nothing Nothing P2 [blockingDep] Nothing ready <- getReadyTasks (taskId task1 `elem` map taskId ready) Test.@?= True (taskId task2 `notElem` map taskId ready) Test.@?= True, Test.unit "discovered-from dependencies don't block" <| do task1 <- createTask "Original task" WorkTask Nothing Nothing P2 [] Nothing let discDep = Dependency {depId = taskId task1, depType = DiscoveredFrom} task2 <- createTask "Discovered work" WorkTask Nothing Nothing P2 [discDep] Nothing ready <- getReadyTasks -- Both should be ready since DiscoveredFrom doesn't block (taskId task1 `elem` map taskId ready) Test.@?= True (taskId task2 `elem` map taskId ready) Test.@?= True, Test.unit "related dependencies don't block" <| do task1 <- createTask "Task A" WorkTask Nothing Nothing P2 [] Nothing let relDep = Dependency {depId = taskId task1, depType = Related} task2 <- createTask "Task B" WorkTask Nothing Nothing P2 [relDep] Nothing ready <- getReadyTasks -- 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 child2 <- createTask "Child 2" WorkTask (Just (taskId parent)) Nothing P2 [] Nothing taskId child1 Test.@?= taskId parent <> ".1" taskId child2 Test.@?= taskId parent <> ".2", Test.unit "grandchild task gets sequential ID" <| do parent <- createTask "Grandparent" Epic Nothing Nothing P2 [] Nothing child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 [] Nothing grandchild <- createTask "Grandchild" WorkTask (Just (taskId child)) Nothing P2 [] Nothing taskId grandchild Test.@?= taskId parent <> ".1.1", Test.unit "siblings of grandchild task get sequential ID" <| do parent <- createTask "Grandparent" Epic Nothing Nothing P2 [] Nothing child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 [] Nothing grandchild1 <- createTask "Grandchild 1" WorkTask (Just (taskId child)) Nothing P2 [] Nothing grandchild2 <- createTask "Grandchild 2" WorkTask (Just (taskId child)) Nothing P2 [] Nothing taskId grandchild1 Test.@?= taskId parent <> ".1.1" taskId grandchild2 Test.@?= taskId parent <> ".1.2", Test.unit "child ID generation skips gaps" <| do parent <- createTask "Parent with gaps" Epic Nothing Nothing P2 [] Nothing child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 [] Nothing -- Manually create a task with .3 suffix to simulate a gap (or deleted task) let child3Id = taskId parent <> ".3" child3 = Task { taskId = child3Id, taskTitle = "Child 3", taskType = WorkTask, taskParent = Just (taskId parent), taskNamespace = Nothing, taskStatus = Open, taskPriority = P2, taskDependencies = [], taskCreatedAt = taskCreatedAt child1, taskUpdatedAt = taskUpdatedAt child1, taskDescription = Nothing } saveTask child3 -- 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 upperTid = T.toUpper tid tasks <- loadTasks let found = findTask upperTid tasks case found of Just t -> taskId t Test.@?= tid Nothing -> Test.assertFailure "Could not find task with upper case ID", Test.unit "namespace normalization handles .hs suffix" <| do let ns = "Omni/Task.hs" validNs = Namespace.fromHaskellModule ns Namespace.toPath validNs Test.@?= "Omni/Task.hs", Test.unit "generated IDs are lowercase" <| do task <- createTask "Lowercase check" WorkTask Nothing Nothing P2 [] Nothing let tid = taskId task tid Test.@?= T.toLower tid -- check it matches regex for base36 (t-[0-9a-z]+) let isLowerBase36 = T.all (\c -> c `elem` ['0' .. '9'] ++ ['a' .. 'z'] || c == 't' || c == '-') tid isLowerBase36 Test.@?= True, Test.unit "dependencies are case insensitive" <| do task1 <- createTask "Blocker" WorkTask Nothing Nothing P2 [] Nothing let tid1 = taskId task1 -- Use uppercase ID for dependency upperTid1 = T.toUpper tid1 dep = Dependency {depId = upperTid1, depType = Blocks} task2 <- createTask "Blocked" WorkTask Nothing Nothing P2 [dep] Nothing -- task1 is Open, so task2 should NOT be ready ready <- getReadyTasks (taskId task2 `notElem` map taskId ready) Test.@?= True updateTaskStatus tid1 Done [] -- task2 should now be ready because dependency check normalizes IDs ready2 <- getReadyTasks (taskId task2 `elem` map taskId ready2) Test.@?= True, Test.unit "can create task with lowercase ID" <| do -- This verifies that lowercase IDs are accepted and not rejected let lowerId = "t-lowercase" 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 cliTests :: Test.Tree cliTests = Test.group "CLI argument parsing" [ Test.unit "init command" <| do let result = Docopt.parseArgs help ["init"] case result of Left err -> Test.assertFailure <| "Failed to parse 'init': " <> show err Right args -> args `Cli.has` Cli.command "init" Test.@?= True, Test.unit "init with --quiet flag" <| do let result = Docopt.parseArgs help ["init", "--quiet"] case result of Left err -> Test.assertFailure <| "Failed to parse 'init --quiet': " <> show err Right args -> do args `Cli.has` Cli.command "init" Test.@?= True args `Cli.has` Cli.longOption "quiet" Test.@?= True, Test.unit "create with title" <| do let result = Docopt.parseArgs help ["create", "Test task"] case result of Left err -> Test.assertFailure <| "Failed to parse 'create': " <> show err Right args -> do args `Cli.has` Cli.command "create" Test.@?= True Cli.getArg args (Cli.argument "title") Test.@?= Just "Test task", Test.unit "create with --json flag" <| do let result = Docopt.parseArgs help ["create", "Test", "--json"] case result of Left err -> Test.assertFailure <| "Failed to parse 'create --json': " <> show err Right args -> do args `Cli.has` Cli.command "create" Test.@?= True args `Cli.has` Cli.longOption "json" Test.@?= True, Test.unit "create with --namespace flag" <| do let result = Docopt.parseArgs help ["create", "Test", "--namespace=Omni/Task"] case result of Left err -> Test.assertFailure <| "Failed to parse 'create --namespace': " <> show err Right args -> do args `Cli.has` Cli.command "create" Test.@?= True Cli.getArg args (Cli.longOption "namespace") Test.@?= Just "Omni/Task", Test.unit "create with --discovered-from flag" <| do let result = Docopt.parseArgs help ["create", "Test", "--discovered-from=t-abc123"] case result of Left err -> Test.assertFailure <| "Failed to parse 'create --discovered-from': " <> show err Right args -> do args `Cli.has` Cli.command "create" Test.@?= True Cli.getArg args (Cli.longOption "discovered-from") Test.@?= Just "t-abc123", Test.unit "create with --priority flag" <| do let result = Docopt.parseArgs help ["create", "Test", "--priority=1"] case result of Left err -> Test.assertFailure <| "Failed to parse 'create --priority': " <> show err 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 Left err -> Test.assertFailure <| "Failed to parse 'list': " <> show err Right args -> args `Cli.has` Cli.command "list" Test.@?= True, Test.unit "list with --json flag" <| do let result = Docopt.parseArgs help ["list", "--json"] case result of Left err -> Test.assertFailure <| "Failed to parse 'list --json': " <> show err Right args -> do args `Cli.has` Cli.command "list" Test.@?= True args `Cli.has` Cli.longOption "json" Test.@?= True, Test.unit "list with --status filter" <| do let result = Docopt.parseArgs help ["list", "--status=open"] case result of Left err -> Test.assertFailure <| "Failed to parse 'list --status': " <> show err 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 Left err -> Test.assertFailure <| "Failed to parse 'ready': " <> show err Right args -> args `Cli.has` Cli.command "ready" Test.@?= True, Test.unit "ready with --json flag" <| do let result = Docopt.parseArgs help ["ready", "--json"] case result of Left err -> Test.assertFailure <| "Failed to parse 'ready --json': " <> show err Right args -> do args `Cli.has` Cli.command "ready" Test.@?= True args `Cli.has` Cli.longOption "json" Test.@?= True, Test.unit "update command" <| do let result = Docopt.parseArgs help ["update", "t-abc123", "done"] case result of Left err -> Test.assertFailure <| "Failed to parse 'update': " <> 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 "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 Left err -> Test.assertFailure <| "Failed to parse 'update --json': " <> show err Right args -> do args `Cli.has` Cli.command "update" Test.@?= True args `Cli.has` Cli.longOption "json" Test.@?= True, Test.unit "deps command" <| do let result = Docopt.parseArgs help ["deps", "t-abc123"] case result of Left err -> Test.assertFailure <| "Failed to parse 'deps': " <> show err Right args -> do args `Cli.has` Cli.command "deps" Test.@?= True Cli.getArg args (Cli.argument "id") Test.@?= Just "t-abc123", Test.unit "tree command" <| do let result = Docopt.parseArgs help ["tree"] case result of Left err -> Test.assertFailure <| "Failed to parse 'tree': " <> show err Right args -> args `Cli.has` Cli.command "tree" Test.@?= True, Test.unit "tree with id" <| do let result = Docopt.parseArgs help ["tree", "t-abc123"] case result of Left err -> Test.assertFailure <| "Failed to parse 'tree <id>': " <> show err Right args -> do args `Cli.has` Cli.command "tree" Test.@?= True Cli.getArg args (Cli.argument "id") Test.@?= Just "t-abc123", Test.unit "export command" <| do let result = Docopt.parseArgs help ["export"] case result of Left err -> Test.assertFailure <| "Failed to parse 'export': " <> show err Right args -> args `Cli.has` Cli.command "export" Test.@?= True, Test.unit "import command" <| do let result = Docopt.parseArgs help ["import", "-i", "tasks.jsonl"] case result of Left err -> Test.assertFailure <| "Failed to parse 'import': " <> show err Right args -> do args `Cli.has` Cli.command "import" Test.@?= True -- Note: -i is a short option, not an argument Cli.getArg args (Cli.shortOption 'i') Test.@?= Just "tasks.jsonl", Test.unit "show command" <| do let result = Docopt.parseArgs help ["show", "t-abc123"] case result of Left err -> Test.assertFailure <| "Failed to parse 'show': " <> show err Right args -> do args `Cli.has` Cli.command "show" Test.@?= True Cli.getArg args (Cli.argument "id") Test.@?= Just "t-abc123", Test.unit "show with --json flag" <| do let result = Docopt.parseArgs help ["show", "t-abc123", "--json"] case result of Left err -> Test.assertFailure <| "Failed to parse 'show --json': " <> show err Right args -> do args `Cli.has` Cli.command "show" Test.@?= True args `Cli.has` Cli.longOption "json" Test.@?= True, Test.unit "stats command" <| do let result = Docopt.parseArgs help ["stats"] case result of Left err -> Test.assertFailure <| "Failed to parse 'stats': " <> show err Right args -> args `Cli.has` Cli.command "stats" Test.@?= True, Test.unit "stats with --json flag" <| do let result = Docopt.parseArgs help ["stats", "--json"] case result of Left err -> Test.assertFailure <| "Failed to parse 'stats --json': " <> show err Right args -> do args `Cli.has` Cli.command "stats" Test.@?= True args `Cli.has` Cli.longOption "json" Test.@?= True, Test.unit "stats with --epic flag" <| do let result = Docopt.parseArgs help ["stats", "--epic=t-abc123"] case result of Left err -> Test.assertFailure <| "Failed to parse 'stats --epic': " <> show err Right args -> do args `Cli.has` Cli.command "stats" Test.@?= True Cli.getArg args (Cli.longOption "epic") Test.@?= Just "t-abc123", Test.unit "create with flags in different order" <| do let result = Docopt.parseArgs help ["create", "Test", "--json", "--priority=1", "--namespace=Omni/Task"] case result of Left err -> Test.assertFailure <| "Failed to parse 'create' with reordered flags: " <> show err Right args -> do args `Cli.has` Cli.command "create" Test.@?= True args `Cli.has` Cli.longOption "json" Test.@?= True Cli.getArg args (Cli.longOption "priority") Test.@?= Just "1" Cli.getArg args (Cli.longOption "namespace") Test.@?= Just "Omni/Task" ]