module Yesod.Markdown
( Markdown(..)
, markdownToHtml
, markdownToHtmlTrusted
, markdownFromFile
, parseMarkdown
, writePandoc
, writePandocTrusted
, yesodDefaultWriterOptions
, yesodDefaultReaderOptions
, yesodDefaultExtensions
, markdownField
) 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.Html (preEscapedToMarkup)
import Text.Hamlet (Html, hamlet)
import Text.HTML.SanitizeXSS (sanitizeBalance)
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 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
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 md = do
p <- parseMarkdown yesodDefaultReaderOptions md
writePandoc yesodDefaultWriterOptions p
markdownToHtmlTrusted :: Markdown -> Either PandocError Html
markdownToHtmlTrusted md = do
p <- parseMarkdown yesodDefaultReaderOptions md
writePandocTrusted yesodDefaultWriterOptions p
markdownFromFile :: FilePath -> IO Markdown
markdownFromFile f = do
exists <- doesFileExist f
Markdown <$> if exists
then readFileUtf8 f
else return ""
where
readFileUtf8 :: FilePath -> IO Text
readFileUtf8 fp = decodeUtf8With lenientDecode <$> B.readFile fp
writePandoc :: WriterOptions -> Pandoc -> Either PandocError Html
writePandoc wo p = preEscapedToMarkup . sanitizeBalance <$> writeHTML wo p
writePandocTrusted :: WriterOptions -> Pandoc -> Either PandocError Html
writePandocTrusted wo p = preEscapedToMarkup <$> writeHTML wo p
writeHTML :: WriterOptions -> Pandoc -> Either PandocError Text
writeHTML wo = runPure . writeHtml5String wo
parseMarkdown :: ReaderOptions -> Markdown -> Either PandocError Pandoc
parseMarkdown ro = runPure . readMarkdown ro . unMarkdown
yesodDefaultWriterOptions :: WriterOptions
yesodDefaultWriterOptions = def
{ writerWrapText = WrapNone
, writerExtensions = extensionsFromList yesodDefaultExtensions
}
yesodDefaultReaderOptions :: ReaderOptions
yesodDefaultReaderOptions = def
{ readerExtensions = extensionsFromList yesodDefaultExtensions
}
yesodDefaultExtensions :: [Extension]
yesodDefaultExtensions =
[ Ext_raw_html
, Ext_auto_identifiers
]
handleError :: Either PandocError a -> a
handleError = either (error . show) id