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}