{-# LANGUAGE OverloadedStrings #-}
module Text.Markdown.Types where
import Data.Text (Text)
import qualified Data.Text as T
import Data.Default (Default (def))
import Data.Set (Set, empty)
import Data.Map (Map, singleton)
import Data.Monoid (mappend)
import Text.Blaze.Html (Html)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
data MarkdownSettings = MarkdownSettings
{ MarkdownSettings -> Bool
msXssProtect :: Bool
, MarkdownSettings -> Set Text
msStandaloneHtml :: Set Text
, MarkdownSettings -> Map Text (Text -> FencedHandler)
msFencedHandlers :: Map Text (Text -> FencedHandler)
, MarkdownSettings -> Maybe Text -> (Text, Html) -> Html
msBlockCodeRenderer :: Maybe Text -> (Text,Html) -> Html
, MarkdownSettings -> Bool
msLinkNewTab :: Bool
, MarkdownSettings -> Bool
msBlankBeforeBlockquote :: Bool
, MarkdownSettings -> [Block [Inline]] -> [Block [Inline]]
msBlockFilter :: [Block [Inline]] -> [Block [Inline]]
, MarkdownSettings -> Bool
msAddHeadingId :: Bool
, MarkdownSettings -> Bool
msNoFollowExternal :: Bool
}
data FencedHandler = FHRaw (Text -> [Block Text])
| FHParsed ([Block Text] -> [Block Text])
defaultMarkdownSettings :: MarkdownSettings
defaultMarkdownSettings :: MarkdownSettings
defaultMarkdownSettings = MarkdownSettings :: Bool
-> Set Text
-> Map Text (Text -> FencedHandler)
-> (Maybe Text -> (Text, Html) -> Html)
-> Bool
-> Bool
-> ([Block [Inline]] -> [Block [Inline]])
-> Bool
-> Bool
-> MarkdownSettings
MarkdownSettings
{ msXssProtect :: Bool
msXssProtect = Bool
True
, msStandaloneHtml :: Set Text
msStandaloneHtml = Set Text
forall a. Set a
empty
, msFencedHandlers :: Map Text (Text -> FencedHandler)
msFencedHandlers = Text -> Map Text (Text -> FencedHandler)
codeFencedHandler Text
"```" Map Text (Text -> FencedHandler)
-> Map Text (Text -> FencedHandler)
-> Map Text (Text -> FencedHandler)
forall a. Monoid a => a -> a -> a
`mappend` Text -> Map Text (Text -> FencedHandler)
codeFencedHandler Text
"~~~"
, msBlockCodeRenderer :: Maybe Text -> (Text, Html) -> Html
msBlockCodeRenderer =
\Maybe Text
lang (Text
_,Html
rendered) -> case Maybe Text
lang of
Just Text
l -> Html -> Html
H.pre (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.code (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
H.! AttributeValue -> Attribute
HA.class_ (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue Text
l) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
rendered
Maybe Text
Nothing -> Html -> Html
H.pre (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.code (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
rendered
, msLinkNewTab :: Bool
msLinkNewTab = Bool
False
, msBlankBeforeBlockquote :: Bool
msBlankBeforeBlockquote = Bool
True
, msBlockFilter :: [Block [Inline]] -> [Block [Inline]]
msBlockFilter = [Block [Inline]] -> [Block [Inline]]
forall a. a -> a
id
, msAddHeadingId :: Bool
msAddHeadingId = Bool
False
, msNoFollowExternal :: Bool
msNoFollowExternal = Bool
False
}
instance Default MarkdownSettings where
def :: MarkdownSettings
def = MarkdownSettings
defaultMarkdownSettings
codeFencedHandler :: Text
-> Map Text (Text -> FencedHandler)
codeFencedHandler :: Text -> Map Text (Text -> FencedHandler)
codeFencedHandler Text
key = Text -> (Text -> FencedHandler) -> Map Text (Text -> FencedHandler)
forall k a. k -> a -> Map k a
singleton Text
key ((Text -> FencedHandler) -> Map Text (Text -> FencedHandler))
-> (Text -> FencedHandler) -> Map Text (Text -> FencedHandler)
forall a b. (a -> b) -> a -> b
$ \Text
lang -> (Text -> [Block Text]) -> FencedHandler
FHRaw ((Text -> [Block Text]) -> FencedHandler)
-> (Text -> [Block Text]) -> FencedHandler
forall a b. (a -> b) -> a -> b
$
Block Text -> [Block Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Block Text -> [Block Text])
-> (Text -> Block Text) -> Text -> [Block Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Text -> Block Text
forall inline. Maybe Text -> Text -> Block inline
BlockCode (if Text -> Bool
T.null Text
lang then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lang)
htmlFencedHandler :: Text
-> (Text -> Text)
-> (Text -> Text)
-> Map Text (Text -> FencedHandler)
htmlFencedHandler :: Text
-> (Text -> Text)
-> (Text -> Text)
-> Map Text (Text -> FencedHandler)
htmlFencedHandler Text
key Text -> Text
start Text -> Text
end = Text -> (Text -> FencedHandler) -> Map Text (Text -> FencedHandler)
forall k a. k -> a -> Map k a
singleton Text
key ((Text -> FencedHandler) -> Map Text (Text -> FencedHandler))
-> (Text -> FencedHandler) -> Map Text (Text -> FencedHandler)
forall a b. (a -> b) -> a -> b
$ \Text
lang -> ([Block Text] -> [Block Text]) -> FencedHandler
FHParsed (([Block Text] -> [Block Text]) -> FencedHandler)
-> ([Block Text] -> [Block Text]) -> FencedHandler
forall a b. (a -> b) -> a -> b
$ \[Block Text]
blocks ->
Text -> Block Text
forall inline. Text -> Block inline
BlockHtml (Text -> Text
start Text
lang)
Block Text -> [Block Text] -> [Block Text]
forall a. a -> [a] -> [a]
: [Block Text]
blocks
[Block Text] -> [Block Text] -> [Block Text]
forall a. [a] -> [a] -> [a]
++ [Text -> Block Text
forall inline. Text -> Block inline
BlockHtml (Text -> Block Text) -> Text -> Block Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
end Text
lang]
data ListType = Ordered | Unordered
deriving (Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
(Int -> ListType -> ShowS)
-> (ListType -> String) -> ([ListType] -> ShowS) -> Show ListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq)
data Block inline
= BlockPara inline
| BlockList ListType (Either inline [Block inline])
| BlockCode (Maybe Text) Text
| BlockQuote [Block inline]
| BlockHtml Text
| BlockRule
| BlockHeading Int inline
| BlockReference Text Text
| BlockPlainText inline
deriving (Int -> Block inline -> ShowS
[Block inline] -> ShowS
Block inline -> String
(Int -> Block inline -> ShowS)
-> (Block inline -> String)
-> ([Block inline] -> ShowS)
-> Show (Block inline)
forall inline. Show inline => Int -> Block inline -> ShowS
forall inline. Show inline => [Block inline] -> ShowS
forall inline. Show inline => Block inline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block inline] -> ShowS
$cshowList :: forall inline. Show inline => [Block inline] -> ShowS
show :: Block inline -> String
$cshow :: forall inline. Show inline => Block inline -> String
showsPrec :: Int -> Block inline -> ShowS
$cshowsPrec :: forall inline. Show inline => Int -> Block inline -> ShowS
Show, Block inline -> Block inline -> Bool
(Block inline -> Block inline -> Bool)
-> (Block inline -> Block inline -> Bool) -> Eq (Block inline)
forall inline. Eq inline => Block inline -> Block inline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block inline -> Block inline -> Bool
$c/= :: forall inline. Eq inline => Block inline -> Block inline -> Bool
== :: Block inline -> Block inline -> Bool
$c== :: forall inline. Eq inline => Block inline -> Block inline -> Bool
Eq)
instance Functor Block where
fmap :: (a -> b) -> Block a -> Block b
fmap a -> b
f (BlockPara a
i) = b -> Block b
forall inline. inline -> Block inline
BlockPara (a -> b
f a
i)
fmap a -> b
f (BlockList ListType
lt (Left a
i)) = ListType -> Either b [Block b] -> Block b
forall inline.
ListType -> Either inline [Block inline] -> Block inline
BlockList ListType
lt (Either b [Block b] -> Block b) -> Either b [Block b] -> Block b
forall a b. (a -> b) -> a -> b
$ b -> Either b [Block b]
forall a b. a -> Either a b
Left (b -> Either b [Block b]) -> b -> Either b [Block b]
forall a b. (a -> b) -> a -> b
$ a -> b
f a
i
fmap a -> b
f (BlockList ListType
lt (Right [Block a]
bs)) = ListType -> Either b [Block b] -> Block b
forall inline.
ListType -> Either inline [Block inline] -> Block inline
BlockList ListType
lt (Either b [Block b] -> Block b) -> Either b [Block b] -> Block b
forall a b. (a -> b) -> a -> b
$ [Block b] -> Either b [Block b]
forall a b. b -> Either a b
Right ([Block b] -> Either b [Block b])
-> [Block b] -> Either b [Block b]
forall a b. (a -> b) -> a -> b
$ (Block a -> Block b) -> [Block a] -> [Block b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Block a -> Block b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Block a]
bs
fmap a -> b
_ (BlockCode Maybe Text
a Text
b) = Maybe Text -> Text -> Block b
forall inline. Maybe Text -> Text -> Block inline
BlockCode Maybe Text
a Text
b
fmap a -> b
f (BlockQuote [Block a]
bs) = [Block b] -> Block b
forall inline. [Block inline] -> Block inline
BlockQuote ([Block b] -> Block b) -> [Block b] -> Block b
forall a b. (a -> b) -> a -> b
$ (Block a -> Block b) -> [Block a] -> [Block b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Block a -> Block b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Block a]
bs
fmap a -> b
_ (BlockHtml Text
t) = Text -> Block b
forall inline. Text -> Block inline
BlockHtml Text
t
fmap a -> b
_ Block a
BlockRule = Block b
forall inline. Block inline
BlockRule
fmap a -> b
f (BlockHeading Int
level a
i) = Int -> b -> Block b
forall inline. Int -> inline -> Block inline
BlockHeading Int
level (a -> b
f a
i)
fmap a -> b
_ (BlockReference Text
x Text
y) = Text -> Text -> Block b
forall inline. Text -> Text -> Block inline
BlockReference Text
x Text
y
fmap a -> b
f (BlockPlainText a
x) = b -> Block b
forall inline. inline -> Block inline
BlockPlainText (a -> b
f a
x)
data Inline = InlineText Text
| InlineItalic [Inline]
| InlineBold [Inline]
| InlineCode Text
| InlineHtml Text
| InlineLink Text (Maybe Text) [Inline]
| InlineImage Text (Maybe Text) Text
| Integer
| Integer
deriving (Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
(Int -> Inline -> ShowS)
-> (Inline -> String) -> ([Inline] -> ShowS) -> Show Inline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inline] -> ShowS
$cshowList :: [Inline] -> ShowS
show :: Inline -> String
$cshow :: Inline -> String
showsPrec :: Int -> Inline -> ShowS
$cshowsPrec :: Int -> Inline -> ShowS
Show, Inline -> Inline -> Bool
(Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool) -> Eq Inline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c== :: Inline -> Inline -> Bool
Eq)