{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} -- : out task 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 plan :: Cli.Plan () plan = Cli.Plan { help = help, move = move, test = test, tidy = \_ -> pure () } help :: Cli.Docopt help = [Cli.docopt| task Usage: task init [--quiet] task create [options] task list [options] task ready [--json] task show <id> [--json] task update <id> <status> [--json] task deps <id> [--json] task tree [<id>] [--json] task stats [--json] task export [--flush] task import -i <file> task sync task test task (-h | --help) Commands: init Initialize task database create Create a new task or epic list List all tasks ready Show ready tasks (not blocked) show Show detailed task information update Update task status deps Show dependency tree tree Show task tree (epics with children, or all epics if no ID given) stats Show task statistics 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, review, 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: <title> Task title <id> Task ID <status> Task status (open, in-progress, review, done) <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" = 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 other -> panic <| "Invalid task type: " <> T.pack other <> ". Use: epic or task" 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 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 Just "epic" -> pure <| Just Epic Just "task" -> pure <| Just WorkTask 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 "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 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 filter (\t -> taskId t == tid) tasks of [] -> putText "Task not found" (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" 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 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" 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 "stats" = do if isJsonMode args then do stats <- getTaskStats outputJson stats else showTaskStats | args `Cli.has` Cli.command "export" = do exportTasks putText "Exported and consolidated tasks to .tasks/tasks.jsonl" | args `Cli.has` Cli.command "import" = do -- 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 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] unitTests :: Test.Tree unitTests = Test.group "Unit tests" [ Test.unit "setup test database" <| do -- Set up test mode for all tests setEnv "TASK_TEST_MODE" "1" -- Clean up test database before all tests let testFile = ".tasks/tasks-test.jsonl" 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 [] 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 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 P2 [] let blockingDep = Dependency {depId = taskId task1, depType = Blocks} 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 P2 [] let discDep = Dependency {depId = taskId task1, depType = DiscoveredFrom} 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 P2 [] let relDep = Dependency {depId = taskId task1, depType = Related} 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 "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 "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, 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 "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" ]