{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Text.Seonbi.ContentTypes
    ( ContentType
    , HtmlTransformer
    , TextTransformer
    , asCommonMarkTransformer
    , asHtmlTransformer
    , asHtmlTransformer'
    , asPlainTextTransformer
    , asXhtmlTransformer
    , contentTypeFromText
    , contentTypes
    , contentTypeText
    , transformWithContentType
    ) where

#if MIN_VERSION_base(4,13,0)
import Prelude hiding (MonadFail)
#endif

import Control.Monad (forM)
import Control.Monad.Fail (MonadFail)
import Data.Maybe (fromMaybe, isNothing)
import Data.List
import Text.Read (readMaybe)

import CMark
import Data.Set
import Data.Text as ST
import Data.Text.Encoding
import Data.Text.Lazy as LT
import Data.Text.Lazy.Builder
import HTMLEntities.Builder
import HTMLEntities.Decoder
import Network.HTTP.Media.Accept
import Network.HTTP.Media.MediaType
import Network.HTTP.Media.RenderHeader

import Text.Seonbi.Html
import Text.Seonbi.Html.Tag (headingLevel, headingTag')
import qualified Text.Seonbi.Html.TagStack as TagStack

-- | Represents a function that transforms an 'HtmlEntity' list.
type HtmlTransformer m
    = (Monad m, MonadFail m) => [HtmlEntity] -> m [HtmlEntity]

-- | Represents a function that transforms a text.
type TextTransformer m
    = (Monad m, MonadFail m) => LT.Text -> m LT.Text

-- | Represents a function that transforms an 'HtmlTransformer' into
-- a 'TextTransformer'.
type TransformerTransformer m
    = (Monad m, MonadFail m) => HtmlTransformer m -> TextTransformer m

-- | Gets a 'TransformerTransformer' that transforms 'HtmlTransformer' into
-- a 'TextTransformer' which transforms an HTML/XHTML text.
asHtmlTransformer'
    :: (Monad m, MonadFail m)
    => Bool
    -- ^ 'True' for XHTML, and 'False' for HTML.
    -> TransformerTransformer m
    -- ^ A 'TransformerTransformer' that transforms an 'HtmlTransformer' into
    -- a 'TextTransformer' which transforms an HTML/XHTML text.
asHtmlTransformer' :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
Bool -> TransformerTransformer m
asHtmlTransformer' Bool
xhtml HtmlTransformer m
transformer Text
htmlText = do
    case Text -> Result [HtmlEntity]
scanHtml Text
htmlText of
        Done Text
"" [HtmlEntity]
input -> do
            [HtmlEntity]
output <- HtmlTransformer m
transformer [HtmlEntity]
input
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> Text
printHtml' [HtmlEntity]
output
        Result [HtmlEntity]
_ ->
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse input"
  where
    printHtml' :: [HtmlEntity] -> LT.Text
    printHtml' :: [HtmlEntity] -> Text
printHtml'
      | Bool
xhtml = [HtmlEntity] -> Text
printXhtml
      | Bool
otherwise = [HtmlEntity] -> Text
printHtml

-- | Transforms an 'HtmlTransformer' into a 'TextTransformer' which transforms
-- an HTML text.
asHtmlTransformer :: (Monad m, MonadFail m) => TransformerTransformer m
asHtmlTransformer :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asHtmlTransformer = forall (m :: * -> *).
(Monad m, MonadFail m) =>
Bool -> TransformerTransformer m
asHtmlTransformer' Bool
False

-- | Transforms an 'HtmlTransformer' into a 'TextTransformer' which transforms
-- an XHTML text.
asXhtmlTransformer :: (Monad m, MonadFail m) => TransformerTransformer m
asXhtmlTransformer :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asXhtmlTransformer = forall (m :: * -> *).
(Monad m, MonadFail m) =>
Bool -> TransformerTransformer m
asHtmlTransformer' Bool
True

-- | Transforms an 'HtmlTransformer' into a 'TextTransformer' which transforms
-- a plain text.
asPlainTextTransformer :: (Monad m, MonadFail m) => TransformerTransformer m
asPlainTextTransformer :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asPlainTextTransformer HtmlTransformer m
transformer Text
text' = do
    let escaped :: Text
escaped = Builder -> Text
toLazyText forall a b. (a -> b) -> a -> b
$ Text -> Builder
HTMLEntities.Builder.text forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict Text
text'
    let entities :: [HtmlEntity]
entities = [HtmlTagStack -> Text -> HtmlEntity
HtmlText HtmlTagStack
TagStack.empty forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict Text
escaped]
    [HtmlEntity]
output <- HtmlTransformer m
transformer [HtmlEntity]
entities
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> Text
printText [HtmlEntity]
output

-- | Transforms an 'HtmlTransformer' into a 'TextTransformer' which transforms
-- a CommonMark (Markdown) text.
asCommonMarkTransformer :: (Monad m, MonadFail m) => TransformerTransformer m
asCommonMarkTransformer :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asCommonMarkTransformer HtmlTransformer m
transformer Text
input = do
    let inputNode :: Node
inputNode = [CMarkOption] -> Text -> Node
commonmarkToNode [CMarkOption
optSourcePos, CMarkOption
optUnsafe] forall a b. (a -> b) -> a -> b
$
            Text -> Text
LT.toStrict Text
input
    [HtmlEntity]
inputEntities <- forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTagStack -> Node -> m [HtmlEntity]
fromNode [] Node
inputNode
    [HtmlEntity]
outputEntities <- HtmlTransformer m
transformer forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> [HtmlEntity]
normalizeText [HtmlEntity]
inputEntities
    let outputNodes :: [Node]
outputNodes = [HtmlEntity] -> [Node]
toNode [HtmlEntity]
outputEntities
    let outputNode :: Item [Node]
outputNode = case [Node]
outputNodes of
            [node :: Item [Node]
node@(Node Maybe PosInfo
_ NodeType
DOCUMENT [Node]
_)] -> Item [Node]
node
            [Node]
nodes -> Maybe PosInfo -> NodeType -> [Node] -> Node
Node forall a. Maybe a
Nothing NodeType
DOCUMENT [Node]
nodes
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.fromStrict forall a b. (a -> b) -> a -> b
$
        [CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark [CMarkOption
optSourcePos , CMarkOption
optUnsafe] forall a. Maybe a
Nothing Node
outputNode
  where
    fromNode :: (Monad m, MonadFail m) => HtmlTagStack -> Node -> m [HtmlEntity]
    fromNode :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTagStack -> Node -> m [HtmlEntity]
fromNode HtmlTagStack
stack (Node Maybe PosInfo
posInfo NodeType
nodeType [Node]
children) = case NodeType
nodeType of
        NodeType
DOCUMENT ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren HtmlTag
Article
        NodeType
THEMATIC_BREAK -> forall (m :: * -> *) a. Monad m => a -> m a
return
            [ HtmlTagStack -> HtmlTag -> Text -> HtmlEntity
HtmlStartTag HtmlTagStack
stack HtmlTag
HR (Maybe PosInfo -> Text
posAttr Maybe PosInfo
posInfo)
            , HtmlTagStack -> HtmlTag -> HtmlEntity
HtmlEndTag HtmlTagStack
stack HtmlTag
HR
            ]
        NodeType
PARAGRAPH ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren HtmlTag
P
        NodeType
BLOCK_QUOTE ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren HtmlTag
BlockQuote
        HTML_BLOCK Text
html ->
            case Text -> Result [HtmlEntity]
scanHtml forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.fromStrict Text
html of
                Done Text
"" [HtmlEntity]
input' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> [HtmlEntity]
rebaseStack [HtmlEntity]
input'
                Result [HtmlEntity]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [HtmlTagStack -> Text -> HtmlEntity
HtmlCdata HtmlTagStack
stack Text
html]
        CUSTOM_BLOCK Text
_ Text
_ ->
            forall (m :: * -> *) a. Monad m => a -> m a
return []
        CODE_BLOCK Text
info Text
text' -> forall (m :: * -> *) a. Monad m => a -> m a
return
            [ HtmlTagStack -> HtmlTag -> Text -> HtmlEntity
HtmlStartTag HtmlTagStack
stack HtmlTag
Pre (Maybe PosInfo -> Text
posAttr Maybe PosInfo
posInfo forall a. Semigroup a => a -> a -> a
<> forall a. Show a => Text -> a -> Text
attr' Text
"info" Text
info)
            , HtmlTagStack -> Text -> HtmlEntity
HtmlCdata (HtmlTag -> HtmlTagStack
nextStack HtmlTag
Pre) Text
text'
            , HtmlTagStack -> HtmlTag -> HtmlEntity
HtmlEndTag HtmlTagStack
stack HtmlTag
Pre
            ]
        HEADING Int
level ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren forall a b. (a -> b) -> a -> b
$ Int -> HtmlTag
headingTag' Int
level
        LIST ListAttributes
listAttrs ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> Text -> m [HtmlEntity]
nodeWithChildren' HtmlTag
UL forall a b. (a -> b) -> a -> b
$ forall a. Show a => Text -> a -> Text
attr' Text
"list-attrs" ListAttributes
listAttrs
        NodeType
ITEM ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren HtmlTag
LI
        TEXT Text
text' ->
            forall (m :: * -> *) a. Monad m => a -> m a
return [HtmlTagStack -> Text -> HtmlEntity
HtmlCdata HtmlTagStack
stack Text
text']
        NodeType
SOFTBREAK -> forall (m :: * -> *) a. Monad m => a -> m a
return
            [ HtmlTagStack -> HtmlTag -> Text -> HtmlEntity
HtmlStartTag HtmlTagStack
stack HtmlTag
BR (Maybe PosInfo -> Text
posAttr Maybe PosInfo
posInfo forall a. Semigroup a => a -> a -> a
<> forall a. Show a => Text -> a -> Text
attr' Text
"softbreak" Bool
True)
            , HtmlTagStack -> HtmlTag -> HtmlEntity
HtmlEndTag HtmlTagStack
stack HtmlTag
BR
            ]
        NodeType
LINEBREAK -> forall (m :: * -> *) a. Monad m => a -> m a
return
            [ HtmlTagStack -> HtmlTag -> Text -> HtmlEntity
HtmlStartTag HtmlTagStack
stack HtmlTag
BR (Maybe PosInfo -> Text
posAttr Maybe PosInfo
posInfo)
            , HtmlTagStack -> HtmlTag -> HtmlEntity
HtmlEndTag HtmlTagStack
stack HtmlTag
BR
            ]
        HTML_INLINE Text
html ->
            case Text -> Result [HtmlEntity]
scanHtml forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.fromStrict Text
html of
                Done Text
"" [HtmlEntity]
input' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> [HtmlEntity]
rebaseStack [HtmlEntity]
input'
                Result [HtmlEntity]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [HtmlTagStack -> Text -> HtmlEntity
HtmlCdata HtmlTagStack
stack Text
html]
        CUSTOM_INLINE Text
_ Text
_ ->
            forall (m :: * -> *) a. Monad m => a -> m a
return []
        CODE Text
text' -> forall (m :: * -> *) a. Monad m => a -> m a
return
            [ HtmlTagStack -> HtmlTag -> Text -> HtmlEntity
HtmlStartTag HtmlTagStack
stack HtmlTag
Code (Maybe PosInfo -> Text
posAttr Maybe PosInfo
posInfo)
            , HtmlTagStack -> Text -> HtmlEntity
HtmlCdata (HtmlTag -> HtmlTagStack
nextStack HtmlTag
Code) Text
text'
            , HtmlTagStack -> HtmlTag -> HtmlEntity
HtmlEndTag HtmlTagStack
stack HtmlTag
Code
            ]
        NodeType
EMPH ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren HtmlTag
Em
        NodeType
STRONG ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren HtmlTag
Strong
        LINK Text
href Text
title ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> Text -> m [HtmlEntity]
nodeWithChildren' HtmlTag
A forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
rawAttr Text
" href" Text
href forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
rawAttr Text
" title" Text
title
        IMAGE Text
src Text
title ->
            forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> Text -> m [HtmlEntity]
nodeWithChildren' HtmlTag
Img forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
rawAttr Text
" src" Text
src forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
rawAttr Text
" title" Text
title
      where
        nextStack :: HtmlTag -> HtmlTagStack
        nextStack :: HtmlTag -> HtmlTagStack
nextStack = (HtmlTag -> HtmlTagStack -> HtmlTagStack
`TagStack.push` HtmlTagStack
stack)
        nodeWithChildren :: (Monad m, MonadFail m) => HtmlTag -> m [HtmlEntity]
        nodeWithChildren :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> m [HtmlEntity]
nodeWithChildren HtmlTag
tag' = forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> Text -> m [HtmlEntity]
nodeWithChildren' HtmlTag
tag' Text
""
        nodeWithChildren' :: (Monad m, MonadFail m)
                          => HtmlTag -> ST.Text -> m [HtmlEntity]
        nodeWithChildren' :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTag -> Text -> m [HtmlEntity]
nodeWithChildren' HtmlTag
tag' Text
extraAttrs = do
            [[HtmlEntity]]
mid <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
children forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *).
(Monad m, MonadFail m) =>
HtmlTagStack -> Node -> m [HtmlEntity]
fromNode (HtmlTag -> HtmlTagStack
nextStack HtmlTag
tag')
            let middle :: [HtmlEntity]
middle = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Data.List.concat [[HtmlEntity]]
mid
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HtmlTagStack -> HtmlTag -> Text -> HtmlEntity
HtmlStartTag HtmlTagStack
stack HtmlTag
tag' (Maybe PosInfo -> Text
posAttr Maybe PosInfo
posInfo forall a. Semigroup a => a -> a -> a
<> Text
extraAttrs) forall a. a -> [a] -> [a]
:
                [HtmlEntity]
middle forall a. [a] -> [a] -> [a]
++ [HtmlTagStack -> HtmlTag -> HtmlEntity
HtmlEndTag HtmlTagStack
stack HtmlTag
tag']
        rebase' :: HtmlTagStack -> HtmlTagStack
        rebase' :: HtmlTagStack -> HtmlTagStack
rebase' = HtmlTagStack -> HtmlTagStack -> HtmlTagStack -> HtmlTagStack
TagStack.rebase [] HtmlTagStack
stack
        rebaseStack :: [HtmlEntity] -> [HtmlEntity]
        rebaseStack :: [HtmlEntity] -> [HtmlEntity]
rebaseStack = forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\HtmlEntity
e -> HtmlEntity
e { tagStack :: HtmlTagStack
tagStack = HtmlTagStack -> HtmlTagStack
rebase' forall a b. (a -> b) -> a -> b
$ HtmlEntity -> HtmlTagStack
tagStack HtmlEntity
e })
    toNode :: [HtmlEntity] -> [Node]
    toNode :: [HtmlEntity] -> [Node]
toNode [] = []
    toNode (HtmlEntity
x:[HtmlEntity]
xs) = case HtmlEntity
x of
        HtmlComment HtmlTagStack
_ Text
comment' ->
            Maybe PosInfo -> NodeType -> [Node] -> Node
Node forall a. Maybe a
Nothing (Text -> NodeType
htmlNode Text
comment') [] forall a. a -> [a] -> [a]
: [HtmlEntity] -> [Node]
toNode [HtmlEntity]
xs
        HtmlCdata HtmlTagStack
_ Text
cdata ->
            Maybe PosInfo -> NodeType -> [Node] -> Node
Node forall a. Maybe a
Nothing (Text -> NodeType
TEXT Text
cdata) [] forall a. a -> [a] -> [a]
: [HtmlEntity] -> [Node]
toNode [HtmlEntity]
xs
        HtmlText HtmlTagStack
_ Text
rawText' ->
            Maybe PosInfo -> NodeType -> [Node] -> Node
Node forall a. Maybe a
Nothing (Text -> NodeType
TEXT forall a b. (a -> b) -> a -> b
$ Text -> Text
unescape Text
rawText') [] forall a. a -> [a] -> [a]
: [HtmlEntity] -> [Node]
toNode [HtmlEntity]
xs
        HtmlEndTag HtmlTagStack
_ HtmlTag
_ ->
            [HtmlEntity] -> [Node]
toNode [HtmlEntity]
xs
        start :: HtmlEntity
start@(HtmlStartTag HtmlTagStack
stack HtmlTag
tag' Text
attrs) ->
            let ([HtmlEntity]
children', [HtmlEntity]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.break (HtmlTagStack -> HtmlTag -> HtmlEntity -> Bool
endOf HtmlTagStack
stack HtmlTag
tag') [HtmlEntity]
xs
                ([HtmlEntity]
end, [HtmlEntity]
rest') = case [HtmlEntity]
rest of
                    end' :: HtmlEntity
end'@(HtmlEndTag HtmlTagStack
endStack HtmlTag
endTag):[HtmlEntity]
afterEnd ->
                        if HtmlTagStack
endStack forall a. Eq a => a -> a -> Bool
== HtmlTagStack
stack Bool -> Bool -> Bool
&& HtmlTag
endTag forall a. Eq a => a -> a -> Bool
== HtmlTag
tag'
                            then ([HtmlEntity
end'], [HtmlEntity]
afterEnd)
                            else ([], [HtmlEntity]
rest)
                    [HtmlEntity]
_ -> ([], [HtmlEntity]
rest)
                posInfo :: Maybe PosInfo
posInfo = forall a. a -> Maybe a -> a
fromMaybe forall a. Maybe a
Nothing
                    (forall a. Read a => Text -> Text -> Maybe a
getAttr Text
attrs Text
"posinfo" :: Maybe (Maybe PosInfo))
                softbreak :: Maybe Bool
softbreak = forall a. Read a => Text -> Text -> Maybe a
getAttr Text
attrs Text
"softbreak" :: Maybe Bool
                childrenHtmlNode :: NodeType
childrenHtmlNode = Text -> NodeType
htmlNode forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> Text
printHtml forall a b. (a -> b) -> a -> b
$
                    HtmlEntity
start forall a. a -> [a] -> [a]
: [HtmlEntity]
children' forall a. [a] -> [a] -> [a]
++ [HtmlEntity]
end
                nodeType :: NodeType
nodeType = case HtmlTag
tag' of
                    HtmlTag
Article -> NodeType
DOCUMENT
                    HtmlTag
BlockQuote -> NodeType
BLOCK_QUOTE
                    HtmlTag
HR -> NodeType
THEMATIC_BREAK
                    HtmlTag
P -> NodeType
PARAGRAPH
                    HtmlTag
Pre -> case forall a. Read a => Text -> Text -> Maybe a
getAttr Text
"info" Text
attrs of
                        Just Text
info -> Text -> Text -> NodeType
CODE_BLOCK Text
info forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> Text
printText' [HtmlEntity]
children'
                        Maybe Text
Nothing -> NodeType
childrenHtmlNode
                    HtmlTag
UL ->
                        forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeType
childrenHtmlNode ListAttributes -> NodeType
LIST (forall a. Read a => Text -> Text -> Maybe a
getAttr Text
attrs Text
"list-attrs")
                    HtmlTag
LI -> NodeType
ITEM
                    HtmlTag
BR ->
                        if Maybe Bool
softbreak forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True then NodeType
SOFTBREAK else NodeType
LINEBREAK
                    HtmlTag
Code -> Text -> NodeType
CODE forall a b. (a -> b) -> a -> b
$ [HtmlEntity] -> Text
printText' [HtmlEntity]
children'
                    HtmlTag
Em -> NodeType
EMPH
                    HtmlTag
Strong -> NodeType
STRONG
                    HtmlTag
A -> Text -> Text -> NodeType
LINK
                        (forall a. a -> Maybe a -> a
fromMaybe Text
ST.empty forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
getRawAttr Text
attrs Text
"href")
                        (forall a. a -> Maybe a -> a
fromMaybe Text
ST.empty forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
getRawAttr Text
attrs Text
"title")
                    HtmlTag
Img -> Text -> Text -> NodeType
IMAGE
                        (forall a. a -> Maybe a -> a
fromMaybe Text
ST.empty forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
getRawAttr Text
attrs Text
"src")
                        (forall a. a -> Maybe a -> a
fromMaybe Text
ST.empty forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
getRawAttr Text
attrs Text
"title")
                    HtmlTag
_ ->
                        forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeType
childrenHtmlNode Int -> NodeType
HEADING (HtmlTag -> Maybe Int
headingLevel HtmlTag
tag')
                (NodeType
nodeType', [Node]
nodeChildren) =
                    if forall a. Maybe a -> Bool
isNothing Maybe PosInfo
posInfo Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Bool
softbreak
                        then (NodeType
childrenHtmlNode, [])
                        else (NodeType
nodeType, [HtmlEntity] -> [Node]
toNode [HtmlEntity]
children')
            in
                Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
posInfo NodeType
nodeType' [Node]
nodeChildren forall a. a -> [a] -> [a]
: [HtmlEntity] -> [Node]
toNode [HtmlEntity]
rest'
      where
        block :: Bool
        block :: Bool
block = case HtmlTagStack -> Maybe HtmlTag
TagStack.last (HtmlEntity -> HtmlTagStack
tagStack HtmlEntity
x) of
            Just HtmlTag
A -> Bool
False
            Just HtmlTag
Em -> Bool
False
            Just HtmlTag
H1 -> Bool
False
            Just HtmlTag
H2 -> Bool
False
            Just HtmlTag
H3 -> Bool
False
            Just HtmlTag
H4 -> Bool
False
            Just HtmlTag
H5 -> Bool
False
            Just HtmlTag
H6 -> Bool
False
            Just HtmlTag
P -> Bool
False
            Just HtmlTag
Strong -> Bool
False
            Just HtmlTag
tag' -> forall a. Maybe a -> Bool
isNothing (HtmlTag -> Maybe Int
headingLevel HtmlTag
tag')
            Maybe HtmlTag
_ -> Bool
True
        htmlNode :: ST.Text -> NodeType
        htmlNode :: Text -> NodeType
htmlNode
          | Bool
block = Text -> NodeType
HTML_BLOCK
          | Bool
otherwise = Text -> NodeType
HTML_INLINE
    unescape :: ST.Text -> ST.Text
    unescape :: Text -> Text
unescape = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
htmlEncodedText
    rawAttr :: ST.Text -> ST.Text -> ST.Text
    rawAttr :: Text -> Text -> Text
rawAttr Text
name Text
value = Text -> Text -> Text
ST.append Text
name forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict forall a b. (a -> b) -> a -> b
$
        Text
"=\"" forall a. Semigroup a => a -> a -> a
<> Builder -> Text
toLazyText (Text -> Builder
HTMLEntities.Builder.text Text
value) forall a. Semigroup a => a -> a -> a
<> Text
"\""
    attr :: Show a => ST.Text -> a -> ST.Text
    attr :: forall a. Show a => Text -> a -> Text
attr Text
name a
value =
        Text -> Text -> Text
rawAttr (Text
"data-seonbi-cmark-" forall a. Semigroup a => a -> a -> a
<> Text
name) forall a b. (a -> b) -> a -> b
$ String -> Text
ST.pack (forall a. Show a => a -> String
show a
value)
    attr' :: Show a => ST.Text -> a -> ST.Text
    attr' :: forall a. Show a => Text -> a -> Text
attr' Text
name = Char -> Text -> Text
ST.cons Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Text -> a -> Text
attr Text
name
    posAttr :: Maybe PosInfo -> ST.Text
    posAttr :: Maybe PosInfo -> Text
posAttr = forall a. Show a => Text -> a -> Text
attr Text
"posinfo"
    getRawAttr :: HtmlRawAttrs -> ST.Text -> Maybe ST.Text
    getRawAttr :: Text -> Text -> Maybe Text
getRawAttr Text
attrs Text
name =
        case Text -> Text -> (Text, Text)
ST.breakOn Text
prefix Text
attrs of
            (Text
_, Text
"") -> forall a. Maybe a
Nothing
            (Text
_, Text
head') ->
                case (Char -> Bool) -> Text -> (Text, Text)
ST.break (forall a. Eq a => a -> a -> Bool
== Char
'"') (Int -> Text -> Text
ST.drop (Text -> Int
ST.length Text
prefix) Text
head') of
                    (Text
_, Text
"") -> forall a. Maybe a
Nothing
                    (Text
value, Text
_) ->
                        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText forall a b. (a -> b) -> a -> b
$ Text -> Builder
htmlEncodedText Text
value
      where
        prefix :: ST.Text
        prefix :: Text
prefix = Text
name forall a. Semigroup a => a -> a -> a
<> Text
"=\""
    getAttr :: Read a => HtmlRawAttrs -> ST.Text -> Maybe a
    getAttr :: forall a. Read a => Text -> Text -> Maybe a
getAttr Text
attrs Text
name =
        case Text -> Text -> Maybe Text
getRawAttr Text
attrs (Text
"data-seonbi-cmark-" forall a. Semigroup a => a -> a -> a
<> Text
name) of
            Maybe Text
Nothing -> forall a. Maybe a
Nothing
            Just Text
value -> forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
ST.unpack Text
value
    endOf :: HtmlTagStack -> HtmlTag -> HtmlEntity -> Bool
    endOf :: HtmlTagStack -> HtmlTag -> HtmlEntity -> Bool
endOf HtmlTagStack
stack HtmlTag
tag' (HtmlEndTag HtmlTagStack
endStack HtmlTag
endTag) =
        Bool -> Bool
not (HtmlTagStack
endStack HtmlTagStack -> HtmlTagStack -> Bool
`TagStack.descendsFrom` HtmlTagStack
stack) Bool -> Bool -> Bool
|| HtmlTag
endTag forall a. Eq a => a -> a -> Bool
== HtmlTag
tag'
    endOf HtmlTagStack
_ HtmlTag
_ HtmlEntity
_ = Bool
False
    printText' :: [HtmlEntity] -> ST.Text
    printText' :: [HtmlEntity] -> Text
printText' = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HtmlEntity] -> Text
printText


-- | Represents a case-insensitive content type.
type ContentType = MediaType

-- | Converts a 'Text' to a 'ContentType'.
contentTypeFromText :: ST.Text -> Maybe ContentType
contentTypeFromText :: Text -> Maybe ContentType
contentTypeFromText = forall a. Accept a => ByteString -> Maybe a
parseAccept forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Converts a 'ContentType' to a 'Text'.
contentTypeText :: ContentType -> ST.Text
contentTypeText :: ContentType -> Text
contentTypeText = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h. RenderHeader h => h -> ByteString
renderHeader

newtype TransformerTransformer' m =
    TransformerTransformer' (TransformerTransformer m)
transformers :: (Monad m, MonadFail m)
             => [(ContentType, TransformerTransformer' m)]
transformers :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
[(ContentType, TransformerTransformer' m)]
transformers =
    [ (ContentType
"text/html", forall (m :: * -> *).
TransformerTransformer m -> TransformerTransformer' m
TransformerTransformer' forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asHtmlTransformer)
    , (ContentType
"application/xhtml+xml", forall (m :: * -> *).
TransformerTransformer m -> TransformerTransformer' m
TransformerTransformer' forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asXhtmlTransformer)
    , (ContentType
"text/plain", forall (m :: * -> *).
TransformerTransformer m -> TransformerTransformer' m
TransformerTransformer' forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asPlainTextTransformer)
    , (ContentType
"text/markdown", forall (m :: * -> *).
TransformerTransformer m -> TransformerTransformer' m
TransformerTransformer' forall (m :: * -> *).
(Monad m, MonadFail m) =>
TransformerTransformer m
asCommonMarkTransformer)
    ]

-- | Supported content types.
contentTypes :: Set ContentType
contentTypes :: Set ContentType
contentTypes = (forall a. Ord a => [a] -> Set a
Data.Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall a b. (a, b) -> a
fst)
    (forall (m :: * -> *).
(Monad m, MonadFail m) =>
[(ContentType, TransformerTransformer' m)]
transformers :: [(ContentType, TransformerTransformer' IO)])

getTransformerTransformer :: (Monad m, MonadFail m)
                          => ContentType
                          -> Maybe (TransformerTransformer' m)
getTransformerTransformer :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
ContentType -> Maybe (TransformerTransformer' m)
getTransformerTransformer ContentType
contentType =
    forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (forall a. Accept a => a -> a -> Bool
matches ContentType
contentType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (m :: * -> *).
(Monad m, MonadFail m) =>
[(ContentType, TransformerTransformer' m)]
transformers

-- | Applies an 'HtmlTransformer' to the given text with respect to the
-- given content type.
transformWithContentType
    :: (Monad m, MonadFail m)
    => ContentType
    -- ^ A content type.  If the content type is unsupported (i.e. not in
    -- 'contentTypes'), this function fails.
    -> HtmlTransformer m
    -- ^ An 'HtmlTransformer' to apply.
    -> LT.Text
    -- ^ A input text to transform.
    -> m LT.Text
    -- ^ A transformed text.
transformWithContentType :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
ContentType -> HtmlTransformer m -> Text -> m Text
transformWithContentType ContentType
contentType HtmlTransformer m
transformer Text
inputText =
    case forall (m :: * -> *).
(Monad m, MonadFail m) =>
ContentType -> Maybe (TransformerTransformer' m)
getTransformerTransformer ContentType
contentType of
        Maybe (TransformerTransformer' m)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ Text -> String
ST.unpack forall a b. (a -> b) -> a -> b
$
            Text
"unknown content type: " forall a. Semigroup a => a -> a -> a
<> ContentType -> Text
contentTypeText ContentType
contentType
        Just (TransformerTransformer' TransformerTransformer m
transformTransformer) ->
            TransformerTransformer m
transformTransformer HtmlTransformer m
transformer Text
inputText