{-# 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 a b. (a -> b) -> Parser Text a -> Parser Text b
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 a. Parser Text a -> Parser Text [a]
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Eq a => a -> [a] -> 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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> c -> Parser Text c
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> c
front []))
            Parser Text c -> Parser Text c -> Parser Text c
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
                x <- RefMap -> Parser Text Inline
inlineAny RefMap
refs
                go $ front . (x:))

    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 -> Parser Text
string Text
t
        is <- inlinesTill t
        if null is then fail "wrapped around something missing" else return 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 a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text a
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 a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text a
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 a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text a
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 a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Char
satisfy (Char -> String -> Bool
forall a. Eq a => a -> [a] -> 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
            c <- Parser Text Char
anyChar
            case 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 a. a -> Parser Text a
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
            c <- Parser Text Char
anyChar
            let 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
            c' <-
                if c == '\\'
                    then anyChar
                    else return c
            cs <- parseUrl' level'
            return $ c' : cs
        | Bool
otherwise = (do
            c <- Parser Text Char
hrefChar
            if c == '('
                then (c:) <$> parseUrl' 1
                else (c:) <$> parseUrl' 0) Parser Text String -> Parser Text String -> Parser Text String
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Text String
forall a. a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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
        url <- Parser Text
parseUrl
        mtitle <- (Just <$> title) <|> (skipSpace >> endTitle >> pure Nothing)
        return (url, mtitle)
      where
        title :: Parser Text
title = do
            _ <- Parser Text Char
space
            skipSpace
            _ <- char '"'
            t <- T.stripEnd . T.pack <$> go
            return $
                if not (T.null t) && T.last t == '"'
                    then T.init t
                    else t
          where
            go :: Parser Text String
go =  (Char -> Parser Text Char
char Char
'\\' Parser Text Char -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Text String
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
              Parser Text String -> Parser Text String -> Parser Text String
forall a. Parser Text a -> Parser Text a -> Parser Text a
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 a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text b
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
        ref' <- (Parser ()
skipSpace Parser () -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text b
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 a b. Parser Text a -> Parser Text b -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
        let ref = if Text -> Bool
T.null Text
ref' then Text
defRef else Text
ref'
        case Map.lookup (T.unwords $ T.words ref) refs of
            Maybe Text
Nothing -> String -> Parser Text (Text, Maybe Text)
forall a. String -> Parser Text a
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 a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text, Maybe Text) -> Parser Text (Text, Maybe Text)
forall a. a -> Parser Text a
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 -> Parser Text Char
char Char
'['
        rawContent <- takeBalancedBrackets
        content <- either fail return $ parseOnly (inlineParser refs) rawContent
        (url, mtitle) <- parseUrlTitle rawContent
        return $ InlineLink url mtitle content

    image :: Parser Text Inline
image = do
        _ <- Text -> Parser Text
string Text
"!["
        content <- takeBalancedBrackets
        (url, mtitle) <- parseUrlTitle content
        return $ InlineImage url mtitle 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
&& HasCallStack => Text -> Char
Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
&& HasCallStack => Text -> Char
Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>' = HasCallStack => Text -> Text
Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
T.tail Text
t
        | Bool
otherwise = Text
t

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

    html :: Parser Text Inline
html = do
        c <- Char -> Parser Text Char
char Char
'<'
        t <- 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 T.null t
            then fail "invalid tag"
            else do
                t2 <- takeWhile (/= '>')
                c2 <- char '>'
                return $ InlineHtml $ T.concat
                    [ T.singleton c
                    , t
                    , t2
                    , T.singleton c2
                    ]

    entity :: Parser Text Inline
entity =
            Text -> Parser Text Inline
rawent Text
"&lt;"
        Parser Text Inline -> Parser Text Inline -> Parser Text Inline
forall a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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 a. Parser Text a -> Parser Text a -> Parser Text a
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
        s <- Text -> Parser Text
string Text
"&#"
        t <- takeWhile1 $ \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')
        c <- char ';'
        return $ InlineHtml $ T.concat
            [ s
            , t
            , T.singleton c
            ]

    hexEnt :: Parser Text Inline
hexEnt = do
        s <- Text -> Parser Text
string Text
"&#x" Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"&#X"
        t <- takeWhile1 $ \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')
        c <- char ';'
        return $ InlineHtml $ T.concat
            [ s
            , t
            , T.singleton c
            ]

    namedEnt :: Parser Text Inline
namedEnt = do
        _s <- Char -> Parser Text Char
char Char
'&'
        t <- takeWhile1 (/= ';')
        _c <- char ';'
        case decodeHtmlEntities t of
            ContentText Text
t' -> Inline -> Parser Text Inline
forall a. a -> Parser Text a
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 a. String -> Parser Text a
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 a b. Parser Text a -> Parser Text b -> Parser Text b
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 a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text Char
satisfy (String -> Char -> Bool
notInClass String
" )")