summaryrefslogtreecommitdiff
path: root/Omni/Task.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Task.hs')
-rw-r--r--Omni/Task.hs118
1 files changed, 78 insertions, 40 deletions
diff --git a/Omni/Task.hs b/Omni/Task.hs
index bf262ab..c6e68ac 100644
--- a/Omni/Task.hs
+++ b/Omni/Task.hs
@@ -83,6 +83,7 @@ Options:
--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)
+ --complexity=<c> Complexity: 1-5 for model selection (1=trivial, 5=expert)
--status=<status> Filter by status: draft, open, in-progress, review, approved, done
--epic=<id> Filter stats by epic (recursive)
--deps=<ids> Comma-separated list of dependency IDs
@@ -174,6 +175,13 @@ move' args
Just "4" -> pure P4
Just other -> panic <| "Invalid priority: " <> T.pack other <> ". Use: 0-4"
+ -- Parse complexity (1-5 scale)
+ complexity <- case Cli.getArg args (Cli.longOption "complexity") of
+ Nothing -> pure Nothing
+ Just c -> case readMaybe c of
+ Just n | n >= 1 && n <= 5 -> pure (Just n)
+ _ -> panic <| "Invalid complexity: " <> T.pack c <> ". Use: 1-5"
+
namespace <- case Cli.getArg args (Cli.longOption "namespace") of
Nothing -> pure Nothing
Just ns -> do
@@ -186,7 +194,7 @@ move' args
Nothing -> panic "--description is required for task create"
Just d -> pure (T.pack d)
- createdTask <- createTask title taskType parent namespace priority deps description
+ createdTask <- createTask title taskType parent namespace priority complexity deps description
if isJsonMode args
then outputJson createdTask
else putStrLn <| "Created task: " <> T.unpack (taskId createdTask)
@@ -209,6 +217,11 @@ move' args
Just "3" -> pure <| Just P3
Just "4" -> pure <| Just P4
Just other -> panic <| "Invalid priority: " <> T.pack other <> ". Use: 0-4"
+ maybeComplexity <- case Cli.getArg args (Cli.longOption "complexity") of
+ Nothing -> pure Nothing
+ Just c -> case readMaybe c of
+ Just n | n >= 1 && n <= 5 -> pure (Just (Just n))
+ _ -> panic <| "Invalid complexity: " <> T.pack c <> ". Use: 1-5"
maybeStatus <- case Cli.getArg args (Cli.longOption "status") of
Nothing -> pure Nothing
Just "draft" -> pure <| Just Draft
@@ -248,6 +261,7 @@ move' args
taskNamespace = case maybeNamespace of Nothing -> taskNamespace task; Just ns -> Just ns,
taskStatus = fromMaybe (taskStatus task) maybeStatus,
taskPriority = fromMaybe (taskPriority task) maybePriority,
+ taskComplexity = fromMaybe (taskComplexity task) maybeComplexity,
taskDescription = fromMaybe (taskDescription task) maybeDesc,
taskDependencies = fromMaybe (taskDependencies task) maybeDeps
}
@@ -449,60 +463,69 @@ unitTests =
initTaskDb
True Test.@?= True,
Test.unit "can create task" <| do
- task <- createTask "Test task" WorkTask Nothing Nothing P2 [] "Test description"
+ task <- createTask "Test task" WorkTask Nothing Nothing P2 Nothing [] "Test description"
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 [] "Human task description"
+ task <- createTask "Human Task" HumanTask Nothing Nothing P2 Nothing [] "Human task description"
taskType task Test.@?= HumanTask,
Test.unit "ready tasks exclude human tasks" <| do
- task <- createTask "Human Task" HumanTask Nothing Nothing P2 [] "Human task"
+ task <- createTask "Human Task" HumanTask Nothing Nothing P2 Nothing [] "Human task"
ready <- getReadyTasks
(taskId task `notElem` map taskId ready) Test.@?= True,
Test.unit "ready tasks exclude draft tasks" <| do
- task <- createTask "Draft Task" WorkTask Nothing Nothing P2 [] "Draft description"
+ task <- createTask "Draft Task" WorkTask Nothing Nothing P2 Nothing [] "Draft description"
updateTaskStatus (taskId task) Draft []
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 [] "My description"
+ task <- createTask "Test task" WorkTask Nothing Nothing P2 Nothing [] "My description"
taskDescription task Test.@?= "My description",
+ Test.unit "can create task with complexity" <| do
+ task <- createTask "Complex task" WorkTask Nothing Nothing P2 (Just 4) [] "High complexity task"
+ taskComplexity task Test.@?= Just 4,
+ Test.unit "complexity is persisted" <| do
+ task <- createTask "Persisted complexity" WorkTask Nothing Nothing P2 (Just 3) [] "Medium complexity"
+ tasks <- loadTasks
+ case findTask (taskId task) tasks of
+ Nothing -> Test.assertFailure "Could not reload task"
+ Just reloaded -> taskComplexity reloaded Test.@?= Just 3,
Test.unit "can list tasks" <| do
- _ <- createTask "Test task for list" WorkTask Nothing Nothing P2 [] "List test"
+ _ <- createTask "Test task for list" WorkTask Nothing Nothing P2 Nothing [] "List test"
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 [] "First description"
+ task1 <- createTask "First task" WorkTask Nothing Nothing P2 Nothing [] "First description"
let blockingDep = Dependency {depId = taskId task1, depType = Blocks}
- task2 <- createTask "Blocked task" WorkTask Nothing Nothing P2 [blockingDep] "Blocked description"
+ task2 <- createTask "Blocked task" WorkTask Nothing Nothing P2 Nothing [blockingDep] "Blocked description"
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 [] "Original"
+ task1 <- createTask "Original task" WorkTask Nothing Nothing P2 Nothing [] "Original"
let discDep = Dependency {depId = taskId task1, depType = DiscoveredFrom}
- task2 <- createTask "Discovered work" WorkTask Nothing Nothing P2 [discDep] "Discovered"
+ task2 <- createTask "Discovered work" WorkTask Nothing Nothing P2 Nothing [discDep] "Discovered"
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 [] "Task A description"
+ task1 <- createTask "Task A" WorkTask Nothing Nothing P2 Nothing [] "Task A description"
let relDep = Dependency {depId = taskId task1, depType = Related}
- task2 <- createTask "Task B" WorkTask Nothing Nothing P2 [relDep] "Task B description"
+ task2 <- createTask "Task B" WorkTask Nothing Nothing P2 Nothing [relDep] "Task B description"
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 [] "Epic description"
+ epic <- createTask "Epic task" Epic Nothing Nothing P2 Nothing [] "Epic description"
ready <- getReadyTasks
(taskId epic `notElem` map taskId ready) Test.@?= True,
Test.unit "ready tasks exclude tasks needing intervention (retry >= 3)" <| do
- task <- createTask "Failing task" WorkTask Nothing Nothing P2 [] "Failing description"
+ task <- createTask "Failing task" WorkTask Nothing Nothing P2 Nothing [] "Failing description"
ready1 <- getReadyTasks
(taskId task `elem` map taskId ready1) Test.@?= True
setRetryContext
@@ -517,26 +540,26 @@ unitTests =
ready2 <- getReadyTasks
(taskId task `notElem` map taskId ready2) Test.@?= True,
Test.unit "child task gets sequential ID" <| do
- parent <- createTask "Parent" Epic Nothing Nothing P2 [] "Parent epic"
- child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 [] "Child 1 description"
- child2 <- createTask "Child 2" WorkTask (Just (taskId parent)) Nothing P2 [] "Child 2 description"
+ parent <- createTask "Parent" Epic Nothing Nothing P2 Nothing [] "Parent epic"
+ child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 Nothing [] "Child 1 description"
+ child2 <- createTask "Child 2" WorkTask (Just (taskId parent)) Nothing P2 Nothing [] "Child 2 description"
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 [] "Grandparent epic"
- child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 [] "Parent epic"
- grandchild <- createTask "Grandchild" WorkTask (Just (taskId child)) Nothing P2 [] "Grandchild task"
+ parent <- createTask "Grandparent" Epic Nothing Nothing P2 Nothing [] "Grandparent epic"
+ child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 Nothing [] "Parent epic"
+ grandchild <- createTask "Grandchild" WorkTask (Just (taskId child)) Nothing P2 Nothing [] "Grandchild task"
taskId grandchild Test.@?= taskId parent <> ".1.1",
Test.unit "siblings of grandchild task get sequential ID" <| do
- parent <- createTask "Grandparent" Epic Nothing Nothing P2 [] "Grandparent"
- child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 [] "Parent"
- grandchild1 <- createTask "Grandchild 1" WorkTask (Just (taskId child)) Nothing P2 [] "Grandchild 1"
- grandchild2 <- createTask "Grandchild 2" WorkTask (Just (taskId child)) Nothing P2 [] "Grandchild 2"
+ parent <- createTask "Grandparent" Epic Nothing Nothing P2 Nothing [] "Grandparent"
+ child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 Nothing [] "Parent"
+ grandchild1 <- createTask "Grandchild 1" WorkTask (Just (taskId child)) Nothing P2 Nothing [] "Grandchild 1"
+ grandchild2 <- createTask "Grandchild 2" WorkTask (Just (taskId child)) Nothing P2 Nothing [] "Grandchild 2"
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 [] "Parent with gaps"
- child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 [] "Child 1"
+ parent <- createTask "Parent with gaps" Epic Nothing Nothing P2 Nothing [] "Parent with gaps"
+ child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 Nothing [] "Child 1"
-- Manually create a task with .3 suffix to simulate a gap (or deleted task)
let child3Id = taskId parent <> ".3"
child3 =
@@ -548,6 +571,7 @@ unitTests =
taskNamespace = Nothing,
taskStatus = Open,
taskPriority = P2,
+ taskComplexity = Nothing,
taskDependencies = [],
taskDescription = "Child 3",
taskComments = [],
@@ -557,10 +581,10 @@ unitTests =
saveTask child3
-- Create a new child, it should get .4, not .2
- child4 <- createTask "Child 4" WorkTask (Just (taskId parent)) Nothing P2 [] "Child 4"
+ child4 <- createTask "Child 4" WorkTask (Just (taskId parent)) Nothing P2 Nothing [] "Child 4"
taskId child4 Test.@?= taskId parent <> ".4",
Test.unit "can edit task" <| do
- task <- createTask "Original Title" WorkTask Nothing Nothing P2 [] "Original"
+ task <- createTask "Original Title" WorkTask Nothing Nothing P2 Nothing [] "Original"
let modifyFn t = t {taskTitle = "New Title", taskPriority = P0}
updated <- editTask (taskId task) modifyFn
taskTitle updated Test.@?= "New Title"
@@ -573,7 +597,7 @@ unitTests =
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 [] "Case sensitive description"
+ task <- createTask "Case sensitive" WorkTask Nothing Nothing P2 Nothing [] "Case sensitive description"
let tid = taskId task
upperTid = T.toUpper tid
tasks <- loadTasks
@@ -586,19 +610,19 @@ unitTests =
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 [] "Lowercase description"
+ task <- createTask "Lowercase check" WorkTask Nothing Nothing P2 Nothing [] "Lowercase description"
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 [] "Blocker description"
+ task1 <- createTask "Blocker" WorkTask Nothing Nothing P2 Nothing [] "Blocker description"
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] "Blocked description"
+ task2 <- createTask "Blocked" WorkTask Nothing Nothing P2 Nothing [dep] "Blocked description"
-- task1 is Open, so task2 should NOT be ready
ready <- getReadyTasks
@@ -612,7 +636,7 @@ unitTests =
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 [] "Lower description" [] (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
+ let task = Task lowerId "Lower" WorkTask Nothing Nothing Open P2 Nothing [] "Lower description" [] (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
@@ -620,7 +644,7 @@ unitTests =
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 [] "Auto description" [] (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
+ let task = Task tid "Auto" WorkTask Nothing Nothing Open P2 Nothing [] "Auto description" [] (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
@@ -644,7 +668,7 @@ unitTests =
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 [] "Upper description" [] (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
+ let task1 = Task upperId "Upper Task" WorkTask Nothing Nothing Open P2 Nothing [] "Upper description" [] (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)
@@ -655,7 +679,7 @@ unitTests =
-- treating them as the same is dangerous.
let lowerId = "t-upper"
- let task2 = Task lowerId "Lower Task" WorkTask Nothing Nothing Open P2 [] "Lower description" [] (read "2025-01-01 00:00:01 UTC") (read "2025-01-01 00:00:01 UTC")
+ let task2 = Task lowerId "Lower Task" WorkTask Nothing Nothing Open P2 Nothing [] "Lower description" [] (read "2025-01-01 00:00:01 UTC") (read "2025-01-01 00:00:01 UTC")
saveTask task2
tasks <- loadTasks
@@ -697,14 +721,14 @@ unitTests =
(parseQueryParam "InProgress" :: Either Text Status) Test.@?= Right InProgress
(parseQueryParam "Done" :: Either Text Status) Test.@?= Right Done,
Test.unit "can add comment to task" <| do
- task <- createTask "Task with comment" WorkTask Nothing Nothing P2 [] "Description"
+ task <- createTask "Task with comment" WorkTask Nothing Nothing P2 Nothing [] "Description"
updatedTask <- addComment (taskId task) "This is a test comment"
length (taskComments updatedTask) Test.@?= 1
case taskComments updatedTask of
(c : _) -> commentText c Test.@?= "This is a test comment"
[] -> Test.assertFailure "Expected at least one comment",
Test.unit "can add multiple comments to task" <| do
- task <- createTask "Task with comments" WorkTask Nothing Nothing P2 [] "Description"
+ task <- createTask "Task with comments" WorkTask Nothing Nothing P2 Nothing [] "Description"
_ <- addComment (taskId task) "First comment"
updatedTask <- addComment (taskId task) "Second comment"
length (taskComments updatedTask) Test.@?= 2
@@ -714,7 +738,7 @@ unitTests =
commentText c2 Test.@?= "Second comment"
_ -> Test.assertFailure "Expected at least two comments",
Test.unit "comments are persisted" <| do
- task <- createTask "Persistent comments" WorkTask Nothing Nothing P2 [] "Description"
+ task <- createTask "Persistent comments" WorkTask Nothing Nothing P2 Nothing [] "Description"
_ <- addComment (taskId task) "Persisted comment"
tasks <- loadTasks
case findTask (taskId task) tasks of
@@ -778,6 +802,20 @@ cliTests =
Right args -> do
args `Cli.has` Cli.command "create" Test.@?= True
Cli.getArg args (Cli.longOption "priority") Test.@?= Just "1",
+ Test.unit "create with --complexity flag" <| do
+ let result = Docopt.parseArgs help ["create", "Test", "--complexity=3"]
+ case result of
+ Left err -> Test.assertFailure <| "Failed to parse 'create --complexity': " <> show err
+ Right args -> do
+ args `Cli.has` Cli.command "create" Test.@?= True
+ Cli.getArg args (Cli.longOption "complexity") Test.@?= Just "3",
+ Test.unit "edit with --complexity flag" <| do
+ let result = Docopt.parseArgs help ["edit", "t-abc123", "--complexity=4"]
+ case result of
+ Left err -> Test.assertFailure <| "Failed to parse 'edit --complexity': " <> show err
+ Right args -> do
+ args `Cli.has` Cli.command "edit" Test.@?= True
+ Cli.getArg args (Cli.longOption "complexity") Test.@?= Just "4",
Test.unit "edit command" <| do
let result = Docopt.parseArgs help ["edit", "t-abc123"]
case result of
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 21:03:05 +0000