diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Task.hs | 254 | ||||
| -rw-r--r-- | Omni/Task/Core.hs | 53 |
2 files changed, 276 insertions, 31 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 + ] diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index 0351cf4..6c472c5 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -25,6 +25,7 @@ data Task = Task taskParent :: Maybe Text, -- Parent epic ID taskNamespace :: Maybe Text, -- Optional namespace (e.g., "Omni/Task", "Biz/Cloud") taskStatus :: Status, + taskPriority :: Priority, -- Priority level (0-4) taskDependencies :: [Dependency], -- List of dependencies with types taskCreatedAt :: UTCTime, taskUpdatedAt :: UTCTime @@ -37,6 +38,10 @@ data TaskType = Epic | WorkTask data Status = Open | InProgress | Done deriving (Show, Eq, Generic) +-- Priority levels (matching beads convention) +data Priority = P0 | P1 | P2 | P3 | P4 + deriving (Show, Eq, Ord, Generic) + data Dependency = Dependency { depId :: Text, -- ID of the task this depends on depType :: DependencyType -- Type of dependency relationship @@ -58,6 +63,10 @@ instance ToJSON Status instance FromJSON Status +instance ToJSON Priority + +instance FromJSON Priority + instance ToJSON DependencyType instance FromJSON DependencyType @@ -134,7 +143,7 @@ loadTasks = do Just task -> Just task Nothing -> migrateOldTask line - -- Migrate old task format (with taskProject field) to new format + -- Migrate old task format (with taskProject field or missing priority) to new format migrateOldTask :: Text -> Maybe Task migrateOldTask line = case Aeson.decode (BLC.pack <| T.unpack line) :: Maybe Aeson.Object of Nothing -> Nothing @@ -151,6 +160,8 @@ loadTasks = do taskType' = WorkTask -- Old tasks become WorkTask by default taskParent' = Nothing taskNamespace' = KM.lookup "taskNamespace" obj +> parseMaybe Aeson.parseJSON + -- Default priority to P2 (medium) for old tasks + taskPriority' = fromMaybe P2 (KM.lookup "taskPriority" obj +> parseMaybe Aeson.parseJSON) in case (taskId', taskTitle', taskStatus', taskCreatedAt', taskUpdatedAt') of (Just tid, Just title, Just status, Just created, Just updated) -> Just @@ -161,6 +172,7 @@ loadTasks = do taskParent = taskParent', taskNamespace = taskNamespace', taskStatus = status, + taskPriority = taskPriority', taskDependencies = newDeps, taskCreatedAt = created, taskUpdatedAt = updated @@ -175,8 +187,8 @@ saveTask task = do BLC.appendFile tasksFile (json <> "\n") -- Create a new task -createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> [Dependency] -> IO Task -createTask title taskType parent namespace deps = do +createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> IO Task +createTask title taskType parent namespace priority deps = do tid <- generateId now <- getCurrentTime let task = @@ -187,6 +199,7 @@ createTask title taskType parent namespace deps = do taskParent = parent, taskNamespace = namespace, taskStatus = Open, + taskPriority = priority, taskDependencies = deps, taskCreatedAt = now, taskUpdatedAt = now @@ -241,6 +254,20 @@ getReadyTasks = do isReady task = all (`elem` doneIds) (blockingDepIds task) pure <| filter isReady openTasks +-- Get dependency tree for a task (returns tasks) +getDependencyTree :: Text -> IO [Task] +getDependencyTree tid = do + tasks <- loadTasks + case filter (\t -> taskId t == tid) tasks of + [] -> pure [] + (task : _) -> pure <| collectDeps tasks task + where + collectDeps :: [Task] -> Task -> [Task] + collectDeps allTasks task = + let depIds = map depId (taskDependencies task) + deps = filter (\t -> taskId t `elem` depIds) allTasks + in task : concatMap (collectDeps allTasks) deps + -- Show dependency tree for a task showDependencyTree :: Text -> IO () showDependencyTree tid = do @@ -256,6 +283,26 @@ showDependencyTree tid = do deps = filter (\t -> taskId t `elem` depIds) allTasks traverse_ (\dep -> printTree allTasks dep (indent + 1)) deps +-- Get task tree (returns tasks hierarchically) +getTaskTree :: Maybe Text -> IO [Task] +getTaskTree maybeId = do + tasks <- loadTasks + case maybeId of + Nothing -> do + -- Return all epics with their children + let epics = filter (\t -> taskType t == Epic) tasks + in pure <| concatMap (collectChildren tasks) epics + Just tid -> do + -- Return specific task/epic with its children + case filter (\t -> taskId t == tid) tasks of + [] -> pure [] + (task : _) -> pure <| collectChildren tasks task + where + collectChildren :: [Task] -> Task -> [Task] + collectChildren allTasks task = + let children = filter (\t -> taskParent t == Just (taskId task)) allTasks + in task : concatMap (collectChildren allTasks) children + -- Show task tree (epic with children, or all epics if no ID given) showTaskTree :: Maybe Text -> IO () showTaskTree maybeId = do |