diff --git a/src/Vervis/Handler/Cloth.hs b/src/Vervis/Handler/Cloth.hs index 6e357f5..2433203 100644 --- a/src/Vervis/Handler/Cloth.hs +++ b/src/Vervis/Handler/Cloth.hs @@ -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) + -} + diff --git a/templates/cloth/one.cassius b/templates/cloth/one.cassius new file mode 100644 index 0000000..17c40e0 --- /dev/null +++ b/templates/cloth/one.cassius @@ -0,0 +1,19 @@ +/* This file is part of Vervis. + * + * Written in 2016 by fr33domlover . + * + * ♡ 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 + * . + */ + +.#{cRelevant} + +.#{cIrrelevant} + color: #{light gray} diff --git a/templates/cloth/one.hamlet b/templates/cloth/one.hamlet new file mode 100644 index 0000000..19258ad --- /dev/null +++ b/templates/cloth/one.hamlet @@ -0,0 +1,127 @@ +$# This file is part of Vervis. +$# +$# Written in 2016, 2018, 2019, 2020, 2022 +$# by fr33domlover . +$# +$# ♡ 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 +$# . + +

#{preEscapedToHtml $ ticketTitle ticket} + +
+ Created on #{showDate $ ticketCreated ticket} by + ^{personLinkFedW author} + +
+ + + [🐤 Followers] + + + [⤴ Dependencies] + + + [⤷ Dependants] + + [✋ Claim requests] + + [✏ Edit] + +^{followButton} + +
^{desc} + +$# $if ticketStatus ticket /= TSClosed +$#

+$# $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. +$# +$# Ask to have it assigned to you +$# +$# or +$# +$# ^{buttonW POST "Claim this ticket" (ProjectTicketClaimR loomHash clothHash)} +$# +$# or +$# +$# Assign to someone else +$# . + +

+ 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)} + + +

Custom fields + +