{- This file is part of Vervis. - - Written in 2016 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 - . -} -- | Tools for rendering repository file contents and other source files. module Vervis.Render ( renderPlain , renderHighlight , renderSource ) where import Prelude import Control.Monad.Logger (logDebug, logWarn) import Data.ByteString.Lazy (ByteString, toStrict) import Data.Monoid ((<>)) import Data.Text (pack) import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Lazy.Encoding (decodeUtf8With) import Formatting hiding (format) import Text.Highlighter (lexerFromFilename, runLexer, Lexer (lName)) import Text.Highlighter.Formatters.Html (format) import Yesod.Core.Widget (whamlet, toWidget) import Vervis.Foundation (Widget) renderPlain :: ByteString -> Widget renderPlain content = [whamlet|
            #{decodeUtf8With lenientDecode content}
    |]

renderHighlight
    :: FilePath -> ByteString -> Either (Maybe Lexer) (Lexer, Widget)
renderHighlight name content =
    case lexerFromFilename name of
        Nothing    -> Left Nothing
        Just lexer ->
            case runLexer lexer $ toStrict content of
                Left err     -> Left $ Just lexer
                Right tokens -> Right (lexer, toWidget $ format True tokens)

renderSource :: FilePath -> ByteString -> Widget
renderSource name content =
    let plain = renderPlain content
    in  case renderHighlight name content of
            Left Nothing -> do
                $logDebug $ "No lexer found for " <> pack name
                plain
            Left (Just lexer) -> do
                $logWarn $ sformat
                    ( "Failed to highlight " % string % " with lexer "
                    % string
                    )
                    name (lName lexer)
                plain
            Right (lexer, widget) -> do
                $logDebug $ sformat
                    ("Lexed " % string % " with " % string) name (lName lexer)
                widget