{-# LANGUAGE OverloadedStrings #-} module Text.Markdown ( -- * Functions markdown -- * Settings , MarkdownSettings , msXssProtect -- * Newtype , Markdown (..) -- * Convenience re-exports. , def ) where import Text.Markdown.Inline import Text.Markdown.Block import Prelude hiding (sequence, takeWhile) import Data.Default (Default (..)) import Data.Text (Text) import qualified Data.Text.Lazy as TL import Text.Blaze.Html (ToMarkup (..), Html) import Text.Blaze.Html.Renderer.Text (renderHtml) import Data.Conduit import qualified Data.Conduit.List as CL import Data.Monoid (Monoid (mappend, mempty, mconcat)) import Data.Functor.Identity (runIdentity) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as HA import Text.HTML.SanitizeXSS (sanitizeBalance) -- | A settings type providing various configuration options. -- -- See for more information on -- settings types. In general, you can use @def@. data MarkdownSettings = MarkdownSettings { msXssProtect :: Bool -- ^ Whether to automatically apply XSS protection to embedded HTML. Default: @True@. } instance Default MarkdownSettings where def = MarkdownSettings { msXssProtect = True } -- | A newtype wrapper providing a @ToHtml@ instance. newtype Markdown = Markdown TL.Text instance ToMarkup Markdown where toMarkup (Markdown t) = markdown def t -- | Convert the given textual markdown content to HTML. -- -- >>> :set -XOverloadedStrings -- >>> import Text.Blaze.Html.Renderer.Text -- >>> renderHtml $ markdown def "# Hello World!" -- "

Hello World!

" -- -- >>> renderHtml $ markdown def { msXssProtect = False } "" -- "" markdown :: MarkdownSettings -> TL.Text -> Html markdown ms tl = runIdentity $ CL.sourceList (TL.toChunks tl) $$ mapOutput (fmap (toHtmlI ms . toInline)) toBlocks =$ toHtmlB ms =$ CL.fold mappend mempty data MState = NoState | InList ListType toHtmlB :: Monad m => MarkdownSettings -> GInfConduit (Block Html) m Html toHtmlB ms = loop NoState where loop state = awaitE >>= either (\e -> closeState state >> return e) (\x -> do state' <- getState state x yield $ go x loop state') closeState NoState = return () closeState (InList Unordered) = yield $ escape "" closeState (InList Ordered) = yield $ escape "" getState NoState (BlockList ltype _) = do yield $ escape $ case ltype of Unordered -> "