UI: Serve HTML in getClothR, copied from getTicketR
This commit is contained in:
fr33domlover
parent
1e2b3d2006
commit
9deba96cf2
4 changed files with 226 additions and 41 deletions
|
|
@ -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
|
||||
|
||||
{-
|
||||
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
|
||||
)
|
||||
let desc :: Widget
|
||||
desc = toWidget $ preEscapedToMarkup $ clothDescription cloth
|
||||
discuss =
|
||||
discussionW
|
||||
(return $ localClothDiscuss lcloth)
|
||||
(ProjectClothTopReplyR shar proj ltkhid)
|
||||
(ProjectClothReplyR shar proj ltkhid . encodeHid)
|
||||
cRelevant <- newIdent
|
||||
cIrrelevant <- newIdent
|
||||
let relevant filt =
|
||||
bool cIrrelevant cRelevant $
|
||||
case clothStatus cloth of
|
||||
TSNew -> wffNew filt
|
||||
TSTodo -> wffTodo filt
|
||||
TSClosed -> wffClosed filt
|
||||
provideHtmlAndAP' host clothAP $
|
||||
getClothHtml = do
|
||||
mpid <- maybeAuthId
|
||||
(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 $ ticketDescription ticket
|
||||
discuss =
|
||||
discussionW
|
||||
(return $ ticketDiscuss ticket)
|
||||
(ClothReplyR loomHash clothHash)
|
||||
(ReplyR . hashMessageKey)
|
||||
cRelevant <- newIdent
|
||||
cIrrelevant <- newIdent
|
||||
let relevant filt =
|
||||
bool cIrrelevant cRelevant $
|
||||
case ticketStatus ticket of
|
||||
TSNew -> wffNew filt
|
||||
TSTodo -> wffTodo filt
|
||||
TSClosed -> wffClosed filt
|
||||
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)
|
||||
-}
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
19
templates/cloth/one.cassius
Normal file
19
templates/cloth/one.cassius
Normal 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
127
templates/cloth/one.hamlet
Normal 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}
|
||||
|
|
@ -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 --------------------------------------------------------
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue