{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData        #-}

module Commonmark.Inlines
  ( mkInlineParser
  , defaultInlineParser
  , IPState
  , InlineParser
  , getReferenceMap
  , FormattingSpec(..)
  , defaultFormattingSpecs
  , BracketedSpec(..)
  , defaultBracketedSpecs
  , imageSpec
  , linkSpec
  , pLinkLabel
  , pLinkDestination
  , pLinkTitle
  , pEscaped
  , processEmphasis
  , processBrackets
  , pBacktickSpan
  , normalizeCodeSpan
  , withAttributes
  )
where

import           Commonmark.Tag             (htmlTag, Enders, defaultEnders)
import           Commonmark.Tokens
import           Commonmark.TokParsers
import           Commonmark.ReferenceMap
import           Commonmark.Types
import           Control.Monad              (guard, mzero)
import           Control.Monad.Trans.State.Strict
import           Data.List                  (foldl')
import           Data.Char                  (isAscii, isLetter)
import qualified Data.IntMap.Strict         as IntMap
import qualified Data.Map.Strict            as M
import           Data.Maybe                 (isJust, mapMaybe, listToMaybe)
import qualified Data.Set                   as Set
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid                ((<>))
#endif
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import           Commonmark.Entity          (unEntity, charEntity, numEntity)
import           Text.Parsec                hiding (State, space)
import           Text.Parsec.Pos

mkInlineParser :: (Monad m, IsInline a)
               => [BracketedSpec a]
               -> [FormattingSpec a]
               -> [InlineParser m a]
               -> [InlineParser m Attributes]
               -> ReferenceMap
               -> [Tok]
               -> m (Either ParseError a)
mkInlineParser :: [BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> [InlineParser m Attributes]
-> ReferenceMap
-> [Tok]
-> m (Either ParseError a)
mkInlineParser bracketedSpecs :: [BracketedSpec a]
bracketedSpecs formattingSpecs :: [FormattingSpec a]
formattingSpecs ilParsers :: [InlineParser m a]
ilParsers attrParsers :: [InlineParser m Attributes]
attrParsers rm :: ReferenceMap
rm toks :: [Tok]
toks = do
  let iswhite :: Tok -> Bool
iswhite t :: Tok
t = TokType -> Tok -> Bool
hasType TokType
Spaces Tok
t Bool -> Bool -> Bool
|| TokType -> Tok -> Bool
hasType TokType
LineEnd Tok
t
  let attrParser :: InlineParser m Attributes
attrParser = [InlineParser m Attributes] -> InlineParser m Attributes
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [InlineParser m Attributes]
attrParsers
  let toks' :: [Tok]
toks' = (Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Tok -> Bool
iswhite ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> [Tok]
forall a. [a] -> [a]
reverse ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Tok -> Bool
iswhite ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> [Tok]
forall a. [a] -> [a]
reverse ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok]
toks
  Either ParseError [Chunk a]
res <- {-# SCC parseChunks #-} StateT Enders m (Either ParseError [Chunk a])
-> Enders -> m (Either ParseError [Chunk a])
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
          ([BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> InlineParser m Attributes
-> ReferenceMap
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
forall (m :: * -> *) a.
(Monad m, IsInline a) =>
[BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> InlineParser m Attributes
-> ReferenceMap
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
parseChunks [BracketedSpec a]
bracketedSpecs [FormattingSpec a]
formattingSpecs [InlineParser m a]
ilParsers
           InlineParser m Attributes
attrParser ReferenceMap
rm [Tok]
toks') Enders
defaultEnders
  Either ParseError a -> m (Either ParseError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError a -> m (Either ParseError a))
-> Either ParseError a -> m (Either ParseError a)
forall a b. (a -> b) -> a -> b
$!
    case Either ParseError [Chunk a]
res of
       Left err :: ParseError
err     -> ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
err
       Right chunks :: [Chunk a]
chunks ->
         (a -> Either ParseError a
forall a b. b -> Either a b
Right (a -> Either ParseError a)
-> ([Chunk a] -> a) -> [Chunk a] -> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          [Chunk a] -> a
forall a. IsInline a => [Chunk a] -> a
unChunks ([Chunk a] -> a) -> ([Chunk a] -> [Chunk a]) -> [Chunk a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          [Chunk a] -> [Chunk a]
forall a. IsInline a => [Chunk a] -> [Chunk a]
processEmphasis ([Chunk a] -> [Chunk a])
-> ([Chunk a] -> [Chunk a]) -> [Chunk a] -> [Chunk a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
forall a.
IsInline a =>
[BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets [BracketedSpec a]
bracketedSpecs ReferenceMap
rm) [Chunk a]
chunks

defaultInlineParser :: (Monad m, IsInline a) => InlineParser m a
defaultInlineParser :: InlineParser m a
defaultInlineParser =
  {-# SCC defaultInlineParser #-} InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
    tok :: Tok
tok@(Tok toktype :: TokType
toktype _ t :: Text
t) <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
    case TokType
toktype of
        WordChars    -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
        LineEnd      -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. IsInline a => a
softBreak
        Spaces       -> Int -> InlineParser m a
forall a (m :: * -> *) a s.
(Monad m, IsInline a, Num a, Ord a) =>
a -> ParsecT [Tok] s m a
doBreak (Text -> Int
T.length Text
t) InlineParser m a -> InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> a
forall a. IsInline a => Text -> a
str Text
t)
        UnicodeSpace -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
        Symbol '\\'  -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str "\\") InlineParser m a
forall s. ParsecT [Tok] s (StateT Enders m) a
doEscape
        Symbol '`'   -> Tok -> InlineParser m a
forall (m :: * -> *) b.
(Monad m, IsInline b) =>
Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) b
doCodeSpan Tok
tok
        Symbol '&'   -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str "&") InlineParser m a
forall s. ParsecT [Tok] s (StateT Enders m) a
doEntity
        Symbol '<'   -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str "<") (InlineParser m a
doAutolink InlineParser m a -> InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Tok -> InlineParser m a
forall b (m :: * -> *) u.
(IsInline b, Monad m) =>
Tok -> ParsecT [Tok] u (StateT Enders m) b
doHtml Tok
tok)
        _            -> InlineParser m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    where
     doBreak :: a -> ParsecT [Tok] s m a
doBreak len :: a
len
       | a
len a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 2  = a
forall a. IsInline a => a
lineBreak a -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
LineEnd)
       | Bool
otherwise = a
forall a. Monoid a => a
mempty a -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
LineEnd))
     doEscape :: ParsecT [Tok] s (StateT Enders m) a
doEscape = do
       Tok
tok <- (Tok -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok
                    (\case
                      Tok (Symbol c :: Char
c) _ _ -> Char -> Bool
isAscii Char
c
                      Tok LineEnd _ _    -> Bool
True
                      _                  -> Bool
False)
       case Tok
tok of
           Tok (Symbol c :: Char
c) _ _ -> a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] s (StateT Enders m) a)
-> a -> ParsecT [Tok] s (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$ Char -> a
forall a. IsInline a => Char -> a
escapedChar Char
c
           Tok LineEnd    _ _ -> a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. IsInline a => a
lineBreak
           _                  -> String -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Should not happen"
     doEntity :: ParsecT [Tok] u (StateT Enders m) a
doEntity = do
       [Tok]
ent <- ParsecT [Tok] u (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
numEntity ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
charEntity
       a -> ParsecT [Tok] u (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> a
forall a. IsInline a => Text -> a
entity ("&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
ent))
     doAutolink :: InlineParser m a
doAutolink = InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
       (target :: Text
target, lab :: Text
lab) <- InlineParser m (Text, Text)
forall (m :: * -> *). Monad m => InlineParser m (Text, Text)
pUri InlineParser m (Text, Text)
-> InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> InlineParser m (Text, Text)
forall (m :: * -> *). Monad m => InlineParser m (Text, Text)
pEmail
       Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '>'
       a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> a -> a
forall a. IsInline a => Text -> Text -> a -> a
link Text
target "" (Text -> a
forall a. IsInline a => Text -> a
str Text
lab)
     doHtml :: Tok -> ParsecT [Tok] u (StateT Enders m) b
doHtml tok :: Tok
tok = Format -> Text -> b
forall a. IsInline a => Format -> Text -> a
rawInline (Text -> Format
Format "html") (Text -> b) -> ([Tok] -> Text) -> [Tok] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Text) -> ([Tok] -> [Tok]) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok
tokTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> b)
-> ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Tok] u (StateT Enders m) [Tok]
forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlTag
     doCodeSpan :: Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) b
doCodeSpan tok :: Tok
tok = Tok -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *).
Monad m =>
Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan Tok
tok InlineParser m (Either [Tok] [Tok])
-> (Either [Tok] [Tok]
    -> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
       \case
         Left ticks :: [Tok]
ticks     -> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall a b. (a -> b) -> a -> b
$ Text -> b
forall a. IsInline a => Text -> a
str ([Tok] -> Text
untokenize [Tok]
ticks)
         Right codetoks :: [Tok]
codetoks -> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall a b. (a -> b) -> a -> b
$ Text -> b
forall a. IsInline a => Text -> a
code (Text -> b) -> ([Tok] -> Text) -> [Tok] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeCodeSpan (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> b) -> [Tok] -> b
forall a b. (a -> b) -> a -> b
$
                                    [Tok]
codetoks

unChunks :: IsInline a => [Chunk a] -> a
unChunks :: [Chunk a] -> a
unChunks = {-# SCC unChunks #-} (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
forall a. Monoid a => a
mempty ([a] -> a) -> ([Chunk a] -> [a]) -> [Chunk a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk a] -> [a]
forall a. IsInline a => [Chunk a] -> [a]
go
    where
      go :: [Chunk a] -> [a]
go []     = []
      go (c :: Chunk a
c:cs :: [Chunk a]
cs) =
        let (f :: a -> a
f, rest :: [Chunk a]
rest) =
             case [Chunk a]
cs of
               (Chunk (AddAttributes attrs) _pos _ts : ds :: [Chunk a]
ds) ->
                 (Attributes -> a -> a
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs, [Chunk a]
ds)
               _ -> (a -> a
forall a. a -> a
id, [Chunk a]
cs) in
        case Chunk a -> ChunkType a
forall a. Chunk a -> ChunkType a
chunkType Chunk a
c of
          AddAttributes _ -> [Chunk a] -> [a]
go [Chunk a]
rest
          Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
ch, delimSpec :: forall a. ChunkType a -> Maybe (FormattingSpec a)
delimSpec = Maybe (FormattingSpec a)
mbspec } -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Chunk a] -> [a]
go [Chunk a]
rest
              where !x :: a
x = a -> a
f (SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged SourceRange
range (Text -> a
forall a. IsInline a => Text -> a
str Text
txt))
                    txt :: Text
txt = [Tok] -> Text
untokenize ([Tok] -> Text) -> [Tok] -> Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> [Tok]
alterToks ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall a b. (a -> b) -> a -> b
$ Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
c
                    alterToks :: [Tok] -> [Tok]
alterToks =
                      case FormattingSpec a -> Char
forall il. FormattingSpec il -> Char
formattingWhenUnmatched (FormattingSpec a -> Char)
-> Maybe (FormattingSpec a) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FormattingSpec a)
mbspec of
                        Just ch' :: Char
ch' | Char
ch' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
ch ->
                           (Tok -> Tok) -> [Tok] -> [Tok]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: Tok
t -> Tok
t{ tokContents :: Text
tokContents =
                                         (Char -> Char) -> Text -> Text
T.map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
ch') (Tok -> Text
tokContents Tok
t) })
                        _ -> [Tok] -> [Tok]
forall a. a -> a
id
                    range :: SourceRange
range = [(SourcePos, SourcePos)] -> SourceRange
SourceRange
                             [(Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
c,
                               SourcePos -> Int -> SourcePos
incSourceColumn (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
c) (Text -> Int
T.length Text
txt))]
          Parsed ils :: a
ils -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Chunk a] -> [a]
go [Chunk a]
rest
              where !x :: a
x = a -> a
f a
ils

parseChunks :: (Monad m, IsInline a)
            => [BracketedSpec a]
            -> [FormattingSpec a]
            -> [InlineParser m a]
            -> InlineParser m Attributes
            -> ReferenceMap
            -> [Tok]
            -> StateT Enders m (Either ParseError [Chunk a])
parseChunks :: [BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> InlineParser m Attributes
-> ReferenceMap
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
parseChunks bspecs :: [BracketedSpec a]
bspecs specs :: [FormattingSpec a]
specs ilParsers :: [InlineParser m a]
ilParsers attrParser :: InlineParser m Attributes
attrParser rm :: ReferenceMap
rm ts :: [Tok]
ts =
  ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
-> IPState m
-> String
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT
     (do case [Tok]
ts of
           t :: Tok
t:_ -> SourcePos -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (Tok -> SourcePos
tokPos Tok
t)
           []  -> () -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
forall a (m :: * -> *).
(IsInline a, Monad m) =>
FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> InlineParser m (Chunk a)
pChunk FormattingSpecMap a
specmap InlineParser m Attributes
attrParser [InlineParser m a]
ilParsers Char -> Bool
isDelimChar) ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
     $WIPState :: forall (m :: * -> *).
IntMap [SourcePos]
-> ReferenceMap
-> Map SourcePos TokType
-> InlineParser m Attributes
-> IPState m
IPState{ backtickSpans :: IntMap [SourcePos]
backtickSpans = [Tok] -> IntMap [SourcePos]
getBacktickSpans [Tok]
ts,
              ipReferenceMap :: ReferenceMap
ipReferenceMap = ReferenceMap
rm,
              precedingTokTypes :: Map SourcePos TokType
precedingTokTypes = Map SourcePos TokType
precedingTokTypeMap,
              attributeParser :: InlineParser m Attributes
attributeParser = InlineParser m Attributes
attrParser }
     "source" [Tok]
ts
  where
   isDelimChar :: Char -> Bool
isDelimChar = (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
delimcharset)
   !delimcharset :: Set Char
delimcharset = String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList String
delimchars
   delimchars :: String
delimchars = '[' Char -> String -> String
forall a. a -> [a] -> [a]
: ']' Char -> String -> String
forall a. a -> [a] -> [a]
: String
suffixchars String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
prefixchars String -> String -> String
forall a. [a] -> [a] -> [a]
++ FormattingSpecMap a -> String
forall k a. Map k a -> [k]
M.keys FormattingSpecMap a
specmap
   specmap :: FormattingSpecMap a
specmap = [FormattingSpec a] -> FormattingSpecMap a
forall il. [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap [FormattingSpec a]
specs
   prefixchars :: String
prefixchars = (BracketedSpec a -> Maybe Char) -> [BracketedSpec a] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix [BracketedSpec a]
bspecs
   suffixchars :: String
suffixchars = (BracketedSpec a -> Maybe Char) -> [BracketedSpec a] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedSuffixEnd [BracketedSpec a]
bspecs
   precedingTokTypeMap :: Map SourcePos TokType
precedingTokTypeMap = {-# SCC precedingTokTypeMap #-}(Map SourcePos TokType, TokType) -> Map SourcePos TokType
forall a b. (a, b) -> a
fst ((Map SourcePos TokType, TokType) -> Map SourcePos TokType)
-> (Map SourcePos TokType, TokType) -> Map SourcePos TokType
forall a b. (a -> b) -> a -> b
$! ((Map SourcePos TokType, TokType)
 -> Tok -> (Map SourcePos TokType, TokType))
-> (Map SourcePos TokType, TokType)
-> [Tok]
-> (Map SourcePos TokType, TokType)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map SourcePos TokType, TokType)
-> Tok -> (Map SourcePos TokType, TokType)
forall a. (Map SourcePos a, a) -> Tok -> (Map SourcePos a, TokType)
go  (Map SourcePos TokType
forall a. Monoid a => a
mempty, TokType
LineEnd) [Tok]
ts
   go :: (Map SourcePos a, a) -> Tok -> (Map SourcePos a, TokType)
go (!Map SourcePos a
m, !a
prevTy) (Tok !TokType
ty !SourcePos
pos _) =
     case TokType
ty of
       Symbol c :: Char
c | Char -> Bool
isDelimChar Char
c -> (SourcePos -> a -> Map SourcePos a -> Map SourcePos a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SourcePos
pos a
prevTy Map SourcePos a
m, TokType
ty)
       _                        -> (Map SourcePos a
m, TokType
ty)

data Chunk a = Chunk
     { Chunk a -> ChunkType a
chunkType :: ChunkType a
     , Chunk a -> SourcePos
chunkPos  :: !SourcePos
     , Chunk a -> [Tok]
chunkToks :: [Tok]
     } deriving Int -> Chunk a -> String -> String
[Chunk a] -> String -> String
Chunk a -> String
(Int -> Chunk a -> String -> String)
-> (Chunk a -> String)
-> ([Chunk a] -> String -> String)
-> Show (Chunk a)
forall a. Show a => Int -> Chunk a -> String -> String
forall a. Show a => [Chunk a] -> String -> String
forall a. Show a => Chunk a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Chunk a] -> String -> String
$cshowList :: forall a. Show a => [Chunk a] -> String -> String
show :: Chunk a -> String
$cshow :: forall a. Show a => Chunk a -> String
showsPrec :: Int -> Chunk a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Chunk a -> String -> String
Show

data ChunkType a =
       Delim{ ChunkType a -> Char
delimType     :: !Char
            , ChunkType a -> Bool
delimCanOpen  :: !Bool
            , ChunkType a -> Bool
delimCanClose :: !Bool
            , ChunkType a -> Int
delimLength   :: !Int
            , ChunkType a -> Maybe (FormattingSpec a)
delimSpec     :: Maybe (FormattingSpec a)
            }
     | Parsed a
     | AddAttributes Attributes
     deriving Int -> ChunkType a -> String -> String
[ChunkType a] -> String -> String
ChunkType a -> String
(Int -> ChunkType a -> String -> String)
-> (ChunkType a -> String)
-> ([ChunkType a] -> String -> String)
-> Show (ChunkType a)
forall a. Show a => Int -> ChunkType a -> String -> String
forall a. Show a => [ChunkType a] -> String -> String
forall a. Show a => ChunkType a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ChunkType a] -> String -> String
$cshowList :: forall a. Show a => [ChunkType a] -> String -> String
show :: ChunkType a -> String
$cshow :: forall a. Show a => ChunkType a -> String
showsPrec :: Int -> ChunkType a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> ChunkType a -> String -> String
Show

data IPState m = IPState
     { IPState m -> IntMap [SourcePos]
backtickSpans        :: IntMap.IntMap [SourcePos]
                               -- record of lengths of
                               -- backtick spans so we don't scan in vain
     , IPState m -> ReferenceMap
ipReferenceMap       :: !ReferenceMap
     , IPState m -> Map SourcePos TokType
precedingTokTypes    :: M.Map SourcePos TokType
     , IPState m -> InlineParser m Attributes
attributeParser      :: InlineParser m Attributes
     }

type InlineParser m = ParsecT [Tok] (IPState m) (StateT Enders m)

--- Formatting specs:

-- ^ Specifies delimiters for formatting, e.g. strong emphasis.
data FormattingSpec il = FormattingSpec
    { FormattingSpec il -> Char
formattingDelimChar     :: !Char
                              -- ^ Character that triggers formatting
    , FormattingSpec il -> Bool
formattingIntraWord     :: !Bool
                              -- ^ True if formatting can start/end in a word
    , FormattingSpec il -> Bool
formattingIgnorePunctuation :: !Bool
                              -- ^ Treat punctuation like letters for
                              -- purposes of computing can open/can close
    , FormattingSpec il -> Maybe (il -> il)
formattingSingleMatch   :: Maybe (il -> il)
                              -- ^ Constructor to use for text between
                              -- single delimiters.
    , FormattingSpec il -> Maybe (il -> il)
formattingDoubleMatch   :: Maybe (il -> il)
                              -- ^ Constructor to use for text between
                              -- double delimiters.
    , FormattingSpec il -> Char
formattingWhenUnmatched :: !Char -- ^ Fallback when not matched.
    }

instance Show (FormattingSpec il) where
  show :: FormattingSpec il -> String
show _ = "<FormattingSpec>"

type FormattingSpecMap il = M.Map Char (FormattingSpec il)

defaultFormattingSpecs :: IsInline il => [FormattingSpec il]
defaultFormattingSpecs :: [FormattingSpec il]
defaultFormattingSpecs =
  [ Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
forall il.
Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
FormattingSpec '*' Bool
True Bool
False ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
emph) ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
strong) '*'
  , Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
forall il.
Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
FormattingSpec '_' Bool
False Bool
False ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
emph) ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
strong) '_'
  ]

mkFormattingSpecMap :: [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap :: [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap fs :: [FormattingSpec il]
fs = [(Char, FormattingSpec il)] -> FormattingSpecMap il
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FormattingSpec il -> Char
forall il. FormattingSpec il -> Char
formattingDelimChar FormattingSpec il
s, FormattingSpec il
s) | FormattingSpec il
s <- [FormattingSpec il]
fs]

--- Bracketed specs:

-- ^ Defines an inline element between square brackets.
data BracketedSpec il = BracketedSpec
     { BracketedSpec il -> Text
bracketedName      :: !Text  -- ^ Name of bracketed text type.
     , BracketedSpec il -> Bool
bracketedNests     :: !Bool  -- ^ True if this can be nested.
     , BracketedSpec il -> Maybe Char
bracketedPrefix    :: Maybe Char -- ^ Prefix character.
     , BracketedSpec il -> Maybe Char
bracketedSuffixEnd :: Maybe Char -- ^ Suffix character.
     , BracketedSpec il
-> ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix    :: ReferenceMap
                          -> Text
                          -> Parsec [Tok] () (il -> il)
                          -- ^ Parser for suffix after
                          -- brackets.  Returns a constructor.
                          -- Second parameter is the raw key.
     }

instance Show (BracketedSpec il) where
  show :: BracketedSpec il -> String
show s :: BracketedSpec il
s = "<BracketedSpec " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (BracketedSpec il -> Text
forall il. BracketedSpec il -> Text
bracketedName BracketedSpec il
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">"

-- It's important that specs with prefix chars come first:
defaultBracketedSpecs :: IsInline il
                      => [BracketedSpec il]
defaultBracketedSpecs :: [BracketedSpec il]
defaultBracketedSpecs =
  [ BracketedSpec il
forall il. IsInline il => BracketedSpec il
imageSpec
  , BracketedSpec il
forall il. IsInline il => BracketedSpec il
linkSpec
  ]

linkSpec :: IsInline il => BracketedSpec il
linkSpec :: BracketedSpec il
linkSpec = $WBracketedSpec :: forall il.
Text
-> Bool
-> Maybe Char
-> Maybe Char
-> (ReferenceMap -> Text -> Parsec [Tok] () (il -> il))
-> BracketedSpec il
BracketedSpec
           { bracketedName :: Text
bracketedName = "Link"
           , bracketedNests :: Bool
bracketedNests = Bool
False  -- links don't nest inside links
           , bracketedPrefix :: Maybe Char
bracketedPrefix = Maybe Char
forall a. Maybe a
Nothing
           , bracketedSuffixEnd :: Maybe Char
bracketedSuffixEnd = Char -> Maybe Char
forall a. a -> Maybe a
Just ')'
           , bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix = ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
forall il s.
IsInline il =>
ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix
           }

imageSpec :: IsInline il => BracketedSpec il
imageSpec :: BracketedSpec il
imageSpec = $WBracketedSpec :: forall il.
Text
-> Bool
-> Maybe Char
-> Maybe Char
-> (ReferenceMap -> Text -> Parsec [Tok] () (il -> il))
-> BracketedSpec il
BracketedSpec
            { bracketedName :: Text
bracketedName = "Image"
            , bracketedNests :: Bool
bracketedNests = Bool
True
            , bracketedPrefix :: Maybe Char
bracketedPrefix = Char -> Maybe Char
forall a. a -> Maybe a
Just '!'
            , bracketedSuffixEnd :: Maybe Char
bracketedSuffixEnd = Char -> Maybe Char
forall a. a -> Maybe a
Just ')'
            , bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix = ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
forall il s.
IsInline il =>
ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pImageSuffix
            }

pLinkSuffix :: IsInline il
            => ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix :: ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix rm :: ReferenceMap
rm key :: Text
key = do
  LinkInfo target :: Text
target title :: Text
title attrs :: Attributes
attrs <- ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm Text
key
  (il -> il) -> Parsec [Tok] s (il -> il)
forall (m :: * -> *) a. Monad m => a -> m a
return ((il -> il) -> Parsec [Tok] s (il -> il))
-> (il -> il) -> Parsec [Tok] s (il -> il)
forall a b. (a -> b) -> a -> b
$! Attributes -> il -> il
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (il -> il) -> (il -> il) -> il -> il
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> il -> il
forall a. IsInline a => Text -> Text -> a -> a
link Text
target Text
title

pImageSuffix :: IsInline il
             => ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pImageSuffix :: ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pImageSuffix rm :: ReferenceMap
rm key :: Text
key = do
  LinkInfo target :: Text
target title :: Text
title attrs :: Attributes
attrs <- ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm Text
key
  (il -> il) -> Parsec [Tok] s (il -> il)
forall (m :: * -> *) a. Monad m => a -> m a
return ((il -> il) -> Parsec [Tok] s (il -> il))
-> (il -> il) -> Parsec [Tok] s (il -> il)
forall a b. (a -> b) -> a -> b
$! Attributes -> il -> il
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (il -> il) -> (il -> il) -> il -> il
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> il -> il
forall a. IsInline a => Text -> Text -> a -> a
image Text
target Text
title

---

-- Construct a map of n-length backtick spans, with source positions,
-- so we can avoid scanning forward when it will be fruitless.
getBacktickSpans :: [Tok] -> IntMap.IntMap [SourcePos]
getBacktickSpans :: [Tok] -> IntMap [SourcePos]
getBacktickSpans = Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go 0 (String -> SourcePos
initialPos "")
  where
    go :: Int -> SourcePos -> [Tok] -> IntMap.IntMap [SourcePos]
    go :: Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go n :: Int
n pos :: SourcePos
pos []
     | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0     = Int -> [SourcePos] -> IntMap [SourcePos]
forall a. Int -> a -> IntMap a
IntMap.singleton Int
n [SourcePos
pos]
     | Bool
otherwise = IntMap [SourcePos]
forall a. IntMap a
IntMap.empty
    go n :: Int
n pos :: SourcePos
pos (t :: Tok
t:ts :: [Tok]
ts) =
     case Tok -> TokType
tokType Tok
t of
       Symbol '`'
         | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0     -> Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) SourcePos
pos [Tok]
ts
         | Bool
otherwise -> Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Tok -> SourcePos
tokPos Tok
t) [Tok]
ts
       _ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0     -> (Maybe [SourcePos] -> Maybe [SourcePos])
-> Int -> IntMap [SourcePos] -> IntMap [SourcePos]
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter (\case
                                       Nothing -> [SourcePos] -> Maybe [SourcePos]
forall a. a -> Maybe a
Just [SourcePos
pos]
                                       Just ps :: [SourcePos]
ps -> [SourcePos] -> Maybe [SourcePos]
forall a. a -> Maybe a
Just (SourcePos
posSourcePos -> [SourcePos] -> [SourcePos]
forall a. a -> [a] -> [a]
:[SourcePos]
ps))
                                     Int
n (Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go 0 SourcePos
pos [Tok]
ts)
         | Bool
otherwise -> Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go 0 SourcePos
pos [Tok]
ts

pChunk :: (IsInline a, Monad m)
       => FormattingSpecMap a
       -> InlineParser m Attributes
       -> [InlineParser m a]
       -> (Char -> Bool)
       -> InlineParser m (Chunk a)
pChunk :: FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> InlineParser m (Chunk a)
pChunk specmap :: FormattingSpecMap a
specmap attrParser :: InlineParser m Attributes
attrParser ilParsers :: [InlineParser m a]
ilParsers isDelimChar :: Char -> Bool
isDelimChar =
 do SourcePos
pos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    (res :: ChunkType a
res, ts :: [Tok]
ts) <- ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a, [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw (ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
 -> ParsecT
      [Tok] (IPState m) (StateT Enders m) (ChunkType a, [Tok]))
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a, [Tok])
forall a b. (a -> b) -> a -> b
$
         ({-# SCC attrParser #-} Attributes -> ChunkType a
forall a. Attributes -> ChunkType a
AddAttributes (Attributes -> ChunkType a)
-> InlineParser m Attributes
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineParser m Attributes
attrParser)
         ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
         {-# SCC pInline #-} (a -> ChunkType a
forall a. a -> ChunkType a
Parsed (a -> ChunkType a)
-> InlineParser m a
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InlineParser m a] -> InlineParser m a
forall a (m :: * -> *).
(IsInline a, Monad m) =>
[InlineParser m a] -> InlineParser m a
pInline [InlineParser m a]
ilParsers)
    Chunk a -> InlineParser m (Chunk a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> InlineParser m (Chunk a))
-> Chunk a -> InlineParser m (Chunk a)
forall a b. (a -> b) -> a -> b
$! ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk ChunkType a
res SourcePos
pos [Tok]
ts
  InlineParser m (Chunk a)
-> InlineParser m (Chunk a) -> InlineParser m (Chunk a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ({-# SCC pDelimChunk #-} FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
forall a (m :: * -> *).
(IsInline a, Monad m) =>
FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
pDelimChunk FormattingSpecMap a
specmap Char -> Bool
isDelimChar)
  InlineParser m (Chunk a)
-> InlineParser m (Chunk a) -> InlineParser m (Chunk a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do Tok
t <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
          SourcePos
endpos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
          Chunk a -> InlineParser m (Chunk a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> InlineParser m (Chunk a))
-> Chunk a -> InlineParser m (Chunk a)
forall a b. (a -> b) -> a -> b
$! ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk
            (a -> ChunkType a
forall a. a -> ChunkType a
Parsed (a -> ChunkType a) -> a -> ChunkType a
forall a b. (a -> b) -> a -> b
$ SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged ([(SourcePos, SourcePos)] -> SourceRange
SourceRange [(Tok -> SourcePos
tokPos Tok
t,SourcePos
endpos)])
              (Text -> a
forall a. IsInline a => Text -> a
str (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Tok -> Text
tokContents Tok
t))
            (Tok -> SourcePos
tokPos Tok
t) [Tok
t])

pDelimChunk :: (IsInline a, Monad m)
            => FormattingSpecMap a
            -> (Char -> Bool)
            -> InlineParser m (Chunk a)
pDelimChunk :: FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
pDelimChunk specmap :: FormattingSpecMap a
specmap isDelimChar :: Char -> Bool
isDelimChar = do
  tok :: Tok
tok@(Tok (Symbol !Char
c) !SourcePos
pos _) <-
      (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\case
                    Tok (Symbol c :: Char
c) _ _ -> Char -> Bool
isDelimChar Char
c
                    _                  -> Bool
False)
  let !mbspec :: Maybe (FormattingSpec a)
mbspec = Char -> FormattingSpecMap a -> Maybe (FormattingSpec a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
c FormattingSpecMap a
specmap
  [Tok]
more <- if Maybe (FormattingSpec a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (FormattingSpec a)
mbspec
             then ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c
             else [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  let toks :: [Tok]
toks = Tok
tokTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
more
  IPState m
st <- ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  TokType
next <- TokType
-> ParsecT [Tok] (IPState m) (StateT Enders m) TokType
-> ParsecT [Tok] (IPState m) (StateT Enders m) TokType
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option TokType
LineEnd (Tok -> TokType
tokType (Tok -> TokType)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) TokType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok)
  let precedingTokType :: Maybe TokType
precedingTokType = SourcePos -> Map SourcePos TokType -> Maybe TokType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SourcePos
pos (IPState m -> Map SourcePos TokType
forall (m :: * -> *). IPState m -> Map SourcePos TokType
precedingTokTypes IPState m
st)
  let precededByWhitespace :: Bool
precededByWhitespace = case Maybe TokType
precedingTokType of
                               Just Spaces        -> Bool
True
                               Just UnicodeSpace  -> Bool
True
                               Just LineEnd       -> Bool
True
                               _                  -> Bool
False
  let precededByPunctuation :: Bool
precededByPunctuation =
       case FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIgnorePunctuation (FormattingSpec a -> Bool)
-> Maybe (FormattingSpec a) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FormattingSpec a)
mbspec of
         Just True -> Bool
False
         _         -> case Maybe TokType
precedingTokType of
                        Just (Symbol _) -> Bool
True
                        _               -> Bool
False
  let followedByWhitespace :: Bool
followedByWhitespace = TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
Spaces Bool -> Bool -> Bool
||
                             TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
LineEnd Bool -> Bool -> Bool
||
                             TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
UnicodeSpace
  let followedByPunctuation :: Bool
followedByPunctuation =
       case FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIgnorePunctuation (FormattingSpec a -> Bool)
-> Maybe (FormattingSpec a) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FormattingSpec a)
mbspec of
         Just True -> Bool
False
         _         -> Bool -> Bool
not Bool
followedByWhitespace Bool -> Bool -> Bool
&& TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
/= TokType
WordChars
  let leftFlanking :: Bool
leftFlanking = Bool -> Bool
not Bool
followedByWhitespace Bool -> Bool -> Bool
&&
         (Bool -> Bool
not Bool
followedByPunctuation Bool -> Bool -> Bool
||
          Bool
precededByWhitespace Bool -> Bool -> Bool
||
          Bool
precededByPunctuation)
  let rightFlanking :: Bool
rightFlanking = Bool -> Bool
not Bool
precededByWhitespace Bool -> Bool -> Bool
&&
         (Bool -> Bool
not Bool
precededByPunctuation Bool -> Bool -> Bool
||
          Bool
followedByWhitespace Bool -> Bool -> Bool
||
          Bool
followedByPunctuation)
  let !canOpen :: Bool
canOpen =
         Bool
leftFlanking Bool -> Bool -> Bool
&&
          (Bool
-> (FormattingSpec a -> Bool) -> Maybe (FormattingSpec a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIntraWord Maybe (FormattingSpec a)
mbspec Bool -> Bool -> Bool
||
           Bool -> Bool
not Bool
rightFlanking Bool -> Bool -> Bool
||
           Bool
precededByPunctuation)
  let !canClose :: Bool
canClose =
         Bool
rightFlanking Bool -> Bool -> Bool
&&
          (Bool
-> (FormattingSpec a -> Bool) -> Maybe (FormattingSpec a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIntraWord Maybe (FormattingSpec a)
mbspec Bool -> Bool -> Bool
||
           Bool -> Bool
not Bool
leftFlanking Bool -> Bool -> Bool
||
           Bool
followedByPunctuation)

  let !len :: Int
len = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
toks
  Chunk a -> InlineParser m (Chunk a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> InlineParser m (Chunk a))
-> Chunk a -> InlineParser m (Chunk a)
forall a b. (a -> b) -> a -> b
$! ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk $WDelim :: forall a.
Char
-> Bool -> Bool -> Int -> Maybe (FormattingSpec a) -> ChunkType a
Delim{ delimType :: Char
delimType = Char
c
                       , delimCanOpen :: Bool
delimCanOpen = Bool
canOpen
                       , delimCanClose :: Bool
delimCanClose = Bool
canClose
                       , delimSpec :: Maybe (FormattingSpec a)
delimSpec = Maybe (FormattingSpec a)
mbspec
                       , delimLength :: Int
delimLength = Int
len
                       } SourcePos
pos [Tok]
toks

withAttributes :: (IsInline a, Monad m) => InlineParser m a -> InlineParser m a
withAttributes :: InlineParser m a -> InlineParser m a
withAttributes p :: InlineParser m a
p = do
  a
x <- InlineParser m a
p
  InlineParser m Attributes
attrParser <- IPState m -> InlineParser m Attributes
forall (m :: * -> *). IPState m -> InlineParser m Attributes
attributeParser (IPState m -> InlineParser m Attributes)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
-> ParsecT
     [Tok] (IPState m) (StateT Enders m) (InlineParser m Attributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
x (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ (\attr :: Attributes
attr -> Attributes -> a -> a
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attr a
x) (Attributes -> a) -> InlineParser m Attributes -> InlineParser m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineParser m Attributes
attrParser

pInline :: (IsInline a, Monad m)
        => [InlineParser m a]
        -> InlineParser m a
pInline :: [InlineParser m a] -> InlineParser m a
pInline ilParsers :: [InlineParser m a]
ilParsers =
  [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) [a]
-> InlineParser m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineParser m a -> ParsecT [Tok] (IPState m) (StateT Enders m) [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 InlineParser m a
oneInline
    where
     oneInline :: InlineParser m a
oneInline = InlineParser m a -> InlineParser m a
forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
withAttributes (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
       [Tok]
toks <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
       a
res <- [InlineParser m a] -> InlineParser m a
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [InlineParser m a]
ilParsers
       SourcePos
endpos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
       let range :: SourceRange
range = [Tok] -> SourcePos -> SourceRange
rangeFromToks
                 ((Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
endpos) (SourcePos -> Bool) -> (Tok -> SourcePos) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> SourcePos
tokPos) [Tok]
toks) SourcePos
endpos
       a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$! SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged SourceRange
range a
res

rangeFromToks :: [Tok] -> SourcePos -> SourceRange
rangeFromToks :: [Tok] -> SourcePos -> SourceRange
rangeFromToks [] _ = [(SourcePos, SourcePos)] -> SourceRange
SourceRange [(SourcePos, SourcePos)]
forall a. Monoid a => a
mempty
rangeFromToks (!z :: Tok
z:zs :: [Tok]
zs) !SourcePos
endpos
  | SourcePos -> Int
sourceLine (Tok -> SourcePos
tokPos Tok
z) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
sourceLine SourcePos
endpos
    = [(SourcePos, SourcePos)] -> SourceRange
SourceRange [(Tok -> SourcePos
tokPos Tok
z, SourcePos
endpos)]
  | Bool
otherwise
    = [(SourcePos, SourcePos)] -> SourceRange
SourceRange ([(SourcePos, SourcePos)] -> SourceRange)
-> [(SourcePos, SourcePos)] -> SourceRange
forall a b. (a -> b) -> a -> b
$ [Tok] -> [(SourcePos, SourcePos)]
go (Tok
zTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
zs)
       where
        go :: [Tok] -> [(SourcePos, SourcePos)]
go ts :: [Tok]
ts =
          case (Tok -> Bool) -> [Tok] -> ([Tok], [Tok])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (TokType -> Tok -> Bool
hasType TokType
LineEnd) [Tok]
ts of
             ([], [])     -> []
             ([], _:ys :: [Tok]
ys)   -> [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ys
             (!x :: Tok
x:_, [])   -> [(Tok -> SourcePos
tokPos Tok
x, SourcePos
endpos)]
             (!x :: Tok
x:_, !y :: Tok
y:ys :: [Tok]
ys) ->
               case [Tok]
ys of
                 (Tok _ !SourcePos
pos _ : _) | SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> [Tok] -> [(SourcePos, SourcePos)]
go (Tok
xTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
ys)
                 _ -> (Tok -> SourcePos
tokPos Tok
x, Tok -> SourcePos
tokPos Tok
y) (SourcePos, SourcePos)
-> [(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)]
forall a. a -> [a] -> [a]
: [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ys

getReferenceMap :: Monad m => InlineParser m ReferenceMap
getReferenceMap :: InlineParser m ReferenceMap
getReferenceMap = IPState m -> ReferenceMap
forall (m :: * -> *). IPState m -> ReferenceMap
ipReferenceMap (IPState m -> ReferenceMap)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
-> InlineParser m ReferenceMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

pBacktickSpan :: Monad m
              => Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan :: Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan tok :: Tok
tok = do
  [Tok]
ts <- (Tok
tokTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '`')
  let numticks :: Int
numticks = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts
  IPState m
st' <- ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case (SourcePos -> Bool) -> [SourcePos] -> [SourcePos]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
<= Tok -> SourcePos
tokPos Tok
tok) ([SourcePos] -> [SourcePos])
-> Maybe [SourcePos] -> Maybe [SourcePos]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap [SourcePos] -> Maybe [SourcePos]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
numticks (IPState m -> IntMap [SourcePos]
forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans IPState m
st') of
     Just (pos'' :: SourcePos
pos'':ps :: [SourcePos]
ps) -> do
          [Tok]
codetoks <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\tok' :: Tok
tok' -> Tok -> SourcePos
tokPos Tok
tok' SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
pos'')
          [Tok]
backticks <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol '`'))
          Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
backticks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numticks
          (IPState m -> IPState m)
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((IPState m -> IPState m)
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> (IPState m -> IPState m)
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ \st :: IPState m
st ->
            IPState m
st{ backtickSpans :: IntMap [SourcePos]
backtickSpans = Int -> [SourcePos] -> IntMap [SourcePos] -> IntMap [SourcePos]
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
numticks [SourcePos]
ps (IPState m -> IntMap [SourcePos]
forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans IPState m
st) }
          Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok]))
-> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Either [Tok] [Tok]
forall a b. b -> Either a b
Right [Tok]
codetoks
     _ -> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok]))
-> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Either [Tok] [Tok]
forall a b. a -> Either a b
Left [Tok]
ts

normalizeCodeSpan :: Text -> Text
normalizeCodeSpan :: Text -> Text
normalizeCodeSpan = Text -> Text
removeSurroundingSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
nltosp
  where
   nltosp :: Char -> Char
nltosp '\n' = ' '
   nltosp c :: Char
c    = Char
c
   removeSurroundingSpace :: Text -> Text
removeSurroundingSpace s :: Text
s
     | Bool -> Bool
not (Text -> Bool
T.null Text
s)
     , Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') Text
s)
     , Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' '
     , Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' = Int -> Text -> Text
T.drop 1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.dropEnd 1 Text
s
     | Bool
otherwise = Text
s

pUri :: Monad m => InlineParser m (Text, Text)
pUri :: InlineParser m (Text, Text)
pUri = InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m (Text, Text) -> InlineParser m (Text, Text))
-> InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  Text
s <- InlineParser m Text
forall (m :: * -> *). Monad m => InlineParser m Text
pScheme
  Tok
_ <- Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol ':'
  let isURITok :: Tok -> Bool
isURITok t :: Tok
t =
       case Tok -> TokType
tokType Tok
t of
            Spaces     -> Bool
False
            LineEnd    -> Bool
False
            (Symbol c :: Char
c) -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> ' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '<' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '>'
            _          -> Bool
True
  [Tok]
ts <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
isURITok
  let uri :: Text
uri = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
ts
  (Text, Text) -> InlineParser m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
uri, Text
uri)

pScheme :: Monad m => InlineParser m Text
pScheme :: InlineParser m Text
pScheme = do
  Tok
t <- (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\t :: Text
t -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
                               Nothing -> Bool
False
                               Just (c :: Char
c,rest :: Text
rest) -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
&&
                                                (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
rest)
  [Tok]
ts <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ [TokType] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
oneOfToks [TokType
WordChars, Char -> TokType
Symbol '+', Char -> TokType
Symbol '.', Char -> TokType
Symbol '-']
  let s :: Text
s = [Tok] -> Text
untokenize (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
ts)
  let len :: Int
len = Text -> Int
T.length Text
s
  Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 32
  Text -> InlineParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

pEmail :: Monad m => InlineParser m (Text, Text)
pEmail :: InlineParser m (Text, Text)
pEmail = do
  let isEmailSymbolTok :: Tok -> Bool
isEmailSymbolTok (Tok (Symbol c :: Char
c) _ _) =
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '!' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '%' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '&' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '*' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '?' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '^' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '`' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '{' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '|' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '}' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '~' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ']'
      isEmailSymbolTok _ = Bool
False
  [Tok]
name <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii)
               ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
isEmailSymbolTok
  Tok
_ <- Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '@'
  let domainPart :: ParsecT [Tok] s (StateT Enders m) [Tok]
domainPart = do
        Tok
x <- (Text -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii)
        [Tok]
xs <- ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s (StateT Enders m) Tok
 -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '-' ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '.'))
                  ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii)
        [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$! (Tok
xTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
xs)
  [Tok]
d <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s. ParsecT [Tok] s (StateT Enders m) [Tok]
domainPart
  [[Tok]]
ds <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) [[Tok]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '.' ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s. ParsecT [Tok] s (StateT Enders m) [Tok]
domainPart)
  let addr :: Text
addr = [Tok] -> Text
untokenize [Tok]
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate "." (([Tok] -> Text) -> [[Tok]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Tok] -> Text
untokenize ([Tok]
d[Tok] -> [[Tok]] -> [[Tok]]
forall a. a -> [a] -> [a]
:[[Tok]]
ds))
  (Text, Text) -> InlineParser m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ("mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
addr, Text
addr)

data DState a = DState
     { DState a -> Cursor (Chunk a)
leftCursor     :: Cursor (Chunk a)
     , DState a -> Cursor (Chunk a)
rightCursor    :: Cursor (Chunk a)
     , DState a -> ReferenceMap
refmap         :: ReferenceMap
     , DState a -> Map Text SourcePos
stackBottoms   :: M.Map Text SourcePos
     , DState a -> SourcePos
absoluteBottom :: SourcePos
     }


processEmphasis :: IsInline a => [Chunk a] -> [Chunk a]
processEmphasis :: [Chunk a] -> [Chunk a]
processEmphasis xs :: [Chunk a]
xs =
  case (Chunk a -> Bool) -> [Chunk a] -> ([Chunk a], [Chunk a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\case
               (Chunk Delim{ delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
True } _ _) -> Bool
True
               _ -> Bool
False) [Chunk a]
xs of
       (_,[]) -> [Chunk a]
xs
       (ys :: [Chunk a]
ys,z :: Chunk a
z:zs :: [Chunk a]
zs) ->
           let startcursor :: Cursor (Chunk a)
startcursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
z) ([Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse [Chunk a]
ys) [Chunk a]
zs
           in  DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm $WDState :: forall a.
Cursor (Chunk a)
-> Cursor (Chunk a)
-> ReferenceMap
-> Map Text SourcePos
-> SourcePos
-> DState a
DState{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
startcursor
                               , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a)
startcursor
                               , refmap :: ReferenceMap
refmap = ReferenceMap
emptyReferenceMap
                               , stackBottoms :: Map Text SourcePos
stackBottoms = Map Text SourcePos
forall a. Monoid a => a
mempty
                               , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
z }

{- for debugging:
prettyCursors :: (IsInline a) => Cursor (Chunk a) -> Cursor (Chunk a) -> String
prettyCursors left right =
  toS (reverse $ befores left) <> (maybe "" (inBrs . toS . (:[])) (center left)) <>
  if (chunkPos <$> center left) == (chunkPos <$> center right)
     then toS (afters right)
     else toS (middles) <> (maybe "" (inBrs . toS . (:[])) (center right)) <>
          toS (afters right)
 where middles = take (length (afters left) - length (afters right) -
                         maybe 0 (const 1) (center right)) (afters left)
       toS = show . unChunks
       inBrs x = "{" ++ x ++ "}"
-}

processEm :: IsInline a => DState a -> [Chunk a]
processEm :: DState a -> [Chunk a]
processEm st :: DState a
st =
  let left :: Cursor (Chunk a)
left = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
leftCursor DState a
st
      right :: Cursor (Chunk a)
right = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st
      bottoms :: Map Text SourcePos
bottoms = DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
  in  {-# SCC processEm #-} case -- trace (prettyCursors left right)
          (Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
left, Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
right) of
       (_, Nothing) -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse ([Chunk a] -> [Chunk a]) -> [Chunk a] -> [Chunk a]
forall a b. (a -> b) -> a -> b
$
                         case Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st) of
                            Nothing -> Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)
                            Just c :: Chunk a
c  -> Chunk a
c Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
: Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)

       (Nothing, Just (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c
                                  , delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True } pos :: SourcePos
pos ts :: [Tok]
ts)) ->
           DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
           DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor   = Cursor (Chunk a)
right
             , rightCursor :: Cursor (Chunk a)
rightCursor  = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
             , stackBottoms :: Map Text SourcePos
stackBottoms = Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
                   (String -> Text
T.pack (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 3))) SourcePos
pos
                   (Map Text SourcePos -> Map Text SourcePos)
-> Map Text SourcePos -> Map Text SourcePos
forall a b. (a -> b) -> a -> b
$ DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
             }

       (Nothing, Just _) -> DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
           DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
right
             , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
             }

       (Just chunk :: Chunk a
chunk, Just closedelim :: Chunk a
closedelim@(Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c,
                                                  delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True,
                                                  delimSpec :: forall a. ChunkType a -> Maybe (FormattingSpec a)
delimSpec = Just spec :: FormattingSpec a
spec}
                                           closePos :: SourcePos
closePos ts :: [Tok]
ts))
         | Chunk a -> Chunk a -> Bool
forall a. IsInline a => Chunk a -> Chunk a -> Bool
delimsMatch Chunk a
chunk Chunk a
closedelim ->
           let closelen :: Int
closelen = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts
               opendelim :: Chunk a
opendelim = Chunk a
chunk
               contents :: [Chunk a]
contents = (Chunk a -> Bool) -> [Chunk a] -> [Chunk a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\ch :: Chunk a
ch -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
ch SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
/= SourcePos
closePos)
                          (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
left)
               openlen :: Int
openlen = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
opendelim)
               fallbackConstructor :: a -> a
fallbackConstructor x :: a
x = Text -> a
forall a. IsInline a => Text -> a
str (Char -> Text
T.singleton Char
c) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
                                       Text -> a
forall a. IsInline a => Text -> a
str (Char -> Text
T.singleton Char
c)
               (constructor :: a -> a
constructor, numtoks :: Int
numtoks) =
                case (FormattingSpec a -> Maybe (a -> a)
forall il. FormattingSpec il -> Maybe (il -> il)
formattingSingleMatch FormattingSpec a
spec, FormattingSpec a -> Maybe (a -> a)
forall il. FormattingSpec il -> Maybe (il -> il)
formattingDoubleMatch FormattingSpec a
spec) of
                        (_, Just c2 :: a -> a
c2)
                          | Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
openlen Int
closelen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 -> (a -> a
c2, 2)
                        (Just c1 :: a -> a
c1, _)     -> (a -> a
c1, 1)
                        _                -> (a -> a
forall a. IsInline a => a -> a
fallbackConstructor, 1)
               (openrest :: [Tok]
openrest, opentoks :: [Tok]
opentoks) =
                 Int -> [Tok] -> ([Tok], [Tok])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
openlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numtoks) (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
opendelim)
               (closetoks :: [Tok]
closetoks, closerest :: [Tok]
closerest) =
                 Int -> [Tok] -> ([Tok], [Tok])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
numtoks (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
closedelim)
               addnewopen :: [Chunk a] -> [Chunk a]
addnewopen = if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
openrest
                               then [Chunk a] -> [Chunk a]
forall a. a -> a
id
                               else (Chunk a
opendelim{ chunkToks :: [Tok]
chunkToks = [Tok]
openrest } Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)
               addnewclose :: [Chunk a] -> [Chunk a]
addnewclose = if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
closerest
                                then [Chunk a] -> [Chunk a]
forall a. a -> a
id
                                else (Chunk a
closedelim{ chunkToks :: [Tok]
chunkToks = [Tok]
closerest } Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)
               emphtoks :: [Tok]
emphtoks = [Tok]
opentoks [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ (Chunk a -> [Tok]) -> [Chunk a] -> [Tok]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks [Chunk a]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
closetoks
               newelt :: Chunk a
newelt = ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk
                         (a -> ChunkType a
forall a. a -> ChunkType a
Parsed (a -> ChunkType a) -> a -> ChunkType a
forall a b. (a -> b) -> a -> b
$
                           SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged ([Tok] -> SourcePos -> SourceRange
rangeFromToks [Tok]
emphtoks
                                     (SourcePos -> Int -> SourcePos
incSourceColumn (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
closedelim)
                                       Int
numtoks)) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
                             a -> a
constructor (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [Chunk a] -> a
forall a. IsInline a => [Chunk a] -> a
unChunks [Chunk a]
contents)
                         (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk)
                         [Tok]
emphtoks
               newcursor :: Cursor (Chunk a)
newcursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
newelt)
                              ([Chunk a] -> [Chunk a]
addnewopen (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left))
                              ([Chunk a] -> [Chunk a]
addnewclose (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
right))
           in DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
              DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
newcursor
                , leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
newcursor
                }

         | SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk) Maybe SourcePos -> Maybe SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
<=
             Text -> Map Text SourcePos -> Maybe SourcePos
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> Text
T.pack (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 3))) Map Text SourcePos
bottoms ->
                  DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
                  DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor   = Cursor (Chunk a)
right
                    , rightCursor :: Cursor (Chunk a)
rightCursor  = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                    , stackBottoms :: Map Text SourcePos
stackBottoms =  Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
                        (String -> Text
T.pack (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 3)))
                        (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
closedelim)
                        (Map Text SourcePos -> Map Text SourcePos)
-> Map Text SourcePos -> Map Text SourcePos
forall a b. (a -> b) -> a -> b
$ DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
                    }

         | Bool
otherwise -> DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left }

       _ -> DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
            DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
              , leftCursor :: Cursor (Chunk a)
leftCursor  = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
left }

-- This only applies to emph delims, not []:
delimsMatch :: IsInline a
            => Chunk a -> Chunk a -> Bool
delimsMatch :: Chunk a -> Chunk a -> Bool
delimsMatch (Chunk open :: ChunkType a
open@Delim{} _ opents :: [Tok]
opents) (Chunk close :: ChunkType a
close@Delim{} _ closets :: [Tok]
closets) =
  ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
open Bool -> Bool -> Bool
&& ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanClose ChunkType a
close Bool -> Bool -> Bool
&&
      (ChunkType a -> Char
forall a. ChunkType a -> Char
delimType ChunkType a
open Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkType a -> Char
forall a. ChunkType a -> Char
delimType ChunkType a
close Bool -> Bool -> Bool
&&
           if (ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
open Bool -> Bool -> Bool
&& ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanClose ChunkType a
open) Bool -> Bool -> Bool
||
                (ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
close Bool -> Bool -> Bool
&& ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanClose ChunkType a
close)
                then ChunkType a -> Int
forall a. ChunkType a -> Int
delimLength ChunkType a
close Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
||
                     (ChunkType a -> Int
forall a. ChunkType a -> Int
delimLength ChunkType a
open Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ChunkType a -> Int
forall a. ChunkType a -> Int
delimLength ChunkType a
close) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
                else Bool
True) Bool -> Bool -> Bool
&&
    [Tok]
opents [Tok] -> [Tok] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Tok]
closets
delimsMatch _ _ = Bool
False

processBrackets :: IsInline a
                => [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets :: [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets bracketedSpecs :: [BracketedSpec a]
bracketedSpecs rm :: ReferenceMap
rm xs :: [Chunk a]
xs =
  case (Chunk a -> Bool) -> [Chunk a] -> ([Chunk a], [Chunk a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\case
               (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } _ _) -> Bool
True
               _ -> Bool
False) [Chunk a]
xs of
       (_,[]) -> [Chunk a]
xs
       (ys :: [Chunk a]
ys,z :: Chunk a
z:zs :: [Chunk a]
zs) ->
          let  startcursor :: Cursor (Chunk a)
startcursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
z) ([Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse [Chunk a]
ys) [Chunk a]
zs
          in   [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                 $WDState :: forall a.
Cursor (Chunk a)
-> Cursor (Chunk a)
-> ReferenceMap
-> Map Text SourcePos
-> SourcePos
-> DState a
DState{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
startcursor
                       , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a)
startcursor
                       , refmap :: ReferenceMap
refmap = ReferenceMap
rm
                       , stackBottoms :: Map Text SourcePos
stackBottoms = Map Text SourcePos
forall a. Monoid a => a
mempty
                       , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
z
                       }

data Cursor a = Cursor
     { Cursor a -> Maybe a
center  :: Maybe a
     , Cursor a -> [a]
befores :: [a]
     , Cursor a -> [a]
afters  :: [a]
     }
     deriving Int -> Cursor a -> String -> String
[Cursor a] -> String -> String
Cursor a -> String
(Int -> Cursor a -> String -> String)
-> (Cursor a -> String)
-> ([Cursor a] -> String -> String)
-> Show (Cursor a)
forall a. Show a => Int -> Cursor a -> String -> String
forall a. Show a => [Cursor a] -> String -> String
forall a. Show a => Cursor a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cursor a] -> String -> String
$cshowList :: forall a. Show a => [Cursor a] -> String -> String
show :: Cursor a -> String
$cshow :: forall a. Show a => Cursor a -> String
showsPrec :: Int -> Cursor a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Cursor a -> String -> String
Show

moveLeft :: Cursor a -> Cursor a
moveLeft :: Cursor a -> Cursor a
moveLeft (Cursor Nothing  []     zs :: [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing  [] [a]
zs
moveLeft (Cursor Nothing  (x :: a
x:xs :: [a]
xs) zs :: [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [a]
xs [a]
zs
moveLeft (Cursor (Just x :: a
x) []     zs :: [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing  [] (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs)
moveLeft (Cursor (Just x :: a
x) (y :: a
y:ys :: [a]
ys) zs :: [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
y) [a]
ys (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs)
{-# INLINE moveLeft #-}

moveRight :: Cursor a -> Cursor a
moveRight :: Cursor a -> Cursor a
moveRight (Cursor Nothing zs :: [a]
zs  [])     = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing  [a]
zs     []
moveRight (Cursor Nothing zs :: [a]
zs  (x :: a
x:xs :: [a]
xs)) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [a]
zs     [a]
xs
moveRight (Cursor (Just x :: a
x) zs :: [a]
zs [])     = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing  (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) []
moveRight (Cursor (Just x :: a
x) zs :: [a]
zs (y :: a
y:ys :: [a]
ys)) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
y) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) [a]
ys
{-# INLINE moveRight #-}

processBs :: IsInline a
          => [BracketedSpec a] -> DState a -> [Chunk a]
processBs :: [BracketedSpec a] -> DState a -> [Chunk a]
processBs bracketedSpecs :: [BracketedSpec a]
bracketedSpecs st :: DState a
st =
  let left :: Cursor (Chunk a)
left = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
leftCursor DState a
st
      right :: Cursor (Chunk a)
right = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st
      bottoms :: Map Text SourcePos
bottoms = DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
      bottom :: SourcePos
bottom = DState a -> SourcePos
forall a. DState a -> SourcePos
absoluteBottom DState a
st
  -- trace (prettyCursors left right) $ return $! ()
  in  {-# SCC processBs #-} case (Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
left, Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
right) of
       (_, Nothing) -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse ([Chunk a] -> [Chunk a]) -> [Chunk a] -> [Chunk a]
forall a b. (a -> b) -> a -> b
$
                         case Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st) of
                            Nothing -> Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)
                            Just c :: Chunk a
c  -> Chunk a
c Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
: Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)

       (Nothing, Just chunk :: Chunk a
chunk) ->
          [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                       DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                         , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                         , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk
                         }

       (Just chunk :: Chunk a
chunk, Just chunk' :: Chunk a
chunk')
         | Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
bottom ->
            [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                       DState a
st { leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                          , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                          , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk'
                          }

       (Just opener :: Chunk a
opener@(Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } _ _),
        Just closer :: Chunk a
closer@(Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
']'} closePos :: SourcePos
closePos _)) ->
          let chunksinside :: [Chunk a]
chunksinside = (Chunk a -> Bool) -> [Chunk a] -> [Chunk a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\ch :: Chunk a
ch -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
ch SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
/= SourcePos
closePos)
                               (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
left)
              isBracket :: Chunk a -> Bool
isBracket (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c' } _ _) =
                 Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '[' Bool -> Bool -> Bool
|| Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ']'
              isBracket _ = Bool
False
              key :: Text
key = if (Chunk a -> Bool) -> [Chunk a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Chunk a -> Bool
forall a. Chunk a -> Bool
isBracket [Chunk a]
chunksinside
                       then ""
                       else
                         case [Tok] -> Text
untokenize ((Chunk a -> [Tok]) -> [Chunk a] -> [Tok]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks [Chunk a]
chunksinside) of
                              ks :: Text
ks | Text -> Int
T.length Text
ks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 999 -> Text
ks
                              _  -> ""
              prefixChar :: Maybe Char
prefixChar = case Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left of
                                 Chunk Delim{delimType :: forall a. ChunkType a -> Char
delimType = Char
c} _ [_] : _
                                    -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
                                 _  -> Maybe Char
forall a. Maybe a
Nothing
              rm :: ReferenceMap
rm = DState a -> ReferenceMap
forall a. DState a -> ReferenceMap
refmap DState a
st

              specs :: [BracketedSpec a]
specs = [BracketedSpec a
s | BracketedSpec a
s <- [BracketedSpec a]
bracketedSpecs
                         , case BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix BracketedSpec a
s of
                                Just c :: Char
c  -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Char
prefixChar
                                Nothing -> Bool
True
                         , Bool -> (SourcePos -> Bool) -> Maybe SourcePos -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True  (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
opener)
                            (Text -> Map Text SourcePos -> Maybe SourcePos
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (BracketedSpec a -> Text
forall il. BracketedSpec il -> Text
bracketedName BracketedSpec a
s) Map Text SourcePos
bottoms) ]

              suffixToks :: [Tok]
suffixToks = [[Tok]] -> [Tok]
forall a. Monoid a => [a] -> a
mconcat ((Chunk a -> [Tok]) -> [Chunk a] -> [[Tok]]
forall a b. (a -> b) -> [a] -> [b]
map Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
right))

              suffixPos :: SourcePos
suffixPos = SourcePos -> Int -> SourcePos
incSourceColumn SourcePos
closePos 1

          in case Parsec [Tok] () ((BracketedSpec a, a -> a, SourcePos), [Tok])
-> String
-> [Tok]
-> Either ParseError ((BracketedSpec a, a -> a, SourcePos), [Tok])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse
                 (ParsecT [Tok] () Identity (BracketedSpec a, a -> a, SourcePos)
-> Parsec [Tok] () ((BracketedSpec a, a -> a, SourcePos), [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw
                   (do SourcePos -> ParsecT [Tok] () Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
suffixPos
                       (spec :: BracketedSpec a
spec, constructor :: a -> a
constructor) <- [ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
 -> ParsecT [Tok] () Identity (BracketedSpec a, a -> a))
-> [ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a)
forall a b. (a -> b) -> a -> b
$
                           (BracketedSpec a
 -> ParsecT [Tok] () Identity (BracketedSpec a, a -> a))
-> [BracketedSpec a]
-> [ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: BracketedSpec a
s -> (BracketedSpec a
s,) ((a -> a) -> (BracketedSpec a, a -> a))
-> ParsecT [Tok] () Identity (a -> a)
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BracketedSpec a
-> ReferenceMap -> Text -> ParsecT [Tok] () Identity (a -> a)
forall il.
BracketedSpec il
-> ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix BracketedSpec a
s ReferenceMap
rm Text
key)
                           [BracketedSpec a]
specs
                       SourcePos
pos <- ParsecT [Tok] () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                       (BracketedSpec a, a -> a, SourcePos)
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a, SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (BracketedSpec a
spec, a -> a
constructor, SourcePos
pos)))
                 "" [Tok]
suffixToks of
                   Left _ -> -- match but no link/image
                         [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                            DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
leftCursor DState a
st)
                              , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote (Cursor (Chunk a) -> Cursor (Chunk a))
-> Cursor (Chunk a) -> Cursor (Chunk a)
forall a b. (a -> b) -> a -> b
$
                                    Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st) }
                   Right ((spec :: BracketedSpec a
spec, constructor :: a -> a
constructor, newpos :: SourcePos
newpos), desttoks :: [Tok]
desttoks) ->
                     let left' :: Cursor (Chunk a)
left' = case BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix BracketedSpec a
spec of
                                      Just _  -> Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left
                                      Nothing -> Cursor (Chunk a)
left
                         openers :: [Chunk a]
openers = case BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix BracketedSpec a
spec of
                                        Just _ -> ([Chunk a] -> [Chunk a])
-> (Chunk a -> [Chunk a] -> [Chunk a])
-> Maybe (Chunk a)
-> [Chunk a]
-> [Chunk a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chunk a] -> [Chunk a]
forall a. a -> a
id (:) (Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
left')
                                                   [Chunk a
opener]
                                        Nothing -> [Chunk a
opener]
                         openerPos :: SourcePos
openerPos = case [Chunk a]
openers of
                                          (x :: Chunk a
x:_) -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
x
                                          _     -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
opener
                         elttoks :: [Tok]
elttoks = (Chunk a -> [Tok]) -> [Chunk a] -> [Tok]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks
                                     ([Chunk a]
openers [Chunk a] -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a] -> [a]
++ [Chunk a]
chunksinside [Chunk a] -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a] -> [a]
++ [Chunk a
closer])
                                      [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
desttoks
                         elt :: a
elt = SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged ([Tok] -> SourcePos -> SourceRange
rangeFromToks [Tok]
elttoks SourcePos
newpos)
                                  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
constructor (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [Chunk a] -> a
forall a. IsInline a => [Chunk a] -> a
unChunks ([Chunk a] -> a) -> [Chunk a] -> a
forall a b. (a -> b) -> a -> b
$
                                       [Chunk a] -> [Chunk a]
forall a. IsInline a => [Chunk a] -> [Chunk a]
processEmphasis [Chunk a]
chunksinside
                         eltchunk :: Chunk a
eltchunk = ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk (a -> ChunkType a
forall a. a -> ChunkType a
Parsed a
elt) SourcePos
openerPos [Tok]
elttoks
                         afterchunks :: [Chunk a]
afterchunks = (Chunk a -> Bool) -> [Chunk a] -> [Chunk a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
newpos) (SourcePos -> Bool) -> (Chunk a -> SourcePos) -> Chunk a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos)
                                         (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
right)
                         firstAfterTokPos :: Maybe SourcePos
firstAfterTokPos = Tok -> SourcePos
tokPos (Tok -> SourcePos) -> Maybe Tok -> Maybe SourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tok] -> Maybe Tok
forall a. [a] -> Maybe a
listToMaybe
                                        ((Chunk a -> [Tok]) -> [Chunk a] -> [Tok]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks [Chunk a]
afterchunks)
                         -- in the event that newpos is not at the
                         -- beginning of a chunk, we need to add
                         -- some tokens from that chunk...
                         missingtoks :: [Tok]
missingtoks =
                           [Tok
t | Tok
t <- [Tok]
suffixToks
                              , Tok -> SourcePos
tokPos Tok
t SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
>= SourcePos
newpos
                              , Bool -> (SourcePos -> Bool) -> Maybe SourcePos -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Tok -> SourcePos
tokPos Tok
t SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
<) Maybe SourcePos
firstAfterTokPos]
                         addMissing :: [Chunk a] -> [Chunk a]
addMissing =
                           if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
missingtoks
                              then [Chunk a] -> [Chunk a]
forall a. a -> a
id
                              else (ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk (a -> ChunkType a
forall a. a -> ChunkType a
Parsed (SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged
                                       ([Tok] -> SourcePos -> SourceRange
rangeFromToks [Tok]
missingtoks SourcePos
newpos)
                                       (Text -> a
forall a. IsInline a => Text -> a
str ([Tok] -> Text
untokenize [Tok]
missingtoks))))
                                    SourcePos
newpos [Tok]
missingtoks Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)

                     in case [Chunk a] -> [Chunk a]
addMissing [Chunk a]
afterchunks of
                           []     -> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                                      DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe (Chunk a)
forall a. Maybe a
Nothing
                                          (Chunk a
eltchunk Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
: Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left') [] }
                           (y :: Chunk a
y:ys :: [Chunk a]
ys) ->
                             let lbs :: [Chunk a]
lbs = Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left'
                             in [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs DState a
st{
                                  leftCursor :: Cursor (Chunk a)
leftCursor =
                                    Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
eltchunk) [Chunk a]
lbs (Chunk a
yChunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:[Chunk a]
ys)
                                , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote (Cursor (Chunk a) -> Cursor (Chunk a))
-> Cursor (Chunk a) -> Cursor (Chunk a)
forall a b. (a -> b) -> a -> b
$
                                    Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
y) (Chunk a
eltchunkChunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:[Chunk a]
lbs) [Chunk a]
ys
                                , stackBottoms :: Map Text SourcePos
stackBottoms =
                                    -- if a link, we need to ensure that
                                    -- nothing matches as link containing it
                                    if BracketedSpec a -> Bool
forall il. BracketedSpec il -> Bool
bracketedNests BracketedSpec a
spec
                                       then DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
                                       else Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (BracketedSpec a -> Text
forall il. BracketedSpec il -> Text
bracketedName BracketedSpec a
spec)
                                            (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
opener)
                                            (Map Text SourcePos -> Map Text SourcePos)
-> Map Text SourcePos -> Map Text SourcePos
forall a b. (a -> b) -> a -> b
$ DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
                                }


       (_, Just (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
']' } _ _))
          -> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left }

       (Just _, Just (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } _ _))
          -> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
right
                  , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right }

       (_, _) -> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right }


-- This just changes a single quote Delim that occurs
-- after ) or ] so that canOpen = False.  This is an ad hoc
-- way to prevent "[a]'s dog'" from being parsed wrong.
-- Ideally there'd be a way to put this restriction in
-- the FormattingSpec for smart ', but currently there
-- isn't.
fixSingleQuote :: Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote :: Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote
  (Cursor (Just (Chunk d :: ChunkType a
d@(Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'\'' }) pos :: SourcePos
pos toks :: [Tok]
toks)) xs :: [Chunk a]
xs ys :: [Chunk a]
ys) =
  Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just (ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk ChunkType a
d{ delimCanOpen :: Bool
delimCanOpen = Bool
False } SourcePos
pos [Tok]
toks)) [Chunk a]
xs [Chunk a]
ys
fixSingleQuote cursor :: Cursor (Chunk a)
cursor = Cursor (Chunk a)
cursor

pLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink rm :: ReferenceMap
rm key :: Text
key = do
  Parsec [Tok] s LinkInfo
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m LinkInfo
pInlineLink Parsec [Tok] s LinkInfo
-> Parsec [Tok] s LinkInfo -> Parsec [Tok] s LinkInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink ReferenceMap
rm Text
key

pInlineLink :: Monad m => ParsecT [Tok] s m LinkInfo
pInlineLink :: ParsecT [Tok] s m LinkInfo
pInlineLink = ParsecT [Tok] s m LinkInfo -> ParsecT [Tok] s m LinkInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m LinkInfo -> ParsecT [Tok] s m LinkInfo)
-> ParsecT [Tok] s m LinkInfo -> ParsecT [Tok] s m LinkInfo
forall a b. (a -> b) -> a -> b
$ do
  Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '('
  ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Text
target <- [Tok] -> Text
unEntity ([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination
  ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Text
title <- Text -> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text)
-> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall a b. (a -> b) -> a -> b
$
             [Tok] -> Text
unEntity ([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkTitle ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m () -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
  Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol ')'
  LinkInfo -> ParsecT [Tok] s m LinkInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkInfo -> ParsecT [Tok] s m LinkInfo)
-> LinkInfo -> ParsecT [Tok] s m LinkInfo
forall a b. (a -> b) -> a -> b
$! $WLinkInfo :: Text -> Text -> Attributes -> LinkInfo
LinkInfo { linkDestination :: Text
linkDestination = Text
target
                    , linkTitle :: Text
linkTitle = Text
title
                    , linkAttributes :: Attributes
linkAttributes = Attributes
forall a. Monoid a => a
mempty }

pLinkDestination :: Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination :: ParsecT [Tok] s m [Tok]
pLinkDestination = ParsecT [Tok] s m [Tok]
forall s. ParsecT [Tok] s m [Tok]
pAngleDest ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m [Tok]
pNormalDest 0
  where
    pAngleDest :: ParsecT [Tok] s m [Tok]
pAngleDest = do
      Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '<'
      [Tok]
res <- ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [Char -> TokType
Symbol '<', Char -> TokType
Symbol '>', Char -> TokType
Symbol '\\',
                                TokType
LineEnd] ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped)
      Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '>'
      [Tok] -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res

    pNormalDest :: Int -> ParsecT [Tok] u m [Tok]
pNormalDest (Int
numparens :: Int) = do
      [Tok]
res <- Int -> ParsecT [Tok] u m [Tok]
forall (m :: * -> *) a u.
(Monad m, Num a, Ord a) =>
a -> ParsecT [Tok] u m [Tok]
pNormalDest' Int
numparens
      if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
res
         then [Tok]
res [Tok] -> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol ')')
         else [Tok] -> ParsecT [Tok] u m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res

    pNormalDest' :: a -> ParsecT [Tok] u m [Tok]
pNormalDest' numparens :: a
numparens
     | a
numparens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 32 = ParsecT [Tok] u m [Tok]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     | Bool
otherwise = (do
          Tok
t <- (Tok -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\case
                           Tok (Symbol '\\') _ _ -> Bool
True
                           Tok (Symbol ')') _ _  -> a
numparens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 1
                           Tok Spaces _ _        -> Bool
False
                           Tok LineEnd _ _       -> Bool
False
                           _                     -> Bool
True)
          case Tok
t of
            Tok (Symbol '\\') _ _ -> do
              Tok
t' <- Tok -> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Tok
t (ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok)
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
asciiSymbol
              (Tok
t'Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens
            Tok (Symbol '(') _ _ -> (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' (a
numparens a -> a -> a
forall a. Num a => a -> a -> a
+ 1)
            Tok (Symbol ')') _ _ -> (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' (a
numparens a -> a -> a
forall a. Num a => a -> a -> a
- 1)
            _                    -> (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens)
          ParsecT [Tok] u m [Tok]
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([] [Tok] -> ParsecT [Tok] u m () -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> ParsecT [Tok] u m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
numparens a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0))

-- parses backslash + escapable character, or just backslash
pEscaped :: Monad m => ParsecT [Tok] s m Tok
pEscaped :: ParsecT [Tok] s m Tok
pEscaped = do
  Tok
bs <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '\\'
  Tok -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Tok
bs (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok)
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
asciiSymbol ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd

asciiSymbol :: Tok -> Bool
asciiSymbol :: Tok -> Bool
asciiSymbol (Tok (Symbol c :: Char
c) _ _) = Char -> Bool
isAscii Char
c
asciiSymbol _                    = Bool
False

pLinkTitle :: Monad m => ParsecT [Tok] s m [Tok]
pLinkTitle :: ParsecT [Tok] s m [Tok]
pLinkTitle = Char -> Char -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s.
Monad m =>
Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween '"' '"' ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s.
Monad m =>
Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween '\'' '\'' ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s.
Monad m =>
Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween '(' ')'

inbetween :: Monad m => Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween :: Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween op :: Char
op cl :: Char
cl =
  ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
op) (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
cl)
     (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [Char -> TokType
Symbol Char
op, Char -> TokType
Symbol Char
cl]))

pLinkLabel :: Monad m => ParsecT [Tok] s m Text
pLinkLabel :: ParsecT [Tok] s m Text
pLinkLabel = ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text)
-> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall a b. (a -> b) -> a -> b
$ do
  Text
lab <- [Tok] -> Text
untokenize
      ([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '[') (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol ']')
            (([Tok], [Tok]) -> [Tok]
forall a b. (a, b) -> b
snd (([Tok], [Tok]) -> [Tok])
-> ParsecT [Tok] s m ([Tok], [Tok]) -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ([Tok], [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
              (ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [Char -> TokType
Symbol ']', Char -> TokType
Symbol '[']))))
  Bool -> ParsecT [Tok] s m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s m ()) -> Bool -> ParsecT [Tok] s m ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
lab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 999
  Text -> ParsecT [Tok] s m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab

pReferenceLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink rm :: ReferenceMap
rm key :: Text
key = do
  Text
lab <- Text
-> ParsecT [Tok] s Identity Text -> ParsecT [Tok] s Identity Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
key ParsecT [Tok] s Identity Text
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Text
pLinkLabel
  let key' :: Text
key' = if Text -> Bool
T.null Text
lab
                then Text
key
                else Text
lab
  Parsec [Tok] s LinkInfo
-> (LinkInfo -> Parsec [Tok] s LinkInfo)
-> Maybe LinkInfo
-> Parsec [Tok] s LinkInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parsec [Tok] s LinkInfo
forall (m :: * -> *) a. MonadPlus m => m a
mzero LinkInfo -> Parsec [Tok] s LinkInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LinkInfo -> Parsec [Tok] s LinkInfo)
-> Maybe LinkInfo -> Parsec [Tok] s LinkInfo
forall a b. (a -> b) -> a -> b
$! Text -> ReferenceMap -> Maybe LinkInfo
forall a. Typeable a => Text -> ReferenceMap -> Maybe a
lookupReference Text
key' ReferenceMap
rm