diff options
| author | Ben Sima <ben@bensima.com> | 2025-11-28 01:54:07 -0500 |
|---|---|---|
| committer | Ben Sima <ben@bensima.com> | 2025-11-28 01:54:07 -0500 |
| commit | 340d92f19d8839709f4f2d6ce7b96cbb22f73932 (patch) | |
| tree | 44d2d36b2509b59fc7fe63501d9a456a4a09025c /Omni | |
| parent | 375cf189a94dd9c191ed17c066a8cf0c56bd3e7c (diff) | |
Create /kb web page listing facts with confidence scores
The implementation is complete. The `/kb` web page now:
1. Fetches all facts from the database via `Fact.getAllFacts`
2. Displays each fact in a card showing:
- Fact ID - Confidence score as a colored badge (green ≥80%,
yellow ≥50%, red < - Project name - Fact content - Related files
(if any) - Source task link (if any)
Task-Id: t-158.4
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Jr/Web.hs | 60 |
1 files changed, 36 insertions, 24 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 0893d7c..f65f368 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -26,6 +26,7 @@ import qualified Lucid import qualified Lucid.Base as Lucid import qualified Network.Wai.Handler.Warp as Warp import Numeric (showFFloat) +import qualified Omni.Fact as Fact import qualified Omni.Jr.Web.Style as Style import qualified Omni.Task.Core as TaskCore import Servant @@ -129,7 +130,7 @@ data TaskDiffPage data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text) -newtype KBPage = KBPage [TaskCore.Task] +newtype KBPage = KBPage [TaskCore.Fact] data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] @@ -545,33 +546,45 @@ instance Lucid.ToHtml InterventionPage where instance Lucid.ToHtml KBPage where toHtmlRaw = Lucid.toHtml - toHtml (KBPage tasks) = + toHtml (KBPage facts) = Lucid.doctypehtml_ <| do pageHead "Knowledge Base - Jr" Lucid.body_ <| do navbar Lucid.div_ [Lucid.class_ "container"] <| do Lucid.h1_ "Knowledge Base" - Lucid.p_ [Lucid.class_ "info-msg"] "Epic design documents and project knowledge." - if null tasks - then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics with designs yet." - else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicCard tasks + Lucid.p_ [Lucid.class_ "info-msg"] "Facts learned during task execution." + 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 - renderEpicCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () - renderEpicCard 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.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t)) - case TaskCore.taskDescription t of - Nothing -> pure () - Just desc -> - Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 desc <> "...")) + renderFactCard :: (Monad m) => TaskCore.Fact -> Lucid.HtmlT m () + renderFactCard f = + Lucid.div_ [Lucid.class_ "task-card"] <| 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 (TaskCore.factContent f)) + unless (null (TaskCore.factRelatedFiles f)) <| do + Lucid.p_ [Lucid.class_ "kb-files"] <| do + Lucid.span_ [Lucid.class_ "files-label"] "Files: " + Lucid.toHtml (Text.intercalate ", " (TaskCore.factRelatedFiles f)) + case TaskCore.factSourceTask f of + Nothing -> pure () + Just tid -> + Lucid.p_ [Lucid.class_ "kb-source"] <| do + Lucid.span_ [Lucid.class_ "source-label"] "Source: " + Lucid.a_ [Lucid.href_ ("/tasks/" <> tid)] (Lucid.toHtml tid) + + 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 EpicsPage where toHtmlRaw = Lucid.toHtml @@ -1541,9 +1554,8 @@ server = kbHandler :: Servant.Handler KBPage kbHandler = do - allTasks <- liftIO TaskCore.loadTasks - let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks - pure (KBPage epicTasks) + facts <- liftIO Fact.getAllFacts + pure (KBPage facts) epicsHandler :: Servant.Handler EpicsPage epicsHandler = do |
