Syntax-highlight the pretty JSON display of AP objects

src/Data/MediaType.hs

@@ -16,7 +16,7 @@
 -- | File content types and tools for detecting them. The focus is on content
 -- that gets special treatment in Vervis, and not general MIME type modeling or
 -- detection (although that could be done in the future).
-module Vervis.MediaType
+module Data.MediaType
     ( MediaType (..)
     , FileName
     , FileBaseName

src/Vervis/Handler/Discussion.hs

@@ -61,7 +61,7 @@ import Vervis.Federation
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
-import Vervis.Render
+import Yesod.RenderSource
 import Vervis.Settings
 import Vervis.Widget.Discussion
 

src/Vervis/Handler/Inbox.hs

@@ -115,7 +115,7 @@ import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Paginate
 import Vervis.RemoteActorStore
-import Vervis.Render
+import Yesod.RenderSource
 import Vervis.Settings
 
 getInboxR :: Handler Html

src/Vervis/Handler/Repo.hs

@@ -86,13 +86,13 @@ import Vervis.Foundation
 import Vervis.Handler.Repo.Darcs
 import Vervis.Handler.Repo.Git
 import Vervis.Path
-import Vervis.MediaType (chooseMediaType)
+import Data.MediaType
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Paginate
 import Vervis.Readme
-import Vervis.Render
+import Yesod.RenderSource
 import Vervis.Settings
 import Vervis.SourceTree
 import Vervis.Style

src/Vervis/Handler/Repo/Darcs.hs

@@ -54,14 +54,14 @@ import Vervis.ChangeFeed (changeFeed)
 import Vervis.Form.Repo
 import Vervis.Foundation
 import Vervis.Path
-import Vervis.MediaType (chooseMediaType)
+import Data.MediaType
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Paginate
 import Vervis.Patch
 import Vervis.Readme
-import Vervis.Render
+import Yesod.RenderSource
 import Vervis.Settings
 import Vervis.SourceTree
 import Vervis.Style

src/Vervis/Handler/Repo/Git.hs

@@ -64,14 +64,14 @@ import Vervis.ChangeFeed (changeFeed)
 import Vervis.Form.Repo
 import Vervis.Foundation
 import Vervis.Path
-import Vervis.MediaType (chooseMediaType)
+import Data.MediaType
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Paginate
 import Vervis.Patch
 import Vervis.Readme
-import Vervis.Render
+import Yesod.RenderSource
 import Vervis.Settings
 import Vervis.SourceTree
 import Vervis.Style

src/Vervis/Handler/Ticket.hs

@@ -105,12 +105,12 @@ import Vervis.Form.Ticket
 import Vervis.Foundation
 import Vervis.Handler.Discussion
 import Vervis.GraphProxy (ticketDepGraph)
-import Vervis.MediaType (MediaType (Markdown))
+import Data.MediaType
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Ticket
 import Vervis.Model.Workflow
-import Vervis.Render
+import Yesod.RenderSource
 import Vervis.Settings
 import Vervis.Style
 import Vervis.Ticket

src/Vervis/Handler/Wiki.hs

@@ -33,12 +33,12 @@ import Yesod.Persist.Core (runDB, getBy404)
 import Text.FilePath.Local (breakExt)
 import Vervis.Darcs
 import Vervis.Foundation
-import Vervis.MediaType
+import Data.MediaType
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Path (askRepoDir)
-import Vervis.Render (renderSourceBL)
+import Yesod.RenderSource
 import Vervis.Settings (widgetFile)
 import Vervis.Wiki
 

src/Vervis/Migration.hs

@@ -66,7 +66,7 @@ import Database.Persist.Local
 import Vervis.Model.Ident
 import Vervis.Foundation (Route (..))
 import Vervis.Migration.Model
-import Vervis.Render
+import Yesod.RenderSource
 
 instance PersistDefault ByteString where
     pdef = def

src/Vervis/Readme.hs

@@ -33,8 +33,8 @@ import System.FilePath (isExtSeparator)
 import Data.Git.Local (TreeRows)
 import Text.FilePath.Local (breakExt)
 import Vervis.Foundation (Widget)
-import Vervis.MediaType (chooseMediaType)
-import Vervis.Render (renderSourceBL)
+import Data.MediaType
+import Yesod.RenderSource
 
 -- | Check if the given filename should be considered as README file. Assumes
 -- a flat filename which doesn't contain a directory part.

src/Vervis/SourceTree.hs

@@ -34,9 +34,9 @@ import qualified Data.ByteString.Lazy as BL (ByteString)
 
 import Text.FilePath.Local (breakExt)
 import Vervis.Foundation (Widget)
-import Vervis.MediaType (chooseMediaType)
+import Data.MediaType
 import Vervis.Readme (renderReadme)
-import Vervis.Render (renderSourceBL)
+import Yesod.RenderSource
 
 data EntryType = TypeBlob | TypeTree
 

src/Vervis/Widget/Discussion.hs

@@ -40,10 +40,10 @@ import Data.Time.Clock.Local ()
 
 import Vervis.Discussion
 import Vervis.Foundation
-import Vervis.MediaType (MediaType (Markdown))
+import Data.MediaType
 import Vervis.Model
 import Vervis.Model.Ident
-import Vervis.Render (renderSourceT)
+import Yesod.RenderSource
 import Vervis.Settings (widgetFile)
 import Vervis.Widget.Sharer
 

src/Vervis/Wiki.hs

@@ -26,9 +26,9 @@ import qualified Data.ByteString.Lazy as BL (ByteString)
 
 import Text.FilePath.Local (breakExt)
 import Vervis.Foundation (Widget)
-import Vervis.MediaType (chooseMediaType)
+import Data.MediaType
 import Vervis.Readme (renderReadme)
-import Vervis.Render (renderSourceBL)
+import Yesod.RenderSource
 
 data WikiView
     = WikiViewPage (Maybe Text) BL.ByteString

src/Yesod/ActivityPub.hs

@@ -39,10 +39,10 @@ import qualified Data.Text as T
 
 import Network.HTTP.Signature
 
-import Data.Aeson.Encode.Pretty.ToEncoding
 import Network.FedURI
 import Web.ActivityPub
 import Yesod.MonadSite
+import Yesod.RenderSource
 
 class Yesod site => YesodActivityPub site where
     siteInstanceHost          :: site -> Text
@@ -134,10 +134,7 @@ provideHtmlAndAP' host object widget = selectRep $ do
         mval <- lookupGetParam "prettyjson"
         defaultLayout $
             case mval of
-                Just "true" ->
-                    [whamlet|
-                        <div><pre>#{encodePrettyToLazyText doc}
-                    |]
+                Just "true" -> renderPrettyJSON doc
                 _ -> do
                     widget
                     mroute <- getCurrentRoute

src/Yesod/RenderSource.hs

@@ -36,10 +36,11 @@
 -- (3) Not implemented
 -- (4) Not implemented
 -- (5) Not implmented
-module Vervis.Render
+module Yesod.RenderSource
     ( renderSourceT
     , renderSourceBL
     , renderPandocMarkdown
+    , renderPrettyJSON
     )
 where
 
@@ -48,6 +49,7 @@ import Prelude
 import Control.Exception
 import Control.Monad.Catch (throwM)
 import Control.Monad.Logger (logDebug, logWarn)
+import Data.Aeson
 import Data.Foldable (for_)
 import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
@@ -64,7 +66,7 @@ import Text.Pandoc.Highlighting
 import Text.Pandoc.Options
 import Text.Pandoc.Readers.Markdown
 import Text.Pandoc.Writers.HTML
-import Yesod.Core.Widget (whamlet, toWidget)
+import Yesod.Core.Widget
 
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
@@ -74,9 +76,10 @@ import qualified Data.Text.Encoding.Error as TE
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLE
 import qualified Text.Highlighter.Lexers.Haskell as L.Haskell
+import qualified Text.Highlighter.Lexers.Javascript as L.JS
 
-import Vervis.Foundation (Widget)
-import Vervis.MediaType (MediaType (..))
+import Data.Aeson.Encode.Pretty.ToEncoding
+import Data.MediaType
 
 -- * File uploads and wiki attachments
 -- * Wiki pages
@@ -116,20 +119,20 @@ import Vervis.MediaType (MediaType (..))
 -- * [ ] asciidoc
 -- * [ ] groff manpage
 
-renderPlain :: TL.Text -> Widget
+renderPlain :: TL.Text -> WidgetFor site ()
 renderPlain content =
     [whamlet|
         <pre>
             <code>#{content}
     |]
 
-renderHighlight :: Lexer -> B.ByteString -> Maybe Widget
+renderHighlight :: Lexer -> B.ByteString -> Maybe (WidgetFor site ())
 renderHighlight lexer content =
     case runLexer lexer content of
         Left err     -> Nothing
         Right tokens -> Just $ toWidget $ format True tokens
 
-renderCode :: Lexer -> TL.Text -> B.ByteString -> Widget
+renderCode :: Lexer -> TL.Text -> B.ByteString -> WidgetFor site ()
 renderCode lexer contentTL contentB =
     fromMaybe (renderPlain contentTL) $ renderHighlight lexer contentB
 
@@ -182,7 +185,7 @@ writerOptions = def
 --  , writerSyntaxMap         = defaultSyntaxMap
     }
 
-renderPandoc :: Pandoc -> Widget
+renderPandoc :: Pandoc -> WidgetFor site ()
 renderPandoc
     = either throwM toWidget
     . fmap
@@ -194,20 +197,21 @@ renderPandoc
     . runPure
     . writeHtml5 writerOptions
 
-renderSourceT :: MediaType -> Text -> Widget
+renderSourceT :: MediaType -> Text -> WidgetFor site ()
 renderSourceT mt contentT =
     let contentB = TE.encodeUtf8 contentT
         contentTL = TL.fromStrict contentT
     in  renderSource mt contentB contentTL contentT
 
-renderSourceBL :: MediaType -> BL.ByteString -> Widget
+renderSourceBL :: MediaType -> BL.ByteString -> WidgetFor site ()
 renderSourceBL mt contentBL =
     let contentB = BL.toStrict contentBL
         contentTL = TLE.decodeUtf8With TE.lenientDecode contentBL
         contentT = TL.toStrict contentTL
     in  renderSource mt contentB contentTL contentT
 
-renderSource :: MediaType -> B.ByteString -> TL.Text -> Text -> Widget
+renderSource
+    :: MediaType -> B.ByteString -> TL.Text -> Text -> WidgetFor site ()
 renderSource mt contentB contentTL contentT =
     let mtName = T.pack $ show mt
 
@@ -252,3 +256,10 @@ renderPandocMarkdown input =
         = fmap (sanitizeBalance . TL.toStrict . renderHtml)
         . runPure
         . writeHtml5 writerOptions
+
+renderPrettyJSON :: ToJSON a => a -> WidgetFor site ()
+renderPrettyJSON a =
+    let prettyBL = encodePretty a
+        prettyB = BL.toStrict prettyBL
+        prettyTL = TLE.decodeUtf8 prettyBL
+    in  renderCode L.JS.lexer prettyTL prettyB

vervis.cabal

@@ -69,6 +69,7 @@ library
                        Data.List.Local
                        Data.List.NonEmpty.Local
                        Data.Maybe.Local
+                       Data.MediaType
                        Data.Paginate.Local
                        Data.Text.UTF8.Local
                        Data.Text.Lazy.UTF8.Local
@@ -106,6 +107,7 @@ library
                        Yesod.MonadSite
                        Yesod.Paginate.Local
                        Yesod.Persist.Local
+                       Yesod.RenderSource
                        Yesod.SessionEntity
 
                        Vervis.Access
@@ -162,7 +164,6 @@ library
                        Vervis.Import
                        Vervis.Import.NoFoundation
                        Vervis.KeyFile
-                       Vervis.MediaType
                        Vervis.Migration
                        Vervis.Migration.Model
                        Vervis.Migration.TH
@@ -182,7 +183,6 @@ library
                        Vervis.Query
                        Vervis.Readme
                        Vervis.RemoteActorStore
-                       Vervis.Render
                        Vervis.Role
                        Vervis.Secure
                        Vervis.Settings