commit 1343c0708ff50da6a547bec289d0d8997a0ea17a
Author: Ben Sima <ben@bensima.com>
Date: Thu Jan 1 00:46:29 2026
Deprecate and remove Omni/Jr.hs (t-310)
Remove legacy jr CLI and supporting modules:
- Omni/Jr.hs - main CLI module
- Omni/Jr/Web* - web UI components
- Omni/Agent/Worker.hs - only used by Jr
- Omni/Agent/Status.hs - only used by Worker
- Omni/Agent/Core.hs - only re-exported by Agent.hs
Update documentation:
- AGENTS.md: replace Jr.hs examples with Task.hs
- PLAN.md: update command references
- Task/README.md: update database path
The modern agent interface is via Telegram bot (Ava).
Task management is via the 'task' command.
Task-Id: t-310
diff --git a/AGENTS.md b/AGENTS.md
index d5134c12..d4b5cf74 100644
--- a/AGENTS.md
+++ b/AGENTS.md
@@ -52,7 +52,7 @@ task create "Command X fails when Y" --discovered-from=<current-task-id> --json
**Build:**
```bash
-bild Omni/Jr.hs # Build a Haskell namespace
+bild Omni/Task.hs # Build a Haskell namespace
bild Biz/Cloud/Api.py # Build a Python namespace
```
@@ -69,12 +69,12 @@ typecheck.sh Omni/Bild/Example.py # Run mypy on Python files
**Test:**
```bash
-bild --test Omni/Jr.hs # Build and run tests for a namespace
+bild --test Omni/Task.hs # Build and run tests for a namespace
```
**Run:**
```bash
-Omni/Ide/run.sh Omni/Jr.hs # Build (if needed) and run
+Omni/Ide/run.sh Omni/Task.hs # Build (if needed) and run
```
**Deploy Services:**
diff --git a/Omni/Agent.hs b/Omni/Agent.hs
index 0bae0b56..98fc7667 100644
--- a/Omni/Agent.hs
+++ b/Omni/Agent.hs
@@ -15,9 +15,6 @@ module Omni.Agent
-- * Tools
module Omni.Agent.Tools,
- -- * Core
- module Omni.Agent.Core,
-
-- * Test
main,
test,
@@ -25,7 +22,6 @@ module Omni.Agent
where
import Alpha
-import Omni.Agent.Core
import Omni.Agent.Engine hiding (main, test)
import qualified Omni.Agent.Engine as Engine
import Omni.Agent.Tools hiding (ToolResult, main, test)
@@ -41,9 +37,6 @@ test =
"Omni.Agent"
[ Engine.test,
Tools.test,
- Test.unit "Core types are re-exported" <| do
- let status = Idle :: WorkerStatus
- status Test.@=? status,
Test.unit "Engine and Tools integrate correctly" <| do
let tools = Tools.allTools
length tools Test.@=? 5
diff --git a/Omni/Agent/Core.hs b/Omni/Agent/Core.hs
deleted file mode 100644
index fb4a4b34..00000000
--- a/Omni/Agent/Core.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Omni.Agent.Core where
-
-import Alpha
-import Data.Aeson (FromJSON, ToJSON)
-
--- | Engine/provider selection for agent
-data EngineType
- = EngineOpenRouter
- | EngineOllama
- | EngineAmp
- deriving (Show, Eq, Generic)
-
-instance ToJSON EngineType
-
-instance FromJSON EngineType
-
--- | Status of a worker agent
-data WorkerStatus
- = Idle
- | Syncing
- | -- | Task ID
- Working Text
- | -- | Task ID
- Submitting Text
- | -- | Error message
- Error Text
- deriving (Show, Eq, Generic)
-
-instance ToJSON WorkerStatus
-
-instance FromJSON WorkerStatus
-
--- | Representation of a worker agent
-data Worker = Worker
- { workerName :: Text,
- workerPid :: Maybe Int,
- workerStatus :: WorkerStatus,
- workerPath :: FilePath,
- workerQuiet :: Bool, -- Disable ANSI status bar (for loop mode)
- workerEngine :: EngineType -- Which LLM backend to use
- }
- deriving (Show, Eq, Generic)
-
-instance ToJSON Worker
-
-instance FromJSON Worker
diff --git a/Omni/Agent/PLAN.md b/Omni/Agent/PLAN.md
index e51d09ba..3f4adf0b 100644
--- a/Omni/Agent/PLAN.md
+++ b/Omni/Agent/PLAN.md
@@ -30,7 +30,7 @@ A unified agent infrastructure supporting multiple specialized agents (coder, re
| t-250 | Evals Framework | Open (blocked by t-247) | - |
| t-251 | Telegram Bot Agent | Open (blocked by t-248, t-249) | - |
-Run `jr task show <id>` for full implementation details on each task.
+Run `task show <id>` for full implementation details on each task.
---
@@ -76,12 +76,12 @@ Run `jr task show <id>` for full implementation details on each task.
**Problem**: Custom engine works but Amp is better for complex coding tasks.
-**Solution**: Add `--engine` flag to `jr work`:
+**Solution**: Add `--engine` flag to `ava work`:
```bash
-jr work <task-id> # Uses native Engine (default)
-jr work <task-id> --engine=amp # Uses Amp via subprocess
-jr work <task-id> --engine=ollama # Uses local Ollama
+ava work <task-id> # Uses native Engine (default)
+ava work <task-id> --engine=amp # Uses Amp via subprocess
+ava work <task-id> --engine=ollama # Uses local Ollama
```
**Implementation**:
@@ -402,7 +402,7 @@ Focus: Library primitives first, agents later.
- [ ] Create `Omni.Agent.Provider` module with unified interface
- [ ] Extract OpenRouter logic from `Engine.hs`
- [ ] Add Ollama provider implementation
-- [ ] Add `--engine` flag to `jr work`
+- [ ] Add `--engine` flag to `ava work`
- [ ] Test with local Llama model
### Phase 2: Amp Re-integration (1 day)
@@ -442,7 +442,7 @@ Focus: Library primitives first, agents later.
- [ ] Wire up memory system (recall on message, store learnings)
- [ ] Basic conversation loop with LLM
- [ ] Deploy as background service
-- [ ] Add `jr telegram` command for manual start
+- [ ] Add `ava` command for manual start
**Tools for Telegram agent:**
- `remember` - store facts about user
@@ -452,7 +452,7 @@ Focus: Library primitives first, agents later.
### Phase 7: Training Data Collection (1-2 days)
- [ ] Add session export to training format
- [ ] Store successful completions in `_/training/`
-- [ ] Create `jr train export` command
+- [ ] Create `ava train export` command
### (Future) Additional Agents
- Researcher agent
@@ -586,4 +586,4 @@ Execute tasks in order:
4. **t-250** Evals Framework (after t-247)
5. **t-251** Telegram Bot Agent (after t-248 + t-249)
-Run `jr task ready` to see what's available to work on.
+Run `task ready` to see what's available to work on.
diff --git a/Omni/Agent/Status.hs b/Omni/Agent/Status.hs
deleted file mode 100644
index ab533c4e..00000000
--- a/Omni/Agent/Status.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- | Status bar UI for the jr worker.
--- This is NOT a logging module - use Omni.Log for logging.
-module Omni.Agent.Status where
-
-import Alpha
-import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)
-import qualified Data.Text as Text
-import qualified Data.Text.IO as TIO
-import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
-import Data.Time.Format (defaultTimeLocale, parseTimeOrError)
-import qualified Omni.Log as Log
-import qualified System.Console.ANSI as ANSI
-import qualified System.IO as IO
-import System.IO.Unsafe (unsafePerformIO)
-import Text.Printf (printf)
-
--- | Status of the agent for the UI
-data Status = Status
- { statusWorker :: Text,
- statusTask :: Maybe Text,
- statusThread :: Maybe Text,
- statusFiles :: Int,
- statusCredits :: Double,
- statusStartTime :: UTCTime,
- statusActivity :: Text
- }
- deriving (Show, Eq)
-
-emptyStatus :: Text -> UTCTime -> Status
-emptyStatus workerName startTime =
- Status
- { statusWorker = workerName,
- statusTask = Nothing,
- statusThread = Nothing,
- statusFiles = 0,
- statusCredits = 0.0,
- statusStartTime = startTime,
- statusActivity = "Idle"
- }
-
--- | Global state for the status bar
-{-# NOINLINE currentStatus #-}
-currentStatus :: IORef Status
-currentStatus = unsafePerformIO (newIORef (emptyStatus "Unknown" defaultStartTime))
-
-defaultStartTime :: UTCTime
-defaultStartTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z" "2000-01-01 00:00:00 UTC"
-
--- | Initialize the status bar system
-init :: Text -> IO ()
-init workerName = do
- IO.hSetBuffering IO.stderr IO.LineBuffering
- startTime <- getCurrentTime
- writeIORef currentStatus (emptyStatus workerName startTime)
- -- Reserve 5 lines at bottom
- IO.hPutStrLn IO.stderr ""
- IO.hPutStrLn IO.stderr ""
- IO.hPutStrLn IO.stderr ""
- IO.hPutStrLn IO.stderr ""
- IO.hPutStrLn IO.stderr ""
- ANSI.hCursorUp IO.stderr 5
-
--- | Update the status
-update :: (Status -> Status) -> IO ()
-update f = do
- modifyIORef' currentStatus f
- render
-
--- | Get the current status
-getStatus :: IO Status
-getStatus = readIORef currentStatus
-
--- | Set the activity message
-updateActivity :: Text -> IO ()
-updateActivity msg = update (\s -> s {statusActivity = msg})
-
--- | Log a scrolling message (appears above status bars)
--- Uses Omni.Log for the actual logging, then re-renders status bar
-log :: Text -> IO ()
-log msg = do
- -- Clear status bars temporarily
- ANSI.hClearLine IO.stderr
- ANSI.hCursorDown IO.stderr 1
- ANSI.hClearLine IO.stderr
- ANSI.hCursorDown IO.stderr 1
- ANSI.hClearLine IO.stderr
- ANSI.hCursorDown IO.stderr 1
- ANSI.hClearLine IO.stderr
- ANSI.hCursorDown IO.stderr 1
- ANSI.hClearLine IO.stderr
- ANSI.hCursorUp IO.stderr 4
-
- -- Use Omni.Log for the actual log message
- Log.info [msg]
- Log.br
-
- -- Re-render status bars at bottom
- render
-
--- | Render the five status lines
-render :: IO ()
-render = do
- Status {..} <- readIORef currentStatus
- now <- getCurrentTime
- let taskStr = maybe "None" identity statusTask
- threadStr = maybe "None" identity statusThread
- elapsed = diffUTCTime now statusStartTime
- elapsedStr = formatElapsed elapsed
-
- -- Line 1: Worker | Thread
- ANSI.hSetCursorColumn IO.stderr 0
- ANSI.hClearLine IO.stderr
- TIO.hPutStr IO.stderr ("[Worker: " <> statusWorker <> "] Thread: " <> threadStr)
-
- -- Line 2: Task
- ANSI.hCursorDown IO.stderr 1
- ANSI.hSetCursorColumn IO.stderr 0
- ANSI.hClearLine IO.stderr
- TIO.hPutStr IO.stderr ("Task: " <> taskStr)
-
- -- Line 3: Files | Credits
- ANSI.hCursorDown IO.stderr 1
- ANSI.hSetCursorColumn IO.stderr 0
- ANSI.hClearLine IO.stderr
- let creditsStr = Text.pack (printf "%.2f" statusCredits)
- TIO.hPutStr IO.stderr ("Files: " <> tshow statusFiles <> " | Credits: $" <> creditsStr)
-
- -- Line 4: Time (elapsed duration)
- ANSI.hCursorDown IO.stderr 1
- ANSI.hSetCursorColumn IO.stderr 0
- ANSI.hClearLine IO.stderr
- TIO.hPutStr IO.stderr ("Time: " <> elapsedStr)
-
- -- Line 5: Activity
- ANSI.hCursorDown IO.stderr 1
- ANSI.hSetCursorColumn IO.stderr 0
- ANSI.hClearLine IO.stderr
- TIO.hPutStr IO.stderr ("> " <> statusActivity)
-
- -- Return cursor to line 1
- ANSI.hCursorUp IO.stderr 4
- IO.hFlush IO.stderr
-
--- | Format elapsed time as MM:SS or HH:MM:SS
-formatElapsed :: NominalDiffTime -> Text
-formatElapsed elapsed =
- let totalSecs = floor elapsed :: Int
- hours = totalSecs `div` 3600
- mins = (totalSecs `mod` 3600) `div` 60
- secs = totalSecs `mod` 60
- in if hours > 0
- then Text.pack (printf "%02d:%02d:%02d" hours mins secs)
- else Text.pack (printf "%02d:%02d" mins secs)
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs
deleted file mode 100644
index d6afb735..00000000
--- a/Omni/Agent/Worker.hs
+++ /dev/null
@@ -1,665 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Omni.Agent.Worker
- ( start,
- buildFullPrompt,
- selectModel,
- selectCostByComplexity,
- )
-where
-
-import Alpha
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Key as AesonKey
-import qualified Data.ByteString.Lazy as BSL
-import Data.IORef (modifyIORef', newIORef, readIORef)
-import qualified Data.List as List
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as TE
-import qualified Data.Time
-import qualified Omni.Agent.Core as Core
-import qualified Omni.Agent.Engine as Engine
-import qualified Omni.Agent.Provider as Provider
-import qualified Omni.Agent.Status as AgentStatus
-import qualified Omni.Agent.Tools as Tools
-import qualified Omni.Fact as Fact
-import qualified Omni.Task.Core as TaskCore
-import qualified System.Directory as Directory
-import qualified System.Environment as Env
-import qualified System.Exit as Exit
-import System.FilePath ((</>))
-import qualified System.Process as Process
-
-start :: Core.Worker -> Maybe Text -> IO ()
-start worker maybeTaskId = do
- if Core.workerQuiet worker
- then putText ("[worker] Starting for " <> Core.workerName worker)
- else do
- AgentStatus.init (Core.workerName worker)
- AgentStatus.log ("[worker] Starting for " <> Core.workerName worker)
- case maybeTaskId of
- Just tid -> logMsg worker ("[worker] Target task: " <> tid)
- Nothing -> logMsg worker "[worker] No specific task, will pick from ready queue"
- runOnce worker maybeTaskId
-
--- | Log message respecting quiet mode
-logMsg :: Core.Worker -> Text -> IO ()
-logMsg worker msg =
- if Core.workerQuiet worker
- then putText msg
- else AgentStatus.log msg
-
--- | Convert key-value pairs to JSON metadata string
-toMetadata :: [(Text, Text)] -> Text
-toMetadata pairs =
- let obj = Aeson.object [(AesonKey.fromText k, Aeson.String v) | (k, v) <- pairs]
- in TE.decodeUtf8 (BSL.toStrict (Aeson.encode obj))
-
--- | Format guardrail result for logging
-formatGuardrailResult :: Engine.GuardrailResult -> Text
-formatGuardrailResult Engine.GuardrailOk = "OK"
-formatGuardrailResult (Engine.GuardrailCostExceeded actual limit) =
- "Cost exceeded: " <> tshow actual <> " cents (limit: " <> tshow limit <> ")"
-formatGuardrailResult (Engine.GuardrailTokensExceeded actual limit) =
- "Tokens exceeded: " <> tshow actual <> " (limit: " <> tshow limit <> ")"
-formatGuardrailResult (Engine.GuardrailDuplicateToolCalls tool count) =
- "Duplicate tool calls: " <> tool <> " called " <> tshow count <> " times"
-formatGuardrailResult (Engine.GuardrailTestFailures count) =
- "Test failures: " <> tshow count <> " failures"
-formatGuardrailResult (Engine.GuardrailEditFailures count) =
- "Edit failures: " <> tshow count <> " 'old_str not found' errors"
-
-runOnce :: Core.Worker -> Maybe Text -> IO ()
-runOnce worker maybeTaskId = do
- -- Find work
- targetTask <- case maybeTaskId of
- Just tid -> do
- TaskCore.findTask tid </ TaskCore.loadTasks
- Nothing -> do
- readyTasks <- TaskCore.getReadyTasks
- case readyTasks of
- [] -> pure Nothing
- (task : _) -> pure (Just task)
-
- case targetTask of
- Nothing -> do
- case maybeTaskId of
- Just tid -> do
- unless (Core.workerQuiet worker) <| AgentStatus.updateActivity ("Task " <> tid <> " not found.")
- logMsg worker ("[worker] Task " <> tid <> " not found.")
- Nothing -> do
- unless (Core.workerQuiet worker) <| AgentStatus.updateActivity "No work found."
- logMsg worker "[worker] No ready tasks found."
- Just task -> do
- processTask worker task
-
-processTask :: Core.Worker -> TaskCore.Task -> IO ()
-processTask worker task = do
- let repo = Core.workerPath worker
- let tid = TaskCore.taskId task
- let quiet = Core.workerQuiet worker
- let say = logMsg worker
-
- unless quiet <| AgentStatus.update (\s -> s {AgentStatus.statusTask = Just tid})
- say ("[worker] Claiming task " <> tid)
-
- -- Claim task
- TaskCore.logActivity tid TaskCore.Claiming Nothing
- TaskCore.updateTaskStatusWithActor tid TaskCore.InProgress [] TaskCore.Junior
- say "[worker] Status -> InProgress"
-
- -- Run agent with timing
- startTime <- Data.Time.getCurrentTime
- activityId <- TaskCore.logActivityWithMetrics tid TaskCore.Running Nothing Nothing (Just startTime) Nothing Nothing Nothing
-
- say "[worker] Starting engine..."
- engineResult <- runWithEngine worker repo task
-
- endTime <- Data.Time.getCurrentTime
-
- -- Update the activity record with metrics (convert Double to Int by rounding)
- let costCents = case engineResult of
- EngineSuccess _ c -> c
- EngineGuardrailViolation _ c -> c
- EngineError _ c -> c
- TaskCore.updateActivityMetrics activityId Nothing (Just endTime) (Just (round costCents)) Nothing
-
- case engineResult of
- EngineSuccess output _ -> do
- say "[worker] Agent completed successfully"
- TaskCore.logActivity tid TaskCore.Reviewing Nothing
- say "[worker] Running formatters..."
- _ <- runFormatters repo
-
- -- Try to commit (this runs git hooks which may fail)
- let commitMsg = formatCommitMessage task output
- say "[worker] Attempting commit..."
- commitResult <- tryCommit repo commitMsg
-
- case commitResult of
- CommitFailed commitErr -> do
- say ("[worker] Commit failed: " <> commitErr)
-
- -- Save failure context and reopen task for retry
- maybeCtx <- TaskCore.getRetryContext tid
- let attempt = maybe 1 (\c -> TaskCore.retryAttempt c + 1) maybeCtx
-
- if attempt > 3
- then do
- say "[worker] Task failed 3 times, needs human intervention"
- TaskCore.logActivity tid TaskCore.Failed (Just (toMetadata [("reason", "max_retries_exceeded")]))
- TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Junior
- else do
- let currentReason = "attempt " <> tshow attempt <> ": commit_failed: " <> commitErr
- let accumulatedReason = case maybeCtx of
- Nothing -> currentReason
- Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
- TaskCore.setRetryContext
- TaskCore.RetryContext
- { TaskCore.retryTaskId = tid,
- TaskCore.retryOriginalCommit = "",
- TaskCore.retryConflictFiles = [],
- TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = accumulatedReason,
- TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
- }
- TaskCore.logActivity tid TaskCore.Retrying (Just (toMetadata [("attempt", tshow attempt)]))
- TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Junior
- say ("[worker] Task reopened (attempt " <> tshow attempt <> "/3)")
- NoChanges -> do
- -- No changes = task already implemented, mark as Done
- say "[worker] No changes to commit - task already done"
- TaskCore.clearRetryContext tid
- TaskCore.logActivity tid TaskCore.Completed (Just (toMetadata [("result", "no_changes")]))
- TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.Junior
- say ("[worker] ✓ Task " <> tid <> " -> Done (no changes)")
- unless quiet <| AgentStatus.update (\s -> s {AgentStatus.statusTask = Nothing})
- CommitSuccess -> do
- -- Commit succeeded, set to Review
- TaskCore.logActivity tid TaskCore.Completed (Just (toMetadata [("result", "committed")]))
- TaskCore.updateTaskStatusWithActor tid TaskCore.Review [] TaskCore.Junior
- say ("[worker] ✓ Task " <> tid <> " -> Review")
- unless quiet <| AgentStatus.update (\s -> s {AgentStatus.statusTask = Nothing})
- EngineGuardrailViolation errMsg _ -> do
- say ("[worker] Guardrail violation: " <> errMsg)
- TaskCore.logActivity tid TaskCore.Failed (Just (toMetadata [("reason", "guardrail_violation")]))
- -- Add comment with guardrail details
- _ <- TaskCore.addComment tid errMsg TaskCore.Junior
- -- Set to NeedsHelp so human can review
- TaskCore.updateTaskStatusWithActor tid TaskCore.NeedsHelp [] TaskCore.Junior
- say ("[worker] Task " <> tid <> " -> NeedsHelp (guardrail violation)")
- unless quiet <| AgentStatus.update (\s -> s {AgentStatus.statusTask = Nothing})
- EngineError errMsg _ -> do
- say ("[worker] Engine error: " <> errMsg)
- TaskCore.logActivity tid TaskCore.Failed (Just (toMetadata [("reason", "engine_error")]))
- -- Don't set back to Open here - leave in InProgress for debugging
- say "[worker] Task left in InProgress (engine failure)"
-
--- | Run lint --fix to format and fix lint issues
-runFormatters :: FilePath -> IO (Either Text ())
-runFormatters repo = do
- let cmd = (Process.proc "lint" ["--fix"]) {Process.cwd = Just repo}
- (code, _, _) <- Process.readCreateProcessWithExitCode cmd ""
- case code of
- Exit.ExitSuccess -> pure (Right ())
- Exit.ExitFailure _ -> pure (Right ()) -- lint --fix may exit non-zero but still fix things
-
-data CommitResult = CommitSuccess | NoChanges | CommitFailed Text
- deriving (Show, Eq)
-
--- | Try to commit, returning result
-tryCommit :: FilePath -> Text -> IO CommitResult
-tryCommit repo msg = do
- -- Stage all changes
- let addCmd = (Process.proc "git" ["add", "."]) {Process.cwd = Just repo}
- (addCode, _, addErr) <- Process.readCreateProcessWithExitCode addCmd ""
- case addCode of
- Exit.ExitFailure _ -> pure <| CommitFailed (Text.pack addErr)
- Exit.ExitSuccess -> do
- -- Check for changes
- let checkCmd = (Process.proc "git" ["diff", "--cached", "--quiet"]) {Process.cwd = Just repo}
- (checkCode, _, _) <- Process.readCreateProcessWithExitCode checkCmd ""
- case checkCode of
- Exit.ExitSuccess -> pure NoChanges
- Exit.ExitFailure 1 -> do
- -- There are changes, commit them
- let commitCmd = (Process.proc "git" ["commit", "-m", Text.unpack msg]) {Process.cwd = Just repo}
- (commitCode, _, commitErr) <- Process.readCreateProcessWithExitCode commitCmd ""
- case commitCode of
- Exit.ExitSuccess -> pure CommitSuccess
- Exit.ExitFailure _ -> pure <| CommitFailed (Text.pack commitErr)
- Exit.ExitFailure c -> pure <| CommitFailed ("git diff failed with code " <> tshow c)
-
-data EngineResult
- = EngineSuccess Text Double -- output, cost
- | EngineGuardrailViolation Text Double -- error message, cost
- | EngineError Text Double -- error message, cost
-
--- | Run task using native Engine
--- Returns engine result with output/error and cost
-runWithEngine :: Core.Worker -> FilePath -> TaskCore.Task -> IO EngineResult
-runWithEngine worker repo task = do
- -- Read API key from environment
- maybeApiKey <- Env.lookupEnv "OPENROUTER_API_KEY"
- case maybeApiKey of
- Nothing -> pure (EngineError "OPENROUTER_API_KEY not set" 0)
- Just apiKey -> do
- -- Check for retry context
- maybeRetry <- TaskCore.getRetryContext (TaskCore.taskId task)
-
- -- Get progress from database (checkpoint events from previous sessions)
- progressContent <- TaskCore.getProgressSummary (TaskCore.taskId task)
-
- -- Build the full prompt
- let ns = fromMaybe "." (TaskCore.taskNamespace task)
- let basePrompt = buildBasePrompt ns repo
-
- -- Add progress context if present
- let progressPrompt = buildProgressPrompt progressContent
-
- -- Add retry context if present
- let retryPrompt = buildRetryPrompt maybeRetry
-
- let prompt = basePrompt <> progressPrompt <> retryPrompt
-
- -- Read AGENTS.md
- agentsMd <-
- fmap (fromMaybe "") <| do
- exists <- Directory.doesFileExist (repo </> "AGENTS.md")
- if exists
- then Just </ readFile (repo </> "AGENTS.md")
- else pure Nothing
-
- -- Get relevant facts from the knowledge base
- relevantFacts <- getRelevantFacts task
- let factsSection = formatFacts relevantFacts
-
- -- Build system prompt
- let systemPrompt =
- prompt
- <> "\n\nREPOSITORY GUIDELINES (AGENTS.md):\n"
- <> agentsMd
- <> factsSection
-
- -- Build user prompt from task comments
- let userPrompt = formatTask task
-
- -- Select model based on task complexity (simple heuristic)
- let model = selectModel task
-
- -- Generate session ID for event logging
- sessionId <- TaskCore.generateSessionId
- let tid = TaskCore.taskId task
-
- -- Helper to log events to DB
- -- For text content, store as-is; for structured data, JSON-encode
- let logJuniorEvent eventType content = TaskCore.insertAgentEvent tid sessionId eventType content TaskCore.Junior
- logJuniorJson eventType value = do
- let contentJson = TE.decodeUtf8 (BSL.toStrict (Aeson.encode value))
- TaskCore.insertAgentEvent tid sessionId eventType contentJson TaskCore.Junior
- logSystemEvent eventType content = TaskCore.insertAgentEvent tid sessionId eventType content TaskCore.System
-
- -- Build Engine config with callbacks
- totalCostRef <- newIORef (0 :: Double)
- let quiet = Core.workerQuiet worker
- sayLog msg = if quiet then putText msg else AgentStatus.log msg
- engineCfg =
- Engine.EngineConfig
- { Engine.engineLLM =
- Engine.defaultLLM
- { Engine.llmApiKey = Text.pack apiKey
- },
- Engine.engineOnCost = \tokens cost -> do
- modifyIORef' totalCostRef (+ cost)
- sayLog <| "Cost: " <> tshow cost <> " cents (" <> tshow tokens <> " tokens)"
- logJuniorJson "Cost" (Aeson.object [("tokens", Aeson.toJSON tokens), ("cents", Aeson.toJSON cost)]),
- Engine.engineOnActivity = \activity -> do
- sayLog <| "[engine] " <> activity,
- Engine.engineOnToolCall = \toolName args -> do
- sayLog <| "[tool] " <> toolName
- logJuniorEvent "ToolCall" (toolName <> ": " <> args),
- Engine.engineOnAssistant = \msg -> do
- sayLog <| "[assistant] " <> Text.take 200 msg
- logJuniorEvent "Assistant" msg,
- Engine.engineOnToolResult = \toolName success output -> do
- let statusStr = if success then "ok" else "failed"
- sayLog <| "[result] " <> toolName <> " (" <> statusStr <> "): " <> Text.take 100 output
- logJuniorEvent "ToolResult" output,
- Engine.engineOnComplete = do
- sayLog "[engine] Complete"
- logJuniorEvent "Complete" "",
- Engine.engineOnError = \err -> do
- sayLog <| "[error] " <> err
- logJuniorEvent "Error" err,
- Engine.engineOnGuardrail = \guardrailResult -> do
- let guardrailMsg = formatGuardrailResult guardrailResult
- contentJson = TE.decodeUtf8 (BSL.toStrict (Aeson.encode guardrailResult))
- sayLog <| "[guardrail] " <> guardrailMsg
- logSystemEvent "Guardrail" contentJson
- }
-
- -- Build Agent config with guardrails (scale cost by complexity)
- let baseCost = selectCostByComplexity (TaskCore.taskComplexity task)
- guardrails =
- Engine.Guardrails
- { Engine.guardrailMaxCostCents = baseCost,
- Engine.guardrailMaxTokens = 2000000,
- Engine.guardrailMaxDuplicateToolCalls = 30,
- Engine.guardrailMaxTestFailures = 3,
- Engine.guardrailMaxEditFailures = 5
- }
- agentCfg =
- Engine.AgentConfig
- { Engine.agentModel = model,
- Engine.agentTools = Tools.allTools,
- Engine.agentSystemPrompt = systemPrompt,
- Engine.agentMaxIterations = 100,
- Engine.agentGuardrails = guardrails
- }
-
- -- Run the agent with appropriate provider
- result <- case Core.workerEngine worker of
- Core.EngineOpenRouter -> Engine.runAgent engineCfg agentCfg userPrompt
- Core.EngineOllama -> do
- ollamaModel <- fromMaybe "llama3.1:8b" </ Env.lookupEnv "OLLAMA_MODEL"
- let provider = Provider.defaultOllama (Text.pack ollamaModel)
- Engine.runAgentWithProvider engineCfg provider agentCfg userPrompt
- Core.EngineAmp -> pure (Left "Amp engine not yet implemented")
- totalCost <- readIORef totalCostRef
-
- case result of
- Left err ->
- if "Guardrail: " `Text.isPrefixOf` err
- then pure (EngineGuardrailViolation err totalCost)
- else pure (EngineError ("Engine error: " <> err) totalCost)
- Right agentResult -> do
- let output = Engine.resultFinalMessage agentResult
- pure (EngineSuccess output totalCost)
-
--- | Build the base prompt for the agent
-buildBasePrompt :: Text -> FilePath -> Text
-buildBasePrompt ns repo =
- "You are `jr`, an autonomous Senior Software Engineer. You are rigorous, efficient, and safety-conscious.\n"
- <> "Your Goal: Complete the assigned task with **zero regressions**.\n\n"
- <> "# The Workflow\n"
- <> "Follow this 4-phase loop. Do not skip phases.\n\n"
- <> "## Phase 1: Exploration (MANDATORY)\n"
- <> "- NEVER edit immediately. Explore first.\n"
- <> "- Use search_and_read to find code relevant to the task.\n"
- <> "- Read the imports. Read the tests that cover this code.\n"
- <> "- Understand the *callers* of a function before you modify it.\n\n"
- <> "## Phase 2: Planning (for multi-file changes)\n"
- <> "- If the task involves more than 2 files, plan the order of operations.\n"
- <> "- Identify potential breaking changes (API shifts, import cycles).\n"
- <> "- For refactors: copy code first, verify it works, then delete the original.\n\n"
- <> "## Phase 3: Execution\n"
- <> "- Make atomic changes. One logical edit per edit_file call.\n"
- <> "- Use edit_file with sufficient context (5+ lines) to match uniquely.\n"
- <> "- Do NOT update task status or manage git - the worker handles that.\n\n"
- <> "## Phase 4: Verification\n"
- <> "- Run 'bild --test "
- <> ns
- <> "' after your changes.\n"
- <> "- 'bild --test' tests ALL dependencies transitively - run it ONCE, not per-file.\n"
- <> "- Use 'lint --fix' to handle formatting (not hlint directly).\n"
- <> "- If tests pass, STOP. Do not verify again, do not double-check.\n\n"
- <> "# Tool Usage\n\n"
- <> "Your tools: read_file, write_file, edit_file, run_bash, search_codebase, search_and_read.\n\n"
- <> "## Efficient Reading (CRITICAL FOR BUDGET)\n"
- <> "- Read files ONCE with large ranges (500+ lines), not many small 100-line chunks.\n"
- <> "- WRONG: 10 separate read_file calls with 100-line ranges on the same file.\n"
- <> "- RIGHT: 1-2 read_file calls with 500-1000 line ranges to cover the file.\n"
- <> "- When you know the target file, use read_file directly with a path argument.\n"
- <> "- WRONG: search_and_read across the whole repo when you know the file is Worker.py.\n"
- <> "- RIGHT: read_file on Worker.py, or search_codebase with path='Worker.py'.\n"
- <> "- search_and_read is for discovery when you DON'T know which file to look in.\n\n"
- <> "## Efficient Editing\n"
- <> "- Include enough context in old_str to match uniquely (usually 5+ lines).\n"
- <> "- If edit_file fails with 'old_str not found', you are hallucinating the content.\n"
- <> "- STOP. Call read_file on those exact lines to get fresh content. Then retry.\n"
- <> "- After 3 failed edits on the same file, reconsider your approach.\n\n"
- <> "## Cost Awareness\n"
- <> "- Each tool call costs tokens. Large file writes are expensive.\n"
- <> "- For refactors: plan all new files first, then write them in order.\n"
- <> "- Don't write a file, then immediately read it back - you just wrote it!\n"
- <> "- Monitor your progress: if you're on tool call 30+ and not close to done, simplify.\n\n"
- <> "# Debugging\n"
- <> "If 'bild' fails, do NOT guess the fix.\n"
- <> "1. Read the error output carefully.\n"
- <> "2. For type errors: read the definition of the types involved.\n"
- <> "3. For import cycles: create a Types or Common module to break the cycle.\n"
- <> "4. If tests fail 3 times on the same issue, STOP - the task will be marked for human review.\n\n"
- <> "# Examples\n\n"
- <> "## Example: Splitting a Module\n"
- <> "1. search_and_read to understand the file structure\n"
- <> "2. write_file NewModule.py (with extracted code + proper imports)\n"
- <> "3. edit_file Original.py (remove moved code, add 'from NewModule import ...')\n"
- <> "4. run_bash: bild --test <namespace>\n"
- <> "5. Tests pass -> STOP\n\n"
- <> "## Example: Fixing a Type Error\n"
- <> "1. read_file Main.hs (lines around the error)\n"
- <> "2. Identify: function expects Text but got String\n"
- <> "3. edit_file Main.hs (add import, apply T.pack)\n"
- <> "4. run_bash: bild --test <namespace>\n"
- <> "5. Tests pass -> STOP\n\n"
- <> "# Constraints\n"
- <> "- You are autonomous. There is NO human to ask for clarification.\n"
- <> "- Make reasonable decisions. If ambiguous, implement the straightforward interpretation.\n"
- <> "- Aim to complete the task in under 50 tool calls.\n"
- <> "- Guardrails will stop you if you exceed cost/token limits or make repeated mistakes.\n\n"
- <> "# Context\n"
- <> "- Working directory: "
- <> Text.pack repo
- <> "\n"
- <> "- Namespace: "
- <> ns
- <> "\n"
-
--- | Build progress context prompt
-buildProgressPrompt :: Maybe Text -> Text
-buildProgressPrompt Nothing = ""
-buildProgressPrompt (Just progress) =
- "\n\n## PROGRESS FROM PREVIOUS SESSIONS (from database)\n\n"
- <> "This task has been worked on before. Here are the checkpoint notes:\n\n"
- <> progress
- <> "\n\n"
- <> "IMPORTANT:\n"
- <> "- Review these checkpoints to understand what's already done\n"
- <> "- Do NOT repeat work that's already completed\n"
- <> "- If the task appears complete, verify tests pass and exit\n\n"
-
--- | Build retry context prompt
-buildRetryPrompt :: Maybe TaskCore.RetryContext -> Text
-buildRetryPrompt Nothing = ""
-buildRetryPrompt (Just ctx) =
- "\n\n## RETRY CONTEXT (IMPORTANT)\n\n"
- <> "This task was previously attempted but failed. Attempt: "
- <> tshow (TaskCore.retryAttempt ctx)
- <> "/3\n"
- <> "Reason: "
- <> TaskCore.retryReason ctx
- <> "\n\n"
- <> ( if null (TaskCore.retryConflictFiles ctx)
- then ""
- else
- "Conflicting files from previous attempt:\n"
- <> Text.unlines (map (" - " <>) (TaskCore.retryConflictFiles ctx))
- <> "\n"
- )
- <> "Original commit: "
- <> TaskCore.retryOriginalCommit ctx
- <> "\n\n"
- <> maybe "" (\notes -> "## HUMAN NOTES/GUIDANCE\n\n" <> notes <> "\n\n") (TaskCore.retryNotes ctx)
- <> "INSTRUCTIONS FOR RETRY:\n"
- <> "- The codebase has changed since your last attempt\n"
- <> "- Re-implement this task on top of the CURRENT codebase\n"
- <> "- If there were merge conflicts, the conflicting files may have been modified by others\n"
- <> "- Review the current state of those files before making changes\n"
-
--- | Select model based on task complexity (1-5 scale)
--- Uses OpenRouter model identifiers for Claude models
-selectModel :: TaskCore.Task -> Text
-selectModel task = selectModelByComplexity (TaskCore.taskComplexity task)
-
--- | Select model based on complexity level
-selectModelByComplexity :: Maybe Int -> Text
-selectModelByComplexity Nothing = "anthropic/claude-sonnet-4.5"
-selectModelByComplexity (Just 1) = "anthropic/claude-haiku-4.5"
-selectModelByComplexity (Just 2) = "anthropic/claude-haiku-4.5"
-selectModelByComplexity (Just 3) = "anthropic/claude-sonnet-4.5"
-selectModelByComplexity (Just 4) = "anthropic/claude-sonnet-4.5"
-selectModelByComplexity (Just 5) = "anthropic/claude-opus-4.5"
-selectModelByComplexity (Just _) = "anthropic/claude-sonnet-4.5"
-
--- | Select cost guardrail based on complexity level (in cents)
--- Lower complexity = lower budget, higher complexity = more room for iteration
-selectCostByComplexity :: Maybe Int -> Double
-selectCostByComplexity Nothing = 200.0
-selectCostByComplexity (Just 1) = 50.0
-selectCostByComplexity (Just 2) = 100.0
-selectCostByComplexity (Just 3) = 200.0
-selectCostByComplexity (Just 4) = 400.0
-selectCostByComplexity (Just 5) = 600.0
-selectCostByComplexity (Just _) = 200.0
-
-formatTask :: TaskCore.Task -> Text
-formatTask t =
- "Task: "
- <> TaskCore.taskId t
- <> "\n"
- <> "Title: "
- <> TaskCore.taskTitle t
- <> "\n"
- <> "Type: "
- <> Text.pack (show (TaskCore.taskType t))
- <> "\n"
- <> "Status: "
- <> Text.pack (show (TaskCore.taskStatus t))
- <> "\n"
- <> "Priority: "
- <> Text.pack (show (TaskCore.taskPriority t))
- <> "\n"
- <> maybe "" (\p -> "Parent: " <> p <> "\n") (TaskCore.taskParent t)
- <> maybe "" (\ns -> "Namespace: " <> ns <> "\n") (TaskCore.taskNamespace t)
- <> "Created: "
- <> Text.pack (show (TaskCore.taskCreatedAt t))
- <> "\n"
- <> "Updated: "
- <> Text.pack (show (TaskCore.taskUpdatedAt t))
- <> "\n"
- <> (if Text.null (TaskCore.taskDescription t) then "" else "Description:\n" <> TaskCore.taskDescription t <> "\n\n")
- <> formatDeps (TaskCore.taskDependencies t)
- <> formatComments (TaskCore.taskComments t)
- where
- formatDeps [] = ""
- formatDeps deps = "\nDependencies:\n" <> Text.unlines (map formatDep deps)
- formatDep dep = " - " <> TaskCore.depId dep <> " [" <> Text.pack (show (TaskCore.depType dep)) <> "]"
- formatComments [] = ""
- formatComments cs = "\nComments/Notes:\n" <> Text.unlines (map formatComment cs)
- formatComment c = " [" <> Text.pack (show (TaskCore.commentCreatedAt c)) <> "] " <> TaskCore.commentText c
-
-formatCommitMessage :: TaskCore.Task -> Text -> Text
-formatCommitMessage task agentOutput =
- let tid = TaskCore.taskId task
- subject = cleanSubject (TaskCore.taskTitle task)
- body = cleanBody agentOutput
- in if Text.null body
- then subject <> "\n\nTask-Id: " <> tid
- else subject <> "\n\n" <> body <> "\n\nTask-Id: " <> tid
- where
- cleanSubject s =
- let trailingPunct = ['.', ':', '!', '?', ',', ';', ' ', '-']
- stripped = Text.dropWhileEnd (`elem` trailingPunct) s
- truncated = Text.take 72 stripped
- noPunct = Text.dropWhileEnd (`elem` trailingPunct) truncated
- capitalized = case Text.uncons noPunct of
- Just (c, rest) -> Text.cons (toUpper c) rest
- Nothing -> noPunct
- in capitalized
-
- cleanBody :: Text -> Text
- cleanBody output =
- let stripped = Text.strip output
- in if Text.null stripped
- then ""
- else
- let lns = Text.lines stripped
- cleaned = [Text.take 72 ln | ln <- lns]
- in Text.intercalate "\n" cleaned
-
--- | Get facts relevant to a task based on namespace/project
-getRelevantFacts :: TaskCore.Task -> IO [TaskCore.Fact]
-getRelevantFacts task = do
- let namespace = fromMaybe "Omni" (TaskCore.taskNamespace task)
- projectFacts <- Fact.getFactsByProject namespace
- let sorted = List.sortBy (comparing (Down <. TaskCore.factConfidence)) projectFacts
- pure (take 10 sorted)
-
--- | Format facts for inclusion in the prompt
-formatFacts :: [TaskCore.Fact] -> Text
-formatFacts [] = ""
-formatFacts facts =
- Text.unlines
- [ "\n\nKNOWLEDGE BASE FACTS:",
- "(These are learned patterns/conventions from previous work)",
- ""
- ]
- <> Text.unlines (map formatFact facts)
-
--- | Format a single fact for the prompt
-formatFact :: TaskCore.Fact -> Text
-formatFact f =
- "- "
- <> TaskCore.factContent f
- <> ( if null (TaskCore.factRelatedFiles f)
- then ""
- else " [" <> Text.intercalate ", " (TaskCore.factRelatedFiles f) <> "]"
- )
-
--- | Build the full system prompt for a task without starting the agent.
--- This is useful for debugging/inspecting what the agent will be told.
-buildFullPrompt :: TaskCore.Task -> IO Text
-buildFullPrompt task = do
- repo <- Directory.getCurrentDirectory
- let ns = fromMaybe "." (TaskCore.taskNamespace task)
- let basePrompt = buildBasePrompt ns repo
-
- maybeRetry <- TaskCore.getRetryContext (TaskCore.taskId task)
- progressContent <- TaskCore.getProgressSummary (TaskCore.taskId task)
-
- let progressPrompt = buildProgressPrompt progressContent
- let retryPrompt = buildRetryPrompt maybeRetry
- let prompt = basePrompt <> progressPrompt <> retryPrompt
-
- agentsMd <-
- fmap (fromMaybe "") <| do
- exists <- Directory.doesFileExist (repo </> "AGENTS.md")
- if exists
- then Just </ readFile (repo </> "AGENTS.md")
- else pure Nothing
-
- relevantFacts <- getRelevantFacts task
- let factsSection = formatFacts relevantFacts
-
- let systemPrompt =
- prompt
- <> "\n\nREPOSITORY GUIDELINES (AGENTS.md):\n"
- <> agentsMd
- <> factsSection
-
- let model = selectModel task
- let costBudget = selectCostByComplexity (TaskCore.taskComplexity task)
-
- pure
- <| Text.unlines
- [ "=== AGENT CONFIGURATION ===",
- "Model: " <> model,
- "Cost budget: " <> tshow costBudget <> " cents",
- "",
- "=== SYSTEM PROMPT ===",
- systemPrompt,
- "",
- "=== USER PROMPT (task details) ===",
- formatTask task
- ]
diff --git a/Omni/Jr.hs b/Omni/Jr.hs
deleted file mode 100755
index 48dbf907..00000000
--- a/Omni/Jr.hs
+++ /dev/null
@@ -1,1046 +0,0 @@
-#!/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.Engine as Engine
-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.Environment as Env
-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>] [--engine=ENGINE]
- jr prompt <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
- prompt Show the system prompt that would be sent to the agent
- 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]
- --engine=ENGINE LLM engine: openrouter, ollama, amp [default: openrouter]
- --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 "prompt" = do
- case Cli.getArg args (Cli.argument "task-id") of
- Nothing -> do
- IO.hPutStrLn IO.stderr "Error: task-id is required"
- Exit.exitFailure
- Just tidStr -> do
- let tid = Text.pack tidStr
- tasks <- TaskCore.loadTasks
- case TaskCore.findTask tid tasks of
- Nothing -> do
- IO.hPutStrLn IO.stderr ("Error: task not found: " <> tidStr)
- Exit.exitFailure
- Just task -> do
- prompt <- AgentWorker.buildFullPrompt task
- putText prompt
- | 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)
-
- -- Parse engine flag
- let engineType = case Cli.getArg args (Cli.longOption "engine") of
- Just "ollama" -> AgentCore.EngineOllama
- Just "amp" -> AgentCore.EngineAmp
- _ -> AgentCore.EngineOpenRouter
-
- 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
- AgentCore.workerEngine = engineType
- }
-
- 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
- AgentCore.workerEngine = AgentCore.EngineOpenRouter -- Default for loop
- }
- 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.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
- 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 TaskCore.Junior
-
- if attempt > 3
- then do
- putText "[review] Task has failed 3 times. Needs human intervention."
- TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
- 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.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
- 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.Junior
- TaskCore.clearRetryContext tid
- TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.System
- putText ("[review] Task " <> tid <> " -> Done")
- addCompletionSummary tid commitSha
- extractFacts tid commitSha
- 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 TaskCore.Junior
-
- if attempt > 3
- then do
- putText "[review] Task has failed 3 times. Needs human intervention."
- TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
- 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.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.System
- 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.Human
- TaskCore.clearRetryContext tid
- TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.Human
- putText ("Task " <> tid <> " marked as Done.")
- addCompletionSummary tid commitSha
- extractFacts tid commitSha
- 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 TaskCore.Human
- 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.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
- 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
-
--- | Generate and add a completion summary comment for a task
-addCompletionSummary :: Text -> String -> IO ()
-addCompletionSummary tid commitSha = do
- -- Get the diff and commit message for this commit
- (diffCode, diffOut, _) <- Process.readProcessWithExitCode "git" ["show", "--stat", commitSha] ""
- (msgCode, msgOut, _) <- Process.readProcessWithExitCode "git" ["log", "-1", "--format=%B", commitSha] ""
-
- when (diffCode == Exit.ExitSuccess && msgCode == Exit.ExitSuccess) <| do
- -- Get list of modified files
- (filesCode, filesOut, _) <- Process.readProcessWithExitCode "git" ["diff-tree", "--no-commit-id", "--name-only", "-r", commitSha] ""
-
- let files = if filesCode == Exit.ExitSuccess then List.lines filesOut else []
- commitMessage = Text.pack msgOut
- diffSummary = Text.pack diffOut
-
- -- Build prompt for llm
- let prompt = buildCompletionPrompt tid commitMessage diffSummary files
-
- -- Try to get API key
- maybeApiKey <- Env.lookupEnv "OPENROUTER_API_KEY"
- case maybeApiKey of
- Nothing -> do
- putText "[review] Warning: OPENROUTER_API_KEY not set, skipping completion summary"
- Just apiKey -> do
- -- Call LLM via Engine.chat
- let llm = Engine.defaultLLM {Engine.llmApiKey = Text.pack apiKey}
- messages = [Engine.Message Engine.User prompt Nothing Nothing]
-
- result <- Engine.chat llm [] messages
- case result of
- Left err -> do
- putText ("[review] Failed to generate completion summary: " <> err)
- Right msg -> do
- let summary = Text.strip (Engine.msgContent msg)
- unless (Text.null summary) <| do
- _ <- TaskCore.addComment tid ("## Completion Summary\n\n" <> summary) TaskCore.Junior
- putText "[review] Added completion summary comment"
-
--- | Build prompt for LLM to generate completion summary
-buildCompletionPrompt :: Text -> Text -> Text -> [String] -> Text
-buildCompletionPrompt tid commitMessage diffSummary files =
- Text.unlines
- [ "Generate a concise completion summary for this task. The summary should be 2-4 sentences.",
- "",
- "Task ID: " <> tid,
- "",
- "Commit Message:",
- commitMessage,
- "",
- "Files Modified (" <> tshow (length files) <> "):",
- Text.unlines (map Text.pack (take 10 files)),
- if length files > 10 then "... and " <> tshow (length files - 10) <> " more files" else "",
- "",
- "Diff Summary:",
- diffSummary,
- "",
- "Write a brief summary that includes:",
- "- What was accomplished (from the commit message and changes)",
- "- Key files that were modified (mention 2-3 most important ones)",
- "",
- "Keep it professional and concise. Do NOT include markdown headers or formatting.",
- "Just return the plain summary text."
- ]
-
--- | Extract facts from completed task
-extractFacts :: Text -> String -> IO ()
-extractFacts tid commitSha = do
- -- Get the diff for this commit
- (_, diffOut, _) <- Process.readProcessWithExitCode "git" ["show", "--stat", commitSha] ""
-
- -- Get task context
- tasks <- TaskCore.loadTasks
- case TaskCore.findTask tid tasks of
- Nothing -> pure ()
- Just task -> do
- let prompt = buildFactExtractionPrompt task diffOut
-
- -- Try to get API key
- maybeApiKey <- Env.lookupEnv "OPENROUTER_API_KEY"
- case maybeApiKey of
- Nothing -> do
- putText "[facts] Warning: OPENROUTER_API_KEY not set, skipping fact extraction"
- Just apiKey -> do
- -- Call LLM via Engine.chat
- let llm = Engine.defaultLLM {Engine.llmApiKey = Text.pack apiKey}
- messages = [Engine.Message Engine.User prompt Nothing Nothing]
-
- result <- Engine.chat llm [] messages
- case result of
- Left err -> do
- putText ("[facts] Failed to extract facts: " <> err)
- Right msg -> do
- parseFacts tid (Text.unpack (Engine.msgContent msg))
-
--- | Build prompt for LLM to extract facts from completed task
-buildFactExtractionPrompt :: TaskCore.Task -> String -> Text
-buildFactExtractionPrompt task diffSummary =
- Text.unlines
- [ "You just completed the following task:",
- "",
- "Task: " <> TaskCore.taskId task,
- "Title: " <> TaskCore.taskTitle task,
- "Description: " <> TaskCore.taskDescription task,
- "",
- "Diff summary:",
- Text.pack diffSummary,
- "",
- "List any facts you learned about this codebase that would be useful for future tasks.",
- "Each fact should be on its own line, starting with 'FACT: '.",
- "Include the relevant file paths in brackets after each fact.",
- "Example: FACT: The Alpha module re-exports common Prelude functions [Alpha.hs]",
- "If you didn't learn anything notable, respond with 'NO_FACTS'."
- ]
-
--- | Parse facts from LLM output and add them to the knowledge base
-parseFacts :: Text -> String -> IO ()
-parseFacts tid output = do
- let outputLines = Text.lines (Text.pack output)
- factLines = filter (Text.isPrefixOf "FACT: ") outputLines
- traverse_ (addFactFromLine tid) factLines
-
--- | Parse a single fact line and add it to the knowledge base
-addFactFromLine :: Text -> Text -> IO ()
-addFactFromLine tid line = do
- let content = Text.drop 6 line -- Remove "FACT: "
- (factText, filesRaw) = Text.breakOn " [" content
- files = parseFiles filesRaw
- _ <- Fact.createFact "Omni" factText files (Just tid) 0.7 -- Lower initial confidence
- putText ("[facts] Added: " <> factText)
-
--- | Parse file list from brackets [file1, file2, ...]
-parseFiles :: Text -> [Text]
-parseFiles raw
- | Text.null raw = []
- | not ("[" `Text.isInfixOf` raw) = []
- | otherwise =
- let stripped = Text.strip (Text.dropWhile (/= '[') raw)
- inner = Text.dropEnd 1 (Text.drop 1 stripped) -- Remove [ and ]
- trimmed = Text.strip inner
- in if Text.null trimmed
- then []
- else map Text.strip (Text.splitOn "," inner)
-
--- | Generate a summary comment for an epic when all children are complete
-generateEpicSummary :: Text -> TaskCore.Task -> [TaskCore.Task] -> IO ()
-generateEpicSummary epicId epic children = do
- putText "[epic] Generating summary for completed epic..."
-
- -- Try to get API key
- maybeApiKey <- Env.lookupEnv "OPENROUTER_API_KEY"
- case maybeApiKey of
- Nothing -> do
- putText "[epic] Warning: OPENROUTER_API_KEY not set, skipping summary generation"
- pure ()
- Just apiKey -> do
- -- Build the prompt for LLM
- prompt <- buildEpicSummaryPrompt epic children
-
- -- Call LLM
- let llm = Engine.defaultLLM {Engine.llmApiKey = Text.pack apiKey}
- messages = [Engine.Message Engine.User prompt Nothing Nothing]
-
- result <- Engine.chat llm [] messages
- case result of
- Left err -> do
- putText ("[epic] Failed to generate summary: " <> err)
- Right msg -> do
- let summary = Engine.msgContent msg
- _ <- TaskCore.addComment epicId summary TaskCore.Junior
- putText "[epic] Summary comment added to epic"
-
--- | Build a prompt for the LLM to summarize an epic
-buildEpicSummaryPrompt :: TaskCore.Task -> [TaskCore.Task] -> IO Text
-buildEpicSummaryPrompt epic children = do
- -- Get commit info for each child task
- childSummaries <- traverse summarizeChildTask children
-
- pure
- <| Text.unlines
- [ "Generate a concise summary comment for this completed epic.",
- "",
- "## Epic Information",
- "**Title:** " <> TaskCore.taskTitle epic,
- "**Description:**",
- TaskCore.taskDescription epic,
- "",
- "## Completed Child Tasks (" <> tshow (length children) <> ")",
- Text.unlines childSummaries,
- "",
- "## Instructions",
- "Create a markdown summary that includes:",
- "1. A brief overview of what was accomplished",
- "2. List of completed tasks with their titles",
- "3. Key changes or files modified (if mentioned in task descriptions)",
- "4. Any notable patterns or themes across the work",
- "",
- "Format the summary as a markdown comment starting with '## Epic Summary'.",
- "Keep it concise but informative."
- ]
-
--- | Summarize a single child task for the epic summary
-summarizeChildTask :: TaskCore.Task -> IO Text
-summarizeChildTask task = do
- -- Try to get commit info
- let grepArg = "--grep=" <> Text.unpack (TaskCore.taskId task)
- (code, shaOut, _) <-
- Process.readProcessWithExitCode
- "git"
- ["log", "--pretty=format:%h %s", "-n", "1", grepArg]
- ""
-
- let commitInfo =
- if code == Exit.ExitSuccess && not (null shaOut)
- then " [" <> Text.pack (take 80 shaOut) <> "]"
- else ""
-
- -- Get files changed in the commit
- filesInfo <- getCommitFiles (TaskCore.taskId task)
-
- pure <| "- **" <> TaskCore.taskId task <> "**: " <> TaskCore.taskTitle task <> commitInfo <> filesInfo
-
--- | Get files modified in a commit for a task
-getCommitFiles :: Text -> IO Text
-getCommitFiles taskId = do
- let grepArg = "--grep=" <> Text.unpack taskId
- (code, shaOut, _) <-
- Process.readProcessWithExitCode
- "git"
- ["log", "--pretty=format:%H", "-n", "1", grepArg]
- ""
-
- if code /= Exit.ExitSuccess || null shaOut
- then pure ""
- else do
- let sha = List.head (List.lines shaOut)
- (fileCode, filesOut, _) <-
- Process.readProcessWithExitCode
- "git"
- ["diff-tree", "--no-commit-id", "--name-only", "-r", sha]
- ""
- if fileCode /= Exit.ExitSuccess || null filesOut
- then pure ""
- else do
- let files = List.lines filesOut
- fileList = List.take 3 files -- Limit to first 3 files
- moreCount = length files - 3
- filesText = Text.intercalate ", " (map Text.pack fileList)
- suffix = if moreCount > 0 then " (+" <> tshow moreCount <> " more)" else ""
- pure <| if null files then "" else " — " <> filesText <> suffix
-
--- | 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.updateTaskStatusWithActor parentId TaskCore.Review [] TaskCore.System
- putText ("[review] Epic " <> parentId <> " -> Review")
- -- Generate summary comment for the epic
- generateEpicSummary parentId parentTask children
- 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"
- ]
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
deleted file mode 100644
index bb28e93e..00000000
--- a/Omni/Jr/Web.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- | Jr Web UI - Main module that re-exports the API and provides the run function.
---
--- The web interface is split into submodules:
--- - Types: Data types for pages, partials, and forms
--- - Components: Reusable UI components and helpers
--- - Pages: Full page ToHtml instances
--- - Partials: HTMX partial ToHtml instances
--- - Handlers: Servant handler implementations
--- - Style: CSS styling
---
--- : dep warp
--- : dep servant-server
--- : dep lucid
--- : dep servant-lucid
-module Omni.Jr.Web
- ( run,
- defaultPort,
- -- Re-exports for external use
- API,
- server,
- )
-where
-
-import Alpha
-import qualified Network.Wai.Handler.Warp as Warp
-import Omni.Jr.Web.Handlers (API, api, server)
-import Omni.Jr.Web.Pages ()
-import Omni.Jr.Web.Partials ()
-import Servant (serve)
-
-defaultPort :: Warp.Port
-defaultPort = 8080
-
-run :: Warp.Port -> IO ()
-run port = do
- putText <| "Starting Jr web server on port " <> tshow port
- Warp.run port (serve api server)
diff --git a/Omni/Jr/Web/Components.hs b/Omni/Jr/Web/Components.hs
deleted file mode 100644
index ac36131c..00000000
--- a/Omni/Jr/Web/Components.hs
+++ /dev/null
@@ -1,1751 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- : dep lucid
--- : dep servant-lucid
-module Omni.Jr.Web.Components
- ( -- * Time formatting
- formatRelativeTime,
- relativeText,
- formatExactTimestamp,
- renderRelativeTimestamp,
-
- -- * Small components
- metaSep,
-
- -- * Page layout
- pageHead,
- pageBody,
- pageBodyWithCrumbs,
- navbar,
-
- -- * JavaScript
- navbarDropdownJs,
- statusDropdownJs,
- priorityDropdownJs,
- complexityDropdownJs,
- liveToggleJs,
-
- -- * Breadcrumbs
- Breadcrumb (..),
- Breadcrumbs,
- renderBreadcrumbs,
- getAncestors,
- taskBreadcrumbs,
-
- -- * Badges
- statusBadge,
- complexityBadge,
- statusBadgeWithForm,
- clickableBadge,
- statusDropdownOptions,
- statusOption,
- priorityBadgeWithForm,
- clickablePriorityBadge,
- priorityDropdownOptions,
- priorityOption,
- complexityBadgeWithForm,
- clickableComplexityBadge,
- complexityDropdownOptions,
- complexityOption,
-
- -- * Sorting
- sortDropdown,
- sortOption,
-
- -- * Progress bars
- multiColorProgressBar,
- epicProgressBar,
-
- -- * Task rendering
- renderTaskCard,
- renderBlockedTaskCard,
- renderListGroupItem,
- renderEpicReviewCard,
- renderEpicCardWithStats,
- getDescendants,
-
- -- * Metrics
- renderAggregatedMetrics,
-
- -- * Retry context
- renderRetryContextBanner,
-
- -- * Markdown
- MarkdownBlock (..),
- InlinePart (..),
- renderMarkdown,
- parseBlocks,
- renderBlocks,
- renderBlock,
- renderListItem,
- renderInline,
- parseInline,
- parseBold,
- renderInlineParts,
- renderInlinePart,
-
- -- * Comments
- commentForm,
-
- -- * Live toggles
- renderLiveToggle,
- renderAutoscrollToggle,
-
- -- * Cost/Token metrics
- aggregateCostMetrics,
- formatCostHeader,
- formatTokensHeader,
-
- -- * Timeline
- renderUnifiedTimeline,
- renderTimelineEvent,
- eventTypeIconAndLabel,
- renderActorLabel,
- renderCommentTimelineEvent,
- renderStatusChangeEvent,
- parseStatusChange,
- renderActivityEvent,
- renderErrorTimelineEvent,
- renderAssistantTimelineEvent,
- renderToolCallTimelineEvent,
- renderToolResultTimelineEvent,
- renderCheckpointEvent,
- renderGuardrailEvent,
- renderGenericEvent,
- parseToolCallContent,
- formatToolCallSummary,
- renderCollapsibleOutput,
- renderDecodedToolResult,
- renderFormattedJson,
- timelineScrollScript,
-
- -- * Tool rendering helpers
- renderBashToolCall,
- renderReadToolCall,
- renderEditToolCall,
- renderSearchToolCall,
- renderSearchAndReadToolCall,
- renderWriteToolCall,
- renderGenericToolCall,
- extractJsonField,
- extractJsonFieldInt,
- shortenPath,
- DecodedToolResult (..),
- decodeToolResult,
- )
-where
-
-import Alpha
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Key as AesonKey
-import qualified Data.Aeson.KeyMap as KeyMap
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.List as List
-import qualified Data.Text as Text
-import Data.Time (NominalDiffTime, UTCTime, defaultTimeLocale, diffUTCTime, formatTime)
-import qualified Lucid
-import qualified Lucid.Base as Lucid
-import Numeric (showFFloat)
-import Omni.Jr.Web.Types (SortOrder (..), sortOrderLabel, sortOrderToParam)
-import qualified Omni.Task.Core as TaskCore
-
--- * Time formatting
-
-formatRelativeTime :: UTCTime -> UTCTime -> Text
-formatRelativeTime now timestamp =
- let delta = diffUTCTime now timestamp
- in relativeText delta
-
-relativeText :: NominalDiffTime -> Text
-relativeText delta
- | delta < 60 = "just now"
- | delta < 3600 = tshow (round (delta / 60) :: Int) <> " minutes ago"
- | delta < 7200 = "1 hour ago"
- | delta < 86400 = tshow (round (delta / 3600) :: Int) <> " hours ago"
- | delta < 172800 = "yesterday"
- | delta < 604800 = tshow (round (delta / 86400) :: Int) <> " days ago"
- | delta < 1209600 = "1 week ago"
- | delta < 2592000 = tshow (round (delta / 604800) :: Int) <> " weeks ago"
- | delta < 5184000 = "1 month ago"
- | delta < 31536000 = tshow (round (delta / 2592000) :: Int) <> " months ago"
- | otherwise = tshow (round (delta / 31536000) :: Int) <> " years ago"
-
-formatExactTimestamp :: UTCTime -> Text
-formatExactTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"
-
-renderRelativeTimestamp :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderRelativeTimestamp now timestamp =
- Lucid.span_
- [ Lucid.class_ "relative-time",
- Lucid.title_ (formatExactTimestamp timestamp)
- ]
- (Lucid.toHtml (formatRelativeTime now timestamp))
-
--- * Small components
-
-metaSep :: (Monad m) => Lucid.HtmlT m ()
-metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"
-
--- * Page layout
-
-pageHead :: (Monad m) => Text -> Lucid.HtmlT m ()
-pageHead title =
- Lucid.head_ <| do
- Lucid.title_ (Lucid.toHtml title)
- Lucid.meta_ [Lucid.charset_ "utf-8"]
- Lucid.meta_
- [ Lucid.name_ "viewport",
- Lucid.content_ "width=device-width, initial-scale=1"
- ]
- Lucid.link_ [Lucid.rel_ "stylesheet", Lucid.href_ "/style.css"]
- Lucid.script_
- [ Lucid.src_ "https://unpkg.com/htmx.org@2.0.4",
- Lucid.integrity_ "sha384-HGfztofotfshcF7+8n44JQL2oJmowVChPTg48S+jvZoztPfvwD79OC/LTtG6dMp+",
- Lucid.crossorigin_ "anonymous"
- ]
- ("" :: Text)
- Lucid.script_ [] statusDropdownJs
- Lucid.script_ [] priorityDropdownJs
- Lucid.script_ [] complexityDropdownJs
- Lucid.script_ [] navbarDropdownJs
- Lucid.script_ [] liveToggleJs
-
--- * JavaScript
-
-navbarDropdownJs :: Text
-navbarDropdownJs =
- Text.unlines
- [ "document.addEventListener('DOMContentLoaded', function() {",
- " document.querySelectorAll('.navbar-dropdown-btn').forEach(function(btn) {",
- " btn.addEventListener('click', function(e) {",
- " e.preventDefault();",
- " var dropdown = btn.closest('.navbar-dropdown');",
- " var isOpen = dropdown.classList.contains('open');",
- " document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
- " d.classList.remove('open');",
- " });",
- " if (!isOpen) {",
- " dropdown.classList.add('open');",
- " }",
- " });",
- " });",
- " document.addEventListener('click', function(e) {",
- " if (!e.target.closest('.navbar-dropdown')) {",
- " document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
- " d.classList.remove('open');",
- " });",
- " }",
- " });",
- "});"
- ]
-
-statusDropdownJs :: Text
-statusDropdownJs =
- Text.unlines
- [ "function toggleStatusDropdown(el) {",
- " var container = el.parentElement;",
- " var isOpen = container.classList.toggle('open');",
- " el.setAttribute('aria-expanded', isOpen);",
- " if (isOpen) {",
- " var firstItem = container.querySelector('[role=\"menuitem\"]');",
- " if (firstItem) firstItem.focus();",
- " }",
- "}",
- "",
- "function closeStatusDropdown(container) {",
- " container.classList.remove('open');",
- " var badge = container.querySelector('[role=\"button\"]');",
- " if (badge) {",
- " badge.setAttribute('aria-expanded', 'false');",
- " badge.focus();",
- " }",
- "}",
- "",
- "function handleStatusKeydown(event, el) {",
- " if (event.key === 'Enter' || event.key === ' ') {",
- " event.preventDefault();",
- " toggleStatusDropdown(el);",
- " } else if (event.key === 'Escape') {",
- " closeStatusDropdown(el.parentElement);",
- " } else if (event.key === 'ArrowDown') {",
- " event.preventDefault();",
- " var container = el.parentElement;",
- " if (!container.classList.contains('open')) {",
- " toggleStatusDropdown(el);",
- " } else {",
- " var firstItem = container.querySelector('[role=\"menuitem\"]');",
- " if (firstItem) firstItem.focus();",
- " }",
- " }",
- "}",
- "",
- "function handleMenuItemKeydown(event) {",
- " var container = event.target.closest('.status-badge-dropdown');",
- " var items = container.querySelectorAll('[role=\"menuitem\"]');",
- " var currentIndex = Array.from(items).indexOf(event.target);",
- " ",
- " if (event.key === 'ArrowDown') {",
- " event.preventDefault();",
- " var next = (currentIndex + 1) % items.length;",
- " items[next].focus();",
- " } else if (event.key === 'ArrowUp') {",
- " event.preventDefault();",
- " var prev = (currentIndex - 1 + items.length) % items.length;",
- " items[prev].focus();",
- " } else if (event.key === 'Escape') {",
- " event.preventDefault();",
- " closeStatusDropdown(container);",
- " } else if (event.key === 'Tab') {",
- " closeStatusDropdown(container);",
- " }",
- "}",
- "",
- "document.addEventListener('click', function(e) {",
- " var dropdowns = document.querySelectorAll('.status-badge-dropdown.open');",
- " dropdowns.forEach(function(d) {",
- " if (!d.contains(e.target)) {",
- " closeStatusDropdown(d);",
- " }",
- " });",
- "});"
- ]
-
-priorityDropdownJs :: Text
-priorityDropdownJs =
- Text.unlines
- [ "function togglePriorityDropdown(el) {",
- " var container = el.parentElement;",
- " var isOpen = container.classList.toggle('open');",
- " el.setAttribute('aria-expanded', isOpen);",
- " if (isOpen) {",
- " var firstItem = container.querySelector('[role=\"menuitem\"]');",
- " if (firstItem) firstItem.focus();",
- " }",
- "}",
- "",
- "function closePriorityDropdown(container) {",
- " container.classList.remove('open');",
- " var badge = container.querySelector('[role=\"button\"]');",
- " if (badge) {",
- " badge.setAttribute('aria-expanded', 'false');",
- " badge.focus();",
- " }",
- "}",
- "",
- "function handlePriorityKeydown(event, el) {",
- " if (event.key === 'Enter' || event.key === ' ') {",
- " event.preventDefault();",
- " togglePriorityDropdown(el);",
- " } else if (event.key === 'Escape') {",
- " closePriorityDropdown(el.parentElement);",
- " } else if (event.key === 'ArrowDown') {",
- " event.preventDefault();",
- " var container = el.parentElement;",
- " if (!container.classList.contains('open')) {",
- " togglePriorityDropdown(el);",
- " } else {",
- " var firstItem = container.querySelector('[role=\"menuitem\"]');",
- " if (firstItem) firstItem.focus();",
- " }",
- " }",
- "}",
- "",
- "function handlePriorityMenuItemKeydown(event) {",
- " var container = event.target.closest('.priority-badge-dropdown');",
- " var items = container.querySelectorAll('[role=\"menuitem\"]');",
- " var currentIndex = Array.from(items).indexOf(event.target);",
- " ",
- " if (event.key === 'ArrowDown') {",
- " event.preventDefault();",
- " var next = (currentIndex + 1) % items.length;",
- " items[next].focus();",
- " } else if (event.key === 'ArrowUp') {",
- " event.preventDefault();",
- " var prev = (currentIndex - 1 + items.length) % items.length;",
- " items[prev].focus();",
- " } else if (event.key === 'Escape') {",
- " event.preventDefault();",
- " closePriorityDropdown(container);",
- " } else if (event.key === 'Tab') {",
- " closePriorityDropdown(container);",
- " }",
- "}",
- "",
- "document.addEventListener('click', function(e) {",
- " var dropdowns = document.querySelectorAll('.priority-badge-dropdown.open');",
- " dropdowns.forEach(function(d) {",
- " if (!d.contains(e.target)) {",
- " closePriorityDropdown(d);",
- " }",
- " });",
- "});"
- ]
-
-complexityDropdownJs :: Text
-complexityDropdownJs =
- Text.unlines
- [ "function toggleComplexityDropdown(el) {",
- " var container = el.parentElement;",
- " var isOpen = container.classList.toggle('open');",
- " el.setAttribute('aria-expanded', isOpen);",
- " if (isOpen) {",
- " var firstItem = container.querySelector('[role=\"menuitem\"]');",
- " if (firstItem) firstItem.focus();",
- " }",
- "}",
- "",
- "function closeComplexityDropdown(container) {",
- " container.classList.remove('open');",
- " var badge = container.querySelector('[role=\"button\"]');",
- " if (badge) {",
- " badge.setAttribute('aria-expanded', 'false');",
- " badge.focus();",
- " }",
- "}",
- "",
- "function handleComplexityKeydown(event, el) {",
- " if (event.key === 'Enter' || event.key === ' ') {",
- " event.preventDefault();",
- " toggleComplexityDropdown(el);",
- " } else if (event.key === 'Escape') {",
- " closeComplexityDropdown(el.parentElement);",
- " } else if (event.key === 'ArrowDown') {",
- " event.preventDefault();",
- " var container = el.parentElement;",
- " if (!container.classList.contains('open')) {",
- " toggleComplexityDropdown(el);",
- " } else {",
- " var firstItem = container.querySelector('[role=\"menuitem\"]');",
- " if (firstItem) firstItem.focus();",
- " }",
- " }",
- "}",
- "",
- "function handleComplexityMenuItemKeydown(event) {",
- " var container = event.target.closest('.complexity-badge-dropdown');",
- " var items = container.querySelectorAll('[role=\"menuitem\"]');",
- " var currentIndex = Array.from(items).indexOf(event.target);",
- " ",
- " if (event.key === 'ArrowDown') {",
- " event.preventDefault();",
- " var next = (currentIndex + 1) % items.length;",
- " items[next].focus();",
- " } else if (event.key === 'ArrowUp') {",
- " event.preventDefault();",
- " var prev = (currentIndex - 1 + items.length) % items.length;",
- " items[prev].focus();",
- " } else if (event.key === 'Escape') {",
- " event.preventDefault();",
- " closeComplexityDropdown(container);",
- " } else if (event.key === 'Tab') {",
- " closeComplexityDropdown(container);",
- " }",
- "}",
- "",
- "document.addEventListener('click', function(e) {",
- " var dropdowns = document.querySelectorAll('.complexity-badge-dropdown.open');",
- " dropdowns.forEach(function(d) {",
- " if (!d.contains(e.target)) {",
- " closeComplexityDropdown(d);",
- " }",
- " });",
- "});"
- ]
-
-liveToggleJs :: Text
-liveToggleJs =
- Text.unlines
- [ "var liveUpdatesEnabled = true;",
- "var autoscrollEnabled = true;",
- "",
- "function toggleLiveUpdates() {",
- " liveUpdatesEnabled = !liveUpdatesEnabled;",
- " var btn = document.getElementById('live-toggle');",
- " if (btn) {",
- " btn.classList.toggle('timeline-live-paused', !liveUpdatesEnabled);",
- " }",
- "}",
- "",
- "function toggleAutoscroll() {",
- " autoscrollEnabled = !autoscrollEnabled;",
- " var btn = document.getElementById('autoscroll-toggle');",
- " if (btn) {",
- " btn.classList.toggle('timeline-autoscroll-disabled', !autoscrollEnabled);",
- " }",
- "}",
- "",
- "document.body.addEventListener('htmx:beforeRequest', function(evt) {",
- " var timeline = document.getElementById('unified-timeline');",
- " if (timeline && timeline.contains(evt.target) && !liveUpdatesEnabled) {",
- " evt.preventDefault();",
- " }",
- "});",
- "",
- "document.body.addEventListener('htmx:afterSettle', function(evt) {",
- " if (autoscrollEnabled) {",
- " var log = document.querySelector('.timeline-events');",
- " if (log) {",
- " log.scrollTop = log.scrollHeight;",
- " }",
- " }",
- "});"
- ]
-
-pageBody :: (Monad m) => Lucid.HtmlT m () -> Lucid.HtmlT m ()
-pageBody content =
- Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
- navbar
- content
-
--- * Breadcrumbs
-
-data Breadcrumb = Breadcrumb
- { _crumbLabel :: Text,
- _crumbHref :: Maybe Text
- }
-
-type Breadcrumbs = [Breadcrumb]
-
-pageBodyWithCrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m () -> Lucid.HtmlT m ()
-pageBodyWithCrumbs crumbs content =
- Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
- navbar
- unless (null crumbs) <| do
- Lucid.div_ [Lucid.class_ "breadcrumb-container"] <| do
- Lucid.div_ [Lucid.class_ "container"] <| renderBreadcrumbs crumbs
- content
-
-renderBreadcrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m ()
-renderBreadcrumbs [] = pure ()
-renderBreadcrumbs crumbs =
- Lucid.nav_ [Lucid.class_ "breadcrumbs", Lucid.makeAttribute "aria-label" "Breadcrumb"] <| do
- Lucid.ol_ [Lucid.class_ "breadcrumb-list"] <| do
- traverse_ renderCrumb (zip [0 ..] crumbs)
- where
- renderCrumb :: (Monad m') => (Int, Breadcrumb) -> Lucid.HtmlT m' ()
- renderCrumb (idx, Breadcrumb label mHref) = do
- Lucid.li_ [Lucid.class_ "breadcrumb-item"] <| do
- when (idx > 0) <| Lucid.span_ [Lucid.class_ "breadcrumb-sep"] ">"
- case mHref of
- Just href -> Lucid.a_ [Lucid.href_ href] (Lucid.toHtml label)
- Nothing -> Lucid.span_ [Lucid.class_ "breadcrumb-current"] (Lucid.toHtml label)
-
-getAncestors :: [TaskCore.Task] -> TaskCore.Task -> [TaskCore.Task]
-getAncestors allTasks task =
- case TaskCore.taskParent task of
- Nothing -> [task]
- Just pid -> case TaskCore.findTask pid allTasks of
- Nothing -> [task]
- Just parent -> getAncestors allTasks parent ++ [task]
-
-taskBreadcrumbs :: [TaskCore.Task] -> TaskCore.Task -> Breadcrumbs
-taskBreadcrumbs allTasks task =
- let ancestors = getAncestors allTasks task
- taskCrumbs = [Breadcrumb (TaskCore.taskId t) (Just ("/tasks/" <> TaskCore.taskId t)) | t <- List.init ancestors]
- currentCrumb = Breadcrumb (TaskCore.taskId task) Nothing
- in [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks")]
- ++ taskCrumbs
- ++ [currentCrumb]
-
--- * Navbar
-
-navbar :: (Monad m) => Lucid.HtmlT m ()
-navbar =
- Lucid.nav_ [Lucid.class_ "navbar"] <| do
- Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-brand"] "Junior"
- Lucid.input_
- [ Lucid.type_ "checkbox",
- Lucid.id_ "navbar-toggle",
- Lucid.class_ "navbar-toggle-checkbox"
- ]
- Lucid.label_
- [ Lucid.for_ "navbar-toggle",
- Lucid.class_ "navbar-hamburger"
- ]
- <| do
- Lucid.span_ [Lucid.class_ "hamburger-line"] ""
- Lucid.span_ [Lucid.class_ "hamburger-line"] ""
- Lucid.span_ [Lucid.class_ "hamburger-line"] ""
- Lucid.div_ [Lucid.class_ "navbar-links"] <| do
- Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-link"] "Dashboard"
- Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
- Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Tasks ▾"
- Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
- Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-dropdown-item"] "Ready"
- Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-dropdown-item"] "Blocked"
- Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-dropdown-item"] "Human Action"
- Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-dropdown-item"] "All"
- Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
- Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Plans ▾"
- Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
- Lucid.a_ [Lucid.href_ "/epics", Lucid.class_ "navbar-dropdown-item"] "Epics"
- Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "navbar-dropdown-item"] "KB"
- Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "navbar-link"] "Stats"
-
--- * Badges
-
-statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
-statusBadge status =
- let (cls, label) = case status of
- TaskCore.Draft -> ("badge badge-draft", "Draft")
- TaskCore.Open -> ("badge badge-open", "Open")
- TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
- TaskCore.Review -> ("badge badge-review", "Review")
- TaskCore.Approved -> ("badge badge-approved", "Approved")
- TaskCore.Done -> ("badge badge-done", "Done")
- TaskCore.NeedsHelp -> ("badge badge-needshelp", "Needs Help")
- in Lucid.span_ [Lucid.class_ cls] label
-
-complexityBadge :: (Monad m) => Int -> Lucid.HtmlT m ()
-complexityBadge complexity =
- let cls = "badge badge-complexity badge-complexity-" <> tshow complexity
- label = "ℂ " <> tshow complexity
- in Lucid.span_ [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] (Lucid.toHtml label)
-
--- * Sort dropdown
-
-sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
-sortDropdown basePath currentSort =
- Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
- Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
- Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
- Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
- <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
- Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
- sortOption basePath SortNewest currentSort
- sortOption basePath SortOldest currentSort
- sortOption basePath SortUpdated currentSort
- sortOption basePath SortPriorityHigh currentSort
- sortOption basePath SortPriorityLow currentSort
-
-sortOption :: (Monad m) => Text -> SortOrder -> SortOrder -> Lucid.HtmlT m ()
-sortOption basePath option currentSort =
- let cls = "sort-dropdown-item navbar-dropdown-item" <> if option == currentSort then " active" else ""
- href = basePath <> "?sort=" <> sortOrderToParam option
- in Lucid.a_ [Lucid.href_ href, Lucid.class_ cls] (Lucid.toHtml (sortOrderLabel option))
-
--- * Progress bars
-
-multiColorProgressBar :: (Monad m) => TaskCore.TaskStats -> Lucid.HtmlT m ()
-multiColorProgressBar stats =
- let total = TaskCore.totalTasks stats
- doneCount = TaskCore.doneTasks stats
- inProgressCount = TaskCore.inProgressTasks stats
- openCount = TaskCore.openTasks stats + TaskCore.reviewTasks stats + TaskCore.approvedTasks stats
- donePct = if total == 0 then 0 else (doneCount * 100) `div` total
- inProgressPct = if total == 0 then 0 else (inProgressCount * 100) `div` total
- openPct = if total == 0 then 0 else (openCount * 100) `div` total
- in Lucid.div_ [Lucid.class_ "multi-progress-container"] <| do
- Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
- when (donePct > 0)
- <| Lucid.div_
- [ Lucid.class_ "multi-progress-segment progress-done",
- Lucid.style_ ("width: " <> tshow donePct <> "%"),
- Lucid.title_ (tshow doneCount <> " done")
- ]
- ""
- when (inProgressPct > 0)
- <| Lucid.div_
- [ Lucid.class_ "multi-progress-segment progress-inprogress",
- Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
- Lucid.title_ (tshow inProgressCount <> " in progress")
- ]
- ""
- when (openPct > 0)
- <| Lucid.div_
- [ Lucid.class_ "multi-progress-segment progress-open",
- Lucid.style_ ("width: " <> tshow openPct <> "%"),
- Lucid.title_ (tshow openCount <> " open")
- ]
- ""
- Lucid.div_ [Lucid.class_ "progress-legend"] <| do
- Lucid.span_ [Lucid.class_ "legend-item"] <| do
- Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
- Lucid.toHtml ("Done " <> tshow doneCount)
- Lucid.span_ [Lucid.class_ "legend-item"] <| do
- Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
- Lucid.toHtml ("In Progress " <> tshow inProgressCount)
- Lucid.span_ [Lucid.class_ "legend-item"] <| do
- Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
- Lucid.toHtml ("Open " <> tshow openCount)
-
-epicProgressBar :: (Monad m) => Int -> Int -> Int -> Int -> Lucid.HtmlT m ()
-epicProgressBar doneCount inProgressCount openCount totalCount =
- let donePct = if totalCount == 0 then 0 else (doneCount * 100) `div` totalCount
- inProgressPct = if totalCount == 0 then 0 else (inProgressCount * 100) `div` totalCount
- openPct = if totalCount == 0 then 0 else (openCount * 100) `div` totalCount
- in Lucid.div_ [Lucid.class_ "multi-progress-container epic-progress"] <| do
- Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
- when (donePct > 0)
- <| Lucid.div_
- [ Lucid.class_ "multi-progress-segment progress-done",
- Lucid.style_ ("width: " <> tshow donePct <> "%"),
- Lucid.title_ (tshow doneCount <> " done")
- ]
- ""
- when (inProgressPct > 0)
- <| Lucid.div_
- [ Lucid.class_ "multi-progress-segment progress-inprogress",
- Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
- Lucid.title_ (tshow inProgressCount <> " in progress")
- ]
- ""
- when (openPct > 0)
- <| Lucid.div_
- [ Lucid.class_ "multi-progress-segment progress-open",
- Lucid.style_ ("width: " <> tshow openPct <> "%"),
- Lucid.title_ (tshow openCount <> " open")
- ]
- ""
- Lucid.div_ [Lucid.class_ "progress-legend"] <| do
- Lucid.span_ [Lucid.class_ "legend-item"] <| do
- Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
- Lucid.toHtml (tshow doneCount)
- Lucid.span_ [Lucid.class_ "legend-item"] <| do
- Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
- Lucid.toHtml (tshow inProgressCount)
- Lucid.span_ [Lucid.class_ "legend-item"] <| do
- Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
- Lucid.toHtml (tshow openCount)
-
--- * Status badge with form
-
-statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
-statusBadgeWithForm status tid =
- Lucid.div_
- [ Lucid.id_ "status-badge-container",
- Lucid.class_ "status-badge-dropdown"
- ]
- <| do
- clickableBadge status tid
- statusDropdownOptions status tid
-
-clickableBadge :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
-clickableBadge status _tid =
- let (cls, label) = case status of
- TaskCore.Draft -> ("badge badge-draft status-badge-clickable", "Draft" :: Text)
- TaskCore.Open -> ("badge badge-open status-badge-clickable", "Open")
- TaskCore.InProgress -> ("badge badge-inprogress status-badge-clickable", "In Progress")
- TaskCore.Review -> ("badge badge-review status-badge-clickable", "Review")
- TaskCore.Approved -> ("badge badge-approved status-badge-clickable", "Approved")
- TaskCore.Done -> ("badge badge-done status-badge-clickable", "Done")
- TaskCore.NeedsHelp -> ("badge badge-needshelp status-badge-clickable", "Needs Help")
- in Lucid.span_
- [ Lucid.class_ cls,
- Lucid.tabindex_ "0",
- Lucid.role_ "button",
- Lucid.makeAttribute "aria-haspopup" "true",
- Lucid.makeAttribute "aria-expanded" "false",
- Lucid.makeAttribute "onclick" "toggleStatusDropdown(this)",
- Lucid.makeAttribute "onkeydown" "handleStatusKeydown(event, this)"
- ]
- <| do
- Lucid.toHtml label
- Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
-
-statusDropdownOptions :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
-statusDropdownOptions currentStatus tid =
- Lucid.div_
- [ Lucid.class_ "status-dropdown-menu",
- Lucid.role_ "menu",
- Lucid.makeAttribute "aria-label" "Change task status"
- ]
- <| do
- statusOption TaskCore.Draft currentStatus tid
- statusOption TaskCore.Open currentStatus tid
- statusOption TaskCore.InProgress currentStatus tid
- statusOption TaskCore.Review currentStatus tid
- statusOption TaskCore.Approved currentStatus tid
- statusOption TaskCore.Done currentStatus tid
- statusOption TaskCore.NeedsHelp currentStatus tid
-
-statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Text -> Lucid.HtmlT m ()
-statusOption opt currentStatus tid =
- let (cls, label) = case opt of
- TaskCore.Draft -> ("badge badge-draft", "Draft" :: Text)
- TaskCore.Open -> ("badge badge-open", "Open")
- TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
- TaskCore.Review -> ("badge badge-review", "Review")
- TaskCore.Approved -> ("badge badge-approved", "Approved")
- TaskCore.Done -> ("badge badge-done", "Done")
- TaskCore.NeedsHelp -> ("badge badge-needshelp", "Needs Help")
- isSelected = opt == currentStatus
- optClass = cls <> " status-dropdown-option" <> if isSelected then " selected" else ""
- in Lucid.form_
- [ Lucid.class_ "status-option-form",
- Lucid.role_ "none",
- Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
- Lucid.makeAttribute "hx-target" "#status-badge-container",
- Lucid.makeAttribute "hx-swap" "outerHTML"
- ]
- <| do
- Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ (tshow opt)]
- Lucid.button_
- [ Lucid.type_ "submit",
- Lucid.class_ optClass,
- Lucid.role_ "menuitem",
- Lucid.tabindex_ "-1",
- Lucid.makeAttribute "onkeydown" "handleMenuItemKeydown(event)"
- ]
- (Lucid.toHtml label)
-
--- * Priority badge with form
-
-priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
-priorityBadgeWithForm priority tid =
- Lucid.div_
- [ Lucid.id_ "priority-badge-container",
- Lucid.class_ "priority-badge-dropdown"
- ]
- <| do
- clickablePriorityBadge priority tid
- priorityDropdownOptions priority tid
-
-clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
-clickablePriorityBadge priority _tid =
- let (cls, label) = case priority of
- TaskCore.P0 -> ("badge badge-p0 priority-badge-clickable", "P0 Critical" :: Text)
- TaskCore.P1 -> ("badge badge-p1 priority-badge-clickable", "P1 High")
- TaskCore.P2 -> ("badge badge-p2 priority-badge-clickable", "P2 Normal")
- TaskCore.P3 -> ("badge badge-p3 priority-badge-clickable", "P3 Low")
- TaskCore.P4 -> ("badge badge-p4 priority-badge-clickable", "P4 Defer")
- in Lucid.span_
- [ Lucid.class_ cls,
- Lucid.tabindex_ "0",
- Lucid.role_ "button",
- Lucid.makeAttribute "aria-haspopup" "true",
- Lucid.makeAttribute "aria-expanded" "false",
- Lucid.makeAttribute "onclick" "togglePriorityDropdown(this)",
- Lucid.makeAttribute "onkeydown" "handlePriorityKeydown(event, this)"
- ]
- <| do
- Lucid.toHtml label
- Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
-
-priorityDropdownOptions :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
-priorityDropdownOptions currentPriority tid =
- Lucid.div_
- [ Lucid.class_ "priority-dropdown-menu",
- Lucid.role_ "menu",
- Lucid.makeAttribute "aria-label" "Change task priority"
- ]
- <| do
- priorityOption TaskCore.P0 currentPriority tid
- priorityOption TaskCore.P1 currentPriority tid
- priorityOption TaskCore.P2 currentPriority tid
- priorityOption TaskCore.P3 currentPriority tid
- priorityOption TaskCore.P4 currentPriority tid
-
-priorityOption :: (Monad m) => TaskCore.Priority -> TaskCore.Priority -> Text -> Lucid.HtmlT m ()
-priorityOption opt currentPriority tid =
- let (cls, label) = case opt of
- TaskCore.P0 -> ("badge badge-p0", "P0 Critical" :: Text)
- TaskCore.P1 -> ("badge badge-p1", "P1 High")
- TaskCore.P2 -> ("badge badge-p2", "P2 Normal")
- TaskCore.P3 -> ("badge badge-p3", "P3 Low")
- TaskCore.P4 -> ("badge badge-p4", "P4 Defer")
- isSelected = opt == currentPriority
- optClass = cls <> " priority-dropdown-option" <> if isSelected then " selected" else ""
- in Lucid.form_
- [ Lucid.class_ "priority-option-form",
- Lucid.role_ "none",
- Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
- Lucid.makeAttribute "hx-target" "#priority-badge-container",
- Lucid.makeAttribute "hx-swap" "outerHTML"
- ]
- <| do
- Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "priority", Lucid.value_ (tshow opt)]
- Lucid.button_
- [ Lucid.type_ "submit",
- Lucid.class_ optClass,
- Lucid.role_ "menuitem",
- Lucid.tabindex_ "-1",
- Lucid.makeAttribute "onkeydown" "handlePriorityMenuItemKeydown(event)"
- ]
- (Lucid.toHtml label)
-
--- * Complexity badge with form
-
-complexityBadgeWithForm :: (Monad m) => Maybe Int -> Text -> Lucid.HtmlT m ()
-complexityBadgeWithForm complexity tid =
- Lucid.div_
- [ Lucid.id_ "complexity-badge-container",
- Lucid.class_ "complexity-badge-dropdown"
- ]
- <| do
- clickableComplexityBadge complexity tid
- complexityDropdownOptions complexity tid
-
-clickableComplexityBadge :: (Monad m) => Maybe Int -> Text -> Lucid.HtmlT m ()
-clickableComplexityBadge complexity _tid =
- let (cls, label) = case complexity of
- Nothing -> ("badge badge-complexity-none complexity-badge-clickable", "Set Complexity" :: Text)
- Just 1 -> ("badge badge-complexity-1 complexity-badge-clickable", "ℂ 1")
- Just 2 -> ("badge badge-complexity-2 complexity-badge-clickable", "ℂ 2")
- Just 3 -> ("badge badge-complexity-3 complexity-badge-clickable", "ℂ 3")
- Just 4 -> ("badge badge-complexity-4 complexity-badge-clickable", "ℂ 4")
- Just 5 -> ("badge badge-complexity-5 complexity-badge-clickable", "ℂ 5")
- Just _ -> ("badge badge-complexity-none complexity-badge-clickable", "Invalid")
- in Lucid.span_
- [ Lucid.class_ cls,
- Lucid.tabindex_ "0",
- Lucid.role_ "button",
- Lucid.makeAttribute "aria-haspopup" "true",
- Lucid.makeAttribute "aria-expanded" "false",
- Lucid.makeAttribute "onclick" "toggleComplexityDropdown(this)",
- Lucid.makeAttribute "onkeydown" "handleComplexityKeydown(event, this)"
- ]
- <| do
- Lucid.toHtml label
- Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
-
-complexityDropdownOptions :: (Monad m) => Maybe Int -> Text -> Lucid.HtmlT m ()
-complexityDropdownOptions currentComplexity tid =
- Lucid.div_
- [ Lucid.class_ "complexity-dropdown-menu",
- Lucid.role_ "menu",
- Lucid.makeAttribute "aria-label" "Change task complexity"
- ]
- <| do
- complexityOption Nothing currentComplexity tid
- complexityOption (Just 1) currentComplexity tid
- complexityOption (Just 2) currentComplexity tid
- complexityOption (Just 3) currentComplexity tid
- complexityOption (Just 4) currentComplexity tid
- complexityOption (Just 5) currentComplexity tid
-
-complexityOption :: (Monad m) => Maybe Int -> Maybe Int -> Text -> Lucid.HtmlT m ()
-complexityOption opt currentComplexity tid =
- let (cls, label, val) = case opt of
- Nothing -> ("badge badge-complexity-none", "None" :: Text, "none" :: Text)
- Just 1 -> ("badge badge-complexity-1", "ℂ 1", "1")
- Just 2 -> ("badge badge-complexity-2", "ℂ 2", "2")
- Just 3 -> ("badge badge-complexity-3", "ℂ 3", "3")
- Just 4 -> ("badge badge-complexity-4", "ℂ 4", "4")
- Just 5 -> ("badge badge-complexity-5", "ℂ 5", "5")
- Just _ -> ("badge badge-complexity-none", "Invalid", "none")
- isSelected = opt == currentComplexity
- optClass = cls <> " complexity-dropdown-option" <> if isSelected then " selected" else ""
- in Lucid.form_
- [ Lucid.class_ "complexity-option-form",
- Lucid.role_ "none",
- Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/complexity"),
- Lucid.makeAttribute "hx-target" "#complexity-badge-container",
- Lucid.makeAttribute "hx-swap" "outerHTML"
- ]
- <| do
- Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "complexity", Lucid.value_ val]
- Lucid.button_
- [ Lucid.type_ "submit",
- Lucid.class_ optClass,
- Lucid.role_ "menuitem",
- Lucid.tabindex_ "-1",
- Lucid.makeAttribute "onkeydown" "handleComplexityMenuItemKeydown(event)"
- ]
- (Lucid.toHtml label)
-
--- * Task rendering
-
-renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
-renderTaskCard t =
- Lucid.a_
- [ Lucid.class_ "task-card task-card-link",
- Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
- ]
- <| do
- Lucid.div_ [Lucid.class_ "task-header"] <| do
- Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
- statusBadge (TaskCore.taskStatus t)
- Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
- Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
-
-renderBlockedTaskCard :: (Monad m) => (TaskCore.Task, Int) -> Lucid.HtmlT m ()
-renderBlockedTaskCard (t, impact) =
- Lucid.a_
- [ Lucid.class_ "task-card task-card-link",
- Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
- ]
- <| do
- Lucid.div_ [Lucid.class_ "task-header"] <| do
- Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
- statusBadge (TaskCore.taskStatus t)
- Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
- when (impact > 0)
- <| Lucid.span_ [Lucid.class_ "blocking-impact"] (Lucid.toHtml ("Blocks " <> tshow impact))
- Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
-
-renderListGroupItem :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
-renderListGroupItem t =
- Lucid.a_
- [ Lucid.class_ "list-group-item",
- Lucid.href_ ("/tasks/" <> TaskCore.taskId t),
- Lucid.makeAttribute "hx-boost" "true",
- Lucid.makeAttribute "hx-target" "body",
- Lucid.makeAttribute "hx-swap" "innerHTML"
- ]
- <| do
- Lucid.div_ [Lucid.class_ "list-group-item-content"] <| do
- Lucid.span_ [Lucid.class_ "list-group-item-id"] (Lucid.toHtml (TaskCore.taskId t))
- Lucid.span_ [Lucid.class_ "list-group-item-title"] (Lucid.toHtml (TaskCore.taskTitle t))
- Lucid.div_ [Lucid.class_ "list-group-item-meta"] <| do
- statusBadge (TaskCore.taskStatus t)
- Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
-
-renderEpicReviewCard :: (Monad m) => TaskCore.EpicForReview -> Lucid.HtmlT m ()
-renderEpicReviewCard epicReview = do
- let task = TaskCore.epicTask epicReview
- total = TaskCore.epicTotal epicReview
- completed = TaskCore.epicCompleted epicReview
- progressText = tshow completed <> "/" <> tshow total <> " subtasks done"
- Lucid.div_ [Lucid.class_ "task-card"] <| do
- Lucid.div_ [Lucid.class_ "task-card-header"] <| do
- Lucid.div_ [Lucid.class_ "task-title-row"] <| do
- Lucid.a_
- [Lucid.href_ ("/tasks/" <> TaskCore.taskId task), Lucid.class_ "task-link"]
- <| Lucid.toHtml (TaskCore.taskTitle task)
- Lucid.span_ [Lucid.class_ "badge badge-epic"] "Epic"
- Lucid.span_ [Lucid.class_ "task-id"] <| Lucid.toHtml (TaskCore.taskId task)
- Lucid.div_ [Lucid.class_ "task-card-body"] <| do
- Lucid.div_ [Lucid.class_ "progress-info"] <| do
- Lucid.span_ [Lucid.class_ "badge badge-success"] <| Lucid.toHtml progressText
- Lucid.div_ [Lucid.class_ "epic-actions"] <| do
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status"),
- Lucid.class_ "inline-form"
- ]
- <| do
- Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ "done"]
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-success btn-sm"] "Approve & Close"
-
-renderEpicCardWithStats :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> Lucid.HtmlT m ()
-renderEpicCardWithStats allTasks t =
- let children = getDescendants allTasks (TaskCore.taskId t)
- openCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Open]
- inProgressCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.InProgress]
- reviewCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Review]
- doneCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Done]
- totalCount = length children
- openAndReview = openCount + reviewCount
- in Lucid.a_
- [ Lucid.class_ "task-card task-card-link",
- Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
- ]
- <| do
- Lucid.div_ [Lucid.class_ "task-header"] <| do
- Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
- statusBadge (TaskCore.taskStatus t)
- Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
- Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
- when (totalCount > 0) <| epicProgressBar doneCount inProgressCount openAndReview totalCount
- unless (Text.null (TaskCore.taskDescription t))
- <| Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 (TaskCore.taskDescription t) <> "..."))
-
-getDescendants :: [TaskCore.Task] -> Text -> [TaskCore.Task]
-getDescendants allTasks parentId =
- let children = [c | c <- allTasks, maybe False (TaskCore.matchesId parentId) (TaskCore.taskParent c)]
- in children ++ concatMap (getDescendants allTasks <. TaskCore.taskId) children
-
--- * Aggregated metrics
-
-renderAggregatedMetrics :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> TaskCore.AggregatedMetrics -> Lucid.HtmlT m ()
-renderAggregatedMetrics allTasks task metrics =
- let descendants = getDescendants allTasks (TaskCore.taskId task)
- totalCount = length descendants
- costCents = TaskCore.aggTotalCostCents metrics
- durationSecs = TaskCore.aggTotalDurationSeconds metrics
- completedCount = TaskCore.aggCompletedTasks metrics
- tokensUsed = TaskCore.aggTotalTokens metrics
- in Lucid.div_ [Lucid.class_ "detail-section aggregated-metrics"] <| do
- Lucid.h3_ "Execution Summary"
- Lucid.div_ [Lucid.class_ "metrics-grid"] <| do
- Lucid.div_ [Lucid.class_ "metric-card"] <| do
- Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow completedCount <> "/" <> tshow totalCount))
- Lucid.div_ [Lucid.class_ "metric-label"] "Tasks Completed"
- Lucid.div_ [Lucid.class_ "metric-card"] <| do
- Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostMetric costCents))
- Lucid.div_ [Lucid.class_ "metric-label"] "Total Cost"
- Lucid.div_ [Lucid.class_ "metric-card"] <| do
- Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurationMetric durationSecs))
- Lucid.div_ [Lucid.class_ "metric-label"] "Total Time"
- when (tokensUsed > 0) <| do
- Lucid.div_ [Lucid.class_ "metric-card"] <| do
- Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTokensMetric tokensUsed))
- Lucid.div_ [Lucid.class_ "metric-label"] "Tokens Used"
- where
- formatCostMetric :: Int -> Text
- formatCostMetric cents =
- let dollars = fromIntegral cents / 100.0 :: Double
- in "$" <> Text.pack (showFFloat (Just 2) dollars "")
-
- formatDurationMetric :: Int -> Text
- formatDurationMetric secs
- | secs < 60 = tshow secs <> "s"
- | secs < 3600 =
- let mins = secs `div` 60
- remSecs = secs `mod` 60
- in tshow mins <> "m " <> tshow remSecs <> "s"
- | otherwise =
- let hrs = secs `div` 3600
- mins = (secs `mod` 3600) `div` 60
- in tshow hrs <> "h " <> tshow mins <> "m"
-
- formatTokensMetric :: Int -> Text
- formatTokensMetric t
- | t < 1000 = tshow t
- | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
- | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"
-
--- * Retry context banner
-
-renderRetryContextBanner :: (Monad m) => Text -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
-renderRetryContextBanner _ Nothing = pure ()
-renderRetryContextBanner tid (Just ctx) =
- Lucid.div_ [Lucid.class_ bannerClass] <| do
- Lucid.div_ [Lucid.class_ "retry-banner-header"] <| do
- Lucid.span_ [Lucid.class_ "retry-icon"] retryIcon
- Lucid.span_ [Lucid.class_ "retry-attempt"] (Lucid.toHtml attemptText)
- when maxRetriesExceeded
- <| Lucid.span_ [Lucid.class_ "retry-warning-badge"] "Needs Human Intervention"
-
- Lucid.div_ [Lucid.class_ "retry-banner-details"] <| do
- Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
- Lucid.span_ [Lucid.class_ "retry-label"] "Failure Reason:"
- Lucid.span_ [Lucid.class_ "retry-value"] (Lucid.toHtml (summarizeReason (TaskCore.retryReason ctx)))
-
- let commit = TaskCore.retryOriginalCommit ctx
- unless (Text.null commit) <| do
- Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
- Lucid.span_ [Lucid.class_ "retry-label"] "Original Commit:"
- Lucid.code_ [Lucid.class_ "retry-commit"] (Lucid.toHtml (Text.take 8 commit))
-
- let conflicts = TaskCore.retryConflictFiles ctx
- unless (null conflicts) <| do
- Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
- Lucid.span_ [Lucid.class_ "retry-label"] "Conflict Files:"
- Lucid.ul_ [Lucid.class_ "retry-conflict-list"]
- <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflicts
-
- when maxRetriesExceeded <| do
- Lucid.div_
- [Lucid.class_ "retry-warning-message"]
- "This task has exceeded the maximum number of retries. A human must review the failure and either fix the issue manually or reset the retry count."
-
- Lucid.p_ [Lucid.class_ "retry-hint"] "Use comments below to provide guidance for retry."
-
- Lucid.div_ [Lucid.class_ "retry-reset-section"] <| do
- Lucid.h4_ "Reset Retries"
- Lucid.p_ [Lucid.class_ "notes-help"] "Clear retry context and give task a fresh start:"
- Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/reset-retries")] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reset-btn"] "Reset Retries"
- where
- attempt = TaskCore.retryAttempt ctx
- maxRetriesExceeded = attempt >= 3
- bannerClass = if maxRetriesExceeded then "retry-banner retry-banner-critical" else "retry-banner retry-banner-warning"
- retryIcon = if maxRetriesExceeded then "⚠" else "↻"
- attemptText = "Attempt " <> tshow attempt <> " of 3"
-
- summarizeReason :: Text -> Text
- summarizeReason reason
- | "rejected:" `Text.isPrefixOf` reason = "Rejected: " <> Text.strip (Text.drop 9 reason)
- | "Test failure:" `Text.isPrefixOf` reason = "Test failure (see details below)"
- | "MERGE CONFLICT" `Text.isPrefixOf` reason = "Merge conflict with concurrent changes"
- | otherwise = Text.take 100 reason <> if Text.length reason > 100 then "..." else ""
-
--- * Markdown rendering
-
-renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderMarkdown input = renderBlocks (parseBlocks (Text.lines input))
-
-data MarkdownBlock
- = MdHeader Int Text
- | MdParagraph [Text]
- | MdCodeBlock [Text]
- | MdList [Text]
- deriving (Show, Eq)
-
-parseBlocks :: [Text] -> [MarkdownBlock]
-parseBlocks [] = []
-parseBlocks lns = case lns of
- (l : rest)
- | "```" `Text.isPrefixOf` l ->
- let (codeLines, afterCode) = List.span (not <. Text.isPrefixOf "```") rest
- remaining = List.drop 1 afterCode
- in MdCodeBlock codeLines : parseBlocks remaining
- | "### " `Text.isPrefixOf` l ->
- MdHeader 3 (Text.drop 4 l) : parseBlocks rest
- | "## " `Text.isPrefixOf` l ->
- MdHeader 2 (Text.drop 3 l) : parseBlocks rest
- | "# " `Text.isPrefixOf` l ->
- MdHeader 1 (Text.drop 2 l) : parseBlocks rest
- | isListItem l ->
- let (listLines, afterList) = List.span isListItem lns
- in MdList (map stripListPrefix listLines) : parseBlocks afterList
- | Text.null (Text.strip l) ->
- parseBlocks rest
- | otherwise ->
- let (paraLines, afterPara) = List.span isParagraphLine lns
- in MdParagraph paraLines : parseBlocks afterPara
- where
- isListItem t =
- let stripped = Text.stripStart t
- in "- " `Text.isPrefixOf` stripped || "* " `Text.isPrefixOf` stripped
- stripListPrefix t =
- let stripped = Text.stripStart t
- in Text.drop 2 stripped
- isParagraphLine t =
- not (Text.null (Text.strip t))
- && not ("```" `Text.isPrefixOf` t)
- && not ("#" `Text.isPrefixOf` t)
- && not (isListItem t)
-
-renderBlocks :: (Monad m) => [MarkdownBlock] -> Lucid.HtmlT m ()
-renderBlocks = traverse_ renderBlock
-
-renderBlock :: (Monad m) => MarkdownBlock -> Lucid.HtmlT m ()
-renderBlock block = case block of
- MdHeader 1 txt -> Lucid.h2_ [Lucid.class_ "md-h1"] (renderInline txt)
- MdHeader 2 txt -> Lucid.h3_ [Lucid.class_ "md-h2"] (renderInline txt)
- MdHeader 3 txt -> Lucid.h4_ [Lucid.class_ "md-h3"] (renderInline txt)
- MdHeader _ txt -> Lucid.h4_ (renderInline txt)
- MdParagraph lns -> Lucid.p_ [Lucid.class_ "md-para"] (renderInline (Text.unlines lns))
- MdCodeBlock lns -> Lucid.pre_ [Lucid.class_ "md-code"] (Lucid.code_ (Lucid.toHtml (Text.unlines lns)))
- MdList items -> Lucid.ul_ [Lucid.class_ "md-list"] (traverse_ renderListItem items)
-
-renderListItem :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderListItem txt = Lucid.li_ (renderInline txt)
-
-renderInline :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderInline txt = renderInlineParts (parseInline txt)
-
-data InlinePart = PlainText Text | InlineCode Text | BoldText Text
- deriving (Show, Eq)
-
-parseInline :: Text -> [InlinePart]
-parseInline t
- | Text.null t = []
- | otherwise = case Text.breakOn "`" t of
- (before, rest)
- | Text.null rest -> parseBold before
- | otherwise ->
- let afterTick = Text.drop 1 rest
- in case Text.breakOn "`" afterTick of
- (code, rest2)
- | Text.null rest2 ->
- parseBold before ++ [PlainText ("`" <> afterTick)]
- | otherwise ->
- parseBold before ++ [InlineCode code] ++ parseInline (Text.drop 1 rest2)
-
-parseBold :: Text -> [InlinePart]
-parseBold t
- | Text.null t = []
- | otherwise = case Text.breakOn "**" t of
- (before, rest)
- | Text.null rest -> [PlainText before | not (Text.null before)]
- | otherwise ->
- let afterBold = Text.drop 2 rest
- in case Text.breakOn "**" afterBold of
- (boldText, rest2)
- | Text.null rest2 ->
- [PlainText before | not (Text.null before)] ++ [PlainText ("**" <> afterBold)]
- | otherwise ->
- [PlainText before | not (Text.null before)]
- ++ [BoldText boldText]
- ++ parseBold (Text.drop 2 rest2)
-
-renderInlineParts :: (Monad m) => [InlinePart] -> Lucid.HtmlT m ()
-renderInlineParts = traverse_ renderInlinePart
-
-renderInlinePart :: (Monad m) => InlinePart -> Lucid.HtmlT m ()
-renderInlinePart part = case part of
- PlainText txt -> Lucid.toHtml txt
- InlineCode txt -> Lucid.code_ [Lucid.class_ "md-inline-code"] (Lucid.toHtml txt)
- BoldText txt -> Lucid.strong_ (Lucid.toHtml txt)
-
--- * Comment form
-
-commentForm :: (Monad m) => Text -> Lucid.HtmlT m ()
-commentForm tid =
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> tid <> "/comment"),
- Lucid.class_ "comment-form"
- ]
- <| do
- Lucid.textarea_
- [ Lucid.name_ "comment",
- Lucid.placeholder_ "Add a comment...",
- Lucid.rows_ "3",
- Lucid.class_ "comment-textarea"
- ]
- ""
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Post Comment"
-
--- * Live toggles
-
-renderLiveToggle :: (Monad m) => Lucid.HtmlT m ()
-renderLiveToggle =
- Lucid.button_
- [ Lucid.class_ "timeline-live-toggle",
- Lucid.id_ "live-toggle",
- Lucid.makeAttribute "onclick" "toggleLiveUpdates()",
- Lucid.title_ "Click to pause/resume live updates"
- ]
- " LIVE"
-
-renderAutoscrollToggle :: (Monad m) => Lucid.HtmlT m ()
-renderAutoscrollToggle =
- Lucid.button_
- [ Lucid.class_ "timeline-autoscroll-toggle",
- Lucid.id_ "autoscroll-toggle",
- Lucid.makeAttribute "onclick" "toggleAutoscroll()",
- Lucid.title_ "Toggle automatic scrolling to newest events"
- ]
- " ⬇ Auto-scroll"
-
--- * Cost/Token metrics
-
-aggregateCostMetrics :: [TaskCore.StoredEvent] -> (Int, Int)
-aggregateCostMetrics events =
- let costEvents = filter (\e -> TaskCore.storedEventType e == "Cost") events
- aggregateOne (totalCents, totalTokens) event =
- case Aeson.decode (LBS.fromStrict (str (TaskCore.storedEventContent event))) of
- Just (Aeson.Object obj) ->
- let cents = case KeyMap.lookup "cents" obj of
- Just (Aeson.Number n) -> floor n
- _ -> 0
- tokens = case KeyMap.lookup "tokens" obj of
- Just (Aeson.Number n) -> floor n
- _ -> 0
- in (totalCents + cents, totalTokens + tokens)
- _ -> (totalCents, totalTokens)
- in foldl' aggregateOne (0, 0) costEvents
-
-formatCostHeader :: Int -> Text
-formatCostHeader cents =
- let dollars = fromIntegral cents / 100.0 :: Double
- in "$" <> Text.pack (showFFloat (Just 2) dollars "")
-
-formatTokensHeader :: Int -> Text
-formatTokensHeader t
- | t < 1000 = tshow t
- | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
- | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"
-
--- * Timeline
-
-renderUnifiedTimeline :: (Monad m) => Text -> [TaskCore.Comment] -> [TaskCore.StoredEvent] -> TaskCore.Status -> UTCTime -> Lucid.HtmlT m ()
-renderUnifiedTimeline tid legacyComments events status now = do
- let isInProgress = status == TaskCore.InProgress
- pollAttrs =
- if isInProgress
- then
- [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> tid <> "/events"),
- Lucid.makeAttribute "hx-trigger" "every 3s",
- Lucid.makeAttribute "hx-swap" "innerHTML",
- Lucid.makeAttribute "hx-on::before-request" "var log = this.querySelector('.timeline-events'); if(log) this.dataset.scroll = log.scrollTop",
- Lucid.makeAttribute "hx-on::after-swap" "var log = this.querySelector('.timeline-events'); if(log && this.dataset.scroll) log.scrollTop = this.dataset.scroll"
- ]
- else []
- nonCostEvents = filter (\e -> TaskCore.storedEventType e /= "Cost") events
- eventCount = length nonCostEvents + length legacyComments
- (totalCents, totalTokens) = aggregateCostMetrics events
- Lucid.div_ ([Lucid.class_ "unified-timeline-section", Lucid.id_ "unified-timeline"] <> pollAttrs) <| do
- Lucid.h3_ <| do
- Lucid.toHtml ("Timeline (" <> tshow eventCount <> ")")
- when (totalCents > 0 || totalTokens > 0) <| do
- Lucid.span_ [Lucid.class_ "timeline-cost-summary"] <| do
- metaSep
- when (totalCents > 0) <| Lucid.toHtml (formatCostHeader totalCents)
- when (totalCents > 0 && totalTokens > 0) <| metaSep
- when (totalTokens > 0) <| Lucid.toHtml (formatTokensHeader totalTokens <> " tokens")
- when isInProgress <| do
- renderLiveToggle
- renderAutoscrollToggle
-
- if null nonCostEvents && null legacyComments
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
- else do
- Lucid.div_ [Lucid.class_ "timeline-events"] <| do
- traverse_ (renderTimelineEvent now) nonCostEvents
- when isInProgress <| timelineScrollScript
-
- commentForm tid
-
-renderTimelineEvent :: (Monad m) => UTCTime -> TaskCore.StoredEvent -> Lucid.HtmlT m ()
-renderTimelineEvent now event =
- let eventType = TaskCore.storedEventType event
- content = TaskCore.storedEventContent event
- timestamp = TaskCore.storedEventTimestamp event
- actor = TaskCore.storedEventActor event
- eventId = TaskCore.storedEventId event
- (icon, label) = eventTypeIconAndLabel eventType
- in Lucid.div_
- [ Lucid.class_ ("timeline-event timeline-event-" <> eventType),
- Lucid.makeAttribute "data-event-id" (tshow eventId)
- ]
- <| do
- case eventType of
- "comment" -> renderCommentTimelineEvent content actor timestamp now
- "status_change" -> renderStatusChangeEvent content actor timestamp now
- "claim" -> renderActivityEvent icon label content actor timestamp now
- "running" -> renderActivityEvent icon label content actor timestamp now
- "reviewing" -> renderActivityEvent icon label content actor timestamp now
- "retrying" -> renderActivityEvent icon label content actor timestamp now
- "complete" -> renderActivityEvent icon label content actor timestamp now
- "error" -> renderErrorTimelineEvent content actor timestamp now
- "Assistant" -> renderAssistantTimelineEvent content actor timestamp now
- "ToolCall" -> renderToolCallTimelineEvent content actor timestamp now
- "ToolResult" -> renderToolResultTimelineEvent content actor timestamp now
- "Cost" -> pure ()
- "Checkpoint" -> renderCheckpointEvent content actor timestamp now
- "Guardrail" -> renderGuardrailEvent content actor timestamp now
- _ -> renderGenericEvent eventType content actor timestamp now
-
-eventTypeIconAndLabel :: Text -> (Text, Text)
-eventTypeIconAndLabel "comment" = ("💬", "Comment")
-eventTypeIconAndLabel "status_change" = ("🔄", "Status")
-eventTypeIconAndLabel "claim" = ("🤖", "Claimed")
-eventTypeIconAndLabel "running" = ("▶️", "Running")
-eventTypeIconAndLabel "reviewing" = ("👀", "Reviewing")
-eventTypeIconAndLabel "retrying" = ("🔁", "Retrying")
-eventTypeIconAndLabel "complete" = ("✅", "Complete")
-eventTypeIconAndLabel "error" = ("❌", "Error")
-eventTypeIconAndLabel "Assistant" = ("💭", "Thought")
-eventTypeIconAndLabel "ToolCall" = ("🔧", "Tool")
-eventTypeIconAndLabel "ToolResult" = ("📄", "Result")
-eventTypeIconAndLabel "Cost" = ("💰", "Cost")
-eventTypeIconAndLabel "Checkpoint" = ("📍", "Checkpoint")
-eventTypeIconAndLabel "Guardrail" = ("⚠️", "Guardrail")
-eventTypeIconAndLabel t = ("📝", t)
-
-renderActorLabel :: (Monad m) => TaskCore.CommentAuthor -> Lucid.HtmlT m ()
-renderActorLabel actor =
- let (cls, label) :: (Text, Text) = case actor of
- TaskCore.Human -> ("actor-human", "human")
- TaskCore.Junior -> ("actor-junior", "junior")
- TaskCore.System -> ("actor-system", "system")
- in Lucid.span_ [Lucid.class_ ("actor-label " <> cls)] (Lucid.toHtml ("[" <> label <> "]"))
-
-renderCommentTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderCommentTimelineEvent content actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-comment"] <| do
- Lucid.div_ [Lucid.class_ "event-header"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "💬"
- renderActorLabel actor
- renderRelativeTimestamp now timestamp
- Lucid.div_ [Lucid.class_ "event-content comment-bubble markdown-content"] <| do
- renderMarkdown content
-
-renderStatusChangeEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderStatusChangeEvent content actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-status-change"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "🔄"
- renderActorLabel actor
- Lucid.span_ [Lucid.class_ "status-change-text"] (Lucid.toHtml (parseStatusChange content))
- renderRelativeTimestamp now timestamp
-
-parseStatusChange :: Text -> Text
-parseStatusChange content =
- case Aeson.decode (LBS.fromStrict (str content)) of
- Just (Aeson.Object obj) ->
- let fromStatus = case KeyMap.lookup "from" obj of
- Just (Aeson.String s) -> s
- _ -> "?"
- toStatus = case KeyMap.lookup "to" obj of
- Just (Aeson.String s) -> s
- _ -> "?"
- in fromStatus <> " → " <> toStatus
- _ -> content
-
-renderActivityEvent :: (Monad m) => Text -> Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderActivityEvent icon label content actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-activity"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] (Lucid.toHtml icon)
- Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml label)
- renderActorLabel actor
- unless (Text.null content) <| Lucid.span_ [Lucid.class_ "activity-detail"] (Lucid.toHtml content)
- renderRelativeTimestamp now timestamp
-
-renderErrorTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderErrorTimelineEvent content actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-error"] <| do
- Lucid.div_ [Lucid.class_ "event-header"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "❌"
- Lucid.span_ [Lucid.class_ "event-label"] "Error"
- renderActorLabel actor
- renderRelativeTimestamp now timestamp
- Lucid.div_ [Lucid.class_ "event-content error-message"] (renderFormattedJson content)
-
-renderAssistantTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderAssistantTimelineEvent content _actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-thought"] <| do
- Lucid.div_ [Lucid.class_ "event-header"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "💭"
- Lucid.span_ [Lucid.class_ "event-label"] "Thought"
- renderActorLabel TaskCore.Junior
- renderRelativeTimestamp now timestamp
- Lucid.div_ [Lucid.class_ "event-content thought-bubble markdown-content"] <| do
- let truncated = Text.take 2000 content
- isTruncated = Text.length content > 2000
- renderMarkdown truncated
- when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."
-
-renderToolCallTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderToolCallTimelineEvent content _actor _timestamp _now =
- let (toolName, argsJson) = parseToolCallContent content
- in case toolName of
- "run_bash" -> renderBashToolCall argsJson
- "read_file" -> renderReadToolCall argsJson
- "edit_file" -> renderEditToolCall argsJson
- "search_codebase" -> renderSearchToolCall argsJson
- "search_and_read" -> renderSearchAndReadToolCall argsJson
- "write_file" -> renderWriteToolCall argsJson
- _ -> renderGenericToolCall toolName argsJson
-
-renderBashToolCall :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderBashToolCall argsJson =
- let cmd = extractJsonField "command" argsJson
- in Lucid.div_ [Lucid.class_ "tool-bash"] <| do
- Lucid.span_ [Lucid.class_ "tool-bash-prompt"] "ϟ"
- Lucid.code_ [Lucid.class_ "tool-bash-cmd"] (Lucid.toHtml cmd)
-
-renderReadToolCall :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderReadToolCall argsJson =
- let path = extractJsonField "path" argsJson
- startLine = extractJsonFieldInt "start_line" argsJson
- endLine = extractJsonFieldInt "end_line" argsJson
- lineRange = case (startLine, endLine) of
- (Just s, Just e) -> " @" <> tshow s <> "-" <> tshow e
- (Just s, Nothing) -> " @" <> tshow s <> "+"
- _ -> ""
- in Lucid.div_ [Lucid.class_ "tool-compact"] <| do
- Lucid.span_ [Lucid.class_ "tool-check"] "✓"
- Lucid.span_ [Lucid.class_ "tool-label"] "Read"
- Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path <> lineRange))
-
-renderEditToolCall :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderEditToolCall argsJson =
- let path = extractJsonField "path" argsJson
- in Lucid.div_ [Lucid.class_ "tool-compact"] <| do
- Lucid.span_ [Lucid.class_ "tool-check"] "✓"
- Lucid.span_ [Lucid.class_ "tool-label"] "Edit"
- Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path))
-
-renderSearchToolCall :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderSearchToolCall argsJson =
- let searchPat = extractJsonField "pattern" argsJson
- searchPath = extractJsonField "path" argsJson
- pathSuffix = if Text.null searchPath || searchPath == "." then "" else " in " <> shortenPath searchPath
- in Lucid.div_ [Lucid.class_ "tool-compact"] <| do
- Lucid.span_ [Lucid.class_ "tool-check"] "✓"
- Lucid.span_ [Lucid.class_ "tool-label"] "Grep"
- Lucid.code_ [Lucid.class_ "tool-pattern"] (Lucid.toHtml searchPat)
- unless (Text.null pathSuffix)
- <| Lucid.span_ [Lucid.class_ "tool-path-suffix"] (Lucid.toHtml pathSuffix)
-
-renderWriteToolCall :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderWriteToolCall argsJson =
- let path = extractJsonField "path" argsJson
- in Lucid.div_ [Lucid.class_ "tool-compact"] <| do
- Lucid.span_ [Lucid.class_ "tool-check"] "✓"
- Lucid.span_ [Lucid.class_ "tool-label"] "Write"
- Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path))
-
-renderSearchAndReadToolCall :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderSearchAndReadToolCall argsJson =
- let searchPat = extractJsonField "pattern" argsJson
- searchPath = extractJsonField "path" argsJson
- pathSuffix = if Text.null searchPath || searchPath == "." then "" else " in " <> shortenPath searchPath
- in Lucid.div_ [Lucid.class_ "tool-compact"] <| do
- Lucid.span_ [Lucid.class_ "tool-check"] "✓"
- Lucid.span_ [Lucid.class_ "tool-label"] "Find"
- Lucid.code_ [Lucid.class_ "tool-pattern"] (Lucid.toHtml searchPat)
- unless (Text.null pathSuffix)
- <| Lucid.span_ [Lucid.class_ "tool-path-suffix"] (Lucid.toHtml pathSuffix)
-
-renderGenericToolCall :: (Monad m) => Text -> Text -> Lucid.HtmlT m ()
-renderGenericToolCall toolName argsJson =
- Lucid.details_ [Lucid.class_ "tool-generic"] <| do
- Lucid.summary_ <| do
- Lucid.span_ [Lucid.class_ "tool-check"] "✓"
- Lucid.span_ [Lucid.class_ "tool-label"] (Lucid.toHtml toolName)
- Lucid.pre_ [Lucid.class_ "tool-args-pre"] (Lucid.toHtml argsJson)
-
-extractJsonField :: Text -> Text -> Text
-extractJsonField field jsonText =
- case Aeson.decode (LBS.fromStrict (str jsonText)) of
- Just (Aeson.Object obj) ->
- case KeyMap.lookup (AesonKey.fromText field) obj of
- Just (Aeson.String s) -> s
- _ -> ""
- _ -> ""
-
-extractJsonFieldInt :: Text -> Text -> Maybe Int
-extractJsonFieldInt field jsonText =
- case Aeson.decode (LBS.fromStrict (str jsonText)) of
- Just (Aeson.Object obj) ->
- case KeyMap.lookup (AesonKey.fromText field) obj of
- Just (Aeson.Number n) -> Just (floor n)
- _ -> Nothing
- _ -> Nothing
-
-shortenPath :: Text -> Text
-shortenPath path =
- let parts = Text.splitOn "/" path
- relevant = dropWhile (\p -> p `elem` ["", "home", "ben", "omni"]) parts
- in Text.intercalate "/" relevant
-
-renderToolResultTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderToolResultTimelineEvent content _actor _timestamp _now =
- let decoded = decodeToolResult content
- isSuccess = toolResultIsSuccess decoded
- output = toolResultOutput' decoded
- lineCount = length (Text.lines output)
- in if Text.null output || (isSuccess && lineCount <= 1)
- then pure ()
- else
- Lucid.div_ [Lucid.class_ "tool-result-output"] <| do
- when (lineCount > 10)
- <| Lucid.details_ [Lucid.class_ "result-collapsible"]
- <| do
- Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines"))
- Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml output)
- when (lineCount <= 10)
- <| Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml output)
-
-data DecodedToolResult = DecodedToolResult
- { toolResultIsSuccess :: Bool,
- toolResultOutput' :: Text,
- toolResultError' :: Maybe Text
- }
-
-decodeToolResult :: Text -> DecodedToolResult
-decodeToolResult content =
- case Aeson.decode (LBS.fromStrict (str content)) of
- Just (Aeson.Object obj) ->
- DecodedToolResult
- { toolResultIsSuccess = case KeyMap.lookup "success" obj of
- Just (Aeson.Bool b) -> b
- _ -> True,
- toolResultOutput' = case KeyMap.lookup "output" obj of
- Just (Aeson.String s) -> s
- _ -> "",
- toolResultError' = case KeyMap.lookup "error" obj of
- Just (Aeson.String s) -> Just s
- _ -> Nothing
- }
- _ -> DecodedToolResult True content Nothing
-
-renderCheckpointEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderCheckpointEvent content actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-checkpoint"] <| do
- Lucid.div_ [Lucid.class_ "event-header"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "📍"
- Lucid.span_ [Lucid.class_ "event-label"] "Checkpoint"
- renderActorLabel actor
- renderRelativeTimestamp now timestamp
- Lucid.div_ [Lucid.class_ "event-content checkpoint-content"] (Lucid.toHtml content)
-
-renderGuardrailEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderGuardrailEvent content actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-guardrail"] <| do
- Lucid.div_ [Lucid.class_ "event-header"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "⚠️"
- Lucid.span_ [Lucid.class_ "event-label"] "Guardrail"
- renderActorLabel actor
- renderRelativeTimestamp now timestamp
- Lucid.div_ [Lucid.class_ "event-content guardrail-content"] (renderFormattedJson content)
-
-renderGenericEvent :: (Monad m) => Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
-renderGenericEvent eventType content actor timestamp now =
- Lucid.div_ [Lucid.class_ "timeline-generic"] <| do
- Lucid.div_ [Lucid.class_ "event-header"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "📝"
- Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml eventType)
- renderActorLabel actor
- renderRelativeTimestamp now timestamp
- unless (Text.null content) <| Lucid.div_ [Lucid.class_ "event-content"] (Lucid.toHtml content)
-
-parseToolCallContent :: Text -> (Text, Text)
-parseToolCallContent content =
- case Text.breakOn ":" content of
- (name, rest)
- | Text.null rest -> (content, "")
- | otherwise -> (Text.strip name, Text.strip (Text.drop 1 rest))
-
-formatToolCallSummary :: Text -> Text -> Text
-formatToolCallSummary toolName argsJson =
- case Aeson.decode (LBS.fromStrict (str argsJson)) of
- Just (Aeson.Object obj) ->
- let keyArg = case toolName of
- "run_bash" -> KeyMap.lookup "command" obj
- "read_file" -> KeyMap.lookup "path" obj
- "edit_file" -> KeyMap.lookup "path" obj
- "write_file" -> KeyMap.lookup "path" obj
- "search_codebase" -> KeyMap.lookup "pattern" obj
- "glob_files" -> KeyMap.lookup "pattern" obj
- "list_directory" -> KeyMap.lookup "path" obj
- _ -> Nothing
- in case keyArg of
- Just (Aeson.String s) -> "`" <> Text.take 100 s <> "`"
- _ -> Text.take 80 argsJson
- _ -> Text.take 80 argsJson
-
-renderCollapsibleOutput :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderCollapsibleOutput content =
- let lineCount = length (Text.lines content)
- in if lineCount > 20
- then
- Lucid.details_ [Lucid.class_ "output-collapsible"] <| do
- Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines"))
- Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
- else Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
-
-renderDecodedToolResult :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderDecodedToolResult content =
- case Aeson.decode (LBS.fromStrict (str content)) of
- Just (Aeson.Object obj) ->
- case KeyMap.lookup "output" obj of
- Just (Aeson.String output) -> Lucid.toHtml output
- _ -> Lucid.toHtml content
- _ -> Lucid.toHtml content
-
--- | Format JSON content for human-readable display.
--- Tries to pretty-print JSON, falls back to raw text if not valid JSON.
-renderFormattedJson :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderFormattedJson content =
- case Aeson.decode (LBS.fromStrict (str content)) of
- Just (val :: Aeson.Value) ->
- Lucid.pre_ [Lucid.class_ "formatted-json"] <| do
- Lucid.toHtml (decodeUtf8 (LBS.toStrict (Aeson.encode val)))
- Nothing -> Lucid.toHtml content
-
-timelineScrollScript :: (Monad m) => Lucid.HtmlT m ()
-timelineScrollScript =
- Lucid.script_
- [ Lucid.type_ "text/javascript"
- ]
- ( Text.unlines
- [ "(function() {",
- " function scrollToBottom() {",
- " if (typeof autoscrollEnabled !== 'undefined' && !autoscrollEnabled) return;",
- " var log = document.querySelector('.timeline-events');",
- " if (log) {",
- " var isNearBottom = log.scrollHeight - log.scrollTop - log.clientHeight < 100;",
- " if (isNearBottom) {",
- " log.scrollTop = log.scrollHeight;",
- " }",
- " }",
- " }",
- " scrollToBottom();",
- " document.body.addEventListener('htmx:afterSwap', function(e) {",
- " if (e.target.closest('.timeline-events') || e.target.classList.contains('timeline-events')) {",
- " scrollToBottom();",
- " }",
- " });",
- "})();"
- ]
- )
diff --git a/Omni/Jr/Web/Handlers.hs b/Omni/Jr/Web/Handlers.hs
deleted file mode 100644
index 9dd5847c..00000000
--- a/Omni/Jr/Web/Handlers.hs
+++ /dev/null
@@ -1,649 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- : dep warp
--- : dep servant-server
--- : dep lucid
--- : dep servant-lucid
--- : dep process
--- : dep aeson
-module Omni.Jr.Web.Handlers
- ( API,
- server,
- api,
- streamAgentEvents,
- )
-where
-
-import Alpha
-import qualified Control.Concurrent as Concurrent
-import qualified Data.Aeson as Aeson
-import qualified Data.List as List
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as LazyText
-import Data.Time (getCurrentTime)
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
-import qualified Omni.Fact as Fact
-import qualified Omni.Jr.Web.Style as Style
-import Omni.Jr.Web.Types
-import qualified Omni.Task.Core as TaskCore
-import Servant
-import qualified Servant.HTML.Lucid as Lucid
-import qualified Servant.Types.SourceT as Source
-import qualified System.Exit as Exit
-import qualified System.Process as Process
-
-type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)
-
-type API =
- QueryParam "range" Text :> Get '[Lucid.HTML] HomePage
- :<|> "style.css" :> Get '[CSS] LazyText.Text
- :<|> "ready" :> QueryParam "sort" Text :> Get '[Lucid.HTML] ReadyQueuePage
- :<|> "blocked" :> QueryParam "sort" Text :> Get '[Lucid.HTML] BlockedPage
- :<|> "intervention" :> QueryParam "sort" Text :> Get '[Lucid.HTML] InterventionPage
- :<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage
- :<|> "tasks"
- :> QueryParam "status" Text
- :> QueryParam "priority" Text
- :> QueryParam "namespace" Text
- :> QueryParam "type" Text
- :> QueryParam "sort" Text
- :> Get '[Lucid.HTML] TaskListPage
- :<|> "kb" :> Get '[Lucid.HTML] KBPage
- :<|> "kb" :> "create" :> ReqBody '[FormUrlEncoded] FactCreateForm :> PostRedirect
- :<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage
- :<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect
- :<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect
- :<|> "epics" :> QueryParam "sort" Text :> Get '[Lucid.HTML] EpicsPage
- :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
- :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
- :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial
- :<|> "tasks" :> Capture "id" Text :> "complexity" :> ReqBody '[FormUrlEncoded] ComplexityForm :> Post '[Lucid.HTML] ComplexityBadgePartial
- :<|> "tasks" :> Capture "id" Text :> "description" :> "view" :> Get '[Lucid.HTML] DescriptionViewPartial
- :<|> "tasks" :> Capture "id" Text :> "description" :> "edit" :> Get '[Lucid.HTML] DescriptionEditPartial
- :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> Post '[Lucid.HTML] DescriptionViewPartial
- :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect
- :<|> "tasks" :> Capture "id" Text :> "comment" :> ReqBody '[FormUrlEncoded] CommentForm :> PostRedirect
- :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
- :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
- :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
- :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect
- :<|> "tasks" :> Capture "id" Text :> "reset-retries" :> PostRedirect
- :<|> "partials" :> "recent-activity-new" :> QueryParam "since" Int :> Get '[Lucid.HTML] RecentActivityNewPartial
- :<|> "partials" :> "recent-activity-more" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityMorePartial
- :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial
- :<|> "partials"
- :> "task-list"
- :> QueryParam "status" Text
- :> QueryParam "priority" Text
- :> QueryParam "namespace" Text
- :> QueryParam "type" Text
- :> QueryParam "sort" Text
- :> Get '[Lucid.HTML] TaskListPartial
- :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
- :<|> "partials" :> "task" :> Capture "id" Text :> "events" :> QueryParam "since" Int :> Get '[Lucid.HTML] AgentEventsPartial
- :<|> "tasks" :> Capture "id" Text :> "events" :> "stream" :> StreamGet NoFraming SSE (SourceIO ByteString)
-
-api :: Proxy API
-api = Proxy
-
-server :: Server API
-server =
- homeHandler
- :<|> styleHandler
- :<|> readyQueueHandler
- :<|> blockedHandler
- :<|> interventionHandler
- :<|> statsHandler
- :<|> taskListHandler
- :<|> kbHandler
- :<|> factCreateHandler
- :<|> factDetailHandler
- :<|> factEditHandler
- :<|> factDeleteHandler
- :<|> epicsHandler
- :<|> taskDetailHandler
- :<|> taskStatusHandler
- :<|> taskPriorityHandler
- :<|> taskComplexityHandler
- :<|> descriptionViewHandler
- :<|> descriptionEditHandler
- :<|> descriptionPostHandler
- :<|> taskNotesHandler
- :<|> taskCommentHandler
- :<|> taskReviewHandler
- :<|> taskDiffHandler
- :<|> taskAcceptHandler
- :<|> taskRejectHandler
- :<|> taskResetRetriesHandler
- :<|> recentActivityNewHandler
- :<|> recentActivityMoreHandler
- :<|> readyCountHandler
- :<|> taskListPartialHandler
- :<|> taskMetricsPartialHandler
- :<|> agentEventsPartialHandler
- :<|> taskEventsStreamHandler
- where
- styleHandler :: Servant.Handler LazyText.Text
- styleHandler = pure Style.css
-
- homeHandler :: Maybe Text -> Servant.Handler HomePage
- homeHandler maybeRangeText = do
- now <- liftIO getCurrentTime
- let range = parseTimeRange maybeRangeText
- maybeStart = getTimeRangeStart range now
- allTasks <- liftIO TaskCore.loadTasks
- let filteredTasks = case maybeStart of
- Nothing -> allTasks
- Just start -> [t | t <- allTasks, TaskCore.taskUpdatedAt t >= start]
- stats = TaskCore.computeTaskStatsFromList filteredTasks
- readyTasks <- liftIO TaskCore.getReadyTasks
- allActivities <- liftIO <| concat </ traverse (TaskCore.getActivitiesForTask <. TaskCore.taskId) allTasks
- let filteredActivities = case maybeStart of
- Nothing -> allActivities
- Just start -> [a | a <- allActivities, TaskCore.activityTimestamp a >= start]
- globalMetrics = computeMetricsFromActivities filteredTasks filteredActivities
- sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) filteredTasks
- recentTasks = take 5 sortedTasks
- hasMoreRecent = length filteredTasks > 5
- pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics range now)
-
- readyQueueHandler :: Maybe Text -> Servant.Handler ReadyQueuePage
- readyQueueHandler maybeSortText = do
- now <- liftIO getCurrentTime
- readyTasks <- liftIO TaskCore.getReadyTasks
- let sortOrder = parseSortOrder maybeSortText
- sortedTasks = sortTasks sortOrder readyTasks
- pure (ReadyQueuePage sortedTasks sortOrder now)
-
- blockedHandler :: Maybe Text -> Servant.Handler BlockedPage
- blockedHandler maybeSortText = do
- now <- liftIO getCurrentTime
- blockedTasks <- liftIO TaskCore.getBlockedTasks
- allTasks <- liftIO TaskCore.loadTasks
- let sortOrder = parseSortOrder maybeSortText
- tasksWithImpact = [(t, TaskCore.getBlockingImpact allTasks t) | t <- blockedTasks]
- sorted = List.sortBy (comparing (Down <. snd)) tasksWithImpact
- pure (BlockedPage sorted sortOrder now)
-
- interventionHandler :: Maybe Text -> Servant.Handler InterventionPage
- interventionHandler maybeSortText = do
- now <- liftIO getCurrentTime
- actionItems <- liftIO TaskCore.getHumanActionItems
- let sortOrder = parseSortOrder maybeSortText
- pure (InterventionPage actionItems sortOrder now)
-
- statsHandler :: Maybe Text -> Servant.Handler StatsPage
- statsHandler maybeEpic = do
- let epicId = emptyToNothing maybeEpic
- stats <- liftIO <| TaskCore.getTaskStats epicId
- pure (StatsPage stats epicId)
-
- taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
- taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
- now <- liftIO getCurrentTime
- allTasks <- liftIO TaskCore.loadTasks
- let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
- maybePriority = parsePriority =<< emptyToNothing maybePriorityText
- maybeType = parseTaskType =<< emptyToNothing maybeTypeText
- filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
- sortOrder = parseSortOrder maybeSortText
- filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
- pure (TaskListPage filteredTasks filters sortOrder now)
-
- kbHandler :: Servant.Handler KBPage
- kbHandler = do
- facts <- liftIO Fact.getAllFacts
- pure (KBPage facts)
-
- factCreateHandler :: FactCreateForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- factCreateHandler (FactCreateForm project content filesText confText) = do
- let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
- confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
- fid <- liftIO (Fact.createFact project content files Nothing confidence)
- pure <| addHeader ("/kb/" <> tshow fid) NoContent
-
- factDetailHandler :: Int -> Servant.Handler FactDetailPage
- factDetailHandler fid = do
- now <- liftIO getCurrentTime
- maybeFact <- liftIO (Fact.getFact fid)
- case maybeFact of
- Nothing -> pure (FactDetailNotFound fid)
- Just fact -> pure (FactDetailFound fact now)
-
- factEditHandler :: Int -> FactEditForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- factEditHandler fid (FactEditForm content filesText confText) = do
- let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
- confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
- liftIO (Fact.updateFact fid content files confidence)
- pure <| addHeader ("/kb/" <> tshow fid) NoContent
-
- factDeleteHandler :: Int -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- factDeleteHandler fid = do
- liftIO (Fact.deleteFact fid)
- pure <| addHeader "/kb" NoContent
-
- epicsHandler :: Maybe Text -> Servant.Handler EpicsPage
- epicsHandler maybeSortText = do
- allTasks <- liftIO TaskCore.loadTasks
- let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks
- sortOrder = parseSortOrder maybeSortText
- sortedEpics = sortTasks sortOrder epicTasks
- pure (EpicsPage sortedEpics allTasks sortOrder)
-
- parseStatus :: Text -> Maybe TaskCore.Status
- parseStatus = readMaybe <. Text.unpack
-
- parsePriority :: Text -> Maybe TaskCore.Priority
- parsePriority = readMaybe <. Text.unpack
-
- parseTaskType :: Text -> Maybe TaskCore.TaskType
- parseTaskType = readMaybe <. Text.unpack
-
- emptyToNothing :: Maybe Text -> Maybe Text
- emptyToNothing (Just t) | Text.null (Text.strip t) = Nothing
- emptyToNothing x = x
-
- applyFilters :: TaskFilters -> [TaskCore.Task] -> [TaskCore.Task]
- applyFilters filters = filter matchesAllFilters
- where
- matchesAllFilters task =
- matchesStatus task
- && matchesPriority task
- && matchesNamespace task
- && matchesType task
-
- matchesStatus task = case filterStatus filters of
- Nothing -> True
- Just s -> TaskCore.taskStatus task == s
-
- matchesPriority task = case filterPriority filters of
- Nothing -> True
- Just p -> TaskCore.taskPriority task == p
-
- matchesNamespace task = case filterNamespace filters of
- Nothing -> True
- Just ns -> case TaskCore.taskNamespace task of
- Nothing -> False
- Just taskNs -> ns `Text.isPrefixOf` taskNs
-
- matchesType task = case filterType filters of
- Nothing -> True
- Just t -> TaskCore.taskType task == t
-
- taskDetailHandler :: Text -> Servant.Handler TaskDetailPage
- taskDetailHandler tid = do
- now <- liftIO getCurrentTime
- tasks <- liftIO TaskCore.loadTasks
- case TaskCore.findTask tid tasks of
- Nothing -> pure (TaskDetailNotFound tid)
- Just task -> do
- activities <- liftIO (TaskCore.getActivitiesForTask tid)
- retryCtx <- liftIO (TaskCore.getRetryContext tid)
- commits <- liftIO (getCommitsForTask tid)
- aggMetrics <-
- if TaskCore.taskType task == TaskCore.Epic
- then Just </ liftIO (TaskCore.getAggregatedMetrics tid)
- else pure Nothing
- agentEvents <- liftIO (TaskCore.getAllEventsForTask tid)
- pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics agentEvents now)
-
- taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
- taskStatusHandler tid (StatusForm newStatus) = do
- liftIO <| TaskCore.updateTaskStatusWithActor tid newStatus [] TaskCore.Human
- pure (StatusBadgePartial newStatus tid)
-
- taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
- taskPriorityHandler tid (PriorityForm newPriority) = do
- _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskPriority = newPriority})
- pure (PriorityBadgePartial newPriority tid)
-
- taskComplexityHandler :: Text -> ComplexityForm -> Servant.Handler ComplexityBadgePartial
- taskComplexityHandler tid (ComplexityForm newComplexity) = do
- _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskComplexity = newComplexity})
- pure (ComplexityBadgePartial newComplexity tid)
-
- descriptionViewHandler :: Text -> Servant.Handler DescriptionViewPartial
- descriptionViewHandler tid = do
- tasks <- liftIO TaskCore.loadTasks
- case TaskCore.findTask tid tasks of
- Nothing -> throwError err404
- Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
-
- descriptionEditHandler :: Text -> Servant.Handler DescriptionEditPartial
- descriptionEditHandler tid = do
- tasks <- liftIO TaskCore.loadTasks
- case TaskCore.findTask tid tasks of
- Nothing -> throwError err404
- Just task -> pure (DescriptionEditPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
-
- descriptionPostHandler :: Text -> DescriptionForm -> Servant.Handler DescriptionViewPartial
- descriptionPostHandler tid (DescriptionForm desc) = do
- let descText = Text.strip desc
- _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descText})
- tasks <- liftIO TaskCore.loadTasks
- case TaskCore.findTask tid tasks of
- Nothing -> throwError err404
- Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
-
- taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- taskNotesHandler tid (NotesForm notes) = do
- liftIO <| TaskCore.updateRetryNotes tid notes
- pure <| addHeader ("/tasks/" <> tid) NoContent
-
- taskCommentHandler :: Text -> CommentForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- taskCommentHandler tid (CommentForm commentText) = do
- _ <- liftIO (TaskCore.addComment tid commentText TaskCore.Human)
- pure <| addHeader ("/tasks/" <> tid) NoContent
-
- taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
- taskReviewHandler tid = do
- tasks <- liftIO TaskCore.loadTasks
- case TaskCore.findTask tid tasks of
- Nothing -> pure (ReviewPageNotFound tid)
- Just task -> do
- reviewInfo <- liftIO <| getReviewInfo tid
- pure (ReviewPageFound task reviewInfo)
-
- taskDiffHandler :: Text -> Text -> Servant.Handler TaskDiffPage
- taskDiffHandler tid commitSha = do
- diffOutput <- liftIO <| getDiffForCommit commitSha
- case diffOutput of
- Nothing -> pure (DiffPageNotFound tid commitSha)
- Just output -> pure (DiffPageFound tid commitSha output)
-
- taskAcceptHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- taskAcceptHandler tid = do
- liftIO <| do
- TaskCore.clearRetryContext tid
- TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.Human
- pure <| addHeader ("/tasks/" <> tid) NoContent
-
- taskRejectHandler :: Text -> RejectForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- taskRejectHandler tid (RejectForm maybeNotes) = do
- liftIO <| do
- maybeCommit <- findCommitForTask tid
- let commitSha = fromMaybe "" maybeCommit
- maybeCtx <- TaskCore.getRetryContext tid
- let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
- let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> fromMaybe "(no notes)" maybeNotes
- let accumulatedReason = case maybeCtx of
- Nothing -> currentReason
- Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
- TaskCore.setRetryContext
- TaskCore.RetryContext
- { TaskCore.retryTaskId = tid,
- TaskCore.retryOriginalCommit = commitSha,
- TaskCore.retryConflictFiles = [],
- TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = accumulatedReason,
- TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
- }
- TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
- pure <| addHeader ("/tasks/" <> tid) NoContent
-
- taskResetRetriesHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- taskResetRetriesHandler tid = do
- liftIO <| do
- TaskCore.clearRetryContext tid
- TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
- pure <| addHeader ("/tasks/" <> tid) NoContent
-
- recentActivityNewHandler :: Maybe Int -> Servant.Handler RecentActivityNewPartial
- recentActivityNewHandler maybeSince = do
- allTasks <- liftIO TaskCore.loadTasks
- let sinceTime = maybe (posixSecondsToUTCTime 0) (posixSecondsToUTCTime <. fromIntegral) maybeSince
- sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
- newTasks = filter (\t -> TaskCore.taskUpdatedAt t > sinceTime) sortedTasks
- newestTs = maybe maybeSince (Just <. taskToUnixTs) (head newTasks)
- pure (RecentActivityNewPartial newTasks newestTs)
-
- recentActivityMoreHandler :: Maybe Int -> Servant.Handler RecentActivityMorePartial
- recentActivityMoreHandler maybeOffset = do
- allTasks <- liftIO TaskCore.loadTasks
- let offset = fromMaybe 0 maybeOffset
- pageSize = 5
- sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
- pageTasks = take pageSize <| drop offset sortedTasks
- hasMore = length sortedTasks > offset + pageSize
- nextOffset = offset + pageSize
- pure (RecentActivityMorePartial pageTasks nextOffset hasMore)
-
- readyCountHandler :: Servant.Handler ReadyCountPartial
- readyCountHandler = do
- readyTasks <- liftIO TaskCore.getReadyTasks
- pure (ReadyCountPartial (length readyTasks))
-
- taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
- taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
- allTasks <- liftIO TaskCore.loadTasks
- let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
- maybePriority = parsePriority =<< emptyToNothing maybePriorityText
- maybeType = parseTaskType =<< emptyToNothing maybeTypeText
- filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
- sortOrder = parseSortOrder maybeSortText
- filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
- pure (TaskListPartial filteredTasks)
-
- taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial
- taskMetricsPartialHandler tid = do
- now <- liftIO getCurrentTime
- activities <- liftIO (TaskCore.getActivitiesForTask tid)
- maybeRetry <- liftIO (TaskCore.getRetryContext tid)
- pure (TaskMetricsPartial tid activities maybeRetry now)
-
- agentEventsPartialHandler :: Text -> Maybe Int -> Servant.Handler AgentEventsPartial
- agentEventsPartialHandler tid _maybeSince = do
- now <- liftIO getCurrentTime
- events <- liftIO (TaskCore.getAllEventsForTask tid)
- tasks <- liftIO TaskCore.loadTasks
- let isInProgress = case TaskCore.findTask tid tasks of
- Nothing -> False
- Just task -> TaskCore.taskStatus task == TaskCore.InProgress
- pure (AgentEventsPartial tid events isInProgress now)
-
- taskEventsStreamHandler :: Text -> Servant.Handler (SourceIO ByteString)
- taskEventsStreamHandler tid = do
- maybeSession <- liftIO (TaskCore.getLatestSessionForTask tid)
- case maybeSession of
- Nothing -> pure (Source.source [])
- Just sid -> liftIO (streamAgentEvents tid sid)
-
-streamAgentEvents :: Text -> Text -> IO (SourceIO ByteString)
-streamAgentEvents tid sid = do
- existingEvents <- TaskCore.getEventsForSession sid
- let lastId = if null existingEvents then 0 else maximum (map TaskCore.storedEventId existingEvents)
- let existingSSE = map eventToSSE existingEvents
- pure <| Source.fromStepT <| streamEventsStep tid sid lastId existingSSE True
-
-streamEventsStep :: Text -> Text -> Int -> [ByteString] -> Bool -> Source.StepT IO ByteString
-streamEventsStep tid sid lastId buffer sendExisting = case (sendExisting, buffer) of
- (True, b : bs) -> Source.Yield b (streamEventsStep tid sid lastId bs True)
- (True, []) -> streamEventsStep tid sid lastId [] False
- (False, _) ->
- Source.Effect <| do
- tasks <- TaskCore.loadTasks
- let isComplete = case TaskCore.findTask tid tasks of
- Nothing -> True
- Just task -> TaskCore.taskStatus task /= TaskCore.InProgress
-
- if isComplete
- then do
- let completeSSE = formatSSE "complete" "{}"
- pure <| Source.Yield completeSSE Source.Stop
- else do
- Concurrent.threadDelay 500000
- newEvents <- TaskCore.getEventsSince sid lastId
- if null newEvents
- then pure <| streamEventsStep tid sid lastId [] False
- else do
- let newLastId = maximum (map TaskCore.storedEventId newEvents)
- let newSSE = map eventToSSE newEvents
- case newSSE of
- (e : es) -> pure <| Source.Yield e (streamEventsStep tid sid newLastId es False)
- [] -> pure <| streamEventsStep tid sid newLastId [] False
-
-eventToSSE :: TaskCore.StoredEvent -> ByteString
-eventToSSE event =
- let eventType = Text.toLower (TaskCore.storedEventType event)
- content = TaskCore.storedEventContent event
- jsonData = case eventType of
- "assistant" -> Aeson.object ["content" Aeson..= content]
- "toolcall" ->
- let (tool, args) = parseToolCallContent content
- in Aeson.object ["tool" Aeson..= tool, "args" Aeson..= Aeson.object ["data" Aeson..= args]]
- "toolresult" ->
- Aeson.object ["tool" Aeson..= ("unknown" :: Text), "success" Aeson..= True, "output" Aeson..= content]
- "cost" -> Aeson.object ["cost" Aeson..= content]
- "error" -> Aeson.object ["error" Aeson..= content]
- "complete" -> Aeson.object []
- _ -> Aeson.object ["content" Aeson..= content]
- in formatSSE eventType (str (Aeson.encode jsonData))
-
-formatSSE :: Text -> ByteString -> ByteString
-formatSSE eventType jsonData =
- str
- <| "event: "
- <> eventType
- <> "\n"
- <> "data: "
- <> str jsonData
- <> "\n\n"
-
-parseToolCallContent :: Text -> (Text, Text)
-parseToolCallContent content =
- case Text.breakOn ":" content of
- (name, rest)
- | Text.null rest -> (content, "")
- | otherwise -> (Text.strip name, Text.strip (Text.drop 1 rest))
-
-taskToUnixTs :: TaskCore.Task -> Int
-taskToUnixTs t = ceiling (utcTimeToPOSIXSeconds (TaskCore.taskUpdatedAt t))
-
-getReviewInfo :: Text -> IO ReviewInfo
-getReviewInfo tid = do
- maybeCommit <- findCommitForTask tid
- case maybeCommit of
- Nothing -> pure ReviewNoCommit
- Just commitSha -> do
- conflictResult <- checkMergeConflict (Text.unpack commitSha)
- case conflictResult of
- Just conflictFiles -> pure (ReviewMergeConflict commitSha conflictFiles)
- Nothing -> do
- (_, diffOut, _) <-
- Process.readProcessWithExitCode
- "git"
- ["show", Text.unpack commitSha]
- ""
- pure (ReviewReady commitSha (Text.pack diffOut))
-
-getDiffForCommit :: Text -> IO (Maybe Text)
-getDiffForCommit commitSha = do
- (code, diffOut, _) <-
- Process.readProcessWithExitCode
- "git"
- ["show", Text.unpack commitSha]
- ""
- case code of
- Exit.ExitSuccess -> pure (Just (Text.pack diffOut))
- Exit.ExitFailure _ -> pure Nothing
-
-findCommitForTask :: Text -> IO (Maybe Text)
-findCommitForTask tid = 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 pure Nothing
- else case List.lines shaOut of
- (x : _) -> pure (Just (Text.pack x))
- [] -> pure Nothing
-
-getCommitsForTask :: Text -> IO [GitCommit]
-getCommitsForTask tid = do
- let grepArg = "--grep=Task-Id: " <> Text.unpack tid
- (code, out, _) <-
- Process.readProcessWithExitCode
- "git"
- ["log", "--pretty=format:%H|%h|%s|%an|%ar", grepArg]
- ""
- if code /= Exit.ExitSuccess || null out
- then pure []
- else do
- let commitLines = filter (not <. null) (List.lines out)
- traverse parseCommitLine commitLines
- where
- parseCommitLine :: String -> IO GitCommit
- parseCommitLine line =
- case Text.splitOn "|" (Text.pack line) of
- [sha, shortSha, summary, author, relDate] -> do
- filesCount <- getFilesChangedCount (Text.unpack sha)
- pure
- GitCommit
- { commitHash = sha,
- commitShortHash = shortSha,
- commitSummary = summary,
- commitAuthor = author,
- commitRelativeDate = relDate,
- commitFilesChanged = filesCount
- }
- _ ->
- pure
- GitCommit
- { commitHash = Text.pack line,
- commitShortHash = Text.take 7 (Text.pack line),
- commitSummary = "(parse error)",
- commitAuthor = "",
- commitRelativeDate = "",
- commitFilesChanged = 0
- }
-
- getFilesChangedCount :: String -> IO Int
- getFilesChangedCount sha = do
- (code', out', _) <-
- Process.readProcessWithExitCode
- "git"
- ["show", "--stat", "--format=", sha]
- ""
- pure
- <| if code' /= Exit.ExitSuccess
- then 0
- else
- let statLines = filter (not <. null) (List.lines out')
- in max 0 (length statLines - 1)
-
-checkMergeConflict :: String -> IO (Maybe [Text])
-checkMergeConflict commitSha = do
- (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] ""
-
- (cpCode, _, cpErr) <-
- Process.readProcessWithExitCode
- "git"
- ["cherry-pick", "--no-commit", commitSha]
- ""
-
- _ <- 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
- let errLines = Text.lines (Text.pack cpErr)
- conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
- files = mapMaybe extractConflictFile conflictLines
- pure (Just (if null files then ["(unknown files)"] else files))
-
-extractConflictFile :: Text -> Maybe Text
-extractConflictFile line =
- 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
diff --git a/Omni/Jr/Web/Pages.hs b/Omni/Jr/Web/Pages.hs
deleted file mode 100644
index b3cc8ea8..00000000
--- a/Omni/Jr/Web/Pages.hs
+++ /dev/null
@@ -1,862 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- : dep lucid
--- : dep servant-lucid
-module Omni.Jr.Web.Pages
- ( -- * Re-export page types
- module Omni.Jr.Web.Types,
- )
-where
-
-import Alpha
-import qualified Data.Text as Text
-import Data.Time (utctDayTime)
-import qualified Lucid
-import qualified Lucid.Base as Lucid
-import Numeric (showFFloat)
-import Omni.Jr.Web.Components
- ( Breadcrumb (..),
- complexityBadgeWithForm,
- metaSep,
- multiColorProgressBar,
- pageBody,
- pageBodyWithCrumbs,
- pageHead,
- priorityBadgeWithForm,
- renderAggregatedMetrics,
- renderBlockedTaskCard,
- renderEpicCardWithStats,
- renderEpicReviewCard,
- renderListGroupItem,
- renderRelativeTimestamp,
- renderRetryContextBanner,
- renderTaskCard,
- renderUnifiedTimeline,
- sortDropdown,
- statusBadge,
- statusBadgeWithForm,
- taskBreadcrumbs,
- )
-import Omni.Jr.Web.Partials ()
-import Omni.Jr.Web.Types
- ( BlockedPage (..),
- DescriptionViewPartial (..),
- EpicsPage (..),
- FactDetailPage (..),
- GitCommit (..),
- HomePage (..),
- InterventionPage (..),
- KBPage (..),
- ReadyQueuePage (..),
- ReviewInfo (..),
- SortOrder (..),
- StatsPage (..),
- TaskDetailPage (..),
- TaskDiffPage (..),
- TaskFilters (..),
- TaskListPage (..),
- TaskReviewPage (..),
- TimeRange (..),
- filterNamespace,
- filterPriority,
- filterStatus,
- sortOrderToParam,
- sortTasks,
- timeRangeToParam,
- )
-import qualified Omni.Task.Core as TaskCore
-
-taskToUnixTs :: TaskCore.Task -> Int
-taskToUnixTs t =
- let ts = TaskCore.taskUpdatedAt t
- in floor (realToFrac (utctDayTime ts) :: Double)
-
-instance Lucid.ToHtml HomePage where
- toHtmlRaw = Lucid.toHtml
- toHtml (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics currentRange _now) =
- Lucid.doctypehtml_ <| do
- pageHead "Jr Dashboard"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h2_ "Task Status"
- Lucid.div_ [Lucid.class_ "time-filter"] <| do
- timeFilterBtn "Today" Today currentRange
- timeFilterBtn "This Week" Week currentRange
- timeFilterBtn "This Month" Month currentRange
- timeFilterBtn "All Time" AllTime currentRange
- Lucid.div_ [Lucid.class_ "stats-grid"] <| do
- statCard "Open" (TaskCore.openTasks stats) "badge-open" "/tasks?status=Open"
- statCard "In Progress" (TaskCore.inProgressTasks stats) "badge-inprogress" "/tasks?status=InProgress"
- statCard "Review" (TaskCore.reviewTasks stats) "badge-review" "/tasks?status=Review"
- statCard "Approved" (TaskCore.approvedTasks stats) "badge-approved" "/tasks?status=Approved"
- statCard "Done" (TaskCore.doneTasks stats) "badge-done" "/tasks?status=Done"
- metricCard "Cost" (formatCost (TaskCore.aggTotalCostCents globalMetrics))
- metricCard "Duration" (formatDuration (TaskCore.aggTotalDurationSeconds globalMetrics))
-
- Lucid.h2_ <| do
- "Ready Queue "
- Lucid.span_
- [ Lucid.class_ "ready-count",
- Lucid.makeAttribute "hx-get" "/partials/ready-count",
- Lucid.makeAttribute "hx-trigger" "every 5s"
- ]
- <| do
- Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
- <| Lucid.toHtml ("(" <> tshow (length readyTasks) <> " tasks)")
- if null readyTasks
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks ready for work."
- else
- Lucid.div_ [Lucid.class_ "list-group"]
- <| traverse_ renderListGroupItem (take 5 readyTasks)
-
- Lucid.h2_ "Recent Activity"
- let newestTimestamp = maybe 0 taskToUnixTs (head recentTasks)
- Lucid.div_
- [ Lucid.class_ "recent-activity",
- Lucid.id_ "recent-activity",
- Lucid.makeAttribute "data-newest-ts" (tshow newestTimestamp),
- Lucid.makeAttribute "hx-get" "/partials/recent-activity-new",
- Lucid.makeAttribute "hx-trigger" "every 10s",
- Lucid.makeAttribute "hx-vals" "js:{since: document.getElementById('recent-activity')?.dataset?.newestTs || 0}",
- Lucid.makeAttribute "hx-target" "#activity-list",
- Lucid.makeAttribute "hx-swap" "afterbegin"
- ]
- <| do
- Lucid.div_ [Lucid.id_ "activity-list", Lucid.class_ "list-group"]
- <| traverse_ renderListGroupItem recentTasks
- when hasMoreRecent
- <| Lucid.button_
- [ Lucid.id_ "activity-load-more",
- Lucid.class_ "btn btn-secondary load-more-btn",
- Lucid.makeAttribute "hx-get" "/partials/recent-activity-more?offset=5",
- Lucid.makeAttribute "hx-target" "#activity-list",
- Lucid.makeAttribute "hx-swap" "beforeend"
- ]
- "Load More"
- where
- statCard :: (Monad m) => Text -> Int -> Text -> Text -> Lucid.HtmlT m ()
- statCard label count badgeClass href =
- Lucid.a_ [Lucid.href_ href, Lucid.class_ ("stat-card " <> badgeClass)] <| do
- Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count))
- Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)
-
- metricCard :: (Monad m) => Text -> Text -> Lucid.HtmlT m ()
- metricCard label value =
- Lucid.div_ [Lucid.class_ "stat-card badge-neutral"] <| do
- Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml value)
- Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)
-
- formatCost :: Int -> Text
- formatCost cents =
- let dollars = fromIntegral cents / 100.0 :: Double
- in Text.pack ("$" <> showFFloat (Just 2) dollars "")
-
- formatDuration :: Int -> Text
- formatDuration totalSeconds
- | totalSeconds < 60 = tshow totalSeconds <> "s"
- | totalSeconds < 3600 =
- let mins = totalSeconds `div` 60
- in tshow mins <> "m"
- | otherwise =
- let hours = totalSeconds `div` 3600
- mins = (totalSeconds `mod` 3600) `div` 60
- in tshow hours <> "h " <> tshow mins <> "m"
-
- timeFilterBtn :: (Monad m) => Text -> TimeRange -> TimeRange -> Lucid.HtmlT m ()
- timeFilterBtn label range current =
- let activeClass = if range == current then " active" else ""
- href = "/?" <> "range=" <> timeRangeToParam range
- in Lucid.a_
- [ Lucid.href_ href,
- Lucid.class_ ("time-filter-btn" <> activeClass)
- ]
- (Lucid.toHtml label)
-
-instance Lucid.ToHtml ReadyQueuePage where
- toHtmlRaw = Lucid.toHtml
- toHtml (ReadyQueuePage tasks currentSort _now) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Ready Queue" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Ready Queue - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "page-header-row"] <| do
- Lucid.h1_ <| Lucid.toHtml ("Ready Queue (" <> tshow (length tasks) <> " tasks)")
- sortDropdown "/ready" currentSort
- if null tasks
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks are ready for work."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
-
-instance Lucid.ToHtml BlockedPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (BlockedPage tasksWithImpact currentSort _now) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Blocked" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Blocked Tasks - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "page-header-row"] <| do
- Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasksWithImpact) <> " tasks)")
- sortDropdown "/blocked" currentSort
- Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies, sorted by blocking impact."
- if null tasksWithImpact
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No blocked tasks."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderBlockedTaskCard tasksWithImpact
-
-instance Lucid.ToHtml InterventionPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (InterventionPage actionItems currentSort _now) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Needs Human Action" Nothing]
- failed = TaskCore.failedTasks actionItems
- epicsReady = TaskCore.epicsInReview actionItems
- needsHelp = TaskCore.tasksNeedingHelp actionItems
- totalCount = length failed + length epicsReady + length needsHelp
- in Lucid.doctypehtml_ <| do
- pageHead "Needs Human Action - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "page-header-row"] <| do
- Lucid.h1_ <| Lucid.toHtml ("Needs Human Action (" <> tshow totalCount <> " items)")
- sortDropdown "/intervention" currentSort
- if totalCount == 0
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No items need human action."
- else do
- unless (null failed) <| do
- Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Failed Tasks (" <> tshow (length failed) <> ")")
- Lucid.p_ [Lucid.class_ "info-msg"] "Tasks that have failed 3+ times and need human help."
- Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort failed)
- unless (null epicsReady) <| do
- Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Epics Ready for Review (" <> tshow (length epicsReady) <> ")")
- Lucid.p_ [Lucid.class_ "info-msg"] "Epics with all children completed. Verify before closing."
- Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicReviewCard epicsReady
- unless (null needsHelp) <| do
- Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Needs Help (" <> tshow (length needsHelp) <> ")")
- Lucid.p_ [Lucid.class_ "info-msg"] "Tasks where Jr needs human guidance or decisions."
- Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort needsHelp)
-
-instance Lucid.ToHtml KBPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (KBPage facts) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Knowledge Base - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Knowledge Base"
- Lucid.p_ [Lucid.class_ "info-msg"] "Facts learned during task execution."
-
- Lucid.details_ [Lucid.class_ "create-fact-section"] <| do
- Lucid.summary_ [Lucid.class_ "btn btn-primary create-fact-toggle"] "Create New Fact"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ "/kb/create",
- Lucid.class_ "fact-create-form"
- ]
- <| do
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "project"] "Project:"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "project",
- Lucid.id_ "project",
- Lucid.class_ "form-input",
- Lucid.required_ "required",
- Lucid.placeholder_ "e.g., Omni/Jr"
- ]
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
- Lucid.textarea_
- [ Lucid.name_ "content",
- Lucid.id_ "content",
- Lucid.class_ "form-textarea",
- Lucid.rows_ "4",
- Lucid.required_ "required",
- Lucid.placeholder_ "Describe the fact or knowledge..."
- ]
- ""
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "files",
- Lucid.id_ "files",
- Lucid.class_ "form-input",
- Lucid.placeholder_ "path/to/file1.hs, path/to/file2.hs"
- ]
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
- Lucid.input_
- [ Lucid.type_ "number",
- Lucid.name_ "confidence",
- Lucid.id_ "confidence",
- Lucid.class_ "form-input",
- Lucid.step_ "0.1",
- Lucid.min_ "0",
- Lucid.max_ "1",
- Lucid.value_ "0.8"
- ]
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Create Fact"
-
- if null facts
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No facts recorded yet."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderFactCard facts
- where
- renderFactCard :: (Monad m) => TaskCore.Fact -> Lucid.HtmlT m ()
- renderFactCard f =
- let factUrl = "/kb/" <> maybe "-" tshow (TaskCore.factId f)
- in Lucid.a_
- [ Lucid.class_ "task-card task-card-link",
- Lucid.href_ factUrl
- ]
- <| do
- Lucid.div_ [Lucid.class_ "task-header"] <| do
- Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (maybe "-" tshow (TaskCore.factId f)))
- confidenceBadge (TaskCore.factConfidence f)
- Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (TaskCore.factProject f))
- Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (Text.take 80 (TaskCore.factContent f) <> if Text.length (TaskCore.factContent f) > 80 then "..." else ""))
- unless (null (TaskCore.factRelatedFiles f)) <| do
- Lucid.p_ [Lucid.class_ "kb-files"] <| do
- Lucid.span_ [Lucid.class_ "files-label"] "Files: "
- Lucid.toHtml (Text.intercalate ", " (take 3 (TaskCore.factRelatedFiles f)))
- when (length (TaskCore.factRelatedFiles f) > 3) <| do
- Lucid.toHtml (" +" <> tshow (length (TaskCore.factRelatedFiles f) - 3) <> " more")
-
- confidenceBadge :: (Monad m) => Double -> Lucid.HtmlT m ()
- confidenceBadge conf =
- let pct = floor (conf * 100) :: Int
- cls
- | conf >= 0.8 = "badge badge-done"
- | conf >= 0.5 = "badge badge-inprogress"
- | otherwise = "badge badge-open"
- in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%"))
-
-instance Lucid.ToHtml FactDetailPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (FactDetailNotFound fid) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> tshow fid) Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Fact Not Found - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Fact Not Found"
- Lucid.p_ [Lucid.class_ "error-msg"] (Lucid.toHtml ("Fact with ID " <> tshow fid <> " not found."))
- Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "btn btn-secondary"] "Back to Knowledge Base"
- toHtml (FactDetailFound fact now) =
- let fid' = maybe "-" tshow (TaskCore.factId fact)
- crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> fid') Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Fact Detail - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "task-detail-header"] <| do
- Lucid.h1_ <| do
- Lucid.span_ [Lucid.class_ "detail-id"] (Lucid.toHtml ("Fact #" <> maybe "-" tshow (TaskCore.factId fact)))
- Lucid.div_ [Lucid.class_ "task-meta-row"] <| do
- Lucid.span_ [Lucid.class_ "meta-label"] "Project:"
- Lucid.span_ [Lucid.class_ "meta-value"] (Lucid.toHtml (TaskCore.factProject fact))
- Lucid.span_ [Lucid.class_ "meta-label"] "Confidence:"
- confidenceBadgeDetail (TaskCore.factConfidence fact)
- Lucid.span_ [Lucid.class_ "meta-label"] "Created:"
- Lucid.span_ [Lucid.class_ "meta-value"] (renderRelativeTimestamp now (TaskCore.factCreatedAt fact))
-
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h2_ "Content"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/edit"),
- Lucid.class_ "fact-edit-form"
- ]
- <| do
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
- Lucid.textarea_
- [ Lucid.name_ "content",
- Lucid.id_ "content",
- Lucid.class_ "form-textarea",
- Lucid.rows_ "6"
- ]
- (Lucid.toHtml (TaskCore.factContent fact))
-
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "files",
- Lucid.id_ "files",
- Lucid.class_ "form-input",
- Lucid.value_ (Text.intercalate ", " (TaskCore.factRelatedFiles fact))
- ]
-
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
- Lucid.input_
- [ Lucid.type_ "number",
- Lucid.name_ "confidence",
- Lucid.id_ "confidence",
- Lucid.class_ "form-input",
- Lucid.step_ "0.1",
- Lucid.min_ "0",
- Lucid.max_ "1",
- Lucid.value_ (tshow (TaskCore.factConfidence fact))
- ]
-
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save Changes"
-
- case TaskCore.factSourceTask fact of
- Nothing -> pure ()
- Just tid -> do
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h2_ "Source Task"
- Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "task-link"] (Lucid.toHtml tid)
-
- Lucid.div_ [Lucid.class_ "detail-section danger-zone"] <| do
- Lucid.h2_ "Danger Zone"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/delete"),
- Lucid.class_ "delete-form",
- Lucid.makeAttribute "onsubmit" "return confirm('Are you sure you want to delete this fact?');"
- ]
- <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-danger"] "Delete Fact"
-
- Lucid.div_ [Lucid.class_ "back-link"] <| do
- Lucid.a_ [Lucid.href_ "/kb"] "← Back to Knowledge Base"
- where
- confidenceBadgeDetail :: (Monad m) => Double -> Lucid.HtmlT m ()
- confidenceBadgeDetail conf =
- let pct = floor (conf * 100) :: Int
- cls
- | conf >= 0.8 = "badge badge-done"
- | conf >= 0.5 = "badge badge-inprogress"
- | otherwise = "badge badge-open"
- in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%"))
-
-instance Lucid.ToHtml EpicsPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (EpicsPage epics allTasks currentSort) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Epics" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Epics - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "page-header-row"] <| do
- Lucid.h1_ <| Lucid.toHtml ("Epics (" <> tshow (length epics) <> ")")
- sortDropdown "/epics" currentSort
- Lucid.p_ [Lucid.class_ "info-msg"] "All epics (large, multi-task projects)."
- if null epics
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics found."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ (renderEpicCardWithStats allTasks) epics
-
-instance Lucid.ToHtml TaskListPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (TaskListPage tasks filters currentSort _now) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Tasks - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "page-header-row"] <| do
- Lucid.h1_ <| Lucid.toHtml ("Tasks (" <> tshow (length tasks) <> ")")
- sortDropdown "/tasks" currentSort
-
- Lucid.div_ [Lucid.class_ "filter-form"] <| do
- Lucid.form_
- [ Lucid.method_ "GET",
- Lucid.action_ "/tasks",
- Lucid.makeAttribute "hx-get" "/partials/task-list",
- Lucid.makeAttribute "hx-target" "#task-list",
- Lucid.makeAttribute "hx-push-url" "/tasks",
- Lucid.makeAttribute "hx-trigger" "submit, change from:select"
- ]
- <| do
- Lucid.div_ [Lucid.class_ "filter-row"] <| do
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "status"] "Status:"
- Lucid.select_ [Lucid.name_ "status", Lucid.id_ "status", Lucid.class_ "filter-select"] <| do
- Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterStatus filters)) "All"
- statusFilterOption TaskCore.Open (filterStatus filters)
- statusFilterOption TaskCore.InProgress (filterStatus filters)
- statusFilterOption TaskCore.Review (filterStatus filters)
- statusFilterOption TaskCore.Approved (filterStatus filters)
- statusFilterOption TaskCore.Done (filterStatus filters)
-
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "priority"] "Priority:"
- Lucid.select_ [Lucid.name_ "priority", Lucid.id_ "priority", Lucid.class_ "filter-select"] <| do
- Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterPriority filters)) "All"
- priorityFilterOption TaskCore.P0 (filterPriority filters)
- priorityFilterOption TaskCore.P1 (filterPriority filters)
- priorityFilterOption TaskCore.P2 (filterPriority filters)
- priorityFilterOption TaskCore.P3 (filterPriority filters)
- priorityFilterOption TaskCore.P4 (filterPriority filters)
-
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "namespace"] "Namespace:"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "namespace",
- Lucid.id_ "namespace",
- Lucid.class_ "filter-input",
- Lucid.placeholder_ "e.g. Omni/Jr",
- Lucid.value_ (fromMaybe "" (filterNamespace filters))
- ]
-
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
- Lucid.a_
- [ Lucid.href_ "/tasks",
- Lucid.class_ "clear-btn",
- Lucid.makeAttribute "hx-get" "/partials/task-list",
- Lucid.makeAttribute "hx-target" "#task-list",
- Lucid.makeAttribute "hx-push-url" "/tasks"
- ]
- "Clear"
-
- Lucid.div_ [Lucid.id_ "task-list"] <| do
- if null tasks
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
- else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks
- where
- maybeSelected :: (Eq a) => Maybe a -> Maybe a -> [Lucid.Attribute]
- maybeSelected opt current = [Lucid.selected_ "selected" | opt == current]
-
- statusFilterOption :: (Monad m) => TaskCore.Status -> Maybe TaskCore.Status -> Lucid.HtmlT m ()
- statusFilterOption s current =
- let attrs = [Lucid.value_ (tshow s)] <> [Lucid.selected_ "selected" | Just s == current]
- in Lucid.option_ attrs (Lucid.toHtml (tshow s))
-
- priorityFilterOption :: (Monad m) => TaskCore.Priority -> Maybe TaskCore.Priority -> Lucid.HtmlT m ()
- priorityFilterOption p current =
- let attrs = [Lucid.value_ (tshow p)] <> [Lucid.selected_ "selected" | Just p == current]
- in Lucid.option_ attrs (Lucid.toHtml (tshow p))
-
-instance Lucid.ToHtml TaskDetailPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (TaskDetailNotFound tid) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Task Not Found - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Task Not Found"
- Lucid.p_ <| do
- "The task "
- Lucid.code_ (Lucid.toHtml tid)
- " could not be found."
- toHtml (TaskDetailFound task allTasks _activities maybeRetry commits maybeAggMetrics agentEvents now) =
- let crumbs = taskBreadcrumbs allTasks task
- in Lucid.doctypehtml_ <| do
- pageHead (TaskCore.taskId task <> " - Jr")
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
-
- renderRetryContextBanner (TaskCore.taskId task) maybeRetry
-
- Lucid.div_ [Lucid.class_ "task-detail"] <| do
- Lucid.div_ [Lucid.class_ "task-meta"] <| do
- Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
- Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
- metaSep
- Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
- metaSep
- statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
- metaSep
- priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
- metaSep
- complexityBadgeWithForm (TaskCore.taskComplexity task) (TaskCore.taskId task)
- case TaskCore.taskNamespace task of
- Nothing -> pure ()
- Just ns -> do
- metaSep
- Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
-
- Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do
- case TaskCore.taskParent task of
- Nothing -> pure ()
- Just pid -> do
- Lucid.span_ [Lucid.class_ "task-meta-label"] "Parent:"
- Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
- metaSep
- Lucid.span_ [Lucid.class_ "task-meta-label"] "Created"
- renderRelativeTimestamp now (TaskCore.taskCreatedAt task)
- metaSep
- Lucid.span_ [Lucid.class_ "task-meta-label"] "Updated"
- renderRelativeTimestamp now (TaskCore.taskUpdatedAt task)
-
- let deps = TaskCore.taskDependencies task
- unless (null deps) <| do
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Dependencies"
- Lucid.ul_ [Lucid.class_ "dep-list"] <| do
- traverse_ renderDependency deps
-
- when (TaskCore.taskType task == TaskCore.Epic) <| do
- for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
-
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.toHtml (DescriptionViewPartial (TaskCore.taskId task) (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
-
- let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks
- unless (null children) <| do
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Child Tasks"
- Lucid.ul_ [Lucid.class_ "child-list"] <| do
- traverse_ renderChild children
-
- unless (null commits) <| do
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Git Commits"
- Lucid.div_ [Lucid.class_ "commit-list"] <| do
- traverse_ (renderCommit (TaskCore.taskId task)) commits
-
- when (TaskCore.taskStatus task == TaskCore.Review) <| do
- Lucid.div_ [Lucid.class_ "review-link-section"] <| do
- Lucid.a_
- [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"),
- Lucid.class_ "review-link-btn"
- ]
- "Review This Task"
-
- renderUnifiedTimeline (TaskCore.taskId task) (TaskCore.taskComments task) agentEvents (TaskCore.taskStatus task) now
- where
- renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
- renderDependency dep =
- Lucid.li_ <| do
- Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep))
- Lucid.span_ [Lucid.class_ "dep-type"] <| Lucid.toHtml (" [" <> tshow (TaskCore.depType dep) <> "]")
-
- renderChild :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
- renderChild child =
- Lucid.li_ <| do
- Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child))
- Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child)
- Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]")
-
- renderCommit :: (Monad m) => Text -> GitCommit -> Lucid.HtmlT m ()
- renderCommit tid c =
- Lucid.div_ [Lucid.class_ "commit-item"] <| do
- Lucid.div_ [Lucid.class_ "commit-header"] <| do
- Lucid.a_
- [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c),
- Lucid.class_ "commit-hash"
- ]
- (Lucid.toHtml (commitShortHash c))
- Lucid.span_ [Lucid.class_ "commit-summary"] (Lucid.toHtml (commitSummary c))
- Lucid.div_ [Lucid.class_ "commit-meta"] <| do
- Lucid.span_ [Lucid.class_ "commit-author"] (Lucid.toHtml (commitAuthor c))
- Lucid.span_ [Lucid.class_ "commit-date"] (Lucid.toHtml (commitRelativeDate c))
- Lucid.span_ [Lucid.class_ "commit-files"] (Lucid.toHtml (tshow (commitFilesChanged c) <> " files"))
-
-instance Lucid.ToHtml TaskReviewPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (ReviewPageNotFound tid) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Task Not Found - Jr Review"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Task Not Found"
- Lucid.p_ <| do
- "The task "
- Lucid.code_ (Lucid.toHtml tid)
- " could not be found."
- toHtml (ReviewPageFound task reviewInfo) =
- let tid = TaskCore.taskId task
- crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead ("Review: " <> TaskCore.taskId task <> " - Jr")
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Review Task"
-
- Lucid.div_ [Lucid.class_ "task-summary"] <| do
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
- Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Title:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskTitle task))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
- Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)
-
- case reviewInfo of
- ReviewNoCommit ->
- Lucid.div_ [Lucid.class_ "no-commit-msg"] <| do
- Lucid.h3_ "No Commit Found"
- Lucid.p_ "No commit with this task ID was found in the git history."
- Lucid.p_ "The worker may not have completed yet, or the commit message doesn't include the task ID."
- ReviewMergeConflict commitSha conflictFiles ->
- Lucid.div_ [Lucid.class_ "conflict-warning"] <| do
- Lucid.h3_ "Merge Conflict Detected"
- Lucid.p_ <| do
- "Commit "
- Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
- " cannot be cleanly merged."
- Lucid.p_ "Conflicting files:"
- Lucid.ul_ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflictFiles
- ReviewReady commitSha diffText -> do
- Lucid.div_ [Lucid.class_ "diff-section"] <| do
- Lucid.h3_ <| do
- "Commit: "
- Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
- Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffText)
-
- Lucid.div_ [Lucid.class_ "review-actions"] <| do
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
- Lucid.class_ "inline-form"
- ]
- <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "accept-btn"] "Accept"
-
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
- Lucid.class_ "reject-form"
- ]
- <| do
- Lucid.textarea_
- [ Lucid.name_ "notes",
- Lucid.class_ "reject-notes",
- Lucid.placeholder_ "Rejection notes (optional)"
- ]
- ""
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reject-btn"] "Reject"
-
-instance Lucid.ToHtml TaskDiffPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (DiffPageNotFound tid commitHash') =
- let shortHash = Text.take 8 commitHash'
- crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Commit Not Found - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Commit Not Found"
- Lucid.p_ <| do
- "Could not find commit "
- Lucid.code_ (Lucid.toHtml commitHash')
- Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
- toHtml (DiffPageFound tid commitHash' diffOutput) =
- let shortHash = Text.take 8 commitHash'
- crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead ("Diff " <> shortHash <> " - Jr")
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "diff-header"] <| do
- Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
- Lucid.h1_ <| do
- "Commit "
- Lucid.code_ (Lucid.toHtml shortHash)
- Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffOutput)
-
-instance Lucid.ToHtml StatsPage where
- toHtmlRaw = Lucid.toHtml
- toHtml (StatsPage stats maybeEpic) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Stats" Nothing]
- in Lucid.doctypehtml_ <| do
- pageHead "Task Statistics - Jr"
- pageBodyWithCrumbs crumbs <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ <| case maybeEpic of
- Nothing -> "Task Statistics"
- Just epicId -> Lucid.toHtml ("Statistics for Epic: " <> epicId)
-
- Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/stats", Lucid.class_ "filter-form"] <| do
- Lucid.div_ [Lucid.class_ "filter-row"] <| do
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "epic"] "Epic:"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "epic",
- Lucid.id_ "epic",
- Lucid.class_ "filter-input",
- Lucid.placeholder_ "Epic ID (optional)",
- Lucid.value_ (fromMaybe "" maybeEpic)
- ]
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
- Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "clear-btn"] "Clear"
-
- Lucid.h2_ "By Status"
- multiColorProgressBar stats
- Lucid.div_ [Lucid.class_ "stats-grid"] <| do
- statCard "Open" (TaskCore.openTasks stats) (TaskCore.totalTasks stats)
- statCard "In Progress" (TaskCore.inProgressTasks stats) (TaskCore.totalTasks stats)
- statCard "Review" (TaskCore.reviewTasks stats) (TaskCore.totalTasks stats)
- statCard "Approved" (TaskCore.approvedTasks stats) (TaskCore.totalTasks stats)
- statCard "Done" (TaskCore.doneTasks stats) (TaskCore.totalTasks stats)
-
- Lucid.h2_ "By Priority"
- Lucid.div_ [Lucid.class_ "stats-section"] <| do
- traverse_ (uncurry renderPriorityRow) (TaskCore.tasksByPriority stats)
-
- Lucid.h2_ "By Namespace"
- Lucid.div_ [Lucid.class_ "stats-section"] <| do
- if null (TaskCore.tasksByNamespace stats)
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No namespaces found."
- else traverse_ (uncurry (renderNamespaceRow (TaskCore.totalTasks stats))) (TaskCore.tasksByNamespace stats)
-
- Lucid.h2_ "Summary"
- Lucid.div_ [Lucid.class_ "summary-section"] <| do
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Total Tasks:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalTasks stats)))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Epics:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalEpics stats)))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Ready:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.readyTasks stats)))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Blocked:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.blockedTasks stats)))
- where
- statCard :: (Monad m) => Text -> Int -> Int -> Lucid.HtmlT m ()
- statCard label count total =
- let pct = if total == 0 then 0 else (count * 100) `div` total
- in Lucid.div_ [Lucid.class_ "stat-card"] <| do
- Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count))
- Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)
- Lucid.div_ [Lucid.class_ "progress-bar"] <| do
- Lucid.div_
- [ Lucid.class_ "progress-fill",
- Lucid.style_ ("width: " <> tshow pct <> "%")
- ]
- ""
-
- renderPriorityRow :: (Monad m) => TaskCore.Priority -> Int -> Lucid.HtmlT m ()
- renderPriorityRow priority count =
- let total = TaskCore.totalTasks stats
- pct = if total == 0 then 0 else (count * 100) `div` total
- in Lucid.div_ [Lucid.class_ "stats-row"] <| do
- Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml (tshow priority))
- Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do
- Lucid.div_ [Lucid.class_ "progress-bar"] <| do
- Lucid.div_
- [ Lucid.class_ "progress-fill",
- Lucid.style_ ("width: " <> tshow pct <> "%")
- ]
- ""
- Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count))
-
- renderNamespaceRow :: (Monad m) => Int -> Text -> Int -> Lucid.HtmlT m ()
- renderNamespaceRow total ns count =
- let pct = if total == 0 then 0 else (count * 100) `div` total
- in Lucid.div_ [Lucid.class_ "stats-row"] <| do
- Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml ns)
- Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do
- Lucid.div_ [Lucid.class_ "progress-bar"] <| do
- Lucid.div_
- [ Lucid.class_ "progress-fill",
- Lucid.style_ ("width: " <> tshow pct <> "%")
- ]
- ""
- Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count))
diff --git a/Omni/Jr/Web/Partials.hs b/Omni/Jr/Web/Partials.hs
deleted file mode 100644
index 2660441b..00000000
--- a/Omni/Jr/Web/Partials.hs
+++ /dev/null
@@ -1,274 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- : dep lucid
--- : dep servant-lucid
-module Omni.Jr.Web.Partials
- ( -- Re-export instances for use by Web.hs
- )
-where
-
-import Alpha
-import qualified Data.Text as Text
-import Data.Time (UTCTime, diffUTCTime)
-import qualified Lucid
-import qualified Lucid.Base as Lucid
-import Numeric (showFFloat)
-import Omni.Jr.Web.Components
- ( aggregateCostMetrics,
- commentForm,
- complexityBadgeWithForm,
- formatCostHeader,
- formatTokensHeader,
- metaSep,
- priorityBadgeWithForm,
- renderAutoscrollToggle,
- renderListGroupItem,
- renderLiveToggle,
- renderMarkdown,
- renderRelativeTimestamp,
- renderTimelineEvent,
- statusBadgeWithForm,
- timelineScrollScript,
- )
-import Omni.Jr.Web.Types
- ( AgentEventsPartial (..),
- ComplexityBadgePartial (..),
- DescriptionEditPartial (..),
- DescriptionViewPartial (..),
- PriorityBadgePartial (..),
- ReadyCountPartial (..),
- RecentActivityMorePartial (..),
- RecentActivityNewPartial (..),
- StatusBadgePartial (..),
- TaskListPartial (..),
- TaskMetricsPartial (..),
- )
-import qualified Omni.Task.Core as TaskCore
-
-instance Lucid.ToHtml RecentActivityNewPartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (RecentActivityNewPartial tasks maybeNewestTs) = do
- traverse_ renderListGroupItem tasks
- case maybeNewestTs of
- Nothing -> pure ()
- Just ts ->
- Lucid.div_
- [ Lucid.id_ "recent-activity",
- Lucid.makeAttribute "data-newest-ts" (tshow ts),
- Lucid.makeAttribute "hx-swap-oob" "attributes:#recent-activity data-newest-ts"
- ]
- ""
-
-instance Lucid.ToHtml RecentActivityMorePartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (RecentActivityMorePartial tasks nextOffset hasMore) = do
- traverse_ renderListGroupItem tasks
- if hasMore
- then
- Lucid.button_
- [ Lucid.id_ "activity-load-more",
- Lucid.class_ "btn btn-secondary load-more-btn",
- Lucid.makeAttribute "hx-get" ("/partials/recent-activity-more?offset=" <> tshow nextOffset),
- Lucid.makeAttribute "hx-target" "#activity-list",
- Lucid.makeAttribute "hx-swap" "beforeend",
- Lucid.makeAttribute "hx-swap-oob" "true"
- ]
- "Load More"
- else Lucid.span_ [Lucid.id_ "activity-load-more", Lucid.makeAttribute "hx-swap-oob" "true"] ""
-
-instance Lucid.ToHtml ReadyCountPartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (ReadyCountPartial count) =
- Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
- <| Lucid.toHtml ("(" <> tshow count <> " tasks)")
-
-instance Lucid.ToHtml StatusBadgePartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (StatusBadgePartial status tid) =
- statusBadgeWithForm status tid
-
-instance Lucid.ToHtml PriorityBadgePartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (PriorityBadgePartial priority tid) =
- priorityBadgeWithForm priority tid
-
-instance Lucid.ToHtml ComplexityBadgePartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (ComplexityBadgePartial complexity tid) =
- complexityBadgeWithForm complexity tid
-
-instance Lucid.ToHtml TaskListPartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (TaskListPartial tasks) =
- if null tasks
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
- else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks
-
-instance Lucid.ToHtml TaskMetricsPartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (TaskMetricsPartial _tid activities maybeRetry now) =
- let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) activities
- in if null runningActs
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
- else
- Lucid.div_ [Lucid.class_ "execution-details"] <| do
- let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
- totalDuration = sum [calcDurSecs act | act <- runningActs]
- attemptCount = length runningActs
-
- case maybeRetry of
- Nothing -> pure ()
- Just ctx ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
- Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))
-
- when (attemptCount > 1) <| do
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
- when (totalCost > 0)
- <| Lucid.div_ [Lucid.class_ "metric-row"]
- <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost totalCost))
- Lucid.hr_ [Lucid.class_ "attempts-divider"]
-
- traverse_ (renderAttempt attemptCount now) (zip [1 ..] (reverse runningActs))
- where
- calcDurSecs :: TaskCore.TaskActivity -> Int
- calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
- (Just start, Just end) -> floor (diffUTCTime end start)
- _ -> 0
-
- formatDurSecs :: Int -> Text
- formatDurSecs secs
- | secs < 60 = tshow secs <> "s"
- | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s"
- | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m"
-
- renderAttempt :: (Monad m) => Int -> UTCTime -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m ()
- renderAttempt totalAttempts currentTime (attemptNum, act) = do
- when (totalAttempts > 1)
- <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text))
- case TaskCore.activityThreadUrl act of
- Nothing -> pure ()
- Just url ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Session:"
- Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗"
-
- case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
- (Just start, Just end) ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration start end))
- (Just start, Nothing) ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
- Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime start)
- _ -> pure ()
-
- case TaskCore.activityCostCents act of
- Nothing -> pure ()
- Just cents ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost cents))
-
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:"
- Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime (TaskCore.activityTimestamp act))
-
- formatDuration :: UTCTime -> UTCTime -> Text
- formatDuration start end =
- let diffSecs = floor (diffUTCTime end start) :: Int
- mins = diffSecs `div` 60
- secs = diffSecs `mod` 60
- in if mins > 0
- then tshow mins <> "m " <> tshow secs <> "s"
- else tshow secs <> "s"
-
- formatCost :: Int -> Text
- formatCost cents =
- let dollars = fromIntegral cents / 100.0 :: Double
- in "$" <> Text.pack (showFFloat (Just 2) dollars "")
-
-instance Lucid.ToHtml DescriptionViewPartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (DescriptionViewPartial tid desc isEpic) =
- Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block"] <| do
- Lucid.div_ [Lucid.class_ "description-header"] <| do
- Lucid.h3_ (if isEpic then "Design" else "Description")
- Lucid.a_
- [ Lucid.href_ "#",
- Lucid.class_ "edit-link",
- Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/edit"),
- Lucid.makeAttribute "hx-target" "#description-block",
- Lucid.makeAttribute "hx-swap" "outerHTML"
- ]
- "Edit"
- if Text.null desc
- then Lucid.p_ [Lucid.class_ "empty-msg"] (if isEpic then "No design document yet." else "No description yet.")
- else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc)
-
-instance Lucid.ToHtml DescriptionEditPartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (DescriptionEditPartial tid desc isEpic) =
- Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block editing"] <| do
- Lucid.div_ [Lucid.class_ "description-header"] <| do
- Lucid.h3_ (if isEpic then "Design" else "Description")
- Lucid.button_
- [ Lucid.type_ "button",
- Lucid.class_ "cancel-link",
- Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/view"),
- Lucid.makeAttribute "hx-target" "#description-block",
- Lucid.makeAttribute "hx-swap" "outerHTML",
- Lucid.makeAttribute "hx-confirm" "Discard changes?"
- ]
- "Cancel"
- Lucid.form_
- [ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/description"),
- Lucid.makeAttribute "hx-target" "#description-block",
- Lucid.makeAttribute "hx-swap" "outerHTML"
- ]
- <| do
- Lucid.textarea_
- [ Lucid.name_ "description",
- Lucid.class_ "description-textarea",
- Lucid.rows_ (if isEpic then "15" else "10"),
- Lucid.placeholder_ (if isEpic then "Enter design in Markdown..." else "Enter description...")
- ]
- (Lucid.toHtml desc)
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save"
-
-instance Lucid.ToHtml AgentEventsPartial where
- toHtmlRaw = Lucid.toHtml
- toHtml (AgentEventsPartial tid events isInProgress now) = do
- let nonCostEvents = filter (\e -> TaskCore.storedEventType e /= "Cost") events
- eventCount = length nonCostEvents
- (totalCents, totalTokens) = aggregateCostMetrics events
- Lucid.h3_ <| do
- Lucid.toHtml ("Timeline (" <> tshow eventCount <> ")")
- when (totalCents > 0 || totalTokens > 0) <| do
- Lucid.span_ [Lucid.class_ "timeline-cost-summary"] <| do
- metaSep
- when (totalCents > 0) <| Lucid.toHtml (formatCostHeader totalCents)
- when (totalCents > 0 && totalTokens > 0) <| metaSep
- when (totalTokens > 0) <| Lucid.toHtml (formatTokensHeader totalTokens <> " tokens")
- when isInProgress <| do
- renderLiveToggle
- renderAutoscrollToggle
- if null nonCostEvents
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
- else do
- Lucid.div_ [Lucid.class_ "timeline-events"] <| do
- traverse_ (renderTimelineEvent now) nonCostEvents
- when isInProgress <| timelineScrollScript
- commentForm tid
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
deleted file mode 100644
index f75b33c1..00000000
--- a/Omni/Jr/Web/Style.hs
+++ /dev/null
@@ -1,2260 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- : dep clay
-module Omni.Jr.Web.Style
- ( css,
- statusBadgeClass,
- priorityBadgeClass,
- )
-where
-
-import Alpha hiding (wrap, (**), (|>))
-import Clay
-import qualified Clay.Flexbox as Flexbox
-import qualified Clay.Media as Media
-import qualified Clay.Stylesheet as Stylesheet
-import qualified Data.Text.Lazy as LazyText
-
-css :: LazyText.Text
-css = render stylesheet
-
-stylesheet :: Css
-stylesheet = do
- baseStyles
- layoutStyles
- navigationStyles
- breadcrumbStyles
- cardStyles
- listGroupStyles
- statusBadges
- buttonStyles
- formStyles
- executionDetailsStyles
- activityTimelineStyles
- commitStyles
- markdownStyles
- retryBannerStyles
- commentStyles
- taskMetaStyles
- timeFilterStyles
- sortDropdownStyles
- timelineEventStyles
- unifiedTimelineStyles
- responsiveStyles
- darkModeStyles
-
-baseStyles :: Css
-baseStyles = do
- star ? boxSizing borderBox
- html <> body ? do
- margin (px 0) (px 0) (px 0) (px 0)
- padding (px 0) (px 0) (px 0) (px 0)
- body ? do
- fontFamily
- [ "-apple-system",
- "BlinkMacSystemFont",
- "Segoe UI",
- "Roboto",
- "Helvetica Neue",
- "Arial",
- "Noto Sans",
- "sans-serif"
- ]
- [sansSerif]
- fontSize (px 14)
- lineHeight (em 1.3)
- color "#1f2937"
- backgroundColor "#f5f5f5"
- minHeight (vh 100)
- "h1" ? do
- fontSize (px 20)
- fontWeight bold
- margin (px 0) (px 0) (em 0.3) (px 0)
- "h2" ? do
- fontSize (px 16)
- fontWeight (weight 600)
- color "#374151"
- margin (em 1) (px 0) (em 0.5) (px 0)
- "h3" ? do
- fontSize (px 14)
- fontWeight (weight 600)
- color "#374151"
- margin (em 0.75) (px 0) (em 0.25) (px 0)
- a ? do
- color "#0066cc"
- textDecoration none
- a # hover ? textDecoration underline
- code ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (em 0.9)
- backgroundColor "#f3f4f6"
- padding (px 1) (px 4) (px 1) (px 4)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- pre ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- backgroundColor "#1e1e1e"
- color "#d4d4d4"
- padding (px 8) (px 8) (px 8) (px 8)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- overflow auto
- whiteSpace preWrap
- maxHeight (px 500)
-
-layoutStyles :: Css
-layoutStyles = do
- ".container" ? do
- width (pct 100)
- maxWidth (px 960)
- margin (px 0) auto (px 0) auto
- padding (px 8) (px 12) (px 8) (px 12)
- main_ ? do
- Stylesheet.key "flex" ("1 0 auto" :: Text)
- ".page-content" ? do
- padding (px 0) (px 0) (px 0) (px 0)
- ".stats-grid" ? do
- display grid
- Stylesheet.key "grid-template-columns" ("repeat(auto-fit, minmax(80px, 1fr))" :: Text)
- Stylesheet.key "gap" ("6px" :: Text)
- ".task-list" ? do
- display flex
- flexDirection column
- Stylesheet.key "gap" ("2px" :: Text)
- ".detail-row" ? do
- display flex
- flexWrap Flexbox.wrap
- padding (px 6) (px 0) (px 6) (px 0)
- marginBottom (px 4)
- ".detail-label" ? do
- fontWeight (weight 600)
- width (px 100)
- color "#6b7280"
- minWidth (px 80)
- fontSize (px 13)
- ".detail-value" ? do
- Stylesheet.key "flex" ("1" :: Text)
- minWidth (px 0)
- ".detail-section" ? do
- marginTop (em 0.75)
- paddingTop (em 0.75)
- borderTop (px 1) solid "#e5e7eb"
- ".dep-list" <> ".child-list" ? do
- margin (px 4) (px 0) (px 4) (px 0)
- paddingLeft (px 16)
- (".dep-list" ** li) <> (".child-list" ** li) ? margin (px 2) (px 0) (px 2) (px 0)
- ".dep-type" <> ".child-status" ? do
- color "#6b7280"
- fontSize (px 12)
- ".child-title" ? color "#374151"
- ".priority-desc" ? do
- color "#6b7280"
- marginLeft (px 4)
-
-navigationStyles :: Css
-navigationStyles = do
- ".navbar" ? do
- backgroundColor white
- padding (px 6) (px 12) (px 6) (px 12)
- borderBottom (px 1) solid "#d0d0d0"
- marginBottom (px 8)
- display flex
- alignItems center
- justifyContent spaceBetween
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("8px" :: Text)
- ".navbar-brand" ? do
- fontSize (px 18)
- fontWeight bold
- color "#0066cc"
- textDecoration none
- ".navbar-brand" # hover ? textDecoration none
- ".navbar-toggle-checkbox" ? display none
- ".navbar-hamburger" ? do
- display none
- flexDirection column
- justifyContent center
- alignItems center
- width (px 32)
- height (px 32)
- cursor pointer
- Stylesheet.key "gap" ("4px" :: Text)
- ".hamburger-line" ? do
- display block
- width (px 20)
- height (px 2)
- backgroundColor "#374151"
- borderRadius (px 1) (px 1) (px 1) (px 1)
- transition "all" (ms 200) ease (sec 0)
- ".navbar-links" ? do
- display flex
- Stylesheet.key "gap" ("2px" :: Text)
- flexWrap Flexbox.wrap
- alignItems center
- ".navbar-link" ? do
- display inlineBlock
- padding (px 4) (px 10) (px 4) (px 10)
- color "#374151"
- textDecoration none
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 13)
- fontWeight (weight 500)
- transition "background-color" (ms 150) ease (sec 0)
- ".navbar-link" # hover ? do
- backgroundColor "#f3f4f6"
- textDecoration none
- ".navbar-dropdown" ? do
- position relative
- display inlineBlock
- ".navbar-dropdown-btn" ? do
- display inlineBlock
- padding (px 4) (px 10) (px 4) (px 10)
- color "#374151"
- backgroundColor transparent
- border (px 0) none transparent
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 13)
- fontWeight (weight 500)
- cursor pointer
- transition "background-color" (ms 150) ease (sec 0)
- ".navbar-dropdown-btn" # hover ? backgroundColor "#f3f4f6"
- ".navbar-dropdown-content" ? do
- display none
- position absolute
- left (px 0)
- top (pct 100)
- backgroundColor white
- minWidth (px 120)
- Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- zIndex 100
- Stylesheet.key "overflow" ("hidden" :: Text)
- ".navbar-dropdown" # hover |> ".navbar-dropdown-content" ? display block
- ".navbar-dropdown.open" |> ".navbar-dropdown-content" ? display block
- ".navbar-dropdown-item" ? do
- display block
- padding (px 8) (px 12) (px 8) (px 12)
- color "#374151"
- textDecoration none
- fontSize (px 13)
- transition "background-color" (ms 150) ease (sec 0)
- ".navbar-dropdown-item" # hover ? do
- backgroundColor "#f3f4f6"
- textDecoration none
- header ? do
- backgroundColor white
- padding (px 6) (px 12) (px 6) (px 12)
- borderBottom (px 1) solid "#d0d0d0"
- marginBottom (px 8)
- ".nav-content" ? do
- maxWidth (px 960)
- margin (px 0) auto (px 0) auto
- display flex
- alignItems center
- justifyContent spaceBetween
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("8px" :: Text)
- ".nav-brand" ? do
- fontSize (px 16)
- fontWeight bold
- color "#1f2937"
- textDecoration none
- ".nav-brand" # hover ? textDecoration none
- ".nav-links" ? do
- display flex
- Stylesheet.key "gap" ("4px" :: Text)
- flexWrap Flexbox.wrap
- ".actions" ? do
- display flex
- flexDirection row
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("6px" :: Text)
- marginBottom (px 8)
-
-breadcrumbStyles :: Css
-breadcrumbStyles = do
- ".breadcrumb-container" ? do
- backgroundColor transparent
- padding (px 6) (px 0) (px 6) (px 0)
- ".breadcrumb-list" ? do
- display flex
- alignItems center
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("4px" :: Text)
- margin (px 0) (px 0) (px 0) (px 0)
- padding (px 0) (px 0) (px 0) (px 0)
- listStyleType none
- fontSize (px 12)
- ".breadcrumb-item" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("4px" :: Text)
- ".breadcrumb-sep" ? do
- color "#9ca3af"
- Stylesheet.key "user-select" ("none" :: Text)
- ".breadcrumb-current" ? do
- color "#6b7280"
- fontWeight (weight 500)
- (".breadcrumb-list" ** a) ? do
- color "#0066cc"
- textDecoration none
- (".breadcrumb-list" ** a) # hover ? textDecoration underline
-
-cardStyles :: Css
-cardStyles = do
- ".card"
- <> ".task-card"
- <> ".stat-card"
- <> ".task-detail"
- <> ".task-summary"
- <> ".filter-form"
- <> ".status-form"
- <> ".diff-section"
- <> ".review-actions"
- ? do
- backgroundColor white
- borderRadius (px 2) (px 2) (px 2) (px 2)
- padding (px 8) (px 10) (px 8) (px 10)
- border (px 1) solid "#d0d0d0"
- ".review-actions" ? do
- display flex
- flexDirection row
- flexWrap Flexbox.wrap
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- ".stat-card" ? textAlign center
- ".stat-count" ? do
- fontSize (px 22)
- fontWeight bold
- ".stat-label" ? do
- fontSize (px 11)
- color "#6b7280"
- marginTop (px 2)
- ".stat-card.badge-open" ? do
- borderLeft (px 4) solid "#f59e0b"
- (".stat-card.badge-open" |> ".stat-count") ? color "#92400e"
- ".stat-card.badge-inprogress" ? borderLeft (px 4) solid "#3b82f6"
- (".stat-card.badge-inprogress" |> ".stat-count") ? color "#1e40af"
- ".stat-card.badge-review" ? borderLeft (px 4) solid "#8b5cf6"
- (".stat-card.badge-review" |> ".stat-count") ? color "#6b21a8"
- ".stat-card.badge-approved" ? borderLeft (px 4) solid "#06b6d4"
- (".stat-card.badge-approved" |> ".stat-count") ? color "#0e7490"
- ".stat-card.badge-done" ? borderLeft (px 4) solid "#10b981"
- (".stat-card.badge-done" |> ".stat-count") ? color "#065f46"
- ".stat-card.badge-neutral" ? borderLeft (px 4) solid "#6b7280"
- (".stat-card.badge-neutral" |> ".stat-count") ? color "#374151"
- ".task-card" ? do
- transition "border-color" (ms 150) ease (sec 0)
- ".task-card" # hover ? do
- borderColor "#999"
- ".task-card-link" ? do
- display block
- textDecoration none
- color inherit
- cursor pointer
- ".task-card-link" # hover ? textDecoration none
- ".task-header" ? do
- display flex
- flexWrap Flexbox.wrap
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- marginBottom (px 4)
- ".task-id" ? do
- fontFamily ["SF Mono", "Monaco", "monospace"] [monospace]
- color "#0066cc"
- textDecoration none
- fontSize (px 12)
- padding (px 2) (px 0) (px 2) (px 0)
- ".task-id" # hover ? textDecoration underline
- ".priority" ? do
- fontSize (px 11)
- color "#6b7280"
- ".blocking-impact" ? do
- fontSize (px 10)
- color "#6b7280"
- backgroundColor "#e5e7eb"
- padding (px 1) (px 6) (px 1) (px 6)
- borderRadius (px 8) (px 8) (px 8) (px 8)
- marginLeft auto
- ".task-title" ? do
- fontSize (px 14)
- margin (px 0) (px 0) (px 0) (px 0)
- ".empty-msg" ? do
- color "#6b7280"
- fontStyle italic
- ".info-msg" ? do
- color "#6b7280"
- marginBottom (px 12)
- ".kb-preview" ? do
- color "#6b7280"
- fontSize (px 12)
- marginTop (px 4)
- overflow hidden
- Stylesheet.key "text-overflow" ("ellipsis" :: Text)
- ".ready-link" ? do
- fontSize (px 13)
- color "#0066cc"
- ".count-badge" ? do
- backgroundColor "#0066cc"
- color white
- padding (px 2) (px 8) (px 2) (px 8)
- borderRadius (px 10) (px 10) (px 10) (px 10)
- fontSize (px 12)
- verticalAlign middle
- ".description" ? do
- backgroundColor "#f9fafb"
- padding (px 8) (px 8) (px 8) (px 8)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- margin (px 0) (px 0) (px 0) (px 0)
- color "#374151"
- fontSize (px 13)
- ".description-block" ? do
- pure ()
- ".description-header" ? do
- display flex
- justifyContent spaceBetween
- alignItems center
- marginBottom (px 8)
- (".description-header" |> "h3") ? do
- margin (px 0) (px 0) (px 0) (px 0)
- ".edit-link" <> ".cancel-link" ? do
- fontSize (px 12)
- color "#0066cc"
- "button.cancel-link" ? do
- color "#dc2626"
- backgroundColor transparent
- border (px 0) solid transparent
- padding (px 0) (px 0) (px 0) (px 0)
- cursor pointer
- textDecoration underline
- ".diff-block" ? do
- maxHeight (px 600)
- overflowY auto
- ".progress-bar" ? do
- height (px 6)
- backgroundColor "#e5e7eb"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- overflow hidden
- marginTop (px 6)
- ".progress-fill" ? do
- height (pct 100)
- backgroundColor "#0066cc"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- transition "width" (ms 300) ease (sec 0)
- ".multi-progress-container" ? do
- marginBottom (px 12)
- ".multi-progress-bar" ? do
- display flex
- height (px 8)
- backgroundColor "#e5e7eb"
- borderRadius (px 4) (px 4) (px 4) (px 4)
- overflow hidden
- marginTop (px 6)
- ".multi-progress-segment" ? do
- height (pct 100)
- transition "width" (ms 300) ease (sec 0)
- ".progress-done" ? backgroundColor "#10b981"
- ".progress-inprogress" ? backgroundColor "#f59e0b"
- ".progress-open" ? backgroundColor "#3b82f6"
- ".progress-legend" ? do
- display flex
- Stylesheet.key "gap" ("16px" :: Text)
- marginTop (px 6)
- fontSize (px 12)
- color "#6b7280"
- ".legend-item" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("4px" :: Text)
- ".legend-dot" ? do
- display inlineBlock
- width (px 10)
- height (px 10)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- ".legend-done" ? backgroundColor "#10b981"
- ".legend-inprogress" ? backgroundColor "#f59e0b"
- ".legend-open" ? backgroundColor "#3b82f6"
- ".stats-section" ? do
- backgroundColor white
- borderRadius (px 2) (px 2) (px 2) (px 2)
- padding (px 8) (px 10) (px 8) (px 10)
- border (px 1) solid "#d0d0d0"
- ".stats-row" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- padding (px 4) (px 0) (px 4) (px 0)
- marginBottom (px 2)
- ".stats-label" ? do
- minWidth (px 80)
- fontWeight (weight 500)
- fontSize (px 13)
- ".stats-bar-container" ? do
- Stylesheet.key "flex" ("1" :: Text)
- ".stats-count" ? do
- minWidth (px 32)
- textAlign (alignSide sideRight)
- fontWeight (weight 500)
- fontSize (px 13)
- ".summary-section" ? do
- backgroundColor white
- borderRadius (px 2) (px 2) (px 2) (px 2)
- padding (px 8) (px 10) (px 8) (px 10)
- border (px 1) solid "#d0d0d0"
- ".no-commit-msg" ? do
- backgroundColor "#fff3cd"
- border (px 1) solid "#ffc107"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- padding (px 8) (px 10) (px 8) (px 10)
- margin (px 8) (px 0) (px 8) (px 0)
- ".conflict-warning" ? do
- backgroundColor "#fee2e2"
- border (px 1) solid "#ef4444"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- padding (px 8) (px 10) (px 8) (px 10)
- margin (px 8) (px 0) (px 8) (px 0)
-
-listGroupStyles :: Css
-listGroupStyles = do
- ".list-group" ? do
- display flex
- flexDirection column
- backgroundColor white
- borderRadius (px 2) (px 2) (px 2) (px 2)
- border (px 1) solid "#d0d0d0"
- overflow hidden
- ".list-group-item" ? do
- display flex
- alignItems center
- justifyContent spaceBetween
- padding (px 8) (px 10) (px 8) (px 10)
- borderBottom (px 1) solid "#e5e7eb"
- textDecoration none
- color inherit
- transition "background-color" (ms 150) ease (sec 0)
- ".list-group-item" # lastChild ? borderBottom (px 0) none transparent
- ".list-group-item" # hover ? do
- backgroundColor "#f9fafb"
- textDecoration none
- ".list-group-item-content" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- Stylesheet.key "flex" ("1" :: Text)
- minWidth (px 0)
- overflow hidden
- ".list-group-item-id" ? do
- fontFamily ["SF Mono", "Monaco", "monospace"] [monospace]
- color "#0066cc"
- fontSize (px 12)
- flexShrink 0
- ".list-group-item-title" ? do
- fontSize (px 13)
- color "#374151"
- overflow hidden
- Stylesheet.key "text-overflow" ("ellipsis" :: Text)
- whiteSpace nowrap
- ".list-group-item-meta" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- flexShrink 0
-
-statusBadges :: Css
-statusBadges = do
- ".badge" ? do
- display inlineBlock
- padding (px 2) (px 6) (px 2) (px 6)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 11)
- fontWeight (weight 500)
- whiteSpace nowrap
- ".badge-open" ? do
- backgroundColor "#fef3c7"
- color "#92400e"
- ".badge-inprogress" ? do
- backgroundColor "#dbeafe"
- color "#1e40af"
- ".badge-review" ? do
- backgroundColor "#ede9fe"
- color "#6b21a8"
- ".badge-approved" ? do
- backgroundColor "#cffafe"
- color "#0e7490"
- ".badge-done" ? do
- backgroundColor "#d1fae5"
- color "#065f46"
- ".badge-needshelp" ? do
- backgroundColor "#fef3c7"
- color "#92400e"
- ".status-badge-dropdown" ? do
- position relative
- display inlineBlock
- ".status-badge-clickable" ? do
- cursor pointer
- Stylesheet.key "user-select" ("none" :: Text)
- ".status-badge-clickable" # hover ? do
- opacity 0.85
- ".dropdown-arrow" ? do
- fontSize (px 8)
- marginLeft (px 2)
- opacity 0.7
- ".status-dropdown-menu" ? do
- display none
- position absolute
- left (px 0)
- top (pct 100)
- marginTop (px 2)
- backgroundColor white
- borderRadius (px 4) (px 4) (px 4) (px 4)
- Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
- zIndex 100
- padding (px 4) (px 4) (px 4) (px 4)
- minWidth (px 100)
- ".status-badge-dropdown.open" |> ".status-dropdown-menu" ? do
- display block
- ".status-option-form" ? do
- margin (px 0) (px 0) (px 0) (px 0)
- padding (px 0) (px 0) (px 0) (px 0)
- ".status-dropdown-option" ? do
- display block
- width (pct 100)
- textAlign (alignSide sideLeft)
- margin (px 2) (px 0) (px 2) (px 0)
- border (px 0) none transparent
- cursor pointer
- transition "opacity" (ms 150) ease (sec 0)
- ".status-dropdown-option" # hover ? do
- opacity 0.7
- ".status-dropdown-option" # focus ? do
- opacity 0.85
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("1px" :: Text)
- ".status-dropdown-option.selected" ? do
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("1px" :: Text)
- ".status-badge-clickable" # focus ? do
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("2px" :: Text)
- ".badge-p0" ? do
- backgroundColor "#fee2e2"
- color "#991b1b"
- ".badge-p1" ? do
- backgroundColor "#fef3c7"
- color "#92400e"
- ".badge-p2" ? do
- backgroundColor "#dbeafe"
- color "#1e40af"
- ".badge-p3" ? do
- backgroundColor "#e5e7eb"
- color "#4b5563"
- ".badge-p4" ? do
- backgroundColor "#f3f4f6"
- color "#6b7280"
- ".priority-badge-dropdown" ? do
- position relative
- display inlineBlock
- ".priority-badge-clickable" ? do
- cursor pointer
- Stylesheet.key "user-select" ("none" :: Text)
- ".priority-badge-clickable" # hover ? do
- opacity 0.85
- ".priority-dropdown-menu" ? do
- display none
- position absolute
- left (px 0)
- top (pct 100)
- marginTop (px 2)
- backgroundColor white
- borderRadius (px 4) (px 4) (px 4) (px 4)
- Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
- zIndex 100
- padding (px 4) (px 4) (px 4) (px 4)
- minWidth (px 100)
- ".priority-badge-dropdown.open" |> ".priority-dropdown-menu" ? do
- display block
- ".priority-option-form" ? do
- margin (px 0) (px 0) (px 0) (px 0)
- padding (px 0) (px 0) (px 0) (px 0)
- ".priority-dropdown-option" ? do
- display block
- width (pct 100)
- textAlign (alignSide sideLeft)
- margin (px 2) (px 0) (px 2) (px 0)
- border (px 0) none transparent
- cursor pointer
- transition "opacity" (ms 150) ease (sec 0)
- ".priority-dropdown-option" # hover ? do
- opacity 0.7
- ".priority-dropdown-option" # focus ? do
- opacity 0.85
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("1px" :: Text)
- ".priority-dropdown-option.selected" ? do
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("1px" :: Text)
- ".priority-badge-clickable" # focus ? do
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("2px" :: Text)
- ".badge-complexity" ? do
- backgroundColor "#f0f9ff"
- color "#0c4a6e"
- ".badge-complexity-1" ? do
- backgroundColor "#f0fdf4"
- color "#166534"
- ".badge-complexity-2" ? do
- backgroundColor "#f0f9ff"
- color "#075985"
- ".badge-complexity-3" ? do
- backgroundColor "#fef3c7"
- color "#92400e"
- ".badge-complexity-4" ? do
- backgroundColor "#fef3c7"
- color "#b45309"
- ".badge-complexity-5" ? do
- backgroundColor "#fee2e2"
- color "#991b1b"
- ".badge-complexity-none" ? do
- backgroundColor "#f3f4f6"
- color "#6b7280"
- ".complexity-badge-dropdown" ? do
- position relative
- display inlineBlock
- ".complexity-badge-clickable" ? do
- cursor pointer
- Stylesheet.key "user-select" ("none" :: Text)
- ".complexity-badge-clickable" # hover ? do
- opacity 0.85
- ".complexity-dropdown-menu" ? do
- display none
- position absolute
- left (px 0)
- top (pct 100)
- marginTop (px 2)
- backgroundColor white
- borderRadius (px 4) (px 4) (px 4) (px 4)
- Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
- zIndex 100
- padding (px 4) (px 4) (px 4) (px 4)
- minWidth (px 100)
- ".complexity-badge-dropdown.open" |> ".complexity-dropdown-menu" ? do
- display block
- ".complexity-option-form" ? do
- margin (px 0) (px 0) (px 0) (px 0)
- padding (px 0) (px 0) (px 0) (px 0)
- ".complexity-dropdown-option" ? do
- display block
- width (pct 100)
- textAlign (alignSide sideLeft)
- margin (px 2) (px 0) (px 2) (px 0)
- border (px 0) none transparent
- cursor pointer
- transition "opacity" (ms 150) ease (sec 0)
- ".complexity-dropdown-option" # hover ? do
- opacity 0.7
- ".complexity-dropdown-option" # focus ? do
- opacity 0.85
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("1px" :: Text)
- ".complexity-dropdown-option.selected" ? do
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("1px" :: Text)
- ".complexity-badge-clickable" # focus ? do
- Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
- Stylesheet.key "outline-offset" ("2px" :: Text)
-
-buttonStyles :: Css
-buttonStyles = do
- ".btn"
- <> ".action-btn"
- <> ".filter-btn"
- <> ".submit-btn"
- <> ".accept-btn"
- <> ".reject-btn"
- <> ".review-link-btn"
- ? do
- display inlineBlock
- minHeight (px 32)
- padding (px 6) (px 12) (px 6) (px 12)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- border (px 0) none transparent
- fontSize (px 13)
- fontWeight (weight 500)
- textDecoration none
- cursor pointer
- textAlign center
- transition "all" (ms 150) ease (sec 0)
- Stylesheet.key "touch-action" ("manipulation" :: Text)
- ".action-btn" ? do
- backgroundColor white
- border (px 1) solid "#d1d5db"
- color "#374151"
- ".action-btn" # hover ? do
- backgroundColor "#f9fafb"
- borderColor "#9ca3af"
- ".action-btn-primary" <> ".filter-btn" <> ".submit-btn" ? do
- backgroundColor "#0066cc"
- color white
- borderColor "#0066cc"
- ".action-btn-primary"
- # hover
- <> ".filter-btn"
- # hover
- <> ".submit-btn"
- # hover
- ? do
- backgroundColor "#0052a3"
- ".accept-btn" ? do
- backgroundColor "#10b981"
- color white
- ".accept-btn" # hover ? backgroundColor "#059669"
- ".reject-btn" ? do
- backgroundColor "#ef4444"
- color white
- ".reject-btn" # hover ? backgroundColor "#dc2626"
- ".clear-btn" ? do
- display inlineBlock
- minHeight (px 32)
- padding (px 6) (px 10) (px 6) (px 10)
- backgroundColor "#6b7280"
- color white
- borderRadius (px 2) (px 2) (px 2) (px 2)
- textDecoration none
- fontSize (px 13)
- cursor pointer
- ".clear-btn" # hover ? backgroundColor "#4b5563"
- ".review-link-btn" ? do
- backgroundColor "#8b5cf6"
- color white
- ".review-link-btn" # hover ? backgroundColor "#7c3aed"
- ".review-link-section" ? margin (px 8) (px 0) (px 8) (px 0)
- ".btn-secondary" <> ".load-more-btn" ? do
- backgroundColor "#6b7280"
- color white
- width (pct 100)
- marginTop (px 8)
- ".btn-secondary" # hover <> ".load-more-btn" # hover ? backgroundColor "#4b5563"
-
-formStyles :: Css
-formStyles = do
- ".filter-row" ? do
- display flex
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("8px" :: Text)
- alignItems flexEnd
- ".filter-group" ? do
- display flex
- flexDirection row
- alignItems center
- Stylesheet.key "gap" ("4px" :: Text)
- (".filter-group" |> label) ? do
- fontSize (px 12)
- color "#6b7280"
- fontWeight (weight 500)
- whiteSpace nowrap
- ".filter-select" <> ".filter-input" <> ".status-select" ? do
- minHeight (px 32)
- padding (px 6) (px 10) (px 6) (px 10)
- border (px 1) solid "#d1d5db"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 13)
- minWidth (px 100)
- ".filter-input" ? minWidth (px 120)
- ".inline-form" ? display inlineBlock
- ".reject-form" ? do
- display flex
- Stylesheet.key "gap" ("6px" :: Text)
- Stylesheet.key "flex" ("1" :: Text)
- minWidth (px 200)
- flexWrap Flexbox.wrap
- ".reject-notes" ? do
- Stylesheet.key "flex" ("1" :: Text)
- minWidth (px 160)
- minHeight (px 32)
- padding (px 6) (px 10) (px 6) (px 10)
- border (px 1) solid "#d1d5db"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 13)
- Stylesheet.key "resize" ("vertical" :: Text)
- ".edit-description" ? do
- marginTop (px 8)
- padding (px 8) (px 0) (px 0) (px 0)
- borderTop (px 1) solid "#e5e7eb"
- (".edit-description" |> "summary") ? do
- cursor pointer
- color "#0066cc"
- fontSize (px 13)
- fontWeight (weight 500)
- (".edit-description" |> "summary") # hover ? textDecoration underline
- ".description-textarea" ? do
- width (pct 100)
- minHeight (px 250)
- padding (px 8) (px 10) (px 8) (px 10)
- border (px 1) solid "#d1d5db"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 13)
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- lineHeight (em 1.5)
- Stylesheet.key "resize" ("vertical" :: Text)
- marginTop (px 8)
- ".form-actions" ? do
- display flex
- flexDirection row
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("8px" :: Text)
- marginTop (px 8)
- ".fact-edit-form" ? do
- marginTop (px 8)
- ".form-group" ? do
- marginBottom (px 16)
- (".form-group" |> label) ? do
- display block
- marginBottom (px 4)
- fontSize (px 13)
- fontWeight (weight 500)
- color "#374151"
- ".form-input" <> ".form-textarea" ? do
- width (pct 100)
- padding (px 8) (px 10) (px 8) (px 10)
- border (px 1) solid "#d1d5db"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 14)
- lineHeight (em 1.5)
- ".form-input" # focus <> ".form-textarea" # focus ? do
- borderColor "#0066cc"
- Stylesheet.key "outline" ("none" :: Text)
- Stylesheet.key "box-shadow" ("0 0 0 2px rgba(0, 102, 204, 0.2)" :: Text)
- ".form-textarea" ? do
- minHeight (px 120)
- Stylesheet.key "resize" ("vertical" :: Text)
- fontFamily
- [ "-apple-system",
- "BlinkMacSystemFont",
- "Segoe UI",
- "Roboto",
- "Helvetica Neue",
- "Arial",
- "sans-serif"
- ]
- [sansSerif]
- ".btn" ? do
- display inlineBlock
- padding (px 8) (px 16) (px 8) (px 16)
- border (px 0) none transparent
- borderRadius (px 3) (px 3) (px 3) (px 3)
- fontSize (px 14)
- fontWeight (weight 500)
- textDecoration none
- cursor pointer
- transition "all" (ms 150) ease (sec 0)
- ".btn-primary" ? do
- backgroundColor "#0066cc"
- color white
- ".btn-primary" # hover ? backgroundColor "#0052a3"
- ".btn-secondary" ? do
- backgroundColor "#6b7280"
- color white
- ".btn-secondary" # hover ? backgroundColor "#4b5563"
- ".btn-danger" ? do
- backgroundColor "#dc2626"
- color white
- ".btn-danger" # hover ? backgroundColor "#b91c1c"
- ".danger-zone" ? do
- marginTop (px 24)
- padding (px 16) (px 16) (px 16) (px 16)
- backgroundColor "#fef2f2"
- border (px 1) solid "#fecaca"
- borderRadius (px 4) (px 4) (px 4) (px 4)
- (".danger-zone" |> h2) ? do
- color "#dc2626"
- marginBottom (px 12)
- ".back-link" ? do
- marginTop (px 24)
- paddingTop (px 16)
- borderTop (px 1) solid "#e5e7eb"
- (".back-link" |> a) ? do
- color "#6b7280"
- textDecoration none
- (".back-link" |> a) # hover ? do
- color "#374151"
- textDecoration underline
- ".task-link" ? do
- color "#0066cc"
- textDecoration none
- fontWeight (weight 500)
- ".task-link" # hover ? textDecoration underline
- ".error-msg" ? do
- color "#dc2626"
- backgroundColor "#fef2f2"
- padding (px 16) (px 16) (px 16) (px 16)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- border (px 1) solid "#fecaca"
- ".create-fact-section" ? do
- marginBottom (px 16)
- ".create-fact-toggle" ? do
- cursor pointer
- display inlineBlock
- ".fact-create-form" ? do
- marginTop (px 12)
- padding (px 16) (px 16) (px 16) (px 16)
- backgroundColor white
- borderRadius (px 4) (px 4) (px 4) (px 4)
- border (px 1) solid "#d1d5db"
-
-executionDetailsStyles :: Css
-executionDetailsStyles = do
- ".execution-section" ? do
- marginTop (em 1)
- backgroundColor white
- borderRadius (px 2) (px 2) (px 2) (px 2)
- padding (px 8) (px 10) (px 8) (px 10)
- border (px 1) solid "#d0d0d0"
- ".execution-details" ? do
- marginTop (px 8)
- ".metric-row" ? do
- display flex
- flexWrap Flexbox.wrap
- padding (px 4) (px 0) (px 4) (px 0)
- marginBottom (px 2)
- ".metric-label" ? do
- fontWeight (weight 600)
- width (px 120)
- color "#6b7280"
- fontSize (px 13)
- ".metric-value" ? do
- Stylesheet.key "flex" ("1" :: Text)
- fontSize (px 13)
- ".amp-link" ? do
- color "#0066cc"
- textDecoration none
- wordBreak breakAll
- ".amp-link" # hover ? textDecoration underline
- ".amp-thread-btn" ? do
- display inlineBlock
- padding (px 4) (px 10) (px 4) (px 10)
- backgroundColor "#7c3aed"
- color white
- borderRadius (px 3) (px 3) (px 3) (px 3)
- textDecoration none
- fontSize (px 12)
- fontWeight (weight 500)
- transition "background-color" (ms 150) ease (sec 0)
- ".amp-thread-btn" # hover ? do
- backgroundColor "#6d28d9"
- textDecoration none
- ".retry-count" ? do
- color "#f97316"
- fontWeight (weight 600)
- ".attempts-divider" ? do
- margin (px 12) (px 0) (px 12) (px 0)
- border (px 0) none transparent
- borderTop (px 1) solid "#e5e7eb"
- ".attempt-header" ? do
- fontWeight (weight 600)
- fontSize (px 13)
- color "#374151"
- marginTop (px 8)
- marginBottom (px 4)
- paddingBottom (px 4)
- borderBottom (px 1) solid "#f3f4f6"
- ".aggregated-metrics" ? do
- marginTop (em 0.5)
- paddingTop (em 0.75)
- ".metrics-grid" ? do
- display grid
- Stylesheet.key "grid-template-columns" ("repeat(auto-fit, minmax(100px, 1fr))" :: Text)
- Stylesheet.key "gap" ("10px" :: Text)
- marginTop (px 8)
- ".metric-card" ? do
- backgroundColor "#f9fafb"
- border (px 1) solid "#e5e7eb"
- borderRadius (px 4) (px 4) (px 4) (px 4)
- padding (px 10) (px 12) (px 10) (px 12)
- textAlign center
- (".metric-card" |> ".metric-value") ? do
- fontSize (px 20)
- fontWeight bold
- color "#374151"
- display block
- marginBottom (px 2)
- width auto
- (".metric-card" |> ".metric-label") ? do
- fontSize (px 11)
- color "#6b7280"
- fontWeight (weight 400)
- width auto
-
-activityTimelineStyles :: Css
-activityTimelineStyles = do
- ".activity-section" ? do
- marginTop (em 1)
- backgroundColor white
- borderRadius (px 2) (px 2) (px 2) (px 2)
- padding (px 8) (px 10) (px 8) (px 10)
- border (px 1) solid "#d0d0d0"
- ".activity-timeline" ? do
- position relative
- paddingLeft (px 20)
- marginTop (px 8)
- ".activity-timeline" # before ? do
- Stylesheet.key "content" ("''" :: Text)
- position absolute
- left (px 6)
- top (px 0)
- bottom (px 0)
- width (px 2)
- backgroundColor "#e5e7eb"
- ".activity-item" ? do
- position relative
- display flex
- Stylesheet.key "gap" ("8px" :: Text)
- paddingBottom (px 10)
- marginBottom (px 0)
- ".activity-item" # lastChild ? paddingBottom (px 0)
- ".activity-icon" ? do
- position absolute
- left (px (-16))
- width (px 14)
- height (px 14)
- borderRadius (pct 50) (pct 50) (pct 50) (pct 50)
- display flex
- alignItems center
- justifyContent center
- fontSize (px 8)
- fontWeight bold
- backgroundColor white
- border (px 2) solid "#e5e7eb"
- ".activity-content" ? do
- Stylesheet.key "flex" ("1" :: Text)
- ".activity-header" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- marginBottom (px 2)
- ".activity-stage" ? do
- fontWeight (weight 600)
- fontSize (px 12)
- ".activity-time" ? do
- fontSize (px 11)
- color "#6b7280"
- ".activity-message" ? do
- margin (px 2) (px 0) (px 0) (px 0)
- fontSize (px 12)
- color "#374151"
- ".activity-metadata" ? do
- marginTop (px 4)
- (".activity-metadata" |> "summary") ? do
- fontSize (px 11)
- color "#6b7280"
- cursor pointer
- ".metadata-json" ? do
- fontSize (px 10)
- backgroundColor "#f3f4f6"
- padding (px 4) (px 6) (px 4) (px 6)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- marginTop (px 2)
- maxHeight (px 150)
- overflow auto
- ".stage-claiming" |> ".activity-icon" ? do
- borderColor "#3b82f6"
- color "#3b82f6"
- ".stage-running" |> ".activity-icon" ? do
- borderColor "#f59e0b"
- color "#f59e0b"
- ".stage-reviewing" |> ".activity-icon" ? do
- borderColor "#8b5cf6"
- color "#8b5cf6"
- ".stage-retrying" |> ".activity-icon" ? do
- borderColor "#f97316"
- color "#f97316"
- ".stage-completed" |> ".activity-icon" ? do
- borderColor "#10b981"
- color "#10b981"
- ".stage-failed" |> ".activity-icon" ? do
- borderColor "#ef4444"
- color "#ef4444"
-
-commitStyles :: Css
-commitStyles = do
- ".commit-list" ? do
- display flex
- flexDirection column
- Stylesheet.key "gap" ("4px" :: Text)
- marginTop (px 8)
- ".commit-item" ? do
- padding (px 6) (px 8) (px 6) (px 8)
- backgroundColor "#f9fafb"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- border (px 1) solid "#e5e7eb"
- ".commit-header" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- marginBottom (px 2)
- ".commit-hash" ? do
- fontFamily ["SF Mono", "Monaco", "monospace"] [monospace]
- fontSize (px 12)
- color "#0066cc"
- textDecoration none
- backgroundColor "#e5e7eb"
- padding (px 1) (px 4) (px 1) (px 4)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- ".commit-hash" # hover ? textDecoration underline
- ".commit-summary" ? do
- fontSize (px 13)
- color "#374151"
- fontWeight (weight 500)
- ".commit-meta" ? do
- display flex
- Stylesheet.key "gap" ("12px" :: Text)
- fontSize (px 11)
- color "#6b7280"
- ".commit-author" ? fontWeight (weight 500)
- ".commit-files" ? do
- color "#9ca3af"
-
-markdownStyles :: Css
-markdownStyles = do
- ".markdown-content" ? do
- width (pct 100)
- lineHeight (em 1.6)
- fontSize (px 14)
- color "#374151"
- ".md-h1" ? do
- fontSize (px 18)
- fontWeight bold
- margin (em 1) (px 0) (em 0.5) (px 0)
- paddingBottom (em 0.3)
- borderBottom (px 1) solid "#e5e7eb"
- ".md-h2" ? do
- fontSize (px 16)
- fontWeight (weight 600)
- margin (em 0.8) (px 0) (em 0.4) (px 0)
- ".md-h3" ? do
- fontSize (px 14)
- fontWeight (weight 600)
- margin (em 0.6) (px 0) (em 0.3) (px 0)
- ".md-para" ? do
- margin (em 0.5) (px 0) (em 0.5) (px 0)
- ".md-code" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- backgroundColor "#f8f8f8"
- color "#333333"
- padding (px 10) (px 12) (px 10) (px 12)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- border (px 1) solid "#e1e4e8"
- overflow auto
- whiteSpace preWrap
- margin (em 0.5) (px 0) (em 0.5) (px 0)
- ".md-list" ? do
- margin (em 0.5) (px 0) (em 0.5) (px 0)
- paddingLeft (px 24)
- (".md-list" ** li) ? do
- margin (px 4) (px 0) (px 4) (px 0)
- ".md-inline-code" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (em 0.9)
- backgroundColor "#f3f4f6"
- padding (px 1) (px 4) (px 1) (px 4)
- borderRadius (px 2) (px 2) (px 2) (px 2)
-
-retryBannerStyles :: Css
-retryBannerStyles = do
- ".retry-banner" ? do
- borderRadius (px 4) (px 4) (px 4) (px 4)
- padding (px 12) (px 16) (px 12) (px 16)
- margin (px 0) (px 0) (px 16) (px 0)
- ".retry-banner-warning" ? do
- backgroundColor "#fef3c7"
- border (px 1) solid "#f59e0b"
- ".retry-banner-critical" ? do
- backgroundColor "#fee2e2"
- border (px 1) solid "#ef4444"
- ".retry-banner-header" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- marginBottom (px 8)
- ".retry-icon" ? do
- fontSize (px 18)
- fontWeight bold
- ".retry-attempt" ? do
- fontSize (px 14)
- fontWeight (weight 600)
- color "#374151"
- ".retry-warning-badge" ? do
- backgroundColor "#dc2626"
- color white
- fontSize (px 11)
- fontWeight (weight 600)
- padding (px 2) (px 8) (px 2) (px 8)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- marginLeft auto
- ".retry-banner-details" ? do
- fontSize (px 13)
- color "#374151"
- ".retry-detail-row" ? do
- display flex
- alignItems flexStart
- Stylesheet.key "gap" ("8px" :: Text)
- margin (px 4) (px 0) (px 4) (px 0)
- ".retry-label" ? do
- fontWeight (weight 500)
- minWidth (px 110)
- flexShrink 0
- ".retry-value" ? do
- color "#4b5563"
- ".retry-commit" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (em 0.9)
- backgroundColor "#f3f4f6"
- padding (px 1) (px 4) (px 1) (px 4)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- ".retry-conflict-list" ? do
- margin (px 0) (px 0) (px 0) (px 0)
- padding (px 0) (px 0) (px 0) (px 16)
- (".retry-conflict-list" ** li) ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- margin (px 2) (px 0) (px 2) (px 0)
- ".retry-warning-message" ? do
- marginTop (px 12)
- padding (px 10) (px 12) (px 10) (px 12)
- backgroundColor "#fecaca"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 12)
- color "#991b1b"
- fontWeight (weight 500)
- ".retry-hint" ? do
- marginTop (px 8)
- fontSize (px 12)
- color "#6b7280"
- fontStyle italic
-
-commentStyles :: Css
-commentStyles = do
- ".comments-section" ? do
- marginTop (px 12)
- ".comment-card" ? do
- backgroundColor "#f9fafb"
- border (px 1) solid "#e5e7eb"
- borderRadius (px 4) (px 4) (px 4) (px 4)
- padding (px 10) (px 12) (px 10) (px 12)
- marginBottom (px 8)
- ".comment-text" ? do
- margin (px 0) (px 0) (px 6) (px 0)
- fontSize (px 13)
- color "#374151"
- whiteSpace preWrap
- ".comment-meta" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- ".comment-author" ? do
- display inlineBlock
- padding (px 2) (px 6) (px 2) (px 6)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- fontSize (px 10)
- fontWeight (weight 600)
- textTransform uppercase
- whiteSpace nowrap
- ".author-human" ? do
- backgroundColor "#dbeafe"
- color "#1e40af"
- ".author-junior" ? do
- backgroundColor "#d1fae5"
- color "#065f46"
- ".comment-time" ? do
- fontSize (px 11)
- color "#9ca3af"
- ".comment-form" ? do
- marginTop (px 12)
- display flex
- flexDirection column
- Stylesheet.key "gap" ("8px" :: Text)
- ".comment-textarea" ? do
- width (pct 100)
- padding (px 8) (px 10) (px 8) (px 10)
- fontSize (px 13)
- border (px 1) solid "#d0d0d0"
- borderRadius (px 4) (px 4) (px 4) (px 4)
- Stylesheet.key "resize" ("vertical" :: Text)
- minHeight (px 60)
- ".comment-textarea" # focus ? do
- Stylesheet.key "outline" ("none" :: Text)
- borderColor "#0066cc"
-
-timeFilterStyles :: Css
-timeFilterStyles = do
- ".time-filter" ? do
- display flex
- Stylesheet.key "gap" ("6px" :: Text)
- marginBottom (px 12)
- flexWrap Flexbox.wrap
- ".time-filter-btn" ? do
- display inlineBlock
- padding (px 4) (px 12) (px 4) (px 12)
- fontSize (px 12)
- fontWeight (weight 500)
- textDecoration none
- borderRadius (px 12) (px 12) (px 12) (px 12)
- border (px 1) solid "#d0d0d0"
- backgroundColor white
- color "#374151"
- transition "all" (ms 150) ease (sec 0)
- cursor pointer
- ".time-filter-btn" # hover ? do
- borderColor "#999"
- backgroundColor "#f3f4f6"
- textDecoration none
- ".time-filter-btn.active" ? do
- backgroundColor "#0066cc"
- borderColor "#0066cc"
- color white
- ".time-filter-btn.active" # hover ? do
- backgroundColor "#0055aa"
- borderColor "#0055aa"
-
-sortDropdownStyles :: Css
-sortDropdownStyles = do
- ".page-header-row" ? do
- display flex
- alignItems center
- justifyContent spaceBetween
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("12px" :: Text)
- marginBottom (px 8)
- ".page-header-row" |> "h1" ? do
- margin (px 0) (px 0) (px 0) (px 0)
- ".sort-dropdown" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- fontSize (px 13)
- ".sort-label" ? do
- color "#6b7280"
- fontWeight (weight 500)
- ".sort-dropdown-wrapper" ? do
- position relative
- ".sort-dropdown-btn" ? do
- padding (px 4) (px 10) (px 4) (px 10)
- fontSize (px 13)
- fontWeight (weight 500)
- border (px 1) solid "#d0d0d0"
- borderRadius (px 4) (px 4) (px 4) (px 4)
- backgroundColor white
- color "#374151"
- cursor pointer
- transition "all" (ms 150) ease (sec 0)
- whiteSpace nowrap
- ".sort-dropdown-btn" # hover ? do
- borderColor "#999"
- backgroundColor "#f3f4f6"
- ".sort-dropdown-content" ? do
- minWidth (px 160)
- right (px 0)
- left auto
- ".sort-dropdown-item" ? do
- padding (px 8) (px 12) (px 8) (px 12)
- fontSize (px 13)
- ".sort-dropdown-item.active" ? do
- backgroundColor "#e0f2fe"
- fontWeight (weight 600)
-
-taskMetaStyles :: Css
-taskMetaStyles = do
- ".task-meta" ? do
- marginBottom (px 12)
- ".task-meta-primary" ? do
- display flex
- alignItems center
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("6px" :: Text)
- fontSize (px 14)
- marginBottom (px 4)
- ".task-meta-secondary" ? do
- display flex
- alignItems center
- flexWrap Flexbox.wrap
- Stylesheet.key "gap" ("6px" :: Text)
- fontSize (px 12)
- color "#6b7280"
- ".task-meta-id" ? do
- fontFamily ["SF Mono", "Monaco", "monospace"] [monospace]
- fontSize (px 13)
- backgroundColor "#f3f4f6"
- padding (px 1) (px 4) (px 1) (px 4)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- ".task-meta-label" ? do
- color "#6b7280"
- ".meta-sep" ? do
- color "#d1d5db"
- Stylesheet.key "user-select" ("none" :: Text)
-
-timelineEventStyles :: Css
-timelineEventStyles = do
- ".event-header" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- marginBottom (px 4)
- ".event-icon" ? do
- fontSize (px 14)
- width (px 20)
- textAlign center
- ".event-label" ? do
- fontWeight (weight 500)
- color "#374151"
- ".event-assistant" ? do
- padding (px 0) (px 0) (px 0) (px 0)
- ".event-bubble" ? do
- backgroundColor "#f3f4f6"
- padding (px 8) (px 12) (px 8) (px 12)
- borderRadius (px 8) (px 8) (px 8) (px 8)
- whiteSpace preWrap
- lineHeight (em 1.5)
- ".event-truncated" ? do
- color "#6b7280"
- fontStyle italic
- ".event-tool-call" ? do
- borderLeft (px 3) solid "#3b82f6"
- paddingLeft (px 8)
- ".event-tool-call" |> "summary" ? do
- cursor pointer
- listStyleType none
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- ".event-tool-call" |> "summary" # before ? do
- content (stringContent "▶")
- fontSize (px 10)
- color "#6b7280"
- transition "transform" (ms 150) ease (sec 0)
- ".event-tool-call[open]" |> "summary" # before ? do
- Stylesheet.key "transform" ("rotate(90deg)" :: Text)
- ".tool-name" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- color "#3b82f6"
- ".tool-summary" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- color "#6b7280"
- marginLeft (px 8)
- ".tool-args" ? do
- marginTop (px 4)
- paddingLeft (px 20)
- ".tool-output-pre" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 11)
- backgroundColor "#1e1e1e"
- color "#d4d4d4"
- padding (px 8) (px 10) (px 8) (px 10)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- overflowX auto
- whiteSpace preWrap
- maxHeight (px 300)
- margin (px 0) (px 0) (px 0) (px 0)
- ".event-tool-result" ? do
- borderLeft (px 3) solid "#10b981"
- paddingLeft (px 8)
- ".result-header" ? do
- fontSize (px 12)
- ".line-count" ? do
- fontSize (px 11)
- color "#6b7280"
- backgroundColor "#f3f4f6"
- padding (px 1) (px 6) (px 1) (px 6)
- borderRadius (px 10) (px 10) (px 10) (px 10)
- ".result-collapsible" |> "summary" ? do
- cursor pointer
- fontSize (px 12)
- color "#0066cc"
- marginBottom (px 4)
- ".result-collapsible" |> "summary" # hover ? textDecoration underline
- ".tool-output" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 11)
- backgroundColor "#1e1e1e"
- color "#d4d4d4"
- padding (px 8) (px 10) (px 8) (px 10)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- overflowX auto
- whiteSpace preWrap
- maxHeight (px 300)
- margin (px 0) (px 0) (px 0) (px 0)
- ".event-cost" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- fontSize (px 11)
- color "#6b7280"
- padding (px 4) (px 0) (px 4) (px 0)
- ".cost-text" ? do
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- ".event-error" ? do
- borderLeft (px 3) solid "#ef4444"
- paddingLeft (px 8)
- backgroundColor "#fef2f2"
- padding (px 8) (px 8) (px 8) (px 12)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- ".event-error" |> ".event-label" ? color "#dc2626"
- ".error-message" ? do
- color "#dc2626"
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- whiteSpace preWrap
- ".event-complete" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("8px" :: Text)
- color "#10b981"
- fontWeight (weight 500)
- padding (px 8) (px 0) (px 8) (px 0)
- ".output-collapsible" |> "summary" ? do
- cursor pointer
- fontSize (px 12)
- color "#0066cc"
- marginBottom (px 4)
- ".output-collapsible" |> "summary" # hover ? textDecoration underline
- Stylesheet.key "@keyframes pulse" ("0%, 100% { opacity: 1; } 50% { opacity: 0.5; }" :: Text)
-
-unifiedTimelineStyles :: Css
-unifiedTimelineStyles = do
- ".unified-timeline-section" ? do
- marginTop (em 1.5)
- paddingTop (em 1)
- borderTop (px 1) solid "#e5e7eb"
- ".timeline-live-toggle" ? do
- fontSize (px 10)
- fontWeight bold
- color "#10b981"
- backgroundColor "#d1fae5"
- padding (px 2) (px 6) (px 2) (px 6)
- borderRadius (px 10) (px 10) (px 10) (px 10)
- marginLeft (px 8)
- textTransform uppercase
- border (px 1) solid "#6ee7b7"
- cursor pointer
- Stylesheet.key "transition" ("all 0.3s ease" :: Text)
- Stylesheet.key "animation" ("pulse 2s infinite" :: Text)
- ".timeline-live-toggle:hover" ? do
- Stylesheet.key "box-shadow" ("0 0 8px rgba(16,185,129,0.4)" :: Text)
- ".timeline-live-toggle.timeline-live-paused" ? do
- color "#6b7280"
- backgroundColor "#f3f4f6"
- border (px 1) solid "#d1d5db"
- Stylesheet.key "animation" ("none" :: Text)
- ".timeline-autoscroll-toggle" ? do
- fontSize (px 10)
- fontWeight bold
- color "#3b82f6"
- backgroundColor "#dbeafe"
- padding (px 2) (px 6) (px 2) (px 6)
- borderRadius (px 10) (px 10) (px 10) (px 10)
- marginLeft (px 4)
- border (px 1) solid "#93c5fd"
- cursor pointer
- Stylesheet.key "transition" ("all 0.2s ease" :: Text)
- ".timeline-autoscroll-toggle:hover" ? do
- Stylesheet.key "box-shadow" ("0 0 6px rgba(59,130,246,0.3)" :: Text)
- ".timeline-autoscroll-toggle.timeline-autoscroll-disabled" ? do
- color "#6b7280"
- backgroundColor "#f3f4f6"
- border (px 1) solid "#d1d5db"
- ".timeline-live" ? do
- fontSize (px 10)
- fontWeight bold
- color "#10b981"
- backgroundColor "#d1fae5"
- padding (px 2) (px 6) (px 2) (px 6)
- borderRadius (px 10) (px 10) (px 10) (px 10)
- marginLeft (px 8)
- textTransform uppercase
- Stylesheet.key "animation" ("pulse 2s infinite" :: Text)
- ".timeline-events" ? do
- maxHeight (px 600)
- overflowY auto
- display flex
- flexDirection column
- Stylesheet.key "gap" ("12px" :: Text)
- padding (px 12) (px 0) (px 12) (px 0)
- ".timeline-event" ? do
- fontSize (px 13)
- lineHeight (em 1.4)
- ".actor-label" ? do
- fontSize (px 11)
- fontWeight (weight 500)
- padding (px 1) (px 4) (px 1) (px 4)
- borderRadius (px 3) (px 3) (px 3) (px 3)
- marginLeft (px 4)
- marginRight (px 4)
- ".actor-human" ? do
- color "#7c3aed"
- backgroundColor "#f3e8ff"
- ".actor-junior" ? do
- color "#0369a1"
- backgroundColor "#e0f2fe"
- ".actor-system" ? do
- color "#6b7280"
- backgroundColor "#f3f4f6"
- ".timeline-comment" ? do
- paddingLeft (px 4)
- ".timeline-comment" |> ".comment-bubble" ? do
- backgroundColor "#f3f4f6"
- color "#1f2937"
- padding (px 10) (px 14) (px 10) (px 14)
- borderRadius (px 8) (px 8) (px 8) (px 8)
- whiteSpace preWrap
- marginTop (px 6)
- ".timeline-status-change" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- flexWrap Flexbox.wrap
- padding (px 6) (px 8) (px 6) (px 8)
- backgroundColor "#f0fdf4"
- borderRadius (px 6) (px 6) (px 6) (px 6)
- borderLeft (px 3) solid "#22c55e"
- ".status-change-text" ? do
- fontWeight (weight 500)
- color "#166534"
- ".timeline-activity" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- flexWrap Flexbox.wrap
- padding (px 4) (px 0) (px 4) (px 0)
- color "#6b7280"
- ".activity-detail" ? do
- fontSize (px 11)
- color "#9ca3af"
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- ".timeline-error" ? do
- borderLeft (px 3) solid "#ef4444"
- backgroundColor "#fef2f2"
- padding (px 8) (px 12) (px 8) (px 12)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- ".timeline-error" |> ".error-message" ? do
- marginTop (px 6)
- color "#dc2626"
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- whiteSpace preWrap
- ".timeline-thought" ? do
- paddingLeft (px 4)
- ".timeline-thought" |> ".thought-bubble" ? do
- backgroundColor "#fef3c7"
- color "#78350f"
- padding (px 8) (px 12) (px 8) (px 12)
- borderRadius (px 8) (px 8) (px 8) (px 8)
- whiteSpace preWrap
- marginTop (px 6)
- fontSize (px 12)
- lineHeight (em 1.5)
- ".timeline-tool-call" ? do
- borderLeft (px 3) solid "#3b82f6"
- paddingLeft (px 8)
- ".timeline-tool-call" |> "summary" ? do
- cursor pointer
- listStyleType none
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- ".timeline-tool-call" |> "summary" # before ? do
- content (stringContent "▶")
- fontSize (px 10)
- color "#6b7280"
- transition "transform" (ms 150) ease (sec 0)
- ".timeline-tool-call[open]" |> "summary" # before ? do
- Stylesheet.key "transform" ("rotate(90deg)" :: Text)
- ".timeline-tool-result" ? do
- borderLeft (px 3) solid "#10b981"
- paddingLeft (px 8)
- ".timeline-tool-result" |> "summary" ? do
- cursor pointer
- listStyleType none
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- ".timeline-cost" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- fontSize (px 11)
- color "#6b7280"
- padding (px 2) (px 0) (px 2) (px 0)
- ".timeline-checkpoint" ? do
- borderLeft (px 3) solid "#8b5cf6"
- backgroundColor "#faf5ff"
- padding (px 8) (px 12) (px 8) (px 12)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- ".timeline-checkpoint" |> ".checkpoint-content" ? do
- marginTop (px 6)
- fontSize (px 12)
- whiteSpace preWrap
- ".timeline-guardrail" ? do
- borderLeft (px 3) solid "#f59e0b"
- backgroundColor "#fffbeb"
- padding (px 8) (px 12) (px 8) (px 12)
- borderRadius (px 4) (px 4) (px 4) (px 4)
- ".timeline-guardrail" |> ".guardrail-content" ? do
- marginTop (px 6)
- fontSize (px 12)
- color "#92400e"
- ".timeline-generic" ? do
- padding (px 4) (px 0) (px 4) (px 0)
- color "#6b7280"
- ".formatted-json" ? do
- margin (px 0) (px 0) (px 0) (px 0)
- padding (px 8) (px 8) (px 8) (px 8)
- backgroundColor "#f9fafb"
- borderRadius (px 4) (px 4) (px 4) (px 4)
- overflowX auto
- fontSize (px 12)
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- whiteSpace preWrap
- overflowWrap breakWord
- compactToolStyles
-
-compactToolStyles :: Css
-compactToolStyles = do
- ".tool-compact" ? do
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- padding (px 2) (px 0) (px 2) (px 0)
- ".tool-check" ? do
- color "#10b981"
- fontWeight bold
- ".tool-label" ? do
- color "#6b7280"
- fontWeight (weight 500)
- ".tool-path" ? do
- color "#3b82f6"
- ".tool-pattern" ? do
- color "#8b5cf6"
- backgroundColor "#f5f3ff"
- padding (px 1) (px 4) (px 1) (px 4)
- borderRadius (px 2) (px 2) (px 2) (px 2)
- ".tool-path-suffix" ? do
- color "#6b7280"
- fontSize (px 11)
- ".tool-bash" ? do
- display flex
- alignItems flexStart
- Stylesheet.key "gap" ("6px" :: Text)
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- fontSize (px 12)
- padding (px 2) (px 0) (px 2) (px 0)
- ".tool-bash-prompt" ? do
- color "#f59e0b"
- fontWeight bold
- fontSize (px 14)
- ".tool-bash-cmd" ? do
- color "#374151"
- backgroundColor "#f3f4f6"
- padding (px 2) (px 6) (px 2) (px 6)
- borderRadius (px 3) (px 3) (px 3) (px 3)
- wordBreak breakAll
- ".tool-generic" ? do
- fontSize (px 12)
- fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace]
- ".tool-generic" |> "summary" ? do
- cursor pointer
- display flex
- alignItems center
- Stylesheet.key "gap" ("6px" :: Text)
- ".tool-args-pre" ? do
- margin (px 4) (px 0) (px 0) (px 16)
- padding (px 6) (px 8) (px 6) (px 8)
- backgroundColor "#f9fafb"
- borderRadius (px 3) (px 3) (px 3) (px 3)
- fontSize (px 11)
- whiteSpace preWrap
- maxHeight (px 200)
- overflowY auto
- ".tool-result-output" ? do
- marginLeft (px 16)
- marginTop (px 2)
-
-responsiveStyles :: Css
-responsiveStyles = do
- query Media.screen [Media.maxWidth (px 600)] <| do
- body ? fontSize (px 13)
- ".container" ? padding (px 6) (px 8) (px 6) (px 8)
- ".navbar" ? do
- padding (px 6) (px 8) (px 6) (px 8)
- flexWrap Flexbox.wrap
- ".navbar-hamburger" ? do
- display flex
- Stylesheet.key "order" ("2" :: Text)
- ".navbar-links" ? do
- display none
- width (pct 100)
- Stylesheet.key "order" ("3" :: Text)
- flexDirection column
- alignItems flexStart
- paddingTop (px 8)
- Stylesheet.key "gap" ("0" :: Text)
- ".navbar-toggle-checkbox" # checked |+ ".navbar-hamburger" |+ ".navbar-links" ? do
- display flex
- ".navbar-link" ? do
- padding (px 8) (px 6) (px 8) (px 6)
- fontSize (px 13)
- width (pct 100)
- ".navbar-dropdown" ? do
- width (pct 100)
- ".navbar-dropdown-btn" ? do
- padding (px 8) (px 6) (px 8) (px 6)
- fontSize (px 13)
- width (pct 100)
- textAlign (alignSide sideLeft)
- ".navbar-dropdown-content" ? do
- position static
- Stylesheet.key "box-shadow" ("none" :: Text)
- paddingLeft (px 12)
- backgroundColor transparent
- ".navbar-dropdown-item" ? do
- padding (px 6) (px 10) (px 6) (px 10)
- fontSize (px 12)
- ".nav-content" ? do
- flexDirection column
- alignItems flexStart
- ".stats-grid" ? do
- Stylesheet.key "grid-template-columns" ("repeat(2, 1fr)" :: Text)
- ".detail-row" ? do
- flexDirection column
- Stylesheet.key "gap" ("2px" :: Text)
- ".detail-label" ? width auto
- ".filter-row" ? do
- flexWrap Flexbox.wrap
- ".filter-group" ? do
- width auto
- flexWrap Flexbox.nowrap
- ".filter-select" <> ".filter-input" ? minWidth (px 80)
- ".review-actions" ? do
- flexDirection column
- ".reject-form" ? do
- width (pct 100)
- flexDirection column
- ".reject-notes" ? width (pct 100)
- ".actions" ? flexDirection column
- ".action-btn" ? width (pct 100)
-
-darkModeStyles :: Css
-darkModeStyles =
- query Media.screen [prefersDark] <| do
- body ? do
- backgroundColor "#111827"
- color "#f3f4f6"
- ".card"
- <> ".task-card"
- <> ".stat-card"
- <> ".task-detail"
- <> ".task-summary"
- <> ".filter-form"
- <> ".status-form"
- <> ".diff-section"
- <> ".review-actions"
- <> ".list-group"
- ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
- ".list-group-item" ? borderBottomColor "#374151"
- ".list-group-item" # hover ? backgroundColor "#374151"
- ".list-group-item-id" ? color "#60a5fa"
- ".list-group-item-title" ? color "#d1d5db"
- header ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
- ".navbar" ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
- ".navbar-brand" ? color "#60a5fa"
- ".navbar-link" ? color "#d1d5db"
- ".navbar-link" # hover ? backgroundColor "#374151"
- ".navbar-dropdown-btn" ? color "#d1d5db"
- ".navbar-dropdown-btn" # hover ? backgroundColor "#374151"
- ".navbar-dropdown-content" ? do
- backgroundColor "#1f2937"
- Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text)
- ".navbar-dropdown-item" ? color "#d1d5db"
- ".navbar-dropdown-item" # hover ? backgroundColor "#374151"
- ".status-dropdown-menu" ? do
- backgroundColor "#1f2937"
- Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text)
- ".hamburger-line" ? backgroundColor "#d1d5db"
- ".nav-brand" ? color "#f3f4f6"
- "h2" <> "h3" ? color "#d1d5db"
- a ? color "#60a5fa"
- ".breadcrumb-container" ? backgroundColor transparent
- ".breadcrumb-sep" ? color "#6b7280"
- ".breadcrumb-current" ? color "#9ca3af"
-
- ".detail-label"
- <> ".priority"
- <> ".dep-type"
- <> ".child-status"
- <> ".empty-msg"
- <> ".stat-label"
- <> ".priority-desc"
- ? color "#9ca3af"
- ".child-title" ? color "#d1d5db"
- code ? do
- backgroundColor "#374151"
- color "#f3f4f6"
- ".task-meta-id" ? do
- backgroundColor "#374151"
- color "#e5e7eb"
- ".task-meta-secondary" ? color "#9ca3af"
- ".meta-sep" ? color "#4b5563"
- ".task-meta-label" ? color "#9ca3af"
- ".detail-section" ? borderTopColor "#374151"
- ".description" ? do
- backgroundColor "#374151"
- color "#e5e7eb"
- ".badge-open" ? do
- backgroundColor "#78350f"
- color "#fcd34d"
- ".badge-inprogress" ? do
- backgroundColor "#1e3a8a"
- color "#93c5fd"
- ".badge-review" ? do
- backgroundColor "#4c1d95"
- color "#c4b5fd"
- ".badge-approved" ? do
- backgroundColor "#164e63"
- color "#67e8f9"
- ".badge-done" ? do
- backgroundColor "#064e3b"
- color "#6ee7b7"
- ".badge-needshelp" ? do
- backgroundColor "#78350f"
- color "#fcd34d"
- ".badge-p0" ? do
- backgroundColor "#7f1d1d"
- color "#fca5a5"
- ".badge-p1" ? do
- backgroundColor "#78350f"
- color "#fcd34d"
- ".badge-p2" ? do
- backgroundColor "#1e3a8a"
- color "#93c5fd"
- ".badge-p3" ? do
- backgroundColor "#374151"
- color "#d1d5db"
- ".badge-p4" ? do
- backgroundColor "#1f2937"
- color "#9ca3af"
- ".blocking-impact" ? do
- backgroundColor "#374151"
- color "#9ca3af"
- ".priority-dropdown-menu" ? do
- backgroundColor "#1f2937"
- Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text)
- ".action-btn" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- color "#f3f4f6"
- ".action-btn" # hover ? backgroundColor "#4b5563"
- ".filter-select" <> ".filter-input" <> ".status-select" <> ".reject-notes" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- color "#f3f4f6"
- ".stats-section" <> ".summary-section" ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
-
- (".stat-card.badge-open" |> ".stat-count") ? color "#fbbf24"
- (".stat-card.badge-inprogress" |> ".stat-count") ? color "#60a5fa"
- (".stat-card.badge-review" |> ".stat-count") ? color "#a78bfa"
- (".stat-card.badge-approved" |> ".stat-count") ? color "#22d3ee"
- (".stat-card.badge-done" |> ".stat-count") ? color "#34d399"
- (".stat-card.badge-neutral" |> ".stat-count") ? color "#9ca3af"
-
- ".progress-bar" ? backgroundColor "#374151"
- ".progress-fill" ? backgroundColor "#60a5fa"
- ".multi-progress-bar" ? backgroundColor "#374151"
- ".progress-legend" ? color "#9ca3af"
- ".activity-section" ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
- ".activity-timeline" # before ? backgroundColor "#374151"
- ".activity-icon" ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
- ".activity-time" ? color "#9ca3af"
- ".activity-message" ? color "#d1d5db"
- (".activity-metadata" |> "summary") ? color "#9ca3af"
- ".metadata-json" ? backgroundColor "#374151"
- ".execution-section" ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
-
- ".metric-label" ? color "#9ca3af"
- ".metric-value" ? color "#d1d5db"
- ".metric-card" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- (".metric-card" |> ".metric-value") ? color "#f3f4f6"
- (".metric-card" |> ".metric-label") ? color "#9ca3af"
- ".amp-link" ? color "#60a5fa"
- ".amp-thread-btn" ? do
- backgroundColor "#8b5cf6"
- ".amp-thread-btn" # hover ? backgroundColor "#7c3aed"
- ".markdown-content" ? color "#d1d5db"
- ".commit-item" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- ".commit-hash" ? do
- backgroundColor "#4b5563"
- color "#60a5fa"
- ".commit-summary" ? color "#d1d5db"
- ".commit-meta" ? color "#9ca3af"
- ".md-h1" ? borderBottomColor "#374151"
- ".md-code" ? do
- backgroundColor "#1e1e1e"
- color "#d4d4d4"
- borderColor "#374151"
- ".md-inline-code" ? do
- backgroundColor "#374151"
- color "#f3f4f6"
- ".edit-description" ? borderTopColor "#374151"
- (".edit-description" |> "summary") ? color "#60a5fa"
- ".edit-link" ? color "#60a5fa"
- "button.cancel-link" ? do
- color "#f87171"
- backgroundColor transparent
- border (px 0) solid transparent
- ".description-textarea" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- color "#f3f4f6"
- ".fact-create-form" ? do
- backgroundColor "#1f2937"
- borderColor "#374151"
- ".time-filter-btn" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- color "#d1d5db"
- ".time-filter-btn" # hover ? do
- backgroundColor "#4b5563"
- borderColor "#6b7280"
- ".time-filter-btn.active" ? do
- backgroundColor "#3b82f6"
- borderColor "#3b82f6"
- color white
- ".time-filter-btn.active" # hover ? do
- backgroundColor "#2563eb"
- borderColor "#2563eb"
- ".sort-label" ? color "#9ca3af"
- ".sort-dropdown-btn" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- color "#d1d5db"
- ".sort-dropdown-btn" # hover ? do
- backgroundColor "#4b5563"
- borderColor "#6b7280"
- ".sort-dropdown-item.active" ? do
- backgroundColor "#1e3a5f"
- ".comment-card" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- ".comment-text" ? color "#d1d5db"
- ".author-human" ? do
- backgroundColor "#1e3a8a"
- color "#93c5fd"
- ".author-junior" ? do
- backgroundColor "#064e3b"
- color "#6ee7b7"
- ".comment-time" ? color "#9ca3af"
- ".comment-textarea" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- color "#f3f4f6"
- ".form-input" <> ".form-textarea" ? do
- backgroundColor "#374151"
- borderColor "#4b5563"
- color "#f3f4f6"
- (".form-group" |> label) ? color "#d1d5db"
- ".danger-zone" ? do
- backgroundColor "#450a0a"
- borderColor "#991b1b"
- (".danger-zone" |> h2) ? color "#f87171"
- ".retry-banner-warning" ? do
- backgroundColor "#451a03"
- borderColor "#b45309"
- ".retry-banner-critical" ? do
- backgroundColor "#450a0a"
- borderColor "#dc2626"
- ".retry-attempt" ? color "#d1d5db"
- ".retry-banner-details" ? color "#d1d5db"
- ".retry-value" ? color "#9ca3af"
- ".retry-commit" ? backgroundColor "#374151"
- ".event-bubble" ? backgroundColor "#374151"
- ".comment-bubble" ? do
- backgroundColor "#374151"
- color "#d1d5db"
- ".thought-bubble" ? do
- backgroundColor "#292524"
- color "#a8a29e"
- borderRadius (px 2) (px 2) (px 2) (px 2)
- ".event-label" ? color "#d1d5db"
- ".tool-bash-cmd" ? do
- backgroundColor "#292524"
- color "#a8a29e"
- ".tool-label" ? color "#9ca3af"
- ".tool-path" ? color "#60a5fa"
- ".tool-pattern" ? do
- backgroundColor "#3b2f5e"
- color "#c4b5fd"
- ".output-collapsible" |> "summary" ? color "#60a5fa"
- ".timeline-tool-call" |> "summary" # before ? color "#9ca3af"
- ".line-count" ? do
- backgroundColor "#374151"
- color "#9ca3af"
- ".event-error" ? do
- backgroundColor "#450a0a"
- borderColor "#dc2626"
- ".event-error" |> ".event-label" ? color "#f87171"
- ".error-message" ? color "#f87171"
- ".timeline-error" |> ".event-label" ? color "#fca5a5"
- ".timeline-guardrail" |> ".event-label" ? color "#fbbf24"
- ".timeline-guardrail" ? do
- backgroundColor "#451a03"
- borderColor "#f59e0b"
- ".timeline-guardrail" |> ".guardrail-content" ? color "#fcd34d"
- ".formatted-json" ? do
- backgroundColor "#1e1e1e"
- color "#d4d4d4"
- -- Responsive dark mode: dropdown content needs background on mobile
- query Media.screen [Media.maxWidth (px 600)] <| do
- ".navbar-dropdown-content" ? do
- backgroundColor "#1f2937"
- ".navbar-dropdown-item" # hover ? do
- backgroundColor "#374151"
-
-prefersDark :: Stylesheet.Feature
-prefersDark =
- Stylesheet.Feature "prefers-color-scheme" (Just (Clay.value ("dark" :: Text)))
-
-statusBadgeClass :: Text -> Text
-statusBadgeClass status = case status of
- "Open" -> "badge badge-open"
- "InProgress" -> "badge badge-inprogress"
- "Review" -> "badge badge-review"
- "Approved" -> "badge badge-approved"
- "Done" -> "badge badge-done"
- _ -> "badge"
-
-priorityBadgeClass :: Text -> Text
-priorityBadgeClass priority = case priority of
- "P0" -> "badge badge-p0"
- "P1" -> "badge badge-p1"
- "P2" -> "badge badge-p2"
- "P3" -> "badge badge-p3"
- "P4" -> "badge badge-p4"
- _ -> "badge"
diff --git a/Omni/Jr/Web/Types.hs b/Omni/Jr/Web/Types.hs
deleted file mode 100644
index 93c8d855..00000000
--- a/Omni/Jr/Web/Types.hs
+++ /dev/null
@@ -1,365 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- : dep servant-server
--- : dep lucid
--- : dep http-api-data
--- : dep aeson
-module Omni.Jr.Web.Types
- ( TaskFilters (..),
- TimeRange (..),
- SortOrder (..),
- parseSortOrder,
- sortOrderToParam,
- sortOrderLabel,
- sortTasks,
- parseTimeRange,
- timeRangeToParam,
- getTimeRangeStart,
- startOfDay,
- startOfWeek,
- addDays,
- fromGregorian,
- daysSinceEpoch,
- startOfMonth,
- computeMetricsFromActivities,
- HomePage (..),
- ReadyQueuePage (..),
- BlockedPage (..),
- InterventionPage (..),
- TaskListPage (..),
- TaskDetailPage (..),
- GitCommit (..),
- TaskReviewPage (..),
- ReviewInfo (..),
- TaskDiffPage (..),
- StatsPage (..),
- KBPage (..),
- FactDetailPage (..),
- EpicsPage (..),
- RecentActivityNewPartial (..),
- RecentActivityMorePartial (..),
- ReadyCountPartial (..),
- StatusBadgePartial (..),
- PriorityBadgePartial (..),
- ComplexityBadgePartial (..),
- TaskListPartial (..),
- TaskMetricsPartial (..),
- AgentEventsPartial (..),
- DescriptionViewPartial (..),
- DescriptionEditPartial (..),
- FactEditForm (..),
- FactCreateForm (..),
- RejectForm (..),
- StatusForm (..),
- PriorityForm (..),
- ComplexityForm (..),
- DescriptionForm (..),
- NotesForm (..),
- CommentForm (..),
- Breadcrumb (..),
- Breadcrumbs,
- CSS,
- SSE,
- )
-where
-
-import Alpha
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.List as List
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as LazyText
-import qualified Data.Text.Lazy.Encoding as LazyText
-import Data.Time (Day, DayOfWeek (..), UTCTime (..), dayOfWeek, diffUTCTime, toGregorian)
-import qualified Omni.Task.Core as TaskCore
-import Servant (Accept (..), MimeRender (..))
-import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)
-
-data TaskFilters = TaskFilters
- { filterStatus :: Maybe TaskCore.Status,
- filterPriority :: Maybe TaskCore.Priority,
- filterNamespace :: Maybe Text,
- filterType :: Maybe TaskCore.TaskType
- }
- deriving (Show, Eq)
-
-data TimeRange = Today | Week | Month | AllTime
- deriving (Show, Eq)
-
-data SortOrder
- = SortNewest
- | SortOldest
- | SortUpdated
- | SortPriorityHigh
- | SortPriorityLow
- deriving (Show, Eq)
-
-parseSortOrder :: Maybe Text -> SortOrder
-parseSortOrder (Just "oldest") = SortOldest
-parseSortOrder (Just "updated") = SortUpdated
-parseSortOrder (Just "priority-high") = SortPriorityHigh
-parseSortOrder (Just "priority-low") = SortPriorityLow
-parseSortOrder _ = SortNewest
-
-sortOrderToParam :: SortOrder -> Text
-sortOrderToParam SortNewest = "newest"
-sortOrderToParam SortOldest = "oldest"
-sortOrderToParam SortUpdated = "updated"
-sortOrderToParam SortPriorityHigh = "priority-high"
-sortOrderToParam SortPriorityLow = "priority-low"
-
-sortOrderLabel :: SortOrder -> Text
-sortOrderLabel SortNewest = "Newest First"
-sortOrderLabel SortOldest = "Oldest First"
-sortOrderLabel SortUpdated = "Recently Updated"
-sortOrderLabel SortPriorityHigh = "Priority (High to Low)"
-sortOrderLabel SortPriorityLow = "Priority (Low to High)"
-
-sortTasks :: SortOrder -> [TaskCore.Task] -> [TaskCore.Task]
-sortTasks SortNewest = List.sortBy (comparing (Down <. TaskCore.taskCreatedAt))
-sortTasks SortOldest = List.sortBy (comparing TaskCore.taskCreatedAt)
-sortTasks SortUpdated = List.sortBy (comparing (Down <. TaskCore.taskUpdatedAt))
-sortTasks SortPriorityHigh = List.sortBy (comparing TaskCore.taskPriority)
-sortTasks SortPriorityLow = List.sortBy (comparing (Down <. TaskCore.taskPriority))
-
-parseTimeRange :: Maybe Text -> TimeRange
-parseTimeRange (Just "today") = Today
-parseTimeRange (Just "week") = Week
-parseTimeRange (Just "month") = Month
-parseTimeRange _ = AllTime
-
-timeRangeToParam :: TimeRange -> Text
-timeRangeToParam Today = "today"
-timeRangeToParam Week = "week"
-timeRangeToParam Month = "month"
-timeRangeToParam AllTime = "all"
-
-getTimeRangeStart :: TimeRange -> UTCTime -> Maybe UTCTime
-getTimeRangeStart AllTime _ = Nothing
-getTimeRangeStart Today now = Just (startOfDay now)
-getTimeRangeStart Week now = Just (startOfWeek now)
-getTimeRangeStart Month now = Just (startOfMonth now)
-
-startOfDay :: UTCTime -> UTCTime
-startOfDay t = UTCTime (utctDay t) 0
-
-startOfWeek :: UTCTime -> UTCTime
-startOfWeek t =
- let day = utctDay t
- dow = dayOfWeek day
- daysBack = case dow of
- Monday -> 0
- Tuesday -> 1
- Wednesday -> 2
- Thursday -> 3
- Friday -> 4
- Saturday -> 5
- Sunday -> 6
- in UTCTime (addDays (negate daysBack) day) 0
-
-addDays :: Integer -> Day -> Day
-addDays n d =
- let (y, m, dayNum) = toGregorian d
- in fromGregorian y m (dayNum + fromInteger n)
-
-fromGregorian :: Integer -> Int -> Int -> Day
-fromGregorian y m d = toEnum (fromInteger (daysSinceEpoch y m d))
-
-daysSinceEpoch :: Integer -> Int -> Int -> Integer
-daysSinceEpoch y m d =
- let a = (14 - m) `div` 12
- y' = y + 4800 - toInteger a
- m' = m + 12 * a - 3
- jdn = d + (153 * m' + 2) `div` 5 + 365 * fromInteger y' + fromInteger y' `div` 4 - fromInteger y' `div` 100 + fromInteger y' `div` 400 - 32045
- in toInteger jdn - 2440588
-
-startOfMonth :: UTCTime -> UTCTime
-startOfMonth t =
- let day = utctDay t
- (y, m, _) = toGregorian day
- in UTCTime (fromGregorian y m 1) 0
-
-computeMetricsFromActivities :: [TaskCore.Task] -> [TaskCore.TaskActivity] -> TaskCore.AggregatedMetrics
-computeMetricsFromActivities tasks activities =
- let completedCount = length [t | t <- tasks, TaskCore.taskStatus t == TaskCore.Done]
- totalCost = sum [c | act <- activities, Just c <- [TaskCore.activityCostCents act]]
- totalTokens = sum [t | act <- activities, Just t <- [TaskCore.activityTokensUsed act]]
- totalDuration = sum [calcDuration act | act <- activities]
- in TaskCore.AggregatedMetrics
- { TaskCore.aggTotalCostCents = totalCost,
- TaskCore.aggTotalDurationSeconds = totalDuration,
- TaskCore.aggCompletedTasks = completedCount,
- TaskCore.aggTotalTokens = totalTokens
- }
- where
- calcDuration act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
- (Just start, Just end) -> floor (diffUTCTime end start)
- _ -> 0
-
-data CSS
-
-instance Accept CSS where
- contentType _ = "text/css"
-
-instance MimeRender CSS LazyText.Text where
- mimeRender _ = LazyText.encodeUtf8
-
-data SSE
-
-instance Accept SSE where
- contentType _ = "text/event-stream"
-
-instance MimeRender SSE BS.ByteString where
- mimeRender _ = LBS.fromStrict
-
-data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics TimeRange UTCTime
-
-data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] SortOrder UTCTime
-
-data BlockedPage = BlockedPage [(TaskCore.Task, Int)] SortOrder UTCTime
-
-data InterventionPage = InterventionPage TaskCore.HumanActionItems SortOrder UTCTime
-
-data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
-
-data TaskDetailPage
- = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) [TaskCore.StoredEvent] UTCTime
- | TaskDetailNotFound Text
-
-data GitCommit = GitCommit
- { commitHash :: Text,
- commitShortHash :: Text,
- commitSummary :: Text,
- commitAuthor :: Text,
- commitRelativeDate :: Text,
- commitFilesChanged :: Int
- }
- deriving (Show, Eq)
-
-data TaskReviewPage
- = ReviewPageFound TaskCore.Task ReviewInfo
- | ReviewPageNotFound Text
-
-data ReviewInfo
- = ReviewNoCommit
- | ReviewMergeConflict Text [Text]
- | ReviewReady Text Text
-
-data TaskDiffPage
- = DiffPageFound Text Text Text
- | DiffPageNotFound Text Text
-
-data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text)
-
-newtype KBPage = KBPage [TaskCore.Fact]
-
-data FactDetailPage
- = FactDetailFound TaskCore.Fact UTCTime
- | FactDetailNotFound Int
-
-data FactEditForm = FactEditForm Text Text Text
-
-instance FromForm FactEditForm where
- fromForm form = do
- content <- parseUnique "content" form
- let files = fromRight "" (lookupUnique "files" form)
- let confidence = fromRight "0.8" (lookupUnique "confidence" form)
- Right (FactEditForm content files confidence)
-
-data FactCreateForm = FactCreateForm Text Text Text Text
-
-instance FromForm FactCreateForm where
- fromForm form = do
- project <- parseUnique "project" form
- content <- parseUnique "content" form
- let files = fromRight "" (lookupUnique "files" form)
- let confidence = fromRight "0.8" (lookupUnique "confidence" form)
- Right (FactCreateForm project content files confidence)
-
-data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] SortOrder
-
-data RecentActivityNewPartial = RecentActivityNewPartial [TaskCore.Task] (Maybe Int)
-
-data RecentActivityMorePartial = RecentActivityMorePartial [TaskCore.Task] Int Bool
-
-newtype ReadyCountPartial = ReadyCountPartial Int
-
-data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
-
-data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text
-
-data ComplexityBadgePartial = ComplexityBadgePartial (Maybe Int) Text
-
-newtype TaskListPartial = TaskListPartial [TaskCore.Task]
-
-data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime
-
-data AgentEventsPartial = AgentEventsPartial Text [TaskCore.StoredEvent] Bool UTCTime
-
-data DescriptionViewPartial = DescriptionViewPartial Text Text Bool
-
-data DescriptionEditPartial = DescriptionEditPartial Text Text Bool
-
-newtype RejectForm = RejectForm (Maybe Text)
-
-instance FromForm RejectForm where
- fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form)))
-
-newtype StatusForm = StatusForm TaskCore.Status
-
-instance FromForm StatusForm where
- fromForm form = do
- statusText <- parseUnique "status" form
- case readMaybe (Text.unpack statusText) of
- Just s -> Right (StatusForm s)
- Nothing -> Left "Invalid status"
-
-newtype PriorityForm = PriorityForm TaskCore.Priority
-
-instance FromForm PriorityForm where
- fromForm form = do
- priorityText <- parseUnique "priority" form
- case readMaybe (Text.unpack priorityText) of
- Just p -> Right (PriorityForm p)
- Nothing -> Left "Invalid priority"
-
-newtype ComplexityForm = ComplexityForm (Maybe Int)
-
-instance FromForm ComplexityForm where
- fromForm form = do
- complexityText <- parseUnique "complexity" form
- if complexityText == "none"
- then Right (ComplexityForm Nothing)
- else case readMaybe (Text.unpack complexityText) of
- Just c | c >= 1 && c <= 5 -> Right (ComplexityForm (Just c))
- _ -> Left "Invalid complexity"
-
-newtype DescriptionForm = DescriptionForm Text
-
-instance FromForm DescriptionForm where
- fromForm form = do
- desc <- parseUnique "description" form
- Right (DescriptionForm desc)
-
-newtype NotesForm = NotesForm Text
-
-instance FromForm NotesForm where
- fromForm form = do
- notes <- parseUnique "notes" form
- Right (NotesForm notes)
-
-newtype CommentForm = CommentForm Text
-
-instance FromForm CommentForm where
- fromForm form = do
- commentText <- parseUnique "comment" form
- Right (CommentForm commentText)
-
-data Breadcrumb = Breadcrumb
- { breadcrumbLabel :: Text,
- breadcrumbUrl :: Maybe Text
- }
-
-type Breadcrumbs = [Breadcrumb]
diff --git a/Omni/Task/README.md b/Omni/Task/README.md
index b3ff17f6..62fc0187 100644
--- a/Omni/Task/README.md
+++ b/Omni/Task/README.md
@@ -1,7 +1,7 @@
# Task Manager for AI Agents
The task manager is a dependency-aware issue tracker inspired by beads. It uses:
-- **Storage**: SQLite database (`~/.local/share/jr/jr.db`)
+- **Storage**: SQLite database (`/var/lib/omni/tasks.db`)
- **Dependencies**: Tasks can block other tasks
- **Ready work detection**: Automatically finds unblocked tasks
@@ -144,7 +144,7 @@ task import -i /path/to/backup.jsonl
task init
```
-Creates the SQLite database at `~/.local/share/jr/jr.db`.
+Creates the SQLite database at `/var/lib/omni/tasks.db`.
## Common Workflows
@@ -321,7 +321,7 @@ AI assistants often create planning and design documents during development:
## Storage
-Tasks are stored in a SQLite database at `~/.local/share/jr/jr.db`. This is a local database, not git-tracked.
+Tasks are stored in a SQLite database at `/var/lib/omni/tasks.db`. This is a local database, not git-tracked.
To back up or transfer tasks, use `task export` and `task import`.