diff options
Diffstat (limited to 'Omni/Task.hs')
| -rw-r--r-- | Omni/Task.hs | 254 |
1 files changed, 226 insertions, 28 deletions
diff --git a/Omni/Task.hs b/Omni/Task.hs index ef912f9..e3f89dc 100644 --- a/Omni/Task.hs +++ b/Omni/Task.hs @@ -7,13 +7,17 @@ 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.Test as Test +import qualified System.Console.Docopt as Docopt import System.Directory (doesFileExist, removeFile) import System.Environment (setEnv) +import System.Process (callCommand) main :: IO () main = Cli.main plan @@ -33,15 +37,16 @@ help = task Usage: - task init - task create <title> [--type=<type>] [--parent=<id>] [--deps=<ids>] [--dep-type=<type>] [--discovered-from=<id>] [--namespace=<ns>] - task list [--type=<type>] [--parent=<id>] [--status=<status>] [--namespace=<ns>] - task ready - task update <id> <status> - task deps <id> - task tree [<id>] + task init [--quiet] + task create <title> [--type=<type>] [--parent=<id>] [--priority=<p>] [--deps=<ids>] [--dep-type=<type>] [--discovered-from=<id>] [--namespace=<ns>] [--json] + task list [--type=<type>] [--parent=<id>] [--status=<status>] [--namespace=<ns>] [--json] + task ready [--json] + task update <id> <status> [--json] + task deps <id> [--json] + task tree [<id>] [--json] task export [--flush] task import -i <file> + task sync task test task (-h | --help) @@ -55,18 +60,22 @@ Commands: tree Show task tree (epics with children, or all epics if no ID given) export Export and consolidate tasks to JSONL import Import tasks from JSONL file + sync Export and commit tasks to git (does NOT push) test Run tests Options: -h --help Show this help --type=<type> Task type: epic or task (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, done --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) --flush Force immediate export + --json Output in JSON format (for agent use) + --quiet Non-interactive mode (for agents) -i <file> Input file for import Arguments: @@ -76,9 +85,24 @@ Arguments: <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 - | args `Cli.has` Cli.command "init" = initTaskDb + | 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 @@ -109,6 +133,16 @@ move args 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 @@ -116,8 +150,10 @@ move args let validNs = Namespace.fromHaskellModule ns nsPath = T.pack <| Namespace.toPath validNs pure <| Just nsPath - createdTask <- createTask title taskType parent namespace deps - putStrLn <| "Created task: " <> T.unpack (taskId createdTask) + createdTask <- createTask title taskType parent namespace priority deps + if isJsonMode args + then outputJson createdTask + else putStrLn <| "Created task: " <> T.unpack (taskId createdTask) | args `Cli.has` Cli.command "list" = do maybeType <- case Cli.getArg args (Cli.longOption "type") of Nothing -> pure Nothing @@ -140,11 +176,16 @@ move args nsPath = T.pack <| Namespace.toPath validNs pure <| Just nsPath tasks <- listTasks maybeType maybeParent maybeStatus maybeNamespace - traverse_ printTask tasks + if isJsonMode args + then outputJson tasks + else traverse_ printTask tasks | args `Cli.has` Cli.command "ready" = do tasks <- getReadyTasks - putText "Ready tasks:" - traverse_ printTask tasks + if isJsonMode args + then outputJson tasks + else do + putText "Ready tasks:" + traverse_ printTask tasks | args `Cli.has` Cli.command "update" = do tid <- getArgText args "id" statusStr <- getArgText args "status" @@ -154,24 +195,43 @@ move args "done" -> Done _ -> panic "Invalid status. Use: open, in-progress, or done" updateTaskStatus tid newStatus - putStrLn <| "Updated task " <> T.unpack tid - -- Remind user to commit changes (pre-commit hook will auto-export) - putText "Note: Task changes will be committed automatically on your next git commit." + if isJsonMode args + then outputSuccess <| "Updated task " <> tid + else do + putStrLn <| "Updated task " <> T.unpack tid + putText "Note: Task changes will be committed automatically on your next git commit." | args `Cli.has` Cli.command "deps" = do tid <- getArgText args "id" - showDependencyTree tid + 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) - showTaskTree maybeId + if isJsonMode args + then do + tree <- getTaskTree maybeId + outputJson tree + else showTaskTree maybeId | args `Cli.has` Cli.command "export" = do exportTasks putText "Exported and consolidated tasks to .tasks/tasks.jsonl" | args `Cli.has` Cli.command "import" = do - file <- getArgText args "file" + -- 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 + | args `Cli.has` Cli.command "sync" = do + -- Export tasks and commit locally only + exportTasks + callCommand "git add .tasks/tasks.jsonl" + callCommand "git commit -m 'task: sync database' || true" + putText "Synced tasks: exported and committed to git (use 'git push' to share with remote)" | otherwise = putText (T.pack <| Cli.usage help) where getArgText :: Cli.Arguments -> String -> IO Text @@ -182,7 +242,7 @@ move args Just val -> pure (T.pack val) test :: Test.Tree -test = Test.group "Omni.Task" [unitTests] +test = Test.group "Omni.Task" [unitTests, cliTests] unitTests :: Test.Tree unitTests = @@ -199,36 +259,174 @@ unitTests = initTaskDb True Test.@?= True, Test.unit "can create task" <| do - task <- createTask "Test task" WorkTask Nothing Nothing [] + task <- createTask "Test task" WorkTask Nothing Nothing P2 [] 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 list tasks" <| do - _ <- createTask "Test task for list" WorkTask Nothing Nothing [] + _ <- createTask "Test task for list" WorkTask Nothing Nothing P2 [] 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 [] + task1 <- createTask "First task" WorkTask Nothing Nothing P2 [] let blockingDep = Dependency {depId = taskId task1, depType = Blocks} - task2 <- createTask "Blocked task" WorkTask Nothing Nothing [blockingDep] + task2 <- createTask "Blocked task" WorkTask Nothing Nothing P2 [blockingDep] 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 [] + task1 <- createTask "Original task" WorkTask Nothing Nothing P2 [] let discDep = Dependency {depId = taskId task1, depType = DiscoveredFrom} - task2 <- createTask "Discovered work" WorkTask Nothing Nothing [discDep] + task2 <- createTask "Discovered work" WorkTask Nothing Nothing P2 [discDep] 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 [] + task1 <- createTask "Task A" WorkTask Nothing Nothing P2 [] let relDep = Dependency {depId = taskId task1, depType = Related} - task2 <- createTask "Task B" WorkTask Nothing Nothing [relDep] + task2 <- createTask "Task B" WorkTask Nothing Nothing P2 [relDep] 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 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 "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 "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 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 "sync command" <| do + let result = Docopt.parseArgs help ["sync"] + case result of + Left err -> Test.assertFailure <| "Failed to parse 'sync': " <> show err + Right args -> args `Cli.has` Cli.command "sync" Test.@?= True + ] |