mirror of
https://code.sup39.dev/repos/Wqawg
synced 2025-01-07 20:56:47 +09:00
d8d2d160a0
At the beginning the rendering was invalid because it parsed the entire content as a single line. For some reason, when I read the ticket description from the DB, all newlines are returned as CRLF. I don't know why yet or whether it can or should be changed, but as a quick fix, I made the handler function filter out the CRs from the text. Then the rendering is correct. This matches the documentation of Pandoc, which mentions the readers assume newlines are encoded as LF.
260 lines
8.2 KiB
Haskell
260 lines
8.2 KiB
Haskell
{- This file is part of Vervis.
|
|
-
|
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
-
|
|
- ♡ 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
|
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
-}
|
|
|
|
{-# Language CPP #-}
|
|
|
|
-- | Tools for rendering repository file contents and other source files.
|
|
--
|
|
-- There are several ways to render a file:
|
|
--
|
|
-- (1) As a source file, plain text and with line numbers
|
|
-- (2) As a source file, syntax highlighted and with line numbers
|
|
-- (3) As a plain text document
|
|
-- (4) As a document rendered to HTML, e.g. Markdown is a popular format
|
|
-- (5) As a document rendered to a custom format, e.g. presentation
|
|
--
|
|
-- The difference between 3 and 5 is line numbers and font (3 would use regular
|
|
-- text font, while 5 would use monospaced font).
|
|
--
|
|
-- At the time of writing, not all rendering modes are implemented. The current
|
|
-- status, assuming I'm keeping it updated, is:
|
|
--
|
|
-- (1) Partially implemented: No line numbers
|
|
-- (2) Implemented, using line numbers generated by @highlighter2@ formatter
|
|
-- (3) Not implemented
|
|
-- (4) Not implemented
|
|
-- (5) Not implmented
|
|
module Vervis.Render
|
|
( renderSourceT
|
|
, renderSourceBL
|
|
)
|
|
where
|
|
|
|
import Prelude
|
|
|
|
import Control.Monad.Logger (logDebug, logWarn)
|
|
import Data.Foldable (for_)
|
|
import Data.Maybe (fromMaybe)
|
|
import Data.Monoid ((<>))
|
|
--import Formatting hiding (format)
|
|
import Text.Blaze.Html (preEscapedToMarkup)
|
|
import Text.Blaze.Html.Renderer.Text (renderHtml)
|
|
import Text.Highlighter (lexerFromFilename, runLexer, Lexer (lName))
|
|
import Text.Highlighter.Formatters.Html (format)
|
|
import Text.Highlighting.Kate.Styles (tango)
|
|
import Text.HTML.SanitizeXSS (sanitizeBalance)
|
|
import Text.Pandoc.Definition (Pandoc)
|
|
import Text.Pandoc.Options
|
|
import Text.Pandoc.Readers.Markdown
|
|
import Text.Pandoc.Writers.HTML
|
|
import Yesod.Core.Widget (whamlet, toWidget)
|
|
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Lazy as BL
|
|
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.Encoding as TLE
|
|
import qualified Text.Highlighter.Lexers.Haskell as L.Haskell
|
|
|
|
import Vervis.Foundation (Widget)
|
|
import Vervis.MediaType (MediaType (..))
|
|
|
|
-- * File uploads and wiki attachments
|
|
-- * Wiki pages
|
|
-- * READMEs
|
|
-- * Source files which happen to be documents, e.g. Markdown, manpages,
|
|
-- OrgMode, LaTeX, and
|
|
-- * Literate Haskell files
|
|
--
|
|
-- For now, let's ignore the first two. Which source files, README or other, do
|
|
-- we want to offer to display as HTML rendering?
|
|
--
|
|
-- * [ ] native
|
|
-- * [ ] json
|
|
-- * [x] markdown
|
|
-- * [ ] markdown_strict
|
|
-- * [ ] markdown_phpextra
|
|
-- * [ ] markdown_github
|
|
-- * [ ] markdown_mmd
|
|
-- * [ ] commonmark
|
|
-- * [ ] rst
|
|
-- * [ ] mediawiki
|
|
-- * [ ] docbook
|
|
-- * [ ] opml
|
|
-- * [ ] org
|
|
-- * [ ] textile
|
|
-- * [ ] html
|
|
-- * [ ] latex
|
|
-- * [ ] haddock
|
|
-- * [ ] twiki
|
|
-- * [ ] docx
|
|
-- * [ ] odt
|
|
-- * [ ] t2t
|
|
-- * [ ] epub
|
|
--
|
|
-- Any others not in this list, maybe using other libraries?
|
|
--
|
|
-- * [ ] asciidoc
|
|
-- * [ ] groff manpage
|
|
|
|
renderPlain :: TL.Text -> Widget
|
|
renderPlain content =
|
|
[whamlet|
|
|
<pre>
|
|
<code>#{content}
|
|
|]
|
|
|
|
renderHighlight :: Lexer -> B.ByteString -> Maybe Widget
|
|
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 contentTL contentB =
|
|
fromMaybe (renderPlain contentTL) $ renderHighlight lexer contentB
|
|
|
|
readerOptions :: ReaderOptions
|
|
readerOptions = def
|
|
{ readerExtensions = pandocExtensions
|
|
, readerSmart = True
|
|
, readerStandalone = False
|
|
, readerParseRaw = True
|
|
, readerColumns = 80
|
|
, readerTabStop = 4
|
|
-- , readerOldDashes = False
|
|
-- , readerApplyMacros = True
|
|
-- , readerIndentedCodeClasses = []
|
|
-- , readerDefaultImageExtension = ""
|
|
, readerTrace =
|
|
#if DEVELOPMENT
|
|
True
|
|
#else
|
|
False
|
|
#endif
|
|
-- , readerTrackChanges = AcceptChanges
|
|
-- , readerFileScope = False
|
|
}
|
|
|
|
writerOptions :: WriterOptions
|
|
writerOptions = def
|
|
{ writerStandalone = False
|
|
-- , writerTemplate = ""
|
|
-- , writerVariables = []
|
|
, writerTabStop = 4
|
|
, writerTableOfContents = True
|
|
-- , writerSlideVariant = NoSlides
|
|
-- , writerIncremental = False
|
|
-- , writerHTMLMathMethod = PlainMath
|
|
-- , writerIgnoreNotes = False
|
|
-- , writerNumberSections = False
|
|
-- , writerNumberOffset = [0,0,0,0,0,0]
|
|
-- , writerSectionDivs = False
|
|
, writerExtensions = pandocExtensions
|
|
-- , writerReferenceLinks = False
|
|
-- , writerDpi = 96
|
|
, writerWrapText = WrapAuto
|
|
, writerColumns = 79
|
|
, writerEmailObfuscation = ReferenceObfuscation
|
|
-- , writerIdentifierPrefix = ""
|
|
-- , writerSourceURL = Nothing
|
|
-- , writerUserDataDir = Nothing
|
|
-- , writerCiteMethod = Citeproc
|
|
, writerHtml5 = True
|
|
-- , writerHtmlQTags = False
|
|
-- , writerBeamer = False
|
|
-- , writerSlideLevel = Nothing
|
|
-- , writerChapters = False
|
|
-- , writerListings = False
|
|
, writerHighlight = True
|
|
, writerHighlightStyle = tango
|
|
-- , writerSetextHeaders = True
|
|
-- , writerTeXLigatures = True
|
|
-- , writerEpubVersion = Nothing
|
|
-- , writerEpubMetadata = ""
|
|
-- , writerEpubStylesheet = Nothing
|
|
-- , writerEpubFonts = []
|
|
-- , writerEpubChapterLevel = 1
|
|
-- , writerTOCDepth = 3
|
|
-- , writerReferenceODT = Nothing
|
|
-- , writerReferenceDocx = Nothing
|
|
-- , writerMediaBag = mempty
|
|
, writerVerbose =
|
|
#if DEVELOPMENT
|
|
True
|
|
#else
|
|
False
|
|
#endif
|
|
-- , writerLaTeXArgs = []
|
|
}
|
|
|
|
renderPandoc :: Pandoc -> Widget
|
|
renderPandoc =
|
|
toWidget .
|
|
preEscapedToMarkup .
|
|
sanitizeBalance .
|
|
TL.toStrict .
|
|
renderHtml .
|
|
writeHtml writerOptions
|
|
|
|
renderSourceT :: MediaType -> T.Text -> Widget
|
|
renderSourceT mt contentT =
|
|
let contentB = TE.encodeUtf8 contentT
|
|
contentTL = TL.fromStrict contentT
|
|
contentS = T.unpack contentT
|
|
in renderSource mt contentB contentTL contentS
|
|
|
|
renderSourceBL :: MediaType -> BL.ByteString -> Widget
|
|
renderSourceBL mt contentBL =
|
|
let contentB = BL.toStrict contentBL
|
|
contentTL = TLE.decodeUtf8With TE.lenientDecode contentBL
|
|
contentS = TL.unpack contentTL
|
|
in renderSource mt contentB contentTL contentS
|
|
|
|
renderSource :: MediaType -> B.ByteString -> TL.Text -> String -> Widget
|
|
renderSource mt contentB contentTL contentS =
|
|
let mtName = T.pack $ show mt
|
|
|
|
failed e =
|
|
"Failed to parse " <> mtName <> "content: " <> T.pack (show e)
|
|
|
|
-- Plain text with line numbers
|
|
plain = renderPlain contentTL
|
|
-- Syntax highlighted source code with line numbers
|
|
code l = renderCode l contentTL contentB
|
|
-- Rendered document from String source
|
|
docS r =
|
|
case r readerOptions contentS of
|
|
Left err -> $logWarn (failed err) >> plain
|
|
Right doc -> renderPandoc doc
|
|
-- Rendered document from String source, with warnings
|
|
docSW r =
|
|
case r readerOptions contentS of
|
|
Left err -> $logWarn (failed err) >> plain
|
|
Right (doc, warns) -> do
|
|
for_ warns $ \ warn ->
|
|
$logDebug $ mtName <> " reader warning: " <> T.pack warn
|
|
renderPandoc doc
|
|
in case mt of
|
|
-- * Documents
|
|
PlainText -> plain
|
|
Markdown -> docSW readMarkdownWithWarnings
|
|
-- * Programming languages
|
|
-- ** Haskell
|
|
Haskell -> code L.Haskell.lexer
|
|
-- * Misc
|
|
_ -> plain
|