From d8d2d160a00b998cd9d7c932412f53349cf83272 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 2 May 2016 21:20:25 +0000 Subject: [PATCH] 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. --- src/Vervis/Handler/Repo.hs | 2 +- src/Vervis/Handler/Ticket.hs | 5 ++- src/Vervis/Readme.hs | 4 +- src/Vervis/Render.hs | 84 ++++++++++++++---------------------- templates/ticket/one.hamlet | 7 +-- 5 files changed, 40 insertions(+), 62 deletions(-) diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index ba702c3..35eda19 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -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) diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 6853def..397f903 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -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)] diff --git a/src/Vervis/Readme.hs b/src/Vervis/Readme.hs index 6a59599..ed4816d 100644 --- a/src/Vervis/Readme.hs +++ b/src/Vervis/Readme.hs @@ -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 diff --git a/src/Vervis/Render.hs b/src/Vervis/Render.hs index 97d78f4..4a2f2ba 100644 --- a/src/Vervis/Render.hs +++ b/src/Vervis/Render.hs @@ -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| - 
-            #{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|
+        
+            #{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
--}
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet
index 4e826cc..675a900 100644
--- a/templates/ticket/one.hamlet
+++ b/templates/ticket/one.hamlet
@@ -33,9 +33,4 @@ $# .
 
 
#{ticketTitle ticket}
 
-

-  Below is the ticket description. It’s supposed to be rendered as Markdown,
-  but for now, temporarily, it’s shown here as plain text.
-
-
-  
#{ticketDesc ticket}
+^{desc}