{-# 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 "<" 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 ">" 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 "&" 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 """ 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 "'" 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 " )")