diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,35 @@ +# Yesod Markdown + +A small wrapper over [Pandoc][]'s powerful `Markdown -> Html` support, with +usage tailored for Yesod. + +[pandoc]: http://hackage.haskell.org/package/pandoc + +## Usage + +``` +getPageR :: FilePath -> Handler RepHtml +getPageR fp = do + content <- liftIO $ fmap markdownToHtml (markdownFromFile fp) + + defaultLayout do + [shamlet| +
+ #{content} + |] +``` + +For more information, see the [haddocks][]. + +[haddocks]: http://hackage.haskell.org/package/yesod-markdown/docs/Yesod-Markdown.html + +## Developing & Tests + +``` +stack setup +stack build --pedantic --test +``` + +--- + +[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE) diff --git a/src/Yesod/Markdown.hs b/src/Yesod/Markdown.hs --- a/src/Yesod/Markdown.hs +++ b/src/Yesod/Markdown.hs @@ -1,19 +1,12 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- --- | --- --- Rewrite/simplification of yesod-markdown written by ajdunlap. --- --- Forked from . --- -------------------------------------------------------------------------------- +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeFamilies #-} + module Yesod.Markdown ( Markdown(..) -- * Wrappers @@ -27,38 +20,30 @@ -- * Option sets , yesodDefaultWriterOptions , yesodDefaultReaderOptions + , yesodDefaultExtensions -- * Form helper , markdownField - ) - where - -#if __GLASGOW_HASKELL__ < 710 -import Data.Monoid (Monoid) -#endif + ) where 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 (ToMarkup(toMarkup)) import Text.Blaze.Html (preEscapedToMarkup) +import Text.Hamlet (Html, hamlet) import Text.HTML.SanitizeXSS (sanitizeBalance) -import Text.Hamlet (hamlet, Html) -import Text.Pandoc -import Text.Pandoc.Error - -import Yesod.Core (RenderMessage, HandlerSite) +import Text.Pandoc hiding (handleError) +import Yesod.Core (HandlerSite, RenderMessage) +import Yesod.Core.Widget (toWidget) 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 +import qualified Data.Text as T newtype Markdown = Markdown { unMarkdown :: Text } deriving (Eq, Ord, Show, Read, PersistField, IsString, Monoid) @@ -81,51 +66,64 @@ } markdownToHtml :: Markdown -> Either PandocError Html -markdownToHtml = fmap (writePandoc yesodDefaultWriterOptions) - . parseMarkdown yesodDefaultReaderOptions +markdownToHtml md = do + p <- parseMarkdown yesodDefaultReaderOptions md + writePandoc yesodDefaultWriterOptions p -- | No HTML sanitization markdownToHtmlTrusted :: Markdown -> Either PandocError Html -markdownToHtmlTrusted = fmap (writePandocTrusted yesodDefaultWriterOptions) - . parseMarkdown yesodDefaultReaderOptions +markdownToHtmlTrusted md = do + p <- parseMarkdown yesodDefaultReaderOptions md + writePandocTrusted yesodDefaultWriterOptions p -- | 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 "" + exists <- doesFileExist f + Markdown <$> if exists + then readFileUtf8 f + else return "" - return $ Markdown content + where + readFileUtf8 :: FilePath -> IO Text + readFileUtf8 fp = decodeUtf8With lenientDecode <$> B.readFile fp - where - readFileUtf8 :: FilePath -> IO Text - readFileUtf8 fp = do - bs <- B.readFile fp - return $ decodeUtf8With lenientDecode bs +writePandoc :: WriterOptions -> Pandoc -> Either PandocError Html +writePandoc wo p = preEscapedToMarkup . sanitizeBalance <$> writeHTML wo p -writePandoc :: WriterOptions -> Pandoc -> Html -writePandoc wo = preEscapedToMarkup . sanitizeBalance . T.pack . writeHtmlString wo +writePandocTrusted :: WriterOptions -> Pandoc -> Either PandocError Html +writePandocTrusted wo p = preEscapedToMarkup <$> writeHTML wo p -writePandocTrusted :: WriterOptions -> Pandoc -> Html -writePandocTrusted wo = preEscapedToMarkup . writeHtmlString wo +writeHTML :: WriterOptions -> Pandoc -> Either PandocError Text +writeHTML wo = runPure . writeHtml5String wo parseMarkdown :: ReaderOptions -> Markdown -> Either PandocError Pandoc -parseMarkdown ro = readMarkdown ro . T.unpack . unMarkdown +parseMarkdown ro = runPure . readMarkdown ro . unMarkdown --- | Defaults plus Html5, minus WrapText +-- | Defaults minus WrapText, plus our extensions yesodDefaultWriterOptions :: WriterOptions yesodDefaultWriterOptions = def - { writerHtml5 = True - , writerWrapText = WrapNone - , writerHighlight = True - } + { writerWrapText = WrapNone + , writerExtensions = extensionsFromList yesodDefaultExtensions + } --- | Defaults plus Smart and ParseRaw +-- | Defaults plus our extensions, see @'yesodDefaultExtensions'@ yesodDefaultReaderOptions :: ReaderOptions yesodDefaultReaderOptions = def - { readerSmart = True - , readerParseRaw = True + { readerExtensions = extensionsFromList yesodDefaultExtensions } + +-- | @raw_html@ and @auto_identifiers@ +yesodDefaultExtensions :: [Extension] +yesodDefaultExtensions = + [ Ext_raw_html + , Ext_auto_identifiers + ] + +-- | Unsafely handle a @'PandocError'@ +-- +-- This is analagous to pandoc-1 behavior, and is required in a pure context +-- such as the @'ToMarkup'@ instance. +-- +handleError :: Either PandocError a -> a +handleError = either (error . show) id diff --git a/yesod-markdown.cabal b/yesod-markdown.cabal --- a/yesod-markdown.cabal +++ b/yesod-markdown.cabal @@ -1,48 +1,65 @@ -name: yesod-markdown -version: 0.11.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 -category: Web, Yesod -build-type: Simple -cabal-version: >=1.8 +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 8eca8858a9cdb7deee8a76a1246259eeb121ac0f51c263b4d5c5cad22df5e0a0 -library - 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.16 && < 1.20 - , blaze-html >= 0.5 && < 0.10 - , blaze-markup >= 0.5 && < 0.9 - , 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 +name: yesod-markdown +version: 0.12.0 +synopsis: Tools for using markdown in a yesod application +description: A subset of Pandoc functionality useful for markdown processing in yesod applications +category: Web, Yesod +homepage: http://github.com/pbrisbin/yesod-markdown +bug-reports: https://github.com/pbrisbin/yesod-markdown/issues +author: Alexander Dunlap, Patrick Brisbin +maintainer: Patrick Brisbin +license: GPL-2 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 - -- 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 +extra-source-files: + README.md -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: https://github.com/pbrisbin/yesod-markdown -source-repository head - type: git - location: https://github.com/pbrisbin/yesod-markdown +library + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >=4.8.0 && <5 + , blaze-html >=0.5 && <0.10 + , blaze-markup >=0.5 && <0.9 + , bytestring >=0.9 && <0.11 + , directory + , pandoc >=2.0 && <2.1 + , persistent >=0.9 + , shakespeare >=2.0 && <2.1 + , text >=0.11 && <2.0 + , xss-sanitize >=0.3.1 && <0.4 + , yesod-core >=1.2 && <1.5 + , yesod-form >=1.3 && <1.5 + exposed-modules: + Yesod.Markdown + other-modules: + Paths_yesod_markdown + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + ghc-options: -Wall -threaded + build-depends: + base >=4.8.0 && <5 + , blaze-html + , hspec + , text + , yesod-markdown + other-modules: + Paths_yesod_markdown + default-language: Haskell2010