{-# 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 refmap t :: 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 s :: String s -> [Text -> Inline InlineText (Text -> Inline) -> Text -> Inline forall a b. (a -> b) -> a -> b $ String -> Text T.pack String s] Right is :: [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 x :: Text x:InlineText y :: Text y:rest :: [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 x :: Text x:rest :: [Inline] rest) = Text -> Inline InlineText Text x Inline -> [Inline] -> [Inline] forall a. a -> [a] -> [a] : [Inline] -> [Inline] combine [Inline] rest combine (InlineItalic x :: [Inline] x:InlineItalic y :: [Inline] y:rest :: [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 x :: [Inline] x:rest :: [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 x :: [Inline] x:InlineBold y :: [Inline] y:rest :: [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 x :: [Inline] x:rest :: [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 x :: Text x:InlineCode y :: Text y:rest :: [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 x :: Text x:rest :: [Inline] rest) = Text -> Inline InlineCode Text x Inline -> [Inline] -> [Inline] forall a. a -> [a] -> [a] : [Inline] -> [Inline] combine [Inline] rest combine (InlineLink u :: Text u t :: Maybe Text t c :: [Inline] c:rest :: [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 u :: Text u t :: Maybe Text t c :: Text c:rest :: [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 t :: Text t:rest :: [Inline] rest) = Text -> Inline InlineHtml Text t Inline -> [Inline] -> [Inline] forall a. a -> [a] -> [a] : [Inline] -> [Inline] combine [Inline] rest combine (InlineFootnote x :: Integer x:rest :: [Inline] rest) = Integer -> Inline InlineFootnote Integer x Inline -> [Inline] -> [Inline] forall a. a -> [a] -> [a] : [Inline] -> [Inline] combine [Inline] rest combine (InlineFootnoteRef x :: Integer x:rest :: [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 = "*_`\\[]!<&{}" inlineAny :: RefMap -> Parser Inline inlineAny :: RefMap -> Parser Text Inline inlineAny refs :: 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 refs :: 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 "**" [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 "__" [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 "*" [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 "_" [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 end :: 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 front :: [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 t :: Text t wrap :: [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 "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 "`` " 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 " ``")) 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 "``" 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 "``")) 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 '`' 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 /= '`') Parser Text -> Parser Text Char -> Parser Text forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Char -> Parser Text 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 '{' 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 '}') 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 "{^" 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 '}') 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 '\\' 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))) 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 (0 :: Int) where go :: a -> Parser Text String go i :: a i = do Char c <- Parser Text Char anyChar case Char c of '[' -> (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 + 1) ']' | a i a -> a -> Bool forall a. Eq a => a -> a -> Bool == 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 - 1) _ -> (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' (0 :: Int) parseUrl' :: t -> Parser Text String parseUrl' level :: t level | t level t -> t -> Bool forall a. Ord a => a -> a -> Bool > 0 = do Char c <- Parser Text Char anyChar let level' :: t level' | Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == ')' = t level t -> t -> t forall a. Num a => a -> a -> a - 1 | Bool otherwise = t level Char c' <- if Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == '\\' 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 == '(' 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' 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' 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 defRef :: 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 endTitle :: 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 '"' 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 == '"' then Text -> Text T.init Text t else Text t where go :: Parser Text String go = (Char -> Parser Text 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 >>= \c :: 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 >>= \c :: 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 '(' 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 ')') parseUrlTitleRef :: Text -> Parser Text (Text, Maybe Text) parseUrlTitleRef defRef :: 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 '[' 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 /= ']') Parser Text -> Parser Text Char -> Parser Text forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Char -> Parser Text 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 "" 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 Nothing -> String -> Parser Text (Text, Maybe Text) forall (m :: * -> *) a. MonadFail m => String -> m a fail "ref not found" Just t :: 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 '[' 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 (url :: Text url, mtitle :: 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 content <- Parser Text takeBalancedBrackets (url :: Text url, mtitle :: 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 t :: Text t | Text -> Int T.length Text t Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > 2 Bool -> Bool -> Bool && Text -> Char T.head Text t Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == '<' Bool -> Bool -> Bool && Text -> Char T.last Text t Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == '>' = 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 '<' Text a <- Text -> Parser Text string "http:" Parser Text -> Parser Text -> Parser Text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Text -> Parser Text string "https:" Text b <- (Char -> Bool) -> Parser Text takeWhile1 (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /= '>') Char _ <- Char -> Parser Text 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 '<' Text t <- (Char -> Bool) -> Parser Text takeWhile1 (\x :: Char x -> ('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 <= 'Z') Bool -> Bool -> Bool || ('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 <= 'z') Bool -> Bool -> Bool || Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == '/') if Text -> Bool T.null Text t then String -> Parser Text Inline forall (m :: * -> *) a. MonadFail m => String -> m a fail "invalid tag" else do Text t2 <- (Char -> Bool) -> Parser Text takeWhile (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /= '>') Char c2 <- Char -> Parser Text 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 "<" 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 ">" 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 "&" 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 """ 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 "'" 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 t :: 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 t <- (Char -> Bool) -> Parser Text takeWhile1 ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text forall a b. (a -> b) -> a -> b $ \x :: Char x -> ('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 <= '9') Char c <- Char -> Parser Text 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 "&#x" Parser Text -> Parser Text -> Parser Text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Text -> Parser Text string "&#X" Text t <- (Char -> Bool) -> Parser Text takeWhile1 ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text forall a b. (a -> b) -> a -> b $ \x :: Char x -> ('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 <= '9') Bool -> Bool -> Bool || ('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 <= 'F') Bool -> Bool -> Bool || ('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 <= 'f') Char c <- Char -> Parser Text 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 '&' Text t <- (Char -> Bool) -> Parser Text takeWhile1 (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /= ';') Char _c <- Char -> Parser Text Char char ';' case DecodeEntities decodeHtmlEntities Text t of ContentText t' :: 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 _ -> String -> Parser Text Inline forall (m :: * -> *) a. MonadFail m => String -> m a fail "Unknown named entity" hrefChar :: Parser Char hrefChar :: Parser Text Char hrefChar = (Char -> Parser Text 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 " )")