Render ticket description as Markdown

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.
This commit is contained in:
fr33domlover 2016-05-02 21:20:25 +00:00
parent 072928dab1
commit d8d2d160a0
5 changed files with 40 additions and 62 deletions

View file

@ -183,7 +183,7 @@ getRepoSource repository user repo ref dir = do
parent = init dir
(base, ext) = breakExt name
mediaType = chooseMediaType parent base ext () ()
in renderSource mediaType (blobGetContent b)
in renderSourceBL mediaType (blobGetContent b)
Right (v, mr) -> return $ Right (map mkrow v, mr)
let parent = if null dir then [] else init dir
dirs = zip parent (tail $ inits parent)

View file

@ -41,12 +41,14 @@ import Yesod.Form.Functions (runFormPost)
import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)
import qualified Data.Text as T (intercalate, pack)
import qualified Data.Text as T (filter, intercalate, pack)
import qualified Database.Esqueleto as E ((==.))
import Vervis.Form.Ticket
import Vervis.Foundation
import Vervis.MediaType (MediaType (Markdown))
import Vervis.Model
import Vervis.Render (renderSourceT)
import Vervis.Settings (widgetFile)
getTicketsR :: Text -> Text -> Handler Html
@ -116,6 +118,7 @@ getTicketR shar proj num = do
get404 $ personIdent person'
else return author
return (author, closer, ticket)
let desc = renderSourceT Markdown $ T.filter (/= '\r') $ ticketDesc ticket
defaultLayout $ do
setTitle $ toHtml $ T.intercalate " :: "
[shar, proj, "Tickets", T.pack ('#' : show num)]

View file

@ -34,7 +34,7 @@ import System.FilePath (isExtSeparator)
import Vervis.Foundation (Widget)
import Vervis.MediaType (chooseMediaType)
import Vervis.Render (renderSource)
import Vervis.Render (renderSourceBL)
import Text.FilePath.Local (breakExt)
-- | Check if the given filename should be considered as README file. Assumes
@ -65,4 +65,4 @@ renderReadme :: [Text] -> Text -> ByteString -> Widget
renderReadme dir name content =
let (base, ext) = breakExt name
mediaType = chooseMediaType dir base ext () ()
in renderSource mediaType content
in renderSourceBL mediaType content

View file

@ -37,9 +37,8 @@
-- (4) Not implemented
-- (5) Not implmented
module Vervis.Render
( --renderPlain
--, renderHighlight
renderSource
( renderSourceT
, renderSourceBL
)
where
@ -62,8 +61,10 @@ 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
@ -72,24 +73,6 @@ import qualified Text.Highlighter.Lexers.Haskell as L.Haskell
import Vervis.Foundation (Widget)
import Vervis.MediaType (MediaType (..))
renderPlain :: BL.ByteString -> Widget
renderPlain content =
[whamlet|
<pre>
<code>#{TLE.decodeUtf8With TE.lenientDecode content}
|]
{-renderHighlight
:: FilePath -> BL.ByteString -> Either (Maybe Lexer) (Lexer, Widget)
renderHighlight name content =
case lexerFromFilename name of
Nothing -> Left Nothing
Just lexer ->
case runLexer lexer $ BL.toStrict content of
Left err -> Left $ Just lexer
Right tokens -> Right (lexer, toWidget $ format True tokens)
-}
-- * File uploads and wiki attachments
-- * Wiki pages
-- * READMEs
@ -128,15 +111,22 @@ renderHighlight name content =
-- * [ ] asciidoc
-- * [ ] groff manpage
renderHighlight :: Lexer -> BL.ByteString -> Maybe Widget
renderPlain :: TL.Text -> Widget
renderPlain content =
[whamlet|
<pre>
<code>#{content}
|]
renderHighlight :: Lexer -> B.ByteString -> Maybe Widget
renderHighlight lexer content =
case runLexer lexer $ BL.toStrict content of
case runLexer lexer content of
Left err -> Nothing
Right tokens -> Just $ toWidget $ format True tokens
renderCode :: Lexer -> BL.ByteString -> Widget
renderCode lexer content =
fromMaybe (renderPlain content) $ renderHighlight lexer content
renderCode :: Lexer -> TL.Text -> B.ByteString -> Widget
renderCode lexer contentTL contentB =
fromMaybe (renderPlain contentTL) $ renderHighlight lexer contentB
readerOptions :: ReaderOptions
readerOptions = def
@ -221,21 +211,31 @@ renderPandoc =
renderHtml .
writeHtml writerOptions
renderSource :: MediaType -> BL.ByteString -> Widget
renderSource mt content =
let contentBL = content
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
mtName = T.pack $ show mt
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 content
plain = renderPlain contentTL
-- Syntax highlighted source code with line numbers
code l = renderCode l content
code l = renderCode l contentTL contentB
-- Rendered document from String source
docS r =
case r readerOptions contentS of
@ -258,23 +258,3 @@ renderSource mt content =
Haskell -> code L.Haskell.lexer
-- * Misc
_ -> plain
{-renderSource :: FilePath -> BL.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
-}

View file

@ -33,9 +33,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<h2>#{ticketTitle ticket}
<p>
Below is the ticket description. Its supposed to be rendered as Markdown,
but for now, temporarily, its shown here as plain text.
<code>
<pre>#{ticketDesc ticket}
^{desc}