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.hs136
1 files changed, 87 insertions, 49 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index e73b550..a4fdee1 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -110,7 +110,9 @@ type API =
:<|> "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
- :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> PostRedirect
+ :<|> "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 :> "review" :> Get '[Lucid.HTML] TaskReviewPage
:<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
@@ -215,6 +217,10 @@ newtype TaskListPartial = TaskListPartial [TaskCore.Task]
data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime
+data DescriptionViewPartial = DescriptionViewPartial Text Text Bool
+
+data DescriptionEditPartial = DescriptionEditPartial Text Text Bool
+
newtype RejectForm = RejectForm (Maybe Text)
instance FromForm RejectForm where
@@ -1128,50 +1134,11 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.ul_ [Lucid.class_ "dep-list"] <| do
traverse_ renderDependency deps
- case TaskCore.taskType task of
- TaskCore.Epic -> do
- for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Design"
- if Text.null (TaskCore.taskDescription task)
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No design document yet."
- else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown (TaskCore.taskDescription task))
- Lucid.details_ [Lucid.class_ "edit-description"] <| do
- Lucid.summary_ "Edit Design"
- Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/description")] <| do
- Lucid.textarea_
- [ Lucid.name_ "description",
- Lucid.class_ "description-textarea",
- Lucid.rows_ "15",
- Lucid.placeholder_ "Enter design in Markdown format..."
- ]
- (Lucid.toHtml (TaskCore.taskDescription task))
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Design"
- _ ->
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Description"
- if Text.null (TaskCore.taskDescription task)
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No description yet."
- else Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml (TaskCore.taskDescription task))
- Lucid.details_ [Lucid.class_ "edit-description"] <| do
- Lucid.summary_ "Edit Description"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/description"),
- Lucid.makeAttribute "hx-post" ("/tasks/" <> TaskCore.taskId task <> "/description"),
- Lucid.makeAttribute "hx-swap" "none"
- ]
- <| do
- Lucid.textarea_
- [ Lucid.name_ "description",
- Lucid.class_ "description-textarea",
- Lucid.rows_ "10",
- Lucid.placeholder_ "Enter description..."
- ]
- (Lucid.toHtml (TaskCore.taskDescription task))
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Description"
+ 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
@@ -1844,6 +1811,58 @@ instance Lucid.ToHtml TaskMetricsPartial where
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
+ if isEpic
+ then Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc)
+ else Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml 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.a_
+ [ Lucid.href_ "#",
+ 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"
+
-- | Simple markdown renderer for epic descriptions
-- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`)
renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
@@ -1975,7 +1994,9 @@ server =
:<|> epicsHandler
:<|> taskDetailHandler
:<|> taskStatusHandler
- :<|> taskDescriptionHandler
+ :<|> descriptionViewHandler
+ :<|> descriptionEditHandler
+ :<|> descriptionPostHandler
:<|> taskNotesHandler
:<|> taskReviewHandler
:<|> taskDiffHandler
@@ -2140,11 +2161,28 @@ server =
liftIO <| TaskCore.updateTaskStatus tid newStatus []
pure (StatusBadgePartial newStatus tid)
- taskDescriptionHandler :: Text -> DescriptionForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
- taskDescriptionHandler tid (DescriptionForm desc) = do
+ 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})
- pure <| addHeader ("/tasks/" <> tid) NoContent
+ 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
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 11:03:50 +0000