From dae8554a12b53ca6a52f1008e94bd4c3ed7497b9 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 19 Sep 2022 11:00:47 +0000 Subject: [PATCH] UI: getPatchR: Display diff-syntax-highlighted patch content file --- src/Data/MediaType.hs | 13 ++++++++++++- src/Vervis/Foundation.hs | 5 +++++ src/Vervis/Handler/Cloth.hs | 25 ++++++++++++++++++------- src/Yesod/RenderSource.hs | 7 ++++++- templates/patch.hamlet | 25 +++++++++++++++++++++++++ vervis.cabal | 5 ++++- 6 files changed, 70 insertions(+), 10 deletions(-) create mode 100644 templates/patch.hamlet diff --git a/src/Data/MediaType.hs b/src/Data/MediaType.hs index 6b8cae1..ff0b10e 100644 --- a/src/Data/MediaType.hs +++ b/src/Data/MediaType.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2022 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -46,6 +46,8 @@ data MediaType | YesodRouteTemplate | Hamlet | Cassius + | Diff + | DarcsPatch deriving Show type FileName = Text @@ -72,17 +74,20 @@ chooseMediaType dir base ext wt opts = (_, _, "json" , _) -> PlainText (_, _, "yml" , _) -> PlainText (_, _, "yaml" , _) -> PlainText + -- * Documents (_, _, "txt" , _) -> PlainText (_, _, "md" , _) -> Markdown (_, _, "mdwn" , _) -> Markdown (_, _, "mkdn" , _) -> Markdown (_, _, "markdown", _) -> Markdown + -- * Web page basics (_, _, "html" , _) -> PlainText (_, _, "xhtml" , _) -> PlainText (_, _, "css" , _) -> PlainText (_, _, "js" , _) -> PlainText + -- * Programming languages -- ** C (_, _, "c" , _) -> PlainText @@ -116,4 +121,10 @@ chooseMediaType dir base ext wt opts = (_, _, "rb" , _) -> PlainText -- ** Scheme (_, _, "scm" , _) -> PlainText + + -- * Development + (_, _, "diff" , _) -> Diff + (_, _, "patch" , _) -> Diff + (_, _, "dpatch" , _) -> DarcsPatch + (_, _, _ , _) -> PlainText diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index e992c4a..c1ebdd0 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -789,6 +789,11 @@ instance YesodPaginate App where instance YesodBreadcrumbs App where breadcrumb route = return $ case route of + LoomR l -> ("MR Tracker +" <> keyHashidText l, Just HomeR) + LoomClothsR l -> ("MRs", Just $ LoomR l) + ClothR l c -> ("!" <> keyHashidText c, Just $ LoomClothsR l) + BundleR l c b -> ("Bundle " <> keyHashidText b, Just $ ClothR l c) + PatchR l c b p -> ("Patch " <> keyHashidText p, Just $ BundleR l c b) {- StaticR _ -> ("", Nothing) FaviconSvgR -> ("", Nothing) diff --git a/src/Vervis/Handler/Cloth.hs b/src/Vervis/Handler/Cloth.hs index 125995f..3d9df7b 100644 --- a/src/Vervis/Handler/Cloth.hs +++ b/src/Vervis/Handler/Cloth.hs @@ -81,12 +81,14 @@ import qualified Data.List.NonEmpty as NE import qualified Data.List.Ordered as LO import qualified Database.Esqueleto as E +import Data.MediaType import Development.PatchMediaType import Network.FedURI import Web.ActivityPub hiding (Ticket (..), Patch (..), Bundle (..), Repo (..), ActorDetail (..)) import Yesod.ActivityPub import Yesod.FedURI import Yesod.Hashids +import Yesod.RenderSource import qualified Web.ActivityPub as AP @@ -461,12 +463,15 @@ getPatchR loomHash clothHash bundleHash patchHash = do unless (patchBundle patch' == bundleID) notFound return patch' <*> bitraverse - (\ (Entity _ tal) -> return $ ticketAuthorLocalAuthor tal) + (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do + p <- getJust personID + (Entity personID p,) <$> getJust (personActor p) + ) (\ (Entity _ tar) -> do ra <- getJust $ ticketAuthorRemoteAuthor tar ro <- getJust $ remoteActorIdent ra i <- getJust $ remoteObjectInstance ro - return (i, ro) + return (i, ro, ra) ) author' @@ -476,8 +481,8 @@ getPatchR loomHash clothHash bundleHash patchHash = do let host = case author of - Left _ -> hLocal - Right (i, _) -> instanceHost i + Left _ -> hLocal + Right (i, _, _) -> instanceHost i patchLocalAP = AP.PatchLocal { AP.patchId = encodeRouteLocal here , AP.patchContext = @@ -487,14 +492,20 @@ getPatchR loomHash clothHash bundleHash patchHash = do { AP.patchLocal = Just (hLocal, patchLocalAP) , AP.patchAttributedTo = case author of - Left authorID -> + Left (Entity authorID _, _) -> encodeRouteLocal $ PersonR $ hashPerson authorID - Right (_, object) -> remoteObjectIdent object + Right (_, object, _) -> remoteObjectIdent object , AP.patchPublished = Just $ patchCreated patch , AP.patchType = patchType patch , AP.patchContent = patchContent patch } - provideHtmlAndAP' host patchAP $ redirectToPrettyJSON here + provideHtmlAndAP' host patchAP $ do + let syntax = + case patchType patch of + PatchMediaTypeDarcs -> DarcsPatch + PatchMediaTypeGit -> Diff + sourceW = renderSourceT syntax $ patchContent patch + $(widgetFile "patch") where here = PatchR loomHash clothHash bundleHash patchHash diff --git a/src/Yesod/RenderSource.hs b/src/Yesod/RenderSource.hs index 29c14f2..77c85ac 100644 --- a/src/Yesod/RenderSource.hs +++ b/src/Yesod/RenderSource.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2018, 2019 by fr33domlover . + - Written in 2016, 2018, 2019, 2022 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -79,6 +79,8 @@ import qualified Data.Text.Encoding.Error as TE import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Encoding as TLE +import qualified Text.Highlighter.Lexers.DarcsPatch as L.DarcsPatch +import qualified Text.Highlighter.Lexers.Diff as L.Diff import qualified Text.Highlighter.Lexers.Haskell as L.Haskell import qualified Text.Highlighter.Lexers.Javascript as L.JS @@ -238,6 +240,9 @@ renderSource mt contentB contentTL contentT = -- * Programming languages -- ** Haskell Haskell -> code L.Haskell.lexer + -- * Development files + Diff -> code L.Diff.lexer + DarcsPatch -> code L.DarcsPatch.lexer -- * Misc _ -> plain diff --git a/templates/patch.hamlet b/templates/patch.hamlet new file mode 100644 index 0000000..92d0203 --- /dev/null +++ b/templates/patch.hamlet @@ -0,0 +1,25 @@ +$# This file is part of Vervis. +$# +$# Written in 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 +$# . + +
+ $case patchType patch + $of PatchMediaTypeDarcs + Darcs patch bundle, + $of PatchMediaTypeGit + Git patch, + belongs to MR received on #{showDate $ patchCreated patch} from + ^{personLinkFedW author} + +
+ ^{sourceW} diff --git a/vervis.cabal b/vervis.cabal index d6b51ac..89383ce 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -424,7 +424,10 @@ library if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT - ghc-options: -Wall -fwarn-tabs -O0 -Werror=incomplete-patterns -Werror=missing-fields + ghc-options: -Wall -fwarn-tabs -O0 + -Werror=incomplete-patterns + -Werror=missing-fields + -Werror=overlapping-patterns else ghc-options: -Wall -fwarn-tabs -O2