UI: Serve HTML in getClothR, copied from getTicketR

This commit is contained in:
fr33domlover 2022-09-18 07:44:00 +00:00
parent 1e2b3d2006
commit 9deba96cf2
4 changed files with 226 additions and 41 deletions

View file

@ -26,6 +26,10 @@ module Vervis.Handler.Cloth
, getClothDepR
, postClothFollowR
, postClothUnfollowR
, postClothReplyR
@ -60,11 +64,14 @@ where
import Control.Monad
import Data.Bifunctor
import Data.Bitraversable
import Data.Bool
import Data.Function
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import Data.Text (Text)
import Data.Traversable
import Database.Persist
import Text.Blaze.Html (Html, preEscapedToHtml)
import Yesod.Auth
import Yesod.Core
import Yesod.Persist.Core
@ -98,8 +105,13 @@ import Vervis.Model.Ticket
import Vervis.Paginate
import Vervis.Persist.Actor
import Vervis.Recipient
import Vervis.Settings
import Vervis.Style
import Vervis.Ticket
import Vervis.Time (showDate)
import Vervis.Web.Actor
import Vervis.Widget.Discussion
import Vervis.Widget.Person
getClothR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
getClothR loomHash clothHash = do
@ -205,47 +217,51 @@ getClothR loomHash clothHash = do
, AP.ticketAttachment = Just (hLocal, mergeRequestAP)
}
provideHtmlAndAP' authorHost ticketAP $ redirectToPrettyJSON here
provideHtmlAndAP' authorHost ticketAP getClothHtml
where
here = ClothR loomHash clothHash
{-
getClothHtml = do
mpid <- maybeAuthId
( wshr, wfl,
author, massignee, mresolved, cloth, lcloth, tparams, eparams, cparams) <-
runDB $ do
(Entity sid sharer, Entity jid project, Entity tid cloth, Entity _ lcloth, _etcl, _etpl, author, resolved) <- getProjectCloth404 shar proj ltkhid
tparams <- getClothTextParams tid wid
eparams <- getClothEnumParams tid wid
cparams <- getClothClasses tid wid
return
( wshr, wfl
, author', massignee, mresolved, cloth, lcloth
, tparams, eparams, cparams
(ticket, author, tparams, eparams, cparams) <- handlerToWidget $ runDB $ do
(_loom, _ticketloom, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr, _bundles) <-
getCloth404 loomHash clothHash
(ticket,,,,)
<$> bitraverse
(\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
p <- getJust personID
(Entity personID p,) <$> getJust (personActor p)
)
(\ (Entity _ (TicketAuthorRemote _ remoteActorID _)) -> do
ra <- getJust remoteActorID
ro <- getJust $ remoteActorIdent ra
i <- getJust $ remoteObjectInstance ro
return (i, ro, ra)
)
author
<*> getTicketTextParams ticketID --wid
<*> getTicketEnumParams ticketID --wid
<*> getTicketClasses ticketID --wid
hashMessageKey <- handlerToWidget getEncodeKeyHashid
let desc :: Widget
desc = toWidget $ preEscapedToMarkup $ clothDescription cloth
desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket
discuss =
discussionW
(return $ localClothDiscuss lcloth)
(ProjectClothTopReplyR shar proj ltkhid)
(ProjectClothReplyR shar proj ltkhid . encodeHid)
(return $ ticketDiscuss ticket)
(ClothReplyR loomHash clothHash)
(ReplyR . hashMessageKey)
cRelevant <- newIdent
cIrrelevant <- newIdent
let relevant filt =
bool cIrrelevant cRelevant $
case clothStatus cloth of
case ticketStatus ticket of
TSNew -> wffNew filt
TSTodo -> wffTodo filt
TSClosed -> wffClosed filt
provideHtmlAndAP' host clothAP $
let followButton =
followW
(ProjectClothFollowR shar proj ltkhid)
(ProjectClothUnfollowR shar proj ltkhid)
(return $ localClothFollowers lcloth)
in $(widgetFile "cloth/one")
-}
(ClothFollowR loomHash clothHash)
(ClothUnfollowR loomHash clothHash)
(ticketFollowers ticket)
$(widgetFile "cloth/one")
getClothDiscussionR
:: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
@ -481,6 +497,29 @@ getClothDepR _ _ _ = do
tdc
-}
postClothFollowR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler ()
postClothFollowR _ = error "Temporarily disabled"
postClothUnfollowR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler ()
postClothUnfollowR _ = error "Temporarily disabled"
postClothReplyR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler Html
postClothReplyR _ _ = error "Temporarily disabled"
{-
hLocal <- getsYesod $ appInstanceHost . appSettings
postTopReply
hLocal
[ProjectR shr prj]
[ ProjectFollowersR shr prj
, ProjectTicketParticipantsR shr prj ltkhid
, ProjectTicketTeamR shr prj ltkhid
]
(ProjectTicketR shr prj ltkhid)
(ProjectR shr prj)
(ProjectTicketDiscussionR shr prj ltkhid)
(const $ ProjectTicketR shr prj ltkhid)
-}

View file

@ -0,0 +1,19 @@
/* This file is part of Vervis.
*
* Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
*
* ♡ Copying is an act of love. Please copy, reuse and share.
*
* The author(s) have dedicated all copyright and related and neighboring
* rights to this software to the public domain worldwide. This software is
* distributed without any warranty.
*
* You should have received a copy of the CC0 Public Domain Dedication along
* with this software. If not, see
* <http://creativecommons.org/publicdomain/zero/1.0/>.
*/
.#{cRelevant}
.#{cIrrelevant}
color: #{light gray}

127
templates/cloth/one.hamlet Normal file
View file

@ -0,0 +1,127 @@
$# This file is part of Vervis.
$#
$# Written in 2016, 2018, 2019, 2020, 2022
$# by fr33domlover <fr33domlover@riseup.net>.
$#
$# ♡ Copying is an act of love. Please copy, reuse and share.
$#
$# The author(s) have dedicated all copyright and related and neighboring
$# rights to this software to the public domain worldwide. This software is
$# distributed without any warranty.
$#
$# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
<h2>#{preEscapedToHtml $ ticketTitle ticket}
<div>
Created on #{showDate $ ticketCreated ticket} by
^{personLinkFedW author}
<div>
<span>
<a href=@{ClothFollowersR loomHash clothHash}>
[🐤 Followers]
<span>
<a href=@{ClothDepsR loomHash clothHash}>
[⤴ Dependencies]
<span>
<a href=@{ClothReverseDepsR loomHash clothHash}>
[⤷ Dependants]
<span>
[✋ Claim requests]
<span>
[✏ Edit]
^{followButton}
<div>^{desc}
$# $if ticketStatus ticket /= TSClosed
$# <p>
$# $maybe (assignee, me) <- massignee
$# $if me
$# Assigned to you.
$#
$# ^{buttonW POST "Unclaim this ticket" (ProjectTicketUnclaimR loomHash clothHash)}
$# $else
$# Assigned to ^{sharerLinkW assignee}.
$#
$# ^{buttonW POST "Unassign this ticket" (ProjectTicketUnassignR loomHash clothHash)}
$# $nothing
$# Not assigned.
$#
$# <a href=@{ClaimRequestNewR loomHash clothHash}>Ask to have it assigned to you
$#
$# or
$#
$# ^{buttonW POST "Claim this ticket" (ProjectTicketClaimR loomHash clothHash)}
$#
$# or
$#
$# <a href=@{ProjectTicketAssignR loomHash clothHash}>Assign to someone else
$# .
<p>
Status: #
$case ticketStatus ticket
$of TSNew
Open, new.
$# ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR loomHash clothHash)}
$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR loomHash clothHash)}
$of TSTodo
Open, to do.
$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR loomHash clothHash)}
$of TSClosed
Closed on ___ by ___.
$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR loomHash clothHash)}
<h3>Custom fields
<ul>
$forall TicketTextParam field mvalue <- tparams
<li .#{relevant $ wfsFilter field}>
$# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
:
$maybe value <- mvalue
#{ttpvVal value}
$nothing
$if wfsRequired field
NO VALUE FOR REQUIRED FIELD
$else
(none)
$forall TicketEnumParam field enum mvalue <- eparams
<li .#{relevant $ wfsFilter field}>
$# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
:
$maybe value <- mvalue
$# <a href=@{WorkflowEnumCtorsR wshr wfl $ wesIdent enum}>
#{tepvName value}
$nothing
$if wfsRequired field
NO VALUE FOR REQUIRED FIELD
$else
(none)
$forall TicketClassParam field mvalue <- cparams
<li .#{relevant $ wfsFilter field}>
$# <a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
#{wfsName field}
:
$maybe _tpcid <- mvalue
Yes
$nothing
No
$# <p>
$# ^{buttonW DELETE "Delete this ticket" (ProjectTicketR loomHash clothHash)}
<h3>Discussion
^{discuss}

View file

@ -268,9 +268,9 @@
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/unclaim ClothUnclaimR POST
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/assign ClothAssignR GET POST
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/unassign ClothUnassignR POST
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/follow ClothFollowR POST
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/unfollow ClothUnfollowR POST
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/reply ClothTopReplyR GET POST
/looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/follow ClothFollowR POST
/looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/unfollow ClothUnfollowR POST
/looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/reply ClothReplyR POST
---- Cloth Dependency --------------------------------------------------------