Client: Add form to submit a patch via Offer activity
This commit is contained in:
fr33domlover
parent
7812fa6e8f
commit
201736427e
2 changed files with 87 additions and 5 deletions
|
|
@ -30,6 +30,7 @@ module Vervis.Client
|
|||
, undoFollowRepo
|
||||
, unresolve
|
||||
, createMR
|
||||
, offerMR
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -615,8 +616,69 @@ createMR shrAuthor title desc uContext muBranch typ diff = runExceptT $ do
|
|||
}
|
||||
)
|
||||
}
|
||||
create = Create
|
||||
{ createObject = CreateTicket ticket
|
||||
, createTarget = Just uTarget
|
||||
}
|
||||
return (Nothing, Audience recips [] [] [] [] [], ticket, Just uTarget)
|
||||
|
||||
offerMR
|
||||
:: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
|
||||
=> ShrIdent
|
||||
-> TextHtml
|
||||
-> TextPandocMarkdown
|
||||
-> FedURI
|
||||
-> Maybe FedURI
|
||||
-> PatchMediaType
|
||||
-> Text
|
||||
-> m (Either Text (Maybe TextHtml, Audience URIMode, AP.Ticket URIMode))
|
||||
offerMR shrAuthor title desc uContext muBranch typ diff = runExceptT $ do
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
manager <- asksSite appHttpManager
|
||||
hLocal <- asksSite siteInstanceHost
|
||||
|
||||
context <- parseTicketContext uContext
|
||||
descHtml <-
|
||||
ExceptT . pure $ renderPandocMarkdown $ unTextPandocMarkdown desc
|
||||
context' <- bitraverse pure (getRemoteContextHttp "Context") context
|
||||
|
||||
let audAuthor =
|
||||
AudLocal
|
||||
[]
|
||||
[LocalPersonCollectionSharerFollowers shrAuthor]
|
||||
audContext = contextAudience context'
|
||||
|
||||
(_, _, _, audLocal, audRemote) =
|
||||
collectAudience $ audAuthor : audContext
|
||||
|
||||
recips = map encodeRouteHome audLocal ++ audRemote
|
||||
ObjURI hBranch luBranch = fromMaybe uContext muBranch
|
||||
luAuthor = encodeRouteLocal $ SharerR shrAuthor
|
||||
|
||||
ticket = AP.Ticket
|
||||
{ AP.ticketLocal = Nothing
|
||||
, AP.ticketAttributedTo = luAuthor
|
||||
, AP.ticketPublished = Nothing
|
||||
, AP.ticketUpdated = Nothing
|
||||
, AP.ticketContext = Nothing
|
||||
, AP.ticketSummary = title
|
||||
, AP.ticketContent = TextHtml descHtml
|
||||
, AP.ticketSource = desc
|
||||
, AP.ticketAssignedTo = Nothing
|
||||
, AP.ticketResolved = Nothing
|
||||
, AP.ticketAttachment = Just
|
||||
( hBranch
|
||||
, MergeRequest
|
||||
{ mrOrigin = Nothing
|
||||
, mrTarget = luBranch
|
||||
, mrBundle = Right
|
||||
( hLocal
|
||||
, BundleOffer Nothing $ pure AP.Patch
|
||||
{ AP.patchLocal = Nothing
|
||||
, AP.patchAttributedTo = luAuthor
|
||||
, AP.patchPublished = Nothing
|
||||
, AP.patchType = typ
|
||||
, AP.patchContent = diff
|
||||
}
|
||||
)
|
||||
}
|
||||
)
|
||||
}
|
||||
return (Nothing, Audience recips [] [] [] [] [], ticket)
|
||||
|
|
|
|||
|
|
@ -250,6 +250,7 @@ activityWidget
|
|||
-> Widget -> Enctype
|
||||
-> Widget -> Enctype
|
||||
-> Widget -> Enctype
|
||||
-> Widget -> Enctype
|
||||
-> Widget
|
||||
activityWidget
|
||||
widget1 enctype1
|
||||
|
|
@ -258,7 +259,8 @@ activityWidget
|
|||
widget4 enctype4
|
||||
widget5 enctype5
|
||||
widget6 enctype6
|
||||
widget7 enctype7 =
|
||||
widget7 enctype7
|
||||
widget8 enctype8 =
|
||||
[whamlet|
|
||||
<h1>Publish a ticket comment
|
||||
<form method=POST action=@{PublishR} enctype=#{enctype1}>
|
||||
|
|
@ -294,6 +296,11 @@ activityWidget
|
|||
<form method=POST action=@{PublishR} enctype=#{enctype7}>
|
||||
^{widget7}
|
||||
<input type=submit>
|
||||
|
||||
<h1>Submit a patch (via Offer)
|
||||
<form method=POST action=@{PublishR} enctype=#{enctype8}>
|
||||
^{widget8}
|
||||
<input type=submit>
|
||||
|]
|
||||
|
||||
getUser :: Handler (ShrIdent, PersonId)
|
||||
|
|
@ -327,6 +334,8 @@ getPublishR = do
|
|||
runFormPost $ identifyForm "f6" unresolveForm
|
||||
((_result7, widget7), enctype7) <-
|
||||
runFormPost $ identifyForm "f7" createMergeRequestForm
|
||||
((_result8, widget8), enctype8) <-
|
||||
runFormPost $ identifyForm "f8" createMergeRequestForm
|
||||
defaultLayout $
|
||||
activityWidget
|
||||
widget1 enctype1
|
||||
|
|
@ -336,6 +345,7 @@ getPublishR = do
|
|||
widget5 enctype5
|
||||
widget6 enctype6
|
||||
widget7 enctype7
|
||||
widget8 enctype8
|
||||
|
||||
postSharerOutboxR :: ShrIdent -> Handler Text
|
||||
postSharerOutboxR shr = do
|
||||
|
|
@ -395,6 +405,7 @@ data Result
|
|||
| ResultResolve FedURI
|
||||
| ResultUnresolve FedURI
|
||||
| ResultCreateMR (FedURI, Maybe FedURI, TextHtml, TextPandocMarkdown, PatchMediaType, FileInfo)
|
||||
| ResultOfferMR (FedURI, Maybe FedURI, TextHtml, TextPandocMarkdown, PatchMediaType, FileInfo)
|
||||
|
||||
postPublishR :: Handler Html
|
||||
postPublishR = do
|
||||
|
|
@ -415,6 +426,8 @@ postPublishR = do
|
|||
runFormPost $ identifyForm "f6" unresolveForm
|
||||
((result7, widget7), enctype7) <-
|
||||
runFormPost $ identifyForm "f7" createMergeRequestForm
|
||||
((result8, widget8), enctype8) <-
|
||||
runFormPost $ identifyForm "f8" createMergeRequestForm
|
||||
let result
|
||||
= ResultPublishComment <$> result1
|
||||
<|> ResultCreateTicket <$> result2
|
||||
|
|
@ -423,6 +436,7 @@ postPublishR = do
|
|||
<|> ResultResolve <$> result5
|
||||
<|> ResultUnresolve <$> result6
|
||||
<|> ResultCreateMR <$> result7
|
||||
<|> ResultOfferMR <$> result8
|
||||
|
||||
ep@(Entity _ p) <- requireVerifiedAuth
|
||||
s <- runDB $ getJust $ personIdent p
|
||||
|
|
@ -450,6 +464,11 @@ postPublishR = do
|
|||
(summary, audience, ticket, muTarget) <-
|
||||
ExceptT $ createMR shrAuthor title desc uCtx muBranch typ diff
|
||||
createTicketC ep s summary audience ticket muTarget
|
||||
ResultOfferMR (uCtx, muBranch, title, desc, typ, file) -> do
|
||||
diff <- TE.decodeUtf8 <$> fileSourceByteString file
|
||||
(summary, audience, ticket) <-
|
||||
ExceptT $ offerMR shrAuthor title desc uCtx muBranch typ diff
|
||||
offerTicketC ep s summary audience ticket uCtx
|
||||
case eid of
|
||||
Left err -> setMessage $ toHtml err
|
||||
Right _obiid -> setMessage "Activity published"
|
||||
|
|
@ -462,6 +481,7 @@ postPublishR = do
|
|||
widget5 enctype5
|
||||
widget6 enctype6
|
||||
widget7 enctype7
|
||||
widget8 enctype8
|
||||
where
|
||||
publishComment eperson sharer ((hTicket, shrTicket, prj, num), muParent, msg) = do
|
||||
encodeRouteFed <- getEncodeRouteHome
|
||||
|
|
|
|||
Loading…
Reference in a new issue