diff options
Diffstat (limited to 'Omni/Task.hs')
| -rw-r--r-- | Omni/Task.hs | 183 |
1 files changed, 138 insertions, 45 deletions
diff --git a/Omni/Task.hs b/Omni/Task.hs index 24e528b..e1457fb 100644 --- a/Omni/Task.hs +++ b/Omni/Task.hs @@ -13,11 +13,13 @@ 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 (doesFileExist, removeFile) import System.Environment (setEnv) import System.Process (callCommand) +import qualified Test.Tasty as Tasty main :: IO () main = Cli.main plan @@ -42,10 +44,11 @@ Usage: 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 stats [--json] + task progress <id> [--json] + task stats [--epic=<id>] [--json] task export [--flush] task import -i <file> task sync @@ -61,6 +64,7 @@ Commands: 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 and consolidate tasks to JSONL import Import tasks from JSONL file @@ -73,10 +77,12 @@ Options: --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 + --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) --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 --flush Force immediate export --json Output in JSON format (for agent use) --quiet Non-interactive mode (for agents) @@ -154,7 +160,12 @@ move args let validNs = Namespace.fromHaskellModule ns nsPath = T.pack <| Namespace.toPath validNs pure <| Just nsPath - createdTask <- createTask title taskType parent namespace priority deps + + 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) @@ -194,22 +205,39 @@ 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 "done" -> Done _ -> panic "Invalid status. Use: open, in-progress, review, or done" - updateTaskStatus tid newStatus + + updateTaskStatus tid newStatus deps if isJsonMode args then outputSuccess <| "Updated task " <> tid else do @@ -231,12 +259,22 @@ move args 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 + stats <- getTaskStats maybeEpic outputJson stats - else showTaskStats + else showTaskStats maybeEpic | args `Cli.has` Cli.command "export" = do exportTasks putText "Exported and consolidated tasks to .tasks/tasks.jsonl" @@ -263,7 +301,13 @@ move args Just val -> pure (T.pack val) test :: Test.Tree -test = Test.group "Omni.Task" [unitTests, cliTests] +test = + Test.group + "Omni.Task" + [ unitTests, + cliTests, + Tasty.after Tasty.AllSucceed "Unit tests" RaceTest.test + ] unitTests :: Test.Tree unitTests = @@ -280,79 +324,121 @@ unitTests = initTaskDb True Test.@?= True, Test.unit "can create task" <| do - task <- createTask "Test task" WorkTask Nothing Nothing P2 [] + 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 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 [] + _ <- 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 [] + 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] + 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 [] + 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] + 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 [] + 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] + 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 "child task gets sequential ID" <| do - parent <- createTask "Parent" Epic Nothing Nothing P2 [] - child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 [] - child2 <- createTask "Child 2" WorkTask (Just (taskId parent)) Nothing P2 [] + 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 [] - child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 [] - grandchild <- createTask "Grandchild" WorkTask (Just (taskId child)) Nothing P2 [] + 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 [] - child <- createTask "Parent" Epic (Just (taskId parent)) Nothing P2 [] - grandchild1 <- createTask "Grandchild 1" WorkTask (Just (taskId child)) Nothing P2 [] - grandchild2 <- createTask "Grandchild 2" WorkTask (Just (taskId child)) Nothing P2 [] + 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 [] - child1 <- createTask "Child 1" WorkTask (Just (taskId parent)) Nothing P2 [] + 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 - } + 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 [] - taskId child4 Test.@?= taskId parent <> ".4" + child4 <- createTask "Child 4" WorkTask (Just (taskId parent)) Nothing P2 [] Nothing + taskId child4 Test.@?= taskId parent <> ".4", + 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 CLI argument parsing to ensure docopt string matches actual usage @@ -516,6 +602,13 @@ cliTests = 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 |