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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
|
#!/usr/bin/env run.sh
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- : out jr
-- : dep sqlite-simple
-- : dep warp
-- : dep servant-server
-- : dep lucid
-- : dep servant-lucid
module Omni.Jr where
import Alpha
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Omni.Agent.Core as AgentCore
import qualified Omni.Agent.Worker as AgentWorker
import qualified Omni.Cli as Cli
import qualified Omni.Fact as Fact
import qualified Omni.Jr.Web as Web
import qualified Omni.Task as Task
import qualified Omni.Task.Core as TaskCore
import qualified Omni.Test as Test
import qualified System.Console.Docopt as Docopt
import qualified System.Directory as Directory
import System.Environment (withArgs)
import qualified System.Exit as Exit
import System.FilePath (takeFileName)
import qualified System.IO as IO
import qualified System.Process as Process
main :: IO ()
main = Cli.main plan
plan :: Cli.Plan ()
plan =
Cli.Plan
{ Cli.help = help,
Cli.move = move,
Cli.test = test,
Cli.tidy = \_ -> pure ()
}
help :: Cli.Docopt
help =
[Cli.docopt|
jr
Usage:
jr task [<args>...]
jr work [<task-id>]
jr web [--port=PORT]
jr review [<task-id>] [--auto]
jr loop [--delay=SECONDS]
jr facts list [--project=PROJECT] [--json]
jr facts show <fact-id> [--json]
jr facts add <project> <content> [--files=FILES] [--task=TASK] [--confidence=CONF] [--json]
jr facts delete <fact-id> [--json]
jr test
jr (-h | --help)
Commands:
task Manage tasks
work Start a worker agent on a task
web Start the web UI server
review Review a completed task (show diff, accept/reject)
loop Run autonomous work+review loop
facts Manage knowledge base facts
Options:
-h --help Show this help
--port=PORT Port for web server [default: 8080]
--auto Auto-review: accept if tests pass, reject if they fail
--delay=SECONDS Delay between loop iterations [default: 5]
--project=PROJECT Filter facts by project
--files=FILES Comma-separated list of related files
--task=TASK Source task ID
--confidence=CONF Confidence level 0.0-1.0 [default: 0.8]
--json Output in JSON format
|]
move :: Cli.Arguments -> IO ()
move args
| args `Cli.has` Cli.command "task" = do
let extraArgs = Cli.getAllArgs args (Cli.argument "args")
withArgs extraArgs Task.main
| args `Cli.has` Cli.command "web" = do
let port = case Cli.getArg args (Cli.longOption "port") of
Just p -> fromMaybe Web.defaultPort (readMaybe p)
Nothing -> Web.defaultPort
Web.run port
| args `Cli.has` Cli.command "work" = do
-- Always run in current directory
let path = "."
-- Infer name from current directory
absPath <- Directory.getCurrentDirectory
let name = Text.pack (takeFileName absPath)
let worker =
AgentCore.Worker
{ AgentCore.workerName = name,
AgentCore.workerPid = Nothing,
AgentCore.workerStatus = AgentCore.Idle,
AgentCore.workerPath = path,
AgentCore.workerQuiet = False -- Show ANSI status bar for manual work
}
let taskId = fmap Text.pack (Cli.getArg args (Cli.argument "task-id"))
AgentWorker.start worker taskId
| args `Cli.has` Cli.command "review" = do
let autoMode = args `Cli.has` Cli.longOption "auto"
case Cli.getArg args (Cli.argument "task-id") of
Just tidStr -> reviewTask (Text.pack tidStr) autoMode
Nothing -> do
-- Find tasks in Review status
tasks <- TaskCore.loadTasks
let reviewTasks = filter (\t -> TaskCore.taskStatus t == TaskCore.Review) tasks
case reviewTasks of
[] -> putText "No tasks in Review status."
(t : _) -> reviewTask (TaskCore.taskId t) autoMode
| args `Cli.has` Cli.command "loop" = do
let delay = case Cli.getArg args (Cli.longOption "delay") of
Just d -> fromMaybe 5 (readMaybe d)
Nothing -> 5
runLoop delay
| args `Cli.has` Cli.command "facts" = handleFacts args
| otherwise = putText (str <| Docopt.usage help)
-- | Run the autonomous loop: work -> review -> repeat
runLoop :: Int -> IO ()
runLoop delaySec = do
putText "[loop] Starting autonomous jr loop..."
putText ("[loop] Delay between iterations: " <> tshow delaySec <> "s")
go
where
go = do
-- First check for tasks to review (prioritize finishing work)
reviewResult <- reviewPending
if reviewResult
then do
-- Reviewed something, continue loop immediately
threadDelay (delaySec * 1000000)
go
else do
-- No reviews, check for ready work
readyTasks <- TaskCore.getReadyTasks
case readyTasks of
[] -> do
putText "[loop] No ready tasks, no pending reviews."
(task : _) -> do
putText ""
putText ("[loop] === Working on: " <> TaskCore.taskId task <> " ===")
-- Run worker (this blocks until the engine completes)
absPath <- Directory.getCurrentDirectory
let name = Text.pack (takeFileName absPath)
let worker =
AgentCore.Worker
{ AgentCore.workerName = name,
AgentCore.workerPid = Nothing,
AgentCore.workerStatus = AgentCore.Idle,
AgentCore.workerPath = ".",
AgentCore.workerQuiet = True -- No ANSI status bar in loop mode
}
putText "[loop] Starting worker..."
AgentWorker.start worker (Just (TaskCore.taskId task))
putText "[loop] Worker finished."
-- Delay and loop
putText ("[loop] Sleeping " <> tshow delaySec <> "s...")
threadDelay (delaySec * 1000000)
go
-- Returns True if a task was reviewed, False otherwise
reviewPending :: IO Bool
reviewPending = do
tasks <- TaskCore.loadTasks
let reviewTasks = filter (\t -> TaskCore.taskStatus t == TaskCore.Review) tasks
case reviewTasks of
[] -> pure False
(t : _) -> do
putText ""
putText ("[loop] === Reviewing: " <> TaskCore.taskId t <> " ===")
tryAutoReview (TaskCore.taskId t)
pure True
-- Auto-review that doesn't exit on missing commit
tryAutoReview :: Text -> IO ()
tryAutoReview tid = do
tasks <- TaskCore.loadTasks
case TaskCore.findTask tid tasks of
Nothing -> do
putText ("[review] Task " <> tid <> " not found.")
Just task -> do
let grepArg = "--grep=" <> Text.unpack tid
(code, shaOut, _) <-
Process.readProcessWithExitCode
"git"
["log", "--pretty=format:%H", "-n", "1", grepArg]
""
if code /= Exit.ExitSuccess || null shaOut
then do
putText "[review] No commit found for this task."
putText "[review] Resetting to Open for retry."
TaskCore.updateTaskStatus tid TaskCore.Open []
else do
let commitSha = case List.lines shaOut of
(x : _) -> x
[] -> ""
-- Check for merge conflicts
conflictResult <- checkMergeConflict commitSha
case conflictResult of
Just conflictFiles -> do
putText "[review] MERGE CONFLICT DETECTED"
traverse_ (\f -> putText (" - " <> f)) conflictFiles
handleConflict tid conflictFiles commitSha
Nothing -> do
autoReview tid task commitSha
-- | Handle merge conflict during review (Gerrit-style: provide rich context)
handleConflict :: Text -> [Text] -> String -> IO ()
handleConflict tid conflictFiles commitSha = do
maybeCtx <- TaskCore.getRetryContext tid
let attempt = maybe 1 (\c -> TaskCore.retryAttempt c + 1) maybeCtx
let conflictComment = buildConflictComment commitSha conflictFiles attempt
_ <- TaskCore.addComment tid conflictComment
if attempt > 3
then do
putText "[review] Task has failed 3 times. Needs human intervention."
TaskCore.updateTaskStatus tid TaskCore.Open []
else do
conflictDetails <- gatherConflictContext commitSha conflictFiles
maybeExistingCtx <- TaskCore.getRetryContext tid
let currentReason = "attempt " <> tshow attempt <> ":\n" <> conflictDetails
let accumulatedReason = case maybeExistingCtx of
Nothing -> currentReason
Just ctx -> TaskCore.retryReason ctx <> "\n\n" <> currentReason
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = conflictFiles,
TaskCore.retryAttempt = attempt,
TaskCore.retryReason = accumulatedReason,
TaskCore.retryNotes = maybeExistingCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
putText ("[review] Task " <> tid <> " returned to queue (attempt " <> tshow attempt <> "/3).")
-- | Build a review comment for merge conflicts
buildConflictComment :: String -> [Text] -> Int -> Text
buildConflictComment commitSha conflictFiles attempt =
Text.unlines
[ "## Auto-Review: Merge Conflict",
"",
"**Commit:** " <> Text.pack (take 8 commitSha),
"**Result:** ✗ MERGE CONFLICT",
"**Attempt:** " <> tshow attempt <> "/3",
"",
"### Conflicting Files",
Text.unlines (map ("- " <>) conflictFiles),
"Task returned to queue for conflict resolution."
]
-- | Gather Gerrit-style conflict context for the coder
gatherConflictContext :: String -> [Text] -> IO Text
gatherConflictContext commitSha conflictFiles = do
commitInfo <- getCommitInfo commitSha
currentHeadInfo <- getCurrentHeadInfo
fileDiffs <- traverse (getFileConflictInfo commitSha <. Text.unpack) conflictFiles
pure
<| Text.unlines
[ "MERGE CONFLICT - Your changes could not be cleanly applied",
"",
"== Your Commit ==",
commitInfo,
"",
"== Current HEAD ==",
currentHeadInfo,
"",
"== Conflicting Files ==",
Text.unlines fileDiffs,
"",
"== Resolution Instructions ==",
"1. The codebase has been updated since your work",
"2. Review the current state of conflicting files",
"3. Re-implement your changes on top of the current code",
"4. Ensure your changes still make sense given the updates"
]
-- | Get info about the commit that caused the conflict
getCommitInfo :: String -> IO Text
getCommitInfo sha = do
(_, out, _) <-
Process.readProcessWithExitCode
"git"
["log", "-1", "--format=%h %s%n%b", sha]
""
pure <| Text.pack out
-- | Get info about current HEAD
getCurrentHeadInfo :: IO Text
getCurrentHeadInfo = do
(_, out, _) <-
Process.readProcessWithExitCode
"git"
["log", "-1", "--format=%h %s (%cr)"]
""
pure <| Text.pack out
-- | Get file-level conflict context showing what changed in both branches
getFileConflictInfo :: String -> FilePath -> IO Text
getFileConflictInfo commitSha filePath = do
yourChanges <- getYourChangesToFile commitSha filePath
recentChanges <- getRecentChangesToFile filePath
pure
<| Text.unlines
[ "--- " <> Text.pack filePath <> " ---",
"",
"Your changes to this file:",
yourChanges,
"",
"Recent changes by others:",
recentChanges
]
-- | Get a summary of changes in a specific commit to a file
getYourChangesToFile :: String -> FilePath -> IO Text
getYourChangesToFile commitSha filePath = do
(code, out, _) <-
Process.readProcessWithExitCode
"git"
["show", "--stat", commitSha, "--", filePath]
""
case code of
Exit.ExitSuccess -> pure <| Text.pack (take 500 out)
Exit.ExitFailure _ -> pure "(unable to get diff)"
-- | Get recent changes to a file (last few commits)
getRecentChangesToFile :: FilePath -> IO Text
getRecentChangesToFile filePath = do
(code, out, _) <-
Process.readProcessWithExitCode
"git"
["log", "-3", "--oneline", "--", filePath]
""
case code of
Exit.ExitSuccess -> pure <| Text.pack out
Exit.ExitFailure _ -> pure "(unable to get history)"
-- | Interactive review command (jr review <task-id>)
reviewTask :: Text -> Bool -> IO ()
reviewTask tid autoMode = do
tasks <- TaskCore.loadTasks
case TaskCore.findTask tid tasks of
Nothing -> do
putText ("Task " <> tid <> " not found.")
Exit.exitFailure
Just task -> do
unless autoMode <| TaskCore.showTaskDetailed task
let grepArg = "--grep=" <> Text.unpack tid
(code, shaOut, _) <-
Process.readProcessWithExitCode
"git"
["log", "--pretty=format:%H", "-n", "1", grepArg]
""
when (code /= Exit.ExitSuccess || null shaOut) <| do
putText "\nNo commit found for this task."
putText "The worker may not have completed yet, or the commit message doesn't include the task ID."
Exit.exitFailure
let commitSha = case List.lines shaOut of
(x : _) -> x
[] -> ""
-- Check for merge conflicts before showing diff
conflictResult <- checkMergeConflict commitSha
case conflictResult of
Just conflictFiles -> do
putText "\n=== MERGE CONFLICT DETECTED ==="
traverse_ (\f -> putText (" - " <> f)) conflictFiles
handleConflict tid conflictFiles commitSha
Nothing -> do
if autoMode
then autoReview tid task commitSha
else interactiveReview tid task commitSha
-- | Auto-review: run tests on namespace, accept if pass, reject if fail
autoReview :: Text -> TaskCore.Task -> String -> IO ()
autoReview tid task commitSha = do
putText "[review] Running automated review..."
putText ("[review] Commit: " <> Text.pack (take 8 commitSha))
let namespace = fromMaybe "." (TaskCore.taskNamespace task)
let testTarget = Text.unpack namespace
putText ("[review] Testing: " <> Text.pack testTarget)
(testCode, testOut, testErr) <-
Process.readProcessWithExitCode
"bild"
["--test", testTarget]
""
case testCode of
Exit.ExitSuccess -> do
putText "[review] ✓ Tests passed."
let reviewComment = buildReviewComment commitSha testTarget True testOut testErr
_ <- TaskCore.addComment tid reviewComment
TaskCore.clearRetryContext tid
TaskCore.updateTaskStatus tid TaskCore.Done []
putText ("[review] Task " <> tid <> " -> Done")
checkEpicCompletion task
Exit.ExitFailure code -> do
putText ("[review] ✗ Tests failed (exit " <> tshow code <> ")")
let reason = "Test failure:\n" <> Text.pack testOut <> Text.pack testErr
maybeCtx <- TaskCore.getRetryContext tid
let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
let reviewComment = buildReviewComment commitSha testTarget False testOut testErr
_ <- TaskCore.addComment tid reviewComment
if attempt > 3
then do
putText "[review] Task has failed 3 times. Needs human intervention."
TaskCore.updateTaskStatus tid TaskCore.Open []
else do
let currentReason = "attempt " <> tshow attempt <> ": " <> reason
let accumulatedReason = case maybeCtx of
Nothing -> currentReason
Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
TaskCore.retryReason = accumulatedReason,
TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
putText ("[review] Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).")
-- | Build a review comment summarizing what was tested and the result
buildReviewComment :: String -> String -> Bool -> String -> String -> Text
buildReviewComment commitSha testTarget passed testOut testErr =
Text.unlines
[ "## Auto-Review",
"",
"**Commit:** " <> Text.pack (take 8 commitSha),
"**Test target:** " <> Text.pack testTarget,
"**Result:** " <> if passed then "✓ PASSED" else "✗ FAILED",
"",
if passed
then "All tests passed. Task accepted."
else
Text.unlines
[ "### Test Output",
"```",
Text.pack (truncateOutput 1000 (testOut ++ testErr)),
"```",
"",
"Task rejected and returned to queue for retry."
]
]
-- | Truncate output to a maximum number of characters
truncateOutput :: Int -> String -> String
truncateOutput maxLen s
| length s <= maxLen = s
| otherwise = take maxLen s ++ "\n... (truncated)"
-- | Interactive review with user prompts
interactiveReview :: Text -> TaskCore.Task -> String -> IO ()
interactiveReview tid task commitSha = do
putText "\n=== Diff for this task ===\n"
_ <- Process.rawSystem "git" ["show", commitSha]
putText "\n[a]ccept / [r]eject / [s]kip? "
IO.hFlush IO.stdout
choice <- getLine
case Text.toLower choice of
c
| "a" `Text.isPrefixOf` c -> do
let acceptComment = buildHumanReviewComment commitSha True Nothing
_ <- TaskCore.addComment tid acceptComment
TaskCore.clearRetryContext tid
TaskCore.updateTaskStatus tid TaskCore.Done []
putText ("Task " <> tid <> " marked as Done.")
checkEpicCompletion task
| "r" `Text.isPrefixOf` c -> do
putText "Enter rejection reason: "
IO.hFlush IO.stdout
reason <- getLine
let rejectComment = buildHumanReviewComment commitSha False (Just reason)
_ <- TaskCore.addComment tid rejectComment
maybeCtx <- TaskCore.getRetryContext tid
let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> reason
let accumulatedReason = case maybeCtx of
Nothing -> currentReason
Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
TaskCore.retryReason = accumulatedReason,
TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
putText ("Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).")
| otherwise -> putText "Skipped; no status change."
-- | Build a human review comment
buildHumanReviewComment :: String -> Bool -> Maybe Text -> Text
buildHumanReviewComment commitSha accepted maybeReason =
Text.unlines
[ "## Human Review",
"",
"**Commit:** " <> Text.pack (take 8 commitSha),
"**Result:** " <> if accepted then "✓ ACCEPTED" else "✗ REJECTED",
case maybeReason of
Just reason -> "**Reason:** " <> reason
Nothing -> ""
]
-- | Check if a commit can be cleanly cherry-picked onto live
-- Returns Nothing if clean, Just [conflicting files] if conflict
checkMergeConflict :: String -> IO (Maybe [Text])
checkMergeConflict commitSha = do
-- Save current state
(_, _, _) <- Process.readProcessWithExitCode "git" ["branch", "--show-current"] ""
(_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] ""
-- Try cherry-pick
(cpCode, _, cpErr) <-
Process.readProcessWithExitCode
"git"
["cherry-pick", "--no-commit", commitSha]
""
-- Always abort/reset regardless of result
_ <- Process.readProcessWithExitCode "git" ["cherry-pick", "--abort"] ""
_ <- Process.readProcessWithExitCode "git" ["reset", "--hard", List.head (List.lines origHead)] ""
case cpCode of
Exit.ExitSuccess -> pure Nothing
Exit.ExitFailure _ -> do
-- Parse conflict files from error message
let errLines = Text.lines (Text.pack cpErr)
conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
-- Extract file names (rough parsing)
files = mapMaybe extractConflictFile conflictLines
pure (Just (if null files then ["(unknown files)"] else files))
extractConflictFile :: Text -> Maybe Text
extractConflictFile line =
-- CONFLICT (content): Merge conflict in path/to/file.hs
case Text.breakOn "Merge conflict in " line of
(_, rest)
| not (Text.null rest) -> Just (Text.strip (Text.drop 18 rest))
_ -> case Text.breakOn "in " line of
(_, rest)
| not (Text.null rest) -> Just (Text.strip (Text.drop 3 rest))
_ -> Nothing
-- | Check if all children of an epic are Done, and if so, transition epic to Review
checkEpicCompletion :: TaskCore.Task -> IO ()
checkEpicCompletion task =
case TaskCore.taskParent task of
Nothing -> pure ()
Just parentId -> do
tasks <- TaskCore.loadTasks
case TaskCore.findTask parentId tasks of
Nothing -> pure ()
Just parentTask ->
when (TaskCore.taskType parentTask == TaskCore.Epic) <| do
let children = filter (hasParent parentId) tasks
allDone = all (\t -> TaskCore.taskStatus t == TaskCore.Done) children
when (allDone && not (null children)) <| do
putText ("[review] All children of epic " <> parentId <> " are Done.")
TaskCore.updateTaskStatus parentId TaskCore.Review []
putText ("[review] Epic " <> parentId <> " -> Review")
where
hasParent pid t = maybe False (TaskCore.matchesId pid) (TaskCore.taskParent t)
-- | Handle facts subcommands
handleFacts :: Cli.Arguments -> IO ()
handleFacts args
| args `Cli.has` Cli.command "list" = do
let maybeProject = Text.pack </ Cli.getArg args (Cli.longOption "project")
jsonMode = args `Cli.has` Cli.longOption "json"
facts <- maybe Fact.getAllFacts Fact.getFactsByProject maybeProject
if jsonMode
then BLC.putStrLn (Aeson.encode facts)
else traverse_ printFact facts
| args `Cli.has` Cli.command "show" = do
let jsonMode = args `Cli.has` Cli.longOption "json"
case Cli.getArg args (Cli.argument "fact-id") of
Nothing -> putText "fact-id required"
Just fidStr -> case readMaybe fidStr of
Nothing -> putText "Invalid fact ID (must be integer)"
Just fid -> do
maybeFact <- Fact.getFact fid
case maybeFact of
Nothing -> putText "Fact not found"
Just fact ->
if jsonMode
then BLC.putStrLn (Aeson.encode fact)
else printFactDetailed fact
| args `Cli.has` Cli.command "add" = do
let jsonMode = args `Cli.has` Cli.longOption "json"
case (Cli.getArg args (Cli.argument "project"), Cli.getArg args (Cli.argument "content")) of
(Just proj, Just content) -> do
let files = case Cli.getArg args (Cli.longOption "files") of
Just f -> Text.splitOn "," (Text.pack f)
Nothing -> []
sourceTask = Text.pack </ Cli.getArg args (Cli.longOption "task")
confidence = case Cli.getArg args (Cli.longOption "confidence") of
Just c -> fromMaybe 0.8 (readMaybe c)
Nothing -> 0.8
factId <- Fact.createFact (Text.pack proj) (Text.pack content) files sourceTask confidence
if jsonMode
then BLC.putStrLn (Aeson.encode (Aeson.object ["id" Aeson..= factId, "success" Aeson..= True]))
else putText ("Created fact: " <> tshow factId)
_ -> putText "project and content required"
| args `Cli.has` Cli.command "delete" = do
let jsonMode = args `Cli.has` Cli.longOption "json"
case Cli.getArg args (Cli.argument "fact-id") of
Nothing -> putText "fact-id required"
Just fidStr -> case readMaybe fidStr of
Nothing -> putText "Invalid fact ID (must be integer)"
Just fid -> do
Fact.deleteFact fid
if jsonMode
then BLC.putStrLn (Aeson.encode (Aeson.object ["success" Aeson..= True, "message" Aeson..= ("Deleted fact " <> tshow fid)]))
else putText ("Deleted fact: " <> tshow fid)
| otherwise = putText "Unknown facts subcommand. Use: list, show, add, or delete"
-- | Print a fact in a compact format
printFact :: TaskCore.Fact -> IO ()
printFact fact = do
let fid = maybe "?" tshow (TaskCore.factId fact)
proj = TaskCore.factProject fact
content = Text.take 60 (TaskCore.factContent fact)
suffix = if Text.length (TaskCore.factContent fact) > 60 then "..." else ""
putText (fid <> "\t" <> proj <> "\t" <> content <> suffix)
-- | Print a fact in detailed format
printFactDetailed :: TaskCore.Fact -> IO ()
printFactDetailed fact = do
putText ("ID: " <> maybe "?" tshow (TaskCore.factId fact))
putText ("Project: " <> TaskCore.factProject fact)
putText ("Content: " <> TaskCore.factContent fact)
putText ("Files: " <> Text.intercalate ", " (TaskCore.factRelatedFiles fact))
putText ("Source: " <> fromMaybe "-" (TaskCore.factSourceTask fact))
putText ("Confidence: " <> tshow (TaskCore.factConfidence fact))
putText ("Created: " <> tshow (TaskCore.factCreatedAt fact))
test :: Test.Tree
test =
Test.group
"Omni.Jr"
[ Test.unit "can run tests" <| True Test.@?= True,
Test.unit "can parse task command" <| do
let result = Docopt.parseArgs help ["task"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'task': " <> show err
Right args -> args `Cli.has` Cli.command "task" Test.@?= True,
Test.unit "can parse task command with args" <| do
let result = Docopt.parseArgs help ["task", "list", "--json"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'task list --json': " <> show err
Right args -> do
args `Cli.has` Cli.command "task" Test.@?= True
Cli.getAllArgs args (Cli.argument "args") Test.@?= ["list", "--json"],
Test.unit "can parse work command" <| do
let result = Docopt.parseArgs help ["work"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'work': " <> show err
Right args -> args `Cli.has` Cli.command "work" Test.@?= True,
Test.unit "can parse work command with task id" <| do
let result = Docopt.parseArgs help ["work", "t-123"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'work t-123': " <> show err
Right args -> do
args `Cli.has` Cli.command "work" Test.@?= True
Cli.getArg args (Cli.argument "task-id") Test.@?= Just "t-123",
Test.unit "can parse facts list command" <| do
let result = Docopt.parseArgs help ["facts", "list"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'facts list': " <> show err
Right args -> do
args `Cli.has` Cli.command "facts" Test.@?= True
args `Cli.has` Cli.command "list" Test.@?= True,
Test.unit "can parse facts list with --project" <| do
let result = Docopt.parseArgs help ["facts", "list", "--project=myproj"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'facts list --project': " <> show err
Right args -> do
args `Cli.has` Cli.command "facts" Test.@?= True
args `Cli.has` Cli.command "list" Test.@?= True
Cli.getArg args (Cli.longOption "project") Test.@?= Just "myproj",
Test.unit "can parse facts list with --json" <| do
let result = Docopt.parseArgs help ["facts", "list", "--json"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'facts list --json': " <> show err
Right args -> do
args `Cli.has` Cli.command "facts" Test.@?= True
args `Cli.has` Cli.command "list" Test.@?= True
args `Cli.has` Cli.longOption "json" Test.@?= True,
Test.unit "can parse facts show command" <| do
let result = Docopt.parseArgs help ["facts", "show", "42"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'facts show 42': " <> show err
Right args -> do
args `Cli.has` Cli.command "facts" Test.@?= True
args `Cli.has` Cli.command "show" Test.@?= True
Cli.getArg args (Cli.argument "fact-id") Test.@?= Just "42",
Test.unit "can parse facts add command" <| do
let result = Docopt.parseArgs help ["facts", "add", "myproj", "This is a fact"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'facts add': " <> show err
Right args -> do
args `Cli.has` Cli.command "facts" Test.@?= True
args `Cli.has` Cli.command "add" Test.@?= True
Cli.getArg args (Cli.argument "project") Test.@?= Just "myproj"
Cli.getArg args (Cli.argument "content") Test.@?= Just "This is a fact",
Test.unit "can parse facts add with options" <| do
let result = Docopt.parseArgs help ["facts", "add", "myproj", "fact", "--files=a.hs,b.hs", "--task=t-123", "--confidence=0.9"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'facts add' with options: " <> show err
Right args -> do
args `Cli.has` Cli.command "facts" Test.@?= True
args `Cli.has` Cli.command "add" Test.@?= True
Cli.getArg args (Cli.longOption "files") Test.@?= Just "a.hs,b.hs"
Cli.getArg args (Cli.longOption "task") Test.@?= Just "t-123"
Cli.getArg args (Cli.longOption "confidence") Test.@?= Just "0.9",
Test.unit "can parse facts delete command" <| do
let result = Docopt.parseArgs help ["facts", "delete", "42"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'facts delete 42': " <> show err
Right args -> do
args `Cli.has` Cli.command "facts" Test.@?= True
args `Cli.has` Cli.command "delete" Test.@?= True
Cli.getArg args (Cli.argument "fact-id") Test.@?= Just "42"
]
|