yesod-markdown 0.9.4 → 0.10.0
raw patch · 4 files changed
+240/−163 lines, 4 filesdep +hspecdep +yesod-markdowndep ~basedep ~blaze-htmldep ~pandoc
Dependencies added: hspec, yesod-markdown
Dependency ranges changed: base, blaze-html, pandoc, text
Files
- Yesod/Markdown.hs +0/−130
- src/Yesod/Markdown.hs +131/−0
- test/Spec.hs +66/−0
- yesod-markdown.cabal +43/−33
− Yesod/Markdown.hs
@@ -1,130 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}----------------------------------------------------------------------------------- |------ Rewrite/simplification of yesod-markdown written by ajdunlap.------ Forked from <https://github.com/ajdunlap/yesod-markdown>.------------------------------------------------------------------------------------module Yesod.Markdown- ( Markdown(..)- -- * Wrappers- , markdownToHtml- , markdownToHtmlTrusted- , markdownFromFile- -- * Conversions- , parseMarkdown- , writePandoc- , writePandocTrusted- -- * Option sets- , yesodDefaultWriterOptions- , yesodDefaultReaderOptions- -- * Form helper- , markdownField- )- where--#if __GLASGOW_HASKELL__ < 710-import Data.Monoid (Monoid)-#endif--import Data.String (IsString)-import Data.Text (Text)-import Data.Text.Encoding (decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)--import Database.Persist (PersistField, SqlType(SqlString))-import Database.Persist.Sql (PersistFieldSql(..))-import System.Directory (doesFileExist)--import Text.Blaze (ToMarkup (toMarkup))-import Text.Blaze.Html (preEscapedToMarkup)-import Text.HTML.SanitizeXSS (sanitizeBalance)-import Text.Hamlet (hamlet, Html)-import Text.Pandoc--import Yesod.Core (RenderMessage, HandlerSite)-import Yesod.Form.Functions (parseHelper)-import Yesod.Form.Types-import Yesod.Core.Widget (toWidget)--import qualified Data.ByteString as B-import qualified Data.Text as T--newtype Markdown = Markdown { unMarkdown :: Text }- deriving (Eq, Ord, Show, Read, PersistField, IsString, Monoid)--instance PersistFieldSql Markdown where- sqlType _ = SqlString--instance ToMarkup Markdown where- -- | Sanitized by default- toMarkup = markdownToHtml--markdownField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Markdown-markdownField = Field- { fieldParse = parseHelper $ Right . Markdown . T.filter (/= '\r')- , fieldView = \theId name attrs val _isReq -> toWidget- [hamlet|$newline never-<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unMarkdown val}-|]- , fieldEnctype = UrlEncoded- }--markdownToHtml :: Markdown -> Html-markdownToHtml = writePandoc yesodDefaultWriterOptions- . parseMarkdown yesodDefaultReaderOptions---- | No HTML sanitization-markdownToHtmlTrusted :: Markdown -> Html-markdownToHtmlTrusted = writePandocTrusted yesodDefaultWriterOptions- . parseMarkdown yesodDefaultReaderOptions---- | Returns the empty string if the file does not exist-markdownFromFile :: FilePath -> IO Markdown-markdownFromFile f = do- exists <- doesFileExist f- content <-- if exists- then readFileUtf8 f- else return ""-- return $ Markdown content-- where- readFileUtf8 :: FilePath -> IO Text- readFileUtf8 fp = do- bs <- B.readFile fp- return $ decodeUtf8With lenientDecode bs--writePandoc :: WriterOptions -> Pandoc -> Html-writePandoc wo = preEscapedToMarkup . sanitizeBalance . T.pack . writeHtmlString wo--writePandocTrusted :: WriterOptions -> Pandoc -> Html-writePandocTrusted wo = preEscapedToMarkup . writeHtmlString wo--parseMarkdown :: ReaderOptions -> Markdown -> Pandoc-parseMarkdown ro = readMarkdown ro . T.unpack . unMarkdown---- | Defaults plus Html5, minus WrapText-yesodDefaultWriterOptions :: WriterOptions-yesodDefaultWriterOptions = def- { writerHtml5 = True- , writerWrapText = False- , writerHighlight = True- }---- | Defaults plus Smart and ParseRaw-yesodDefaultReaderOptions :: ReaderOptions-yesodDefaultReaderOptions = def- { readerSmart = True- , readerParseRaw = True- }
+ src/Yesod/Markdown.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-------------------------------------------------------------------------------+-- |+--+-- Rewrite/simplification of yesod-markdown written by ajdunlap.+--+-- Forked from <https://github.com/ajdunlap/yesod-markdown>.+--+-------------------------------------------------------------------------------+module Yesod.Markdown+ ( Markdown(..)+ -- * Wrappers+ , markdownToHtml+ , markdownToHtmlTrusted+ , markdownFromFile+ -- * Conversions+ , parseMarkdown+ , writePandoc+ , writePandocTrusted+ -- * Option sets+ , yesodDefaultWriterOptions+ , yesodDefaultReaderOptions+ -- * Form helper+ , markdownField+ )+ where++#if __GLASGOW_HASKELL__ < 710+import Data.Monoid (Monoid)+#endif++import Data.String (IsString)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)++import Database.Persist (PersistField, SqlType(SqlString))+import Database.Persist.Sql (PersistFieldSql(..))+import System.Directory (doesFileExist)++import Text.Blaze (ToMarkup (toMarkup))+import Text.Blaze.Html (preEscapedToMarkup)+import Text.HTML.SanitizeXSS (sanitizeBalance)+import Text.Hamlet (hamlet, Html)+import Text.Pandoc+import Text.Pandoc.Error++import Yesod.Core (RenderMessage, HandlerSite)+import Yesod.Form.Functions (parseHelper)+import Yesod.Form.Types+import Yesod.Core.Widget (toWidget)++import qualified Data.ByteString as B+import qualified Data.Text as T++newtype Markdown = Markdown { unMarkdown :: Text }+ deriving (Eq, Ord, Show, Read, PersistField, IsString, Monoid)++instance PersistFieldSql Markdown where+ sqlType _ = SqlString++instance ToMarkup Markdown where+ -- | Sanitized by default+ toMarkup = handleError . markdownToHtml++markdownField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Markdown+markdownField = Field+ { fieldParse = parseHelper $ Right . Markdown . T.filter (/= '\r')+ , fieldView = \theId name attrs val _isReq -> toWidget+ [hamlet|$newline never+<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unMarkdown val}+|]+ , fieldEnctype = UrlEncoded+ }++markdownToHtml :: Markdown -> Either PandocError Html+markdownToHtml = fmap (writePandoc yesodDefaultWriterOptions)+ . parseMarkdown yesodDefaultReaderOptions++-- | No HTML sanitization+markdownToHtmlTrusted :: Markdown -> Either PandocError Html+markdownToHtmlTrusted = fmap (writePandocTrusted yesodDefaultWriterOptions)+ . parseMarkdown yesodDefaultReaderOptions++-- | Returns the empty string if the file does not exist+markdownFromFile :: FilePath -> IO Markdown+markdownFromFile f = do+ exists <- doesFileExist f+ content <-+ if exists+ then readFileUtf8 f+ else return ""++ return $ Markdown content++ where+ readFileUtf8 :: FilePath -> IO Text+ readFileUtf8 fp = do+ bs <- B.readFile fp+ return $ decodeUtf8With lenientDecode bs++writePandoc :: WriterOptions -> Pandoc -> Html+writePandoc wo = preEscapedToMarkup . sanitizeBalance . T.pack . writeHtmlString wo++writePandocTrusted :: WriterOptions -> Pandoc -> Html+writePandocTrusted wo = preEscapedToMarkup . writeHtmlString wo++parseMarkdown :: ReaderOptions -> Markdown -> Either PandocError Pandoc+parseMarkdown ro = readMarkdown ro . T.unpack . unMarkdown++-- | Defaults plus Html5, minus WrapText+yesodDefaultWriterOptions :: WriterOptions+yesodDefaultWriterOptions = def+ { writerHtml5 = True+ , writerWrapText = False+ , writerHighlight = True+ }++-- | Defaults plus Smart and ParseRaw+yesodDefaultReaderOptions :: ReaderOptions+yesodDefaultReaderOptions = def+ { readerSmart = True+ , readerParseRaw = True+ }
+ test/Spec.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Test.Hspec+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Yesod.Markdown++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "Yesod.Markdown" $ do+ it "converts Markdown to sanitized HTML" $ do+ let markdown = Markdown $ T.unlines+ [ "# Title"+ , ""+ , "- one"+ , "- two"+ , "- three"+ , ""+ , "<script>"+ , " alert('xxs');"+ , "</script>"+ ]++ let Right html = markdownToHtml markdown++ renderHtml html `shouldBe` TL.concat+ [ "<h1 id=\"title\">Title</h1>"+ , "<ul>"+ , "<li>one</li>"+ , "<li>two</li>"+ , "<li>three</li>"+ , "</ul>"+ , "\n alert('xxs');\n"+ ]++ it "converts Markdown to unsanitized HTML" $ do+ let markdown = Markdown $ T.unlines+ [ "# Title"+ , ""+ , "- one"+ , "- two"+ , "- three"+ , ""+ , "<script>"+ , " alert('xxs');"+ , "</script>"+ ]++ let Right html = markdownToHtmlTrusted markdown++ renderHtml html `shouldBe` TL.concat+ [ "<h1 id=\"title\">Title</h1>"+ , "<ul>"+ , "<li>one</li>"+ , "<li>two</li>"+ , "<li>three</li>"+ , "</ul>"+ , "<script>\n"+ , " alert('xxs');\n"+ , "</script>"+ ]
yesod-markdown.cabal view
@@ -1,38 +1,48 @@-name: yesod-markdown-version: 0.9.4-synopsis: Tools for using markdown in a yesod application-description: A subset of pandoc functionality useful for markdown processing in yesod applications-homepage: http://github.com/pbrisbin/yesod-markdown-license: GPL-2-license-file: LICENSE-author: Alexander Dunlap, Patrick Brisbin-maintainer: Patrick Brisbin <pbrisbin@gmail.com>-category: Web, Yesod-build-type: Simple-cabal-version: >=1.8+name: yesod-markdown+version: 0.10.0+synopsis: Tools for using markdown in a yesod application+description: A subset of pandoc functionality useful for markdown processing in yesod applications+homepage: http://github.com/pbrisbin/yesod-markdown+license: GPL-2+license-file: LICENSE+author: Alexander Dunlap, Patrick Brisbin+maintainer: Patrick Brisbin <pbrisbin@gmail.com>+category: Web, Yesod+build-type: Simple+cabal-version: >=1.8 library- exposed-modules: Yesod.Markdown-- build-depends: base >= 4 && < 5- , text >= 0.11 && < 2.0- , bytestring >= 0.9 && < 0.11- , pandoc >= 1.10 && < 1.14- , blaze-html >= 0.5 && < 0.9- , blaze-markup >= 0.5 && < 0.8- , xss-sanitize >= 0.3.1 && < 0.4- , directory- , yesod-core >= 1.2 && < 1.5- , yesod-form >= 1.3 && < 1.5- , shakespeare >= 2.0 && < 2.1- , persistent >= 0.9+ hs-source-dirs: src+ ghc-options: -Wall+ exposed-modules: Yesod.Markdown+ build-depends: base >= 4 && < 5+ , text >= 0.11 && < 2.0+ , bytestring >= 0.9 && < 0.11+ , pandoc >= 1.14 && < 1.16+ , blaze-html >= 0.5 && < 0.9+ , blaze-markup >= 0.5 && < 0.8+ , xss-sanitize >= 0.3.1 && < 0.4+ , directory+ , yesod-core >= 1.2 && < 1.5+ , yesod-form >= 1.3 && < 1.5+ , shakespeare >= 2.0 && < 2.1+ , persistent >= 0.9 - -- See https://github.com/jgm/pandoc/issues/1482 and- -- http://hackage.haskell.org/package/texmath/preferred- , texmath <0.6.5.1 || >0.6.5.1 && <0.6.7 || >0.6.7+ -- See https://github.com/jgm/pandoc/issues/1482 and+ -- http://hackage.haskell.org/package/texmath/preferred+ , texmath <0.6.5.1 || >0.6.5.1 && <0.6.7 || >0.6.7 - ghc-options: -Wall+test-suite test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ ghc-options: -Wall+ build-depends: base+ , yesod-markdown+ , hspec+ , blaze-html+ , text -source-repository head- type: git- location: git://github.com/pbrisbin/yesod-markdown.git+source-repository head+ type: git+ location: https://github.com/pbrisbin/yesod-markdown