1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
{-# 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)
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 <title> [--type=<type>] [--parent=<id>] [--deps=<ids>] [--dep-type=<type>] [--discovered-from=<id>] [--namespace=<ns>]
task list [--type=<type>] [--parent=<id>]
task ready
task update <id> <status>
task deps <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
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
--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)
tasks <- listTasks maybeType maybeParent
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
| args `Cli.has` Cli.command "deps" = do
tid <- getArgText args "id"
showDependencyTree tid
| 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 "can create task" <| do
-- Clean up before test
exists <- doesFileExist ".tasks/tasks.jsonl"
when exists <| removeFile ".tasks/tasks.jsonl"
initTaskDb
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
tasks <- listTasks 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
]
|
