{-# LANGUAGE OverloadedStrings #-}
module Text.Markdown.Inline
    ( Inline (..)
    , inlineParser
    , toInline
    ) where

import Prelude hiding (takeWhile)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Attoparsec.Text
import Control.Applicative
import Data.Monoid ((<>))
import qualified Data.Map as Map
import Text.Markdown.Types (Inline(..))
import Data.XML.Types (Content (..))
import Text.XML.Stream.Parse (decodeHtmlEntities)

type RefMap = Map.Map Text Text

toInline :: RefMap -> Text -> [Inline]
toInline :: RefMap -> Text -> [Inline]
toInline RefMap
refmap Text
t =
    case Parser [Inline] -> Text -> Either String [Inline]
forall a. Parser a -> Text -> Either String a
parseOnly (RefMap -> Parser [Inline]
inlineParser RefMap
refmap) Text
t of
        Left String
s -> [Text -> Inline
InlineText (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s]
        Right [Inline]
is -> [Inline]
is


inlineParser :: RefMap -> Parser [Inline]
inlineParser :: RefMap -> Parser [Inline]
inlineParser = ([Inline] -> [Inline]) -> Parser [Inline] -> Parser [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Inline] -> [Inline]
combine (Parser [Inline] -> Parser [Inline])
-> (RefMap -> Parser [Inline]) -> RefMap -> Parser [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text Inline -> Parser [Inline]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text Inline -> Parser [Inline])
-> (RefMap -> Parser Text Inline) -> RefMap -> Parser [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefMap -> Parser Text Inline
inlineAny

combine :: [Inline] -> [Inline]
combine :: [Inline] -> [Inline]
combine [] = []
combine (InlineText Text
x:InlineText Text
y:[Inline]
rest) = [Inline] -> [Inline]
combine (Text -> Inline
InlineText (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
rest)
combine (InlineText Text
x:[Inline]
rest) = Text -> Inline
InlineText Text
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineItalic [Inline]
x:InlineItalic [Inline]
y:[Inline]
rest) = [Inline] -> [Inline]
combine ([Inline] -> Inline
InlineItalic ([Inline]
x [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
y)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
rest)
combine (InlineItalic [Inline]
x:[Inline]
rest) = [Inline] -> Inline
InlineItalic ([Inline] -> [Inline]
combine [Inline]
x) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineBold [Inline]
x:InlineBold [Inline]
y:[Inline]
rest) = [Inline] -> [Inline]
combine ([Inline] -> Inline
InlineBold ([Inline]
x [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
y)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
rest)
combine (InlineBold [Inline]
x:[Inline]
rest) = [Inline] -> Inline
InlineBold ([Inline] -> [Inline]
combine [Inline]
x) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineCode Text
x:InlineCode Text
y:[Inline]
rest) = [Inline] -> [Inline]
combine (Text -> Inline
InlineCode (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y)Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
rest)
combine (InlineCode Text
x:[Inline]
rest) = Text -> Inline
InlineCode Text
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineLink Text
u Maybe Text
t [Inline]
c:[Inline]
rest) = Text -> Maybe Text -> [Inline] -> Inline
InlineLink Text
u Maybe Text
t ([Inline] -> [Inline]
combine [Inline]
c) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineImage Text
u Maybe Text
t Text
c:[Inline]
rest) = Text -> Maybe Text -> Text -> Inline
InlineImage Text
u Maybe Text
t Text
c Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineHtml Text
t:[Inline]
rest) = Text -> Inline
InlineHtml Text
t Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineFootnote Integer
x:[Inline]
rest) = Integer -> Inline
InlineFootnote Integer
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest
combine (InlineFootnoteRef Integer
x:[Inline]
rest) = Integer -> Inline
InlineFootnoteRef Integer
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
combine [Inline]
rest

specials :: [Char]
specials :: String
specials = String
"*_`\\[]!<&{}"

inlineAny :: RefMap -> Parser Inline
inlineAny :: RefMap -> Parser Text Inline
inlineAny RefMap
refs =
    RefMap -> Parser Text Inline
inline RefMap
refs Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
special
  where
    special :: Parser Text Inline
special = Text -> Inline
InlineText (Text -> Inline) -> (Char -> Text) -> Char -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Inline) -> Parser Text Char -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
specials)

inline :: RefMap -> Parser Inline
inline :: RefMap -> Parser Text Inline
inline RefMap
refs =
    Parser Text Inline
text
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
escape
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
footnote
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
footnoteRef
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ([Inline] -> Inline) -> Parser Text Inline
forall b. Text -> ([Inline] -> b) -> Parser Text b
paired Text
"**" [Inline] -> Inline
InlineBold Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ([Inline] -> Inline) -> Parser Text Inline
forall b. Text -> ([Inline] -> b) -> Parser Text b
paired Text
"__" [Inline] -> Inline
InlineBold
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ([Inline] -> Inline) -> Parser Text Inline
forall b. Text -> ([Inline] -> b) -> Parser Text b
paired Text
"*" [Inline] -> Inline
InlineItalic Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ([Inline] -> Inline) -> Parser Text Inline
forall b. Text -> ([Inline] -> b) -> Parser Text b
paired Text
"_" [Inline] -> Inline
InlineItalic
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
doubleCodeSpace Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
doubleCode Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
code
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
link
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
image
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
autoLink
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
html
    Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
entity
  where
    inlinesTill :: Text -> Parser [Inline]
    inlinesTill :: Text -> Parser [Inline]
inlinesTill Text
end =
        ([Inline] -> [Inline]) -> Parser [Inline]
forall c. ([Inline] -> c) -> Parser Text c
go [Inline] -> [Inline]
forall a. a -> a
id
      where
        go :: ([Inline] -> c) -> Parser Text c
go [Inline] -> c
front =
            (Text -> Parser Text
string Text
end Parser Text -> Parser Text c -> Parser Text c
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> c -> Parser Text c
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> c
front []))
            Parser Text c -> Parser Text c -> Parser Text c
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
                Inline
x <- RefMap -> Parser Text Inline
inlineAny RefMap
refs
                ([Inline] -> c) -> Parser Text c
go (([Inline] -> c) -> Parser Text c)
-> ([Inline] -> c) -> Parser Text c
forall a b. (a -> b) -> a -> b
$ [Inline] -> c
front ([Inline] -> c) -> ([Inline] -> [Inline]) -> [Inline] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:))

    text :: Parser Text Inline
text = Text -> Inline
InlineText (Text -> Inline) -> Parser Text -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile1 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
specials)

    paired :: Text -> ([Inline] -> b) -> Parser Text b
paired Text
t [Inline] -> b
wrap = [Inline] -> b
wrap ([Inline] -> b) -> Parser [Inline] -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Text
_ <- Text -> Parser Text
string Text
t
        [Inline]
is <- Text -> Parser [Inline]
inlinesTill Text
t
        if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
is then String -> Parser [Inline]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"wrapped around something missing" else [Inline] -> Parser [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
is

    doubleCodeSpace :: Parser Text Inline
doubleCodeSpace = Text -> Inline
InlineCode (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Inline) -> Parser Text String -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"`` " Parser Text -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Text -> Parser Text
string Text
" ``"))
    doubleCode :: Parser Text Inline
doubleCode = Text -> Inline
InlineCode (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Inline) -> Parser Text String -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"``" Parser Text -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Text -> Parser Text
string Text
"``"))
    code :: Parser Text Inline
code = Text -> Inline
InlineCode (Text -> Inline) -> Parser Text -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Text Char
char Char
'`' Parser Text Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`') Parser Text -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'`')

    footnoteRef :: Parser Text Inline
footnoteRef = Integer -> Inline
InlineFootnoteRef (Integer -> Inline) -> Parser Text Integer -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Text Char
char Char
'{' Parser Text Char -> Parser Text Integer -> Parser Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Integer
forall a. Integral a => Parser a
decimal Parser Text Integer -> Parser Text Char -> Parser Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'}')
    footnote :: Parser Text Inline
footnote = Integer -> Inline
InlineFootnote (Integer -> Inline) -> Parser Text Integer -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"{^" Parser Text -> Parser Text Integer -> Parser Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Integer
forall a. Integral a => Parser a
decimal Parser Text Integer -> Parser Text Char -> Parser Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'}')

    escape :: Parser Text Inline
escape = Text -> Inline
InlineText (Text -> Inline) -> (Char -> Text) -> Char -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Inline) -> Parser Text Char -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Char -> Parser Text Char
char Char
'\\' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"\\`*_{}[]()#+-.!>" :: String)))

    takeBalancedBrackets :: Parser Text
takeBalancedBrackets =
        String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text String
forall a. (Num a, Eq a) => a -> Parser Text String
go (Int
0 :: Int)
      where
        go :: a -> Parser Text String
go a
i = do
            Char
c <- Parser Text Char
anyChar
            case Char
c of
                Char
'[' -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Parser Text String
go (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
                Char
']'
                    | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 -> String -> Parser Text String
forall (m :: * -> *) a. Monad m => a -> m a
return []
                    | Bool
otherwise -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Parser Text String
go (a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
                Char
_ -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Parser Text String
go a
i

    parseUrl :: Parser Text
parseUrl = Text -> Text
fixUrl (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text String
forall t. (Ord t, Num t) => t -> Parser Text String
parseUrl' (Int
0 :: Int)

    parseUrl' :: t -> Parser Text String
parseUrl' t
level
        | t
level t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0 = do
            Char
c <- Parser Text Char
anyChar
            let level' :: t
level'
                    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' = t
level t -> t -> t
forall a. Num a => a -> a -> a
- t
1
                    | Bool
otherwise = t
level
            Char
c' <-
                if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'
                    then Parser Text Char
anyChar
                    else Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
            String
cs <- t -> Parser Text String
parseUrl' t
level'
            String -> Parser Text String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser Text String) -> String -> Parser Text String
forall a b. (a -> b) -> a -> b
$ Char
c' Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
        | Bool
otherwise = (do
            Char
c <- Parser Text Char
hrefChar
            if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
                then (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Parser Text String
parseUrl' t
1
                else (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Parser Text String
parseUrl' t
0) Parser Text String -> Parser Text String -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Text String
forall (m :: * -> *) a. Monad m => a -> m a
return []

    parseUrlTitle :: Text -> Parser Text (Text, Maybe Text)
parseUrlTitle Text
defRef = Parser Text (Text, Maybe Text)
parseUrlTitleInline Parser Text (Text, Maybe Text)
-> Parser Text (Text, Maybe Text) -> Parser Text (Text, Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text (Text, Maybe Text)
parseUrlTitleRef Text
defRef

    parseUrlTitleInside :: Parser Text a -> Parser Text (Text, Maybe Text)
parseUrlTitleInside Parser Text a
endTitle = do
        Text
url <- Parser Text
parseUrl
        Maybe Text
mtitle <- (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Parser Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
title) Parser Text (Maybe Text)
-> Parser Text (Maybe Text) -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
skipSpace Parser () -> Parser Text a -> Parser Text a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text a
endTitle Parser Text a
-> Parser Text (Maybe Text) -> Parser Text (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing)
        (Text, Maybe Text) -> Parser Text (Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
url, Maybe Text
mtitle)
      where
        title :: Parser Text
title = do
            Char
_ <- Parser Text Char
space
            Parser ()
skipSpace
            Char
_ <- Char -> Parser Text Char
char Char
'"'
            Text
t <- Text -> Text
T.stripEnd (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text String
go
            Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
                if Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'
                    then Text -> Text
T.init Text
t
                    else Text
t
          where
            go :: Parser Text String
go =  (Char -> Parser Text Char
char Char
'\\' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char
anyChar Parser Text Char
-> (Char -> Parser Text String) -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text String
go)
              Parser Text String -> Parser Text String -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text a
endTitle Parser Text a -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Text String
forall (m :: * -> *) a. Monad m => a -> m a
return [])
              Parser Text String -> Parser Text String -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Char
anyChar Parser Text Char
-> (Char -> Parser Text String) -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text String
go)

    parseUrlTitleInline :: Parser Text (Text, Maybe Text)
parseUrlTitleInline = Char -> Parser Text Char
char Char
'(' Parser Text Char
-> Parser Text (Text, Maybe Text) -> Parser Text (Text, Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text (Text, Maybe Text)
forall a. Parser Text a -> Parser Text (Text, Maybe Text)
parseUrlTitleInside (Char -> Parser Text Char
char Char
')')

    parseUrlTitleRef :: Text -> Parser Text (Text, Maybe Text)
parseUrlTitleRef Text
defRef = do
        Text
ref' <- (Parser ()
skipSpace Parser () -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
char Char
'[' Parser Text Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']') Parser Text -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
']') Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
        let ref :: Text
ref = if Text -> Bool
T.null Text
ref' then Text
defRef else Text
ref'
        case Text -> RefMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
ref) RefMap
refs of
            Maybe Text
Nothing -> String -> Parser Text (Text, Maybe Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ref not found"
            Just Text
t -> (String -> Parser Text (Text, Maybe Text))
-> ((Text, Maybe Text) -> Parser Text (Text, Maybe Text))
-> Either String (Text, Maybe Text)
-> Parser Text (Text, Maybe Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Text (Text, Maybe Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text, Maybe Text) -> Parser Text (Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Text, Maybe Text)
 -> Parser Text (Text, Maybe Text))
-> Either String (Text, Maybe Text)
-> Parser Text (Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser Text (Text, Maybe Text)
-> Text -> Either String (Text, Maybe Text)
forall a. Parser a -> Text -> Either String a
parseOnly (Parser () -> Parser Text (Text, Maybe Text)
forall a. Parser Text a -> Parser Text (Text, Maybe Text)
parseUrlTitleInside Parser ()
forall t. Chunk t => Parser t ()
endOfInput) Text
t

    link :: Parser Text Inline
link = do
        Char
_ <- Char -> Parser Text Char
char Char
'['
        Text
rawContent <- Parser Text
takeBalancedBrackets
        [Inline]
content <- (String -> Parser [Inline])
-> ([Inline] -> Parser [Inline])
-> Either String [Inline]
-> Parser [Inline]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser [Inline]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail [Inline] -> Parser [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [Inline] -> Parser [Inline])
-> Either String [Inline] -> Parser [Inline]
forall a b. (a -> b) -> a -> b
$ Parser [Inline] -> Text -> Either String [Inline]
forall a. Parser a -> Text -> Either String a
parseOnly (RefMap -> Parser [Inline]
inlineParser RefMap
refs) Text
rawContent
        (Text
url, Maybe Text
mtitle) <- Text -> Parser Text (Text, Maybe Text)
parseUrlTitle Text
rawContent
        Inline -> Parser Text Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Text Inline) -> Inline -> Parser Text Inline
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> [Inline] -> Inline
InlineLink Text
url Maybe Text
mtitle [Inline]
content

    image :: Parser Text Inline
image = do
        Text
_ <- Text -> Parser Text
string Text
"!["
        Text
content <- Parser Text
takeBalancedBrackets
        (Text
url, Maybe Text
mtitle) <- Text -> Parser Text (Text, Maybe Text)
parseUrlTitle Text
content
        Inline -> Parser Text Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Text Inline) -> Inline -> Parser Text Inline
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text -> Inline
InlineImage Text
url Maybe Text
mtitle Text
content

    fixUrl :: Text -> Text
fixUrl Text
t
        | Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>' = Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
t
        | Bool
otherwise = Text
t

    autoLink :: Parser Text Inline
autoLink = do
        Char
_ <- Char -> Parser Text Char
char Char
'<'
        Text
a <- Text -> Parser Text
string Text
"http:" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"https:"
        Text
b <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>')
        Char
_ <- Char -> Parser Text Char
char Char
'>'
        let url :: Text
url = Text
a Text -> Text -> Text
`T.append` Text
b
        Inline -> Parser Text Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Text Inline) -> Inline -> Parser Text Inline
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> [Inline] -> Inline
InlineLink Text
url Maybe Text
forall a. Maybe a
Nothing [Text -> Inline
InlineText Text
url]

    html :: Parser Text Inline
html = do
        Char
c <- Char -> Parser Text Char
char Char
'<'
        Text
t <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
x -> (Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
|| (Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
        if Text -> Bool
T.null Text
t
            then String -> Parser Text Inline
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"
            else do
                Text
t2 <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>')
                Char
c2 <- Char -> Parser Text Char
char Char
'>'
                Inline -> Parser Text Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Text Inline) -> Inline -> Parser Text Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
InlineHtml (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
                    [ Char -> Text
T.singleton Char
c
                    , Text
t
                    , Text
t2
                    , Char -> Text
T.singleton Char
c2
                    ]

    entity :: Parser Text Inline
entity =
            Text -> Parser Text Inline
rawent Text
"&lt;"
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Inline
rawent Text
"&gt;"
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Inline
rawent Text
"&amp;"
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Inline
rawent Text
"&quot;"
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Inline
rawent Text
"&apos;"
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
decEnt
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
hexEnt
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Inline
namedEnt

    rawent :: Text -> Parser Text Inline
rawent Text
t = Text -> Inline
InlineHtml (Text -> Inline) -> Parser Text -> Parser Text Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Text
string Text
t

    decEnt :: Parser Text Inline
decEnt = do
        Text
s <- Text -> Parser Text
string Text
"&#"
        Text
t <- (Char -> Bool) -> Parser Text
takeWhile1 ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Char
x -> (Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
        Char
c <- Char -> Parser Text Char
char Char
';'
        Inline -> Parser Text Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Text Inline) -> Inline -> Parser Text Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
InlineHtml (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
            [ Text
s
            , Text
t
            , Char -> Text
T.singleton Char
c
            ]

    hexEnt :: Parser Text Inline
hexEnt = do
        Text
s <- Text -> Parser Text
string Text
"&#x" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"&#X"
        Text
t <- (Char -> Bool) -> Parser Text
takeWhile1 ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Char
x -> (Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
|| (Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F') Bool -> Bool -> Bool
|| (Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f')
        Char
c <- Char -> Parser Text Char
char Char
';'
        Inline -> Parser Text Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Text Inline) -> Inline -> Parser Text Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
InlineHtml (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
            [ Text
s
            , Text
t
            , Char -> Text
T.singleton Char
c
            ]

    namedEnt :: Parser Text Inline
namedEnt = do
        Char
_s <- Char -> Parser Text Char
char Char
'&'
        Text
t <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';')
        Char
_c <- Char -> Parser Text Char
char Char
';'
        case DecodeEntities
decodeHtmlEntities Text
t of
            ContentText Text
t' -> Inline -> Parser Text Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> Parser Text Inline) -> Inline -> Parser Text Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
InlineHtml Text
t'
            ContentEntity Text
_ -> String -> Parser Text Inline
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown named entity"

hrefChar :: Parser Char
hrefChar :: Parser Text Char
hrefChar = (Char -> Parser Text Char
char Char
'\\' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char
anyChar) Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text Char
satisfy (String -> Char -> Bool
notInClass String
" )")