diff --git a/src/Yesod/ActivityPub.hs b/src/Yesod/ActivityPub.hs index dac8d08..9f2f270 100644 --- a/src/Yesod/ActivityPub.hs +++ b/src/Yesod/ActivityPub.hs @@ -187,16 +187,27 @@ provideHtmlAndAP' host object widget = selectRep $ do mval <- lookupGetParam "prettyjson" defaultLayout $ case mval of - Just "true" -> renderPrettyJSON doc + Just "true" -> do + mhl <- lookupGetParam "highlight" + let sky = case mhl of + Nothing -> error "Highlight style not set" + Just "hl2" -> False + Just "sky" -> True + Just _ -> error "Invalid highlight style" + if sky + then renderPrettyJSONSkylighting doc + else renderPrettyJSON doc _ -> do widget mroute <- getCurrentRoute for_ mroute $ \ route -> do params <- reqGetParams <$> getRequest let pj = ("prettyjson", "true") + hl = ("highlight", "hl2") + params' = pj : hl : params [whamlet|
- + [See JSON] |] @@ -209,15 +220,26 @@ provideHtmlAndAP'' body widget = selectRep $ do mval <- lookupGetParam "prettyjson" defaultLayout $ case mval of - Just "true" -> renderPrettyJSON' body + Just "true" -> do + mhl <- lookupGetParam "highlight" + let sky = case mhl of + Nothing -> error "Highlight style not set" + Just "hl2" -> False + Just "sky" -> True + Just _ -> error "Invalid highlight style" + if sky + then renderPrettyJSONSkylighting' body + else renderPrettyJSON' body _ -> do widget mroute <- getCurrentRoute for_ mroute $ \ route -> do params <- reqGetParams <$> getRequest let pj = ("prettyjson", "true") + hl = ("highlight", "hl2") + params' = pj : hl : params [whamlet|
- + [See JSON] |] diff --git a/src/Yesod/RenderSource.hs b/src/Yesod/RenderSource.hs index 5e9f91e..506188f 100644 --- a/src/Yesod/RenderSource.hs +++ b/src/Yesod/RenderSource.hs @@ -42,6 +42,8 @@ module Yesod.RenderSource , renderPandocMarkdown , renderPrettyJSON , renderPrettyJSON' + , renderPrettyJSONSkylighting + , renderPrettyJSONSkylighting' ) where @@ -54,6 +56,7 @@ import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Text (Text) --import Formatting hiding (format) +import Skylighting import Text.Blaze.Html (preEscapedToMarkup) import Text.Blaze.Html.Renderer.Text (renderHtml) import Text.Highlighter (lexerFromFilename, runLexer, Lexer (lName)) @@ -69,10 +72,12 @@ import Yesod.Core.Widget import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL +import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Text.Encoding as TE 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.Haskell as L.Haskell import qualified Text.Highlighter.Lexers.Javascript as L.JS @@ -264,3 +269,24 @@ renderPrettyJSON' prettyBL = let prettyB = BL.toStrict prettyBL prettyTL = TLE.decodeUtf8 prettyBL in renderCode L.JS.lexer prettyTL prettyB + +renderPrettyJSONSkylighting' :: BL.ByteString -> WidgetFor site () +renderPrettyJSONSkylighting' prettyBL = + case tokenizeJSON prettyBL of + Left e -> error $ "Tokenizing JSON failed: " ++ e + Right sls -> do + toWidgetHead $ CssBuilder $ TLB.fromString $ styleToCss zenburn + toWidget $ formatHtmlBlock options sls + where + tokenizeJSON = tokenize config jsonSyntax . TE.decodeUtf8 . BL.toStrict + where + syntaxMap = defaultSyntaxMap + jsonSyntax = + case M.lookup "JSON" syntaxMap of + Nothing -> error "Skylighting JSON syntax not found" + Just s -> s + config = TokenizerConfig syntaxMap False + options = defaultFormatOpts { numberLines = True } + +renderPrettyJSONSkylighting :: ToJSON a => a -> WidgetFor site () +renderPrettyJSONSkylighting = renderPrettyJSONSkylighting' . encode diff --git a/vervis.cabal b/vervis.cabal index 14aa24c..e18fcfc 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -326,6 +326,8 @@ library , resourcet , safe , shakespeare + -- for json debug highlighting in Yesod.RenderSource + , skylighting , smtp-mail , ssh -- for holding actor key in a TVar