module Yesod.Markdown
( Markdown (..)
, parseMarkdown
, localLinks
, writePandoc
, yesodDefaultWriterOptions
, yesodDefaultParserState
, yesodDefaultParserStateTrusted
)
where
import Yesod
import Data.Monoid
import Data.String
import Yesod.Form.Core
import Text.Pandoc
import Text.Pandoc.Shared
import Control.Applicative
import Data.Map ( Map )
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as B
newtype Markdown = Markdown String
deriving (Eq, Ord, Show, Read, PersistField, IsString, Monoid)
instance ToFormField Markdown y where
toFormField = markdownField
instance ToFormField (Maybe Markdown) y where
toFormField = maybeMarkdownField
markdownField :: (IsForm f, FormType f ~ Markdown)
=> FormFieldSettings -> Maybe Markdown -> f
markdownField = requiredFieldHelper markdownFieldProfile
maybeMarkdownField :: FormFieldSettings -> FormletField sub y (Maybe Markdown)
maybeMarkdownField = optionalFieldHelper markdownFieldProfile
markdownFieldProfile :: FieldProfile sub y Markdown
markdownFieldProfile = FieldProfile
{ fpParse = Right . Markdown
, fpRender = \(Markdown m) -> m
, fpWidget = \theId name val _isReq -> addHamlet
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
%textarea.markdown#$theId$!name=$name$ $val$
|]
}
writePandoc :: WriterOptions -> Pandoc -> Html
writePandoc wo = preEscapedString . writeHtmlString wo
parseMarkdown :: ParserState -> Markdown -> Pandoc
parseMarkdown ro (Markdown m) = readMarkdown ro m
localLinks :: Yesod master => Pandoc -> GHandler sub master Pandoc
localLinks p = (\y -> processWith (links y) p) <$> getYesod where
links y (Link x ('~':':':l,n)) = Link x (joinPath y (approot y) (links' y (B.pack l)) [],n)
links _ x = x
links' y l = case splitPath y l of
Left corrected -> links' y corrected
Right xs -> xs
yesodDefaultWriterOptions :: WriterOptions
yesodDefaultWriterOptions = defaultWriterOptions
{ writerEmailObfuscation = JavascriptObfuscation
, writerSectionDivs = False
, writerWrapText = False
}
yesodDefaultParserStateTrusted :: ParserState
yesodDefaultParserStateTrusted = yesodDefaultParserState { stateSanitizeHTML = False }
yesodDefaultParserState :: ParserState
yesodDefaultParserState = defaultParserState { stateSmart = True, stateParseRaw = True, stateSanitizeHTML = True }