module Yesod.Markdown
( Markdown(..)
, markdownToHtml
, markdownToHtmlTrusted
, markdownFromFile
, parseMarkdown
, writePandoc
, writePandocTrusted
, yesodDefaultWriterOptions
, yesodDefaultParserState
, markdownField
)
where
#if __GLASGOW_HASKELL__ >= 700
#define HAMLET hamlet
#else
#define HAMLET $hamlet
#endif
import Yesod
import Yesod.Form.Types
import Text.Blaze (preEscapedString, preEscapedText)
import Text.Pandoc
import Text.Pandoc.Shared
import Text.HTML.SanitizeXSS (sanitizeBalance)
import Data.Monoid (Monoid)
import Data.String (IsString)
import System.Directory (doesFileExist)
import qualified Data.Text as T
newtype Markdown = Markdown String
deriving (Eq, Ord, Show, Read, PersistField, IsString, Monoid)
instance ToField Markdown master where
toField = areq markdownField
instance ToField (Maybe Markdown) master where
toField = aopt markdownField
markdownField :: RenderMessage master FormMessage => Field sub master Markdown
markdownField = Field
{ fieldParse = blank $ Right . Markdown . unlines . lines' . T.unpack
, fieldView = \theId name theClass val _isReq -> addHamlet
[HAMLET|\
<textarea id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}">#{either id unMarkdown val}
|]
}
where
unMarkdown :: Markdown -> T.Text
unMarkdown (Markdown s) = T.pack s
lines' :: String -> [String]
lines' = map go . lines
go [] = []
go ('\r':xs) = go xs
go (x:xs) = x : go xs
blank :: (Monad m, RenderMessage master FormMessage)
=> (T.Text -> Either FormMessage a)
-> [T.Text]
-> m (Either (SomeMessage master) (Maybe a))
blank _ [] = return $ Right Nothing
blank _ ("":_) = return $ Right Nothing
blank f (x:_) = return $ either (Left . SomeMessage) (Right . Just) $ f x
markdownToHtml :: Markdown -> Html
markdownToHtml = writePandoc yesodDefaultWriterOptions
. parseMarkdown yesodDefaultParserState
markdownToHtmlTrusted :: Markdown -> Html
markdownToHtmlTrusted = writePandocTrusted yesodDefaultWriterOptions
. parseMarkdown yesodDefaultParserState
markdownFromFile :: FilePath -> IO Markdown
markdownFromFile f = do
exists <- doesFileExist f
content <- do
if exists
then readFile f
else return ""
return $ Markdown content
writePandoc :: WriterOptions -> Pandoc -> Html
writePandoc wo = preEscapedText . sanitizeBalance . T.pack . writeHtmlString wo
writePandocTrusted :: WriterOptions -> Pandoc -> Html
writePandocTrusted wo = preEscapedString . writeHtmlString wo
parseMarkdown :: ParserState -> Markdown -> Pandoc
parseMarkdown ro (Markdown m) = readMarkdown ro m
yesodDefaultWriterOptions :: WriterOptions
yesodDefaultWriterOptions = defaultWriterOptions
{ writerHtml5 = True
, writerWrapText = False
}
yesodDefaultParserState :: ParserState
yesodDefaultParserState = defaultParserState
{ stateSmart = True
, stateParseRaw = True
}