{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} -- : out task module Omni.Task where import Alpha 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 System.Directory (doesFileExist, removeFile) import System.Environment (setEnv) 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 task create [--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 export [--flush] task import -i <file> 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) update Update task status deps Show dependency tree 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 test Run tests Options: -h --help Show this help --type=<type> Task type: epic or task (default: task) --parent=<id> Parent epic ID --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 -i <file> Input file for import Arguments: <title> Task title <id> Task ID <status> Task status (open, in-progress, done) <file> JSONL file to import |] move :: Cli.Arguments -> IO () move args | args `Cli.has` Cli.command "init" = initTaskDb | 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 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 deps 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 "done" -> pure <| Just Done Just other -> panic <| "Invalid status: " <> T.pack other <> ". Use: open, in-progress, 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 traverse_ printTask tasks | args `Cli.has` Cli.command "ready" = do tasks <- getReadyTasks putText "Ready tasks:" traverse_ printTask tasks | 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 "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." | args `Cli.has` Cli.command "deps" = do tid <- getArgText args "id" 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 | 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" importTasks (T.unpack file) putText <| "Imported tasks from " <> file | 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] 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 [] taskTitle task Test.@?= "Test task" taskType task Test.@?= WorkTask taskStatus task Test.@?= Open null (taskDependencies task) Test.@?= True, Test.unit "can list tasks" <| do _ <- createTask "Test task for list" WorkTask Nothing 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 [] let blockingDep = Dependency {depId = taskId task1, depType = Blocks} task2 <- createTask "Blocked task" WorkTask Nothing Nothing [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 [] let discDep = Dependency {depId = taskId task1, depType = DiscoveredFrom} task2 <- createTask "Discovered work" WorkTask Nothing Nothing [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 [] let relDep = Dependency {depId = taskId task1, depType = Related} task2 <- createTask "Task B" WorkTask Nothing Nothing [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 ]