summaryrefslogtreecommitdiff
path: root/Omni/Jr/Web.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr/Web.hs')
-rw-r--r--Omni/Jr/Web.hs176
1 files changed, 160 insertions, 16 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index f65f368..eb8a751 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -62,6 +62,9 @@ type API =
:> QueryParam "type" Text
:> Get '[Lucid.HTML] TaskListPage
:<|> "kb" :> Get '[Lucid.HTML] KBPage
+ :<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage
+ :<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect
+ :<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect
:<|> "epics" :> Get '[Lucid.HTML] EpicsPage
:<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
:<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
@@ -132,6 +135,19 @@ data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text)
newtype KBPage = KBPage [TaskCore.Fact]
+data FactDetailPage
+ = FactDetailFound TaskCore.Fact
+ | 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 EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task]
newtype RecentActivityPartial = RecentActivityPartial [TaskCore.Task]
@@ -560,22 +576,23 @@ instance Lucid.ToHtml KBPage where
where
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)
+ 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 =
@@ -586,6 +603,111 @@ instance Lucid.ToHtml KBPage where
| 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) =
+ Lucid.doctypehtml_ <| do
+ pageHead "Fact Not Found - Jr"
+ Lucid.body_ <| do
+ navbar
+ 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) =
+ Lucid.doctypehtml_ <| do
+ pageHead "Fact Detail - Jr"
+ Lucid.body_ <| do
+ navbar
+ 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"] (Lucid.toHtml (formatTimestamp (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
+ formatTimestamp :: UTCTime -> Text
+ formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
+
+ 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) =
@@ -1492,6 +1614,9 @@ server =
:<|> statsHandler
:<|> taskListHandler
:<|> kbHandler
+ :<|> factDetailHandler
+ :<|> factEditHandler
+ :<|> factDeleteHandler
:<|> epicsHandler
:<|> taskDetailHandler
:<|> taskStatusHandler
@@ -1557,6 +1682,25 @@ server =
facts <- liftIO Fact.getAllFacts
pure (KBPage facts)
+ factDetailHandler :: Int -> Servant.Handler FactDetailPage
+ factDetailHandler fid = do
+ maybeFact <- liftIO (Fact.getFact fid)
+ case maybeFact of
+ Nothing -> pure (FactDetailNotFound fid)
+ Just fact -> pure (FactDetailFound fact)
+
+ 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 :: Servant.Handler EpicsPage
epicsHandler = do
allTasks <- liftIO TaskCore.loadTasks
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 18:53:42 +0000