Parent epic ID
--priority= Priority: 0-4 (0=critical, 4=backlog, default: 2)
--status= Filter by status: open, in-progress, review, approved, done
--epic= Filter stats by epic (recursive)
--deps= Comma-separated list of dependency IDs
--dep-type= Dependency type: blocks, discovered-from, parent-child, related
--discovered-from= Shortcut for --deps= --dep-type=discovered-from
--namespace= Optional namespace (e.g., Omni/Task, Biz/Cloud)
--description= Task description
--db= 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 Input file for import
-o Output file for export
Arguments:
Task title
Task ID
Task status (open, in-progress, review, approved, done)
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 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 "
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
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 "generateId produces sequential IDs" <| do
tid1 <- generateId
tid2 <- generateId
tid3 <- generateId
T.isPrefixOf "t-" tid1 Test.@?= True
T.isPrefixOf "t-" tid2 Test.@?= True
T.isPrefixOf "t-" tid3 Test.@?= True
let num1 = readMaybe (T.unpack (T.drop 2 tid1)) :: Maybe Int
num2 = readMaybe (T.unpack (T.drop 2 tid2)) :: Maybe Int
num3 = readMaybe (T.unpack (T.drop 2 tid3)) :: Maybe Int
case (num1, num2, num3) of
(Just n1, Just n2, Just n3) -> do
(n2 == n1 + 1) Test.@?= True
(n3 == n2 + 1) Test.@?= True
_ -> Test.assertFailure "IDs should be sequential integers",
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.unit "FromHttpApiData Priority: empty string returns Left" <| do
let result = parseQueryParam "" :: Either Text Priority
case result of
Left _ -> pure ()
Right _ -> Test.assertFailure "Empty string should return Left",
Test.unit "FromHttpApiData Priority: valid values parse correctly" <| do
(parseQueryParam "P0" :: Either Text Priority) Test.@?= Right P0
(parseQueryParam "P1" :: Either Text Priority) Test.@?= Right P1
(parseQueryParam "P2" :: Either Text Priority) Test.@?= Right P2
(parseQueryParam "P3" :: Either Text Priority) Test.@?= Right P3
(parseQueryParam "P4" :: Either Text Priority) Test.@?= Right P4,
Test.unit "FromHttpApiData Status: empty string returns Left" <| do
let result = parseQueryParam "" :: Either Text Status
case result of
Left _ -> pure ()
Right _ -> Test.assertFailure "Empty string should return Left",
Test.unit "FromHttpApiData Status: valid values parse correctly" <| do
(parseQueryParam "Open" :: Either Text Status) Test.@?= Right Open
(parseQueryParam "InProgress" :: Either Text Status) Test.@?= Right InProgress
(parseQueryParam "Done" :: Either Text Status) Test.@?= Right Done
]
-- | 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 ': " <> 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"
]