diff options
Diffstat (limited to 'Omni/Jr')
| -rw-r--r-- | Omni/Jr/Web.hs | 176 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 86 |
2 files changed, 246 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 diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index 8ad239c..b262037 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -703,6 +703,92 @@ formStyles = do 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" executionDetailsStyles :: Css executionDetailsStyles = do |