{- This file is part of Vervis. - - Written in 2016, 2018 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.Catch (throwM) import Control.Monad.Logger (logDebug, logWarn) import Data.Foldable (for_) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Text (Text) --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 Skylighting.Styles (tango) import Text.HTML.SanitizeXSS (sanitizeBalance) import Text.Pandoc.Class (runPure) 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 , readerStandalone = False , readerColumns = 80 , readerTabStop = 4 -- , readerIndentedCodeClasses = [] -- , readerAbbreviations = defaultAbbrevs -- , readerDefaultImageExtension = "" -- , readerTrackChanges = AcceptChanges -- , readerStripComments = False } writerOptions :: WriterOptions writerOptions = def { -- writerTemplate = Nothing -- , writerVariables = [] writerTabStop = 4 , writerTableOfContents = True -- , writerIncremental = False -- , writerHTMLMathMethod = PlainMath -- , writerNumberSections = False -- , writerNumberOffset = [0,0,0,0,0,0] -- , writerSectionDivs = False , writerExtensions = pandocExtensions -- , writerReferenceLinks = False -- , writerDpi = 96 , writerWrapText = WrapAuto , writerColumns = 79 , writerEmailObfuscation = ReferenceObfuscation -- , writerIdentifierPrefix = "" -- , writerCiteMethod = Citeproc -- , writerHtmlQTags = False -- , writerSlideLevel = Nothing -- , writerTopLevelDivision = TopLevelDefault -- , writerListings = False , writerHighlightStyle = Just tango -- , writerSetextHeaders = True -- , writerEpubSubdirectory = "EPUB" -- , writerEpubMetadata = Nothing -- , writerEpubFonts = [] -- , writerEpubChapterLevel = 1 -- , writerTOCDepth = 3 -- , writerReferenceDoc = Nothing -- , writerReferenceLocation = EndOfDocument -- , writerSyntaxMap = defaultSyntaxMap } renderPandoc :: Pandoc -> Widget renderPandoc = either throwM toWidget . fmap ( preEscapedToMarkup . sanitizeBalance . TL.toStrict . renderHtml ) . runPure . writeHtml5 writerOptions renderSourceT :: MediaType -> Text -> Widget renderSourceT mt contentT = let contentB = TE.encodeUtf8 contentT contentTL = TL.fromStrict contentT in renderSource mt contentB contentTL contentT renderSourceBL :: MediaType -> BL.ByteString -> Widget 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 mt contentB contentTL contentT = 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 Text source docT r = case runPure $ r readerOptions contentT of Left err -> $logWarn (failed err) >> plain Right doc -> renderPandoc doc in case mt of -- * Documents PlainText -> plain Markdown -> docT readMarkdown -- * Programming languages -- ** Haskell Haskell -> code L.Haskell.lexer -- * Misc _ -> plain