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

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

import           Commonmark.Tag             (htmlTag, Enders, defaultEnders)
import           Commonmark.Tokens
import Commonmark.TokParsers
    ( lineEnd,
      noneOfToks,
      whitespace,
      oneOfToks,
      satisfyWord,
      withRaw,
      symbol,
      satisfyTok,
      anyTok,
      hasType )
import           Commonmark.ReferenceMap
import           Commonmark.Types
import           Control.Monad              (guard, mzero, mplus)
import           Control.Monad.Trans.State.Strict
import           Data.List                  (foldl')
import           Unicode.Char               (isAscii, isAlpha)
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
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import           Commonmark.Entity          (unEntity, charEntity, numEntity,
                                             pEntity)
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 :: forall (m :: * -> *) a.
(Monad m, IsInline a) =>
[BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> [InlineParser m Attributes]
-> ReferenceMap
-> [Tok]
-> m (Either ParseError a)
mkInlineParser [BracketedSpec a]
bracketedSpecs [FormattingSpec a]
formattingSpecs [InlineParser m a]
ilParsers [InlineParser m Attributes]
attrParsers ReferenceMap
rm [Tok]
toks = do
  let iswhite :: Tok -> Bool
iswhite 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 a. a -> m 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 ParseError
err     -> ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
err
       Right [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 :: forall (m :: * -> *) a. (Monad m, IsInline a) => InlineParser m a
defaultInlineParser =
  {-# SCC defaultInlineParser #-} ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) a
 -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$ do
    tok :: Tok
tok@(Tok TokType
toktype SourcePos
_ 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
        TokType
WordChars    -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
        TokType
LineEnd      -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. IsInline a => a
softBreak
        TokType
Spaces       -> Line -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall {a} {m :: * -> *} {a} {s}.
(Monad m, IsInline a, Num a, Ord a) =>
a -> ParsecT [Tok] s m a
doBreak (Text -> Line
T.length Text
t) ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> a
forall a. IsInline a => Text -> a
str Text
t)
        TokType
UnicodeSpace -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
        Symbol Char
'\\'  -> a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders 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 Text
"\\") ParsecT [Tok] (IPState m) (StateT Enders m) a
forall {s}. ParsecT [Tok] s (StateT Enders m) a
doEscape
        Symbol Char
'`'   -> Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall {m :: * -> *} {b}.
(Monad m, IsInline b) =>
Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) b
doCodeSpan Tok
tok
        Symbol Char
'&'   -> a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders 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 Text
"&") ParsecT [Tok] (IPState m) (StateT Enders m) a
forall {s}. ParsecT [Tok] s (StateT Enders m) a
doEntity
        Symbol Char
'<'   -> a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders 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 Text
"<") (ParsecT [Tok] (IPState m) (StateT Enders m) a
doAutolink ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall {b} {m :: * -> *} {u}.
(IsInline b, Monad m) =>
Tok -> ParsecT [Tok] u (StateT Enders m) b
doHtml Tok
tok)
        TokType
_            -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    where
     doBreak :: a -> ParsecT [Tok] s m a
doBreak a
len
       | a
len a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
2  = a
forall a. IsInline a => a
lineBreak a -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m a
forall a b. a -> ParsecT [Tok] s m b -> 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 a b. a -> ParsecT [Tok] s m b -> 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 Char
c) SourcePos
_ Text
_ -> Char -> Bool
isAscii Char
c
                      Tok TokType
LineEnd SourcePos
_ Text
_    -> Bool
True
                      Tok
_                  -> Bool
False)
       case Tok
tok of
           Tok (Symbol Char
c) SourcePos
_ Text
_ -> a -> ParsecT [Tok] s (StateT Enders m) a
forall a. 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 TokType
LineEnd    SourcePos
_ Text
_ -> a -> ParsecT [Tok] s (StateT Enders m) a
forall a. a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. IsInline a => a
lineBreak
           Tok
_                  -> String -> ParsecT [Tok] s (StateT Enders m) a
forall a. String -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 a. 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 -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
ent))
     doAutolink :: ParsecT [Tok] (IPState m) (StateT Enders m) a
doAutolink = ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) a
 -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$ do
       (Text
target, 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 Char
'>'
       a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> a -> ParsecT [Tok] (IPState m) (StateT Enders 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
"" (Text -> a
forall a. IsInline a => Text -> a
str Text
lab)
     doHtml :: Tok -> ParsecT [Tok] u (StateT Enders m) b
doHtml Tok
tok = Format -> Text -> b
forall a. IsInline a => Format -> Text -> a
rawInline (Text -> Format
Format Text
"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 -> 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 a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> (a -> 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 [Tok]
ticks     -> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
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 [Tok]
codetoks -> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
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 :: forall a. IsInline a => [Chunk a] -> a
unChunks = {-# SCC unChunks #-} (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
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 (Chunk a
c:[Chunk a]
cs) =
        let (a -> a
f, [Chunk a]
rest) =
             case [Chunk a]
cs of
               (Chunk (AddAttributes Attributes
attrs) SourcePos
_pos [Tok]
_ts : [Chunk a]
ds) ->
                 (Attributes -> a -> a
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs, [Chunk a]
ds)
               [Chunk a]
_ -> (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 Attributes
_ -> [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 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 (\Tok
t -> Tok
t{ tokContents =
                                         T.map (const ch') (tokContents t) })
                        Maybe Char
_ -> [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 -> Line -> SourcePos
incSourceColumn (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
c) (Text -> Line
T.length Text
txt))]
          Parsed 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 :: 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]
bspecs [FormattingSpec a]
specs [InlineParser m a]
ilParsers InlineParser m Attributes
attrParser ReferenceMap
rm [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
           Tok
t:[Tok]
_ -> 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 a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
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 a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) 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)
     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 }
     String
"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
'[' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
']' 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 b a. (b -> a -> b) -> b -> [a] -> b
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 Text
_) =
     case TokType
ty of
       Symbol 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)
       TokType
_                        -> (Map SourcePos a
m, TokType
ty)

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

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

data IPState m = IPState
     { forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans        :: IntMap.IntMap [SourcePos]
                               -- record of lengths of
                               -- backtick spans so we don't scan in vain
     , forall (m :: * -> *). IPState m -> ReferenceMap
ipReferenceMap       :: !ReferenceMap
     , forall (m :: * -> *). IPState m -> Map SourcePos TokType
precedingTokTypes    :: M.Map SourcePos TokType
     , forall (m :: * -> *). 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
    { forall il. FormattingSpec il -> Char
formattingDelimChar     :: !Char
                              -- ^ Character that triggers formatting
    , forall il. FormattingSpec il -> Bool
formattingIntraWord     :: !Bool
                              -- ^ True if formatting can start/end in a word
    , forall il. FormattingSpec il -> Bool
formattingIgnorePunctuation :: !Bool
                              -- ^ Treat punctuation like letters for
                              -- purposes of computing can open/can close
    , forall il. FormattingSpec il -> Maybe (il -> il)
formattingSingleMatch   :: Maybe (il -> il)
                              -- ^ Constructor to use for text between
                              -- single delimiters.
    , forall il. FormattingSpec il -> Maybe (il -> il)
formattingDoubleMatch   :: Maybe (il -> il)
                              -- ^ Constructor to use for text between
                              -- double delimiters.
    , forall il. FormattingSpec il -> Char
formattingWhenUnmatched :: !Char -- ^ Fallback when not matched.
    }

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

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

defaultFormattingSpecs :: IsInline il => [FormattingSpec il]
defaultFormattingSpecs :: forall il. IsInline il => [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 Char
'*' 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
'*'
  , 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 Char
'_' 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) Char
'_'
  ]

mkFormattingSpecMap :: [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap :: forall il. [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap [FormattingSpec il]
fs =
   (FormattingSpec il -> FormattingSpecMap il -> FormattingSpecMap il)
-> FormattingSpecMap il
-> [FormattingSpec il]
-> FormattingSpecMap il
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FormattingSpec il -> FormattingSpecMap il -> FormattingSpecMap il
forall {il}.
FormattingSpec il
-> Map Char (FormattingSpec il) -> Map Char (FormattingSpec il)
go FormattingSpecMap il
forall a. Monoid a => a
mempty [FormattingSpec il]
fs
 where
   go :: FormattingSpec il
-> Map Char (FormattingSpec il) -> Map Char (FormattingSpec il)
go FormattingSpec il
s =
     (Maybe (FormattingSpec il) -> Maybe (FormattingSpec il))
-> Char
-> Map Char (FormattingSpec il)
-> Map Char (FormattingSpec il)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\case -- combine FormattingSpecs with same character (see #87)
                 Maybe (FormattingSpec il)
Nothing -> FormattingSpec il -> Maybe (FormattingSpec il)
forall a. a -> Maybe a
Just FormattingSpec il
s
                 Just FormattingSpec il
s' -> FormattingSpec il -> Maybe (FormattingSpec il)
forall a. a -> Maybe a
Just
                   FormattingSpec il
s' { formattingSingleMatch =
                         formattingSingleMatch s' `mplus` formattingSingleMatch s
                     , formattingDoubleMatch =
                         formattingDoubleMatch s' `mplus` formattingDoubleMatch s
                     })
             (FormattingSpec il -> Char
forall il. FormattingSpec il -> Char
formattingDelimChar FormattingSpec il
s)

--- Bracketed specs:

-- ^ Defines an inline element between square brackets.
data BracketedSpec il = BracketedSpec
     { forall il. BracketedSpec il -> Text
bracketedName      :: !Text  -- ^ Name of bracketed text type.
     , forall il. BracketedSpec il -> Bool
bracketedNests     :: !Bool  -- ^ True if this can be nested.
     , forall il. BracketedSpec il -> Maybe Char
bracketedPrefix    :: Maybe Char -- ^ Prefix character.
     , forall il. BracketedSpec il -> Maybe Char
bracketedSuffixEnd :: Maybe Char -- ^ Suffix character.
     , forall il.
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 BracketedSpec il
s = String
"<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]
++ String
">"

-- It's important that specs with prefix chars come first:
defaultBracketedSpecs :: IsInline il
                      => [BracketedSpec il]
defaultBracketedSpecs :: forall il. IsInline il => [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 :: forall il. IsInline il => BracketedSpec il
linkSpec = BracketedSpec
           { bracketedName :: Text
bracketedName = Text
"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 Char
')'
           , 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 :: forall il. IsInline il => BracketedSpec il
imageSpec = BracketedSpec
            { bracketedName :: Text
bracketedName = Text
"Image"
            , bracketedNests :: Bool
bracketedNests = Bool
True
            , bracketedPrefix :: Maybe Char
bracketedPrefix = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'!'
            , bracketedSuffixEnd :: Maybe Char
bracketedSuffixEnd = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
')'
            , 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 :: forall il s.
IsInline il =>
ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix ReferenceMap
rm Text
key = do
  LinkInfo Text
target Text
title Attributes
attrs Maybe SourcePos
_mbpos <- 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 a. a -> ParsecT [Tok] s Identity a
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 :: forall il s.
IsInline il =>
ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pImageSuffix ReferenceMap
rm Text
key = do
  LinkInfo Text
target Text
title Attributes
attrs Maybe SourcePos
_mbpos <- 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 a. a -> ParsecT [Tok] s Identity a
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 = Line -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Line
0 (String -> SourcePos
initialPos String
"")
  where
    go :: Int -> SourcePos -> [Tok] -> IntMap.IntMap [SourcePos]
    go :: Line -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Line
n SourcePos
pos []
     | Line
n Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
> Line
0     = Line -> [SourcePos] -> IntMap [SourcePos]
forall a. Line -> a -> IntMap a
IntMap.singleton Line
n [SourcePos
pos]
     | Bool
otherwise = IntMap [SourcePos]
forall a. IntMap a
IntMap.empty
    go Line
n SourcePos
pos (Tok
t:[Tok]
ts) =
     case Tok -> TokType
tokType Tok
t of
       Symbol Char
'`'
         | Line
n Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
> Line
0     -> Line -> SourcePos -> [Tok] -> IntMap [SourcePos]
go (Line
nLine -> Line -> Line
forall a. Num a => a -> a -> a
+Line
1) SourcePos
pos [Tok]
ts
         | Bool
otherwise -> Line -> SourcePos -> [Tok] -> IntMap [SourcePos]
go (Line
nLine -> Line -> Line
forall a. Num a => a -> a -> a
+Line
1) (Tok -> SourcePos
tokPos Tok
t) [Tok]
ts
       TokType
_ | Line
n Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
> Line
0     -> (Maybe [SourcePos] -> Maybe [SourcePos])
-> Line -> IntMap [SourcePos] -> IntMap [SourcePos]
forall a. (Maybe a -> Maybe a) -> Line -> IntMap a -> IntMap a
IntMap.alter (\case
                                       Maybe [SourcePos]
Nothing -> [SourcePos] -> Maybe [SourcePos]
forall a. a -> Maybe a
Just [SourcePos
pos]
                                       Just [SourcePos]
ps -> [SourcePos] -> Maybe [SourcePos]
forall a. a -> Maybe a
Just (SourcePos
posSourcePos -> [SourcePos] -> [SourcePos]
forall a. a -> [a] -> [a]
:[SourcePos]
ps))
                                     Line
n (Line -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Line
0 SourcePos
pos [Tok]
ts)
         | Bool
otherwise -> Line -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Line
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 :: 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 =
 do SourcePos
pos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    (ChunkType a
res, [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 -> ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a))
-> Chunk a -> ParsecT [Tok] (IPState m) (StateT Enders 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
  ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
-> 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 -> ParsecT s u m a
<|> ({-# SCC pDelimChunk #-} FormattingSpecMap a
-> (Char -> Bool)
-> ParsecT [Tok] (IPState m) (StateT Enders 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)
  ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
-> 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 -> 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 -> ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a))
-> Chunk a -> ParsecT [Tok] (IPState m) (StateT Enders 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 :: forall a (m :: * -> *).
(IsInline a, Monad m) =>
FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
pDelimChunk FormattingSpecMap a
specmap Char -> Bool
isDelimChar = do
  tok :: Tok
tok@(Tok (Symbol !Char
c) !SourcePos
pos Text
_) <-
      (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 Char
c) SourcePos
_ Text
_ -> Char -> Bool
isDelimChar Char
c
                    Tok
_                  -> 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 a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
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 TokType
Spaces        -> Bool
True
                               Just TokType
UnicodeSpace  -> Bool
True
                               Just TokType
LineEnd       -> Bool
True
                               Maybe TokType
_                  -> 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 Bool
True -> Bool
False
         Maybe Bool
_         -> case Maybe TokType
precedingTokType of
                        Just (Symbol Char
_) -> Bool
True
                        Maybe TokType
_               -> 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 Bool
True -> Bool
False
         Maybe Bool
_         -> 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 :: Line
len = [Tok] -> Line
forall a. [a] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [Tok]
toks
  Chunk a -> InlineParser m (Chunk a)
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) 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 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 :: Line
delimLength = Line
len
                       } SourcePos
pos [Tok]
toks

withAttributes :: (IsInline a, Monad m) => InlineParser m a -> InlineParser m a
withAttributes :: forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
withAttributes 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
$ (Attributes -> a -> a
forall a. HasAttributes a => Attributes -> a -> a
`addAttributes` 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 :: forall a (m :: * -> *).
(IsInline a, Monad m) =>
[InlineParser m a] -> InlineParser m a
pInline [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 a. a -> ParsecT [Tok] (IPState m) (StateT Enders 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, SourcePos)] -> SourceRange
SourceRange [(SourcePos, SourcePos)]
forall a. Monoid a => a
mempty
rangeFromToks (Tok
z:[Tok]
zs) !SourcePos
endpos
  | SourcePos -> Line
sourceLine (Tok -> SourcePos
tokPos Tok
z) Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos -> Line
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 [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
             ([], [])     -> []
             ([], Tok
_:[Tok]
ys)   -> [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ys
             (Tok
x:[Tok]
_, [])   -> [(Tok -> SourcePos
tokPos Tok
x, SourcePos
endpos)]
             (Tok
x:[Tok]
_, Tok
y:[Tok]
ys) ->
               case [Tok]
ys of
                 (Tok TokType
_ !SourcePos
pos Text
_ : [Tok]
_) | SourcePos -> Line
sourceColumn SourcePos
pos Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
1 -> [Tok] -> [(SourcePos, SourcePos)]
go (Tok
xTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
ys)
                 [Tok]
_ -> (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 :: forall (m :: * -> *). Monad m => 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)
-> ParsecT [Tok] (IPState m) (StateT Enders 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 :: forall (m :: * -> *).
Monad m =>
Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan 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 Char
'`')
  let numticks :: Line
numticks = [Tok] -> Line
forall a. [a] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
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
<$> Line -> IntMap [SourcePos] -> Maybe [SourcePos]
forall a. Line -> IntMap a -> Maybe a
IntMap.lookup Line
numticks (IPState m -> IntMap [SourcePos]
forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans IPState m
st') of
     Just (SourcePos
pos'':[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 -> 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 Char
'`'))
          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] -> Line
forall a. [a] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [Tok]
backticks Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
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
$ \IPState m
st ->
            IPState m
st{ backtickSpans = IntMap.insert numticks ps (backtickSpans st) }
          Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
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
     Maybe [SourcePos]
_ -> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
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 Char
'\n' = Char
' '
   nltosp Char
c    = Char
c
   removeSurroundingSpace :: Text -> Text
removeSurroundingSpace 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
== Char
' ') Text
s)
     , HasCallStack => Text -> Char
Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
     , HasCallStack => Text -> Char
Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = Line -> Text -> Text
T.drop Line
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Line -> Text -> Text
T.dropEnd Line
1 Text
s
     | Bool
otherwise = Text
s

pUri :: Monad m => InlineParser m (Text, Text)
pUri :: forall (m :: * -> *). Monad m => InlineParser m (Text, Text)
pUri = ParsecT [Tok] (IPState m) (StateT Enders m) (Text, Text)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) (Text, Text)
 -> ParsecT [Tok] (IPState m) (StateT Enders m) (Text, Text))
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Text, Text)
-> ParsecT [Tok] (IPState m) (StateT Enders 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 Char
':'
  let isURITok :: Tok -> Bool
isURITok Tok
t =
       case Tok -> TokType
tokType Tok
t of
            TokType
Spaces     -> Bool
False
            TokType
LineEnd    -> Bool
False
            (Symbol Char
c) -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>'
            TokType
_          -> 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 -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
ts
  (Text, Text)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Text, Text)
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
uri, Text
uri)

pScheme :: Monad m => InlineParser m Text
pScheme :: forall (m :: * -> *). Monad m => 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 (\Text
t -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
                               Maybe (Char, Text)
Nothing -> Bool
False
                               Just (Char
c,Text
rest) -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha 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
'+', Char -> TokType
Symbol Char
'.', Char -> TokType
Symbol Char
'-']
  let s :: Text
s = [Tok] -> Text
untokenize (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
ts)
  let len :: Line
len = Text -> Line
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
$ Line
len Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
>= Line
2 Bool -> Bool -> Bool
&& Line
len Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
<= Line
32
  Text -> InlineParser m Text
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

pEmail :: Monad m => InlineParser m (Text, Text)
pEmail :: forall (m :: * -> *). Monad m => InlineParser m (Text, Text)
pEmail = do
  let isEmailSymbolTok :: Tok -> Bool
isEmailSymbolTok (Tok (Symbol Char
c) SourcePos
_ Text
_) =
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'^' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
||
         Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']'
      isEmailSymbolTok Tok
_ = 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 Char
'@'
  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 Char
'-' ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) Tok
forall a b.
ParsecT [Tok] s (StateT Enders m) a
-> ParsecT [Tok] s (StateT Enders m) b
-> ParsecT [Tok] s (StateT Enders m) a
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 a b.
ParsecT [Tok] s (StateT Enders m) a
-> ParsecT [Tok] s (StateT Enders m) b
-> ParsecT [Tok] s (StateT Enders m) a
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 Char
'.'))
                  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 a. a -> ParsecT [Tok] s (StateT Enders m) a
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 Char
'.' 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.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"." (([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 a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
addr, Text
addr)

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


processEmphasis :: IsInline a => [Chunk a] -> [Chunk a]
processEmphasis :: forall a. IsInline a => [Chunk a] -> [Chunk a]
processEmphasis [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 } SourcePos
_ [Tok]
_) -> Bool
True
               Chunk a
_ -> Bool
False) [Chunk a]
xs of
       ([Chunk a]
_,[]) -> [Chunk a]
xs
       ([Chunk a]
ys,Chunk a
z:[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 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 :: forall a. IsInline a => DState a -> [Chunk a]
processEm 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
       (Maybe (Chunk a)
_, Maybe (Chunk a)
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
                            Maybe (Chunk a)
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 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)

       (Maybe (Chunk a)
Nothing, Just (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c
                                  , delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True
                                  , delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
canopen } SourcePos
pos [Tok]
ts)) ->
           DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
           DState a
st{ leftCursor   = right
             , rightCursor  = moveRight right
             , stackBottoms = M.insert
                   (T.pack ([c, if canopen then '1' else '0']
                              ++ show (length ts `mod` 3))) pos
                   $ stackBottoms st
             }

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

       (Just 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,
                                                  delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
canopen,
                                                  delimSpec :: forall a. ChunkType a -> Maybe (FormattingSpec a)
delimSpec = Just FormattingSpec a
spec}
                                           SourcePos
closePos [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 :: Line
closelen = [Tok] -> Line
forall a. [a] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
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 (\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 :: Line
openlen = [Tok] -> Line
forall a. [a] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
opendelim)
               fallbackConstructor :: a -> a
fallbackConstructor 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)
               (a -> a
constructor, Line
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
                        (Maybe (a -> a)
_, Just a -> a
c2)
                          | Line -> Line -> Line
forall a. Ord a => a -> a -> a
min Line
openlen Line
closelen Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
>= Line
2 -> (a -> a
c2, Line
2)
                        (Just a -> a
c1, Maybe (a -> a)
_)     -> (a -> a
c1, Line
1)
                        (Maybe (a -> a), Maybe (a -> a))
_                -> (a -> a
forall a. IsInline a => a -> a
fallbackConstructor, Line
1)
               ([Tok]
openrest, [Tok]
opentoks) =
                 Line -> [Tok] -> ([Tok], [Tok])
forall a. Line -> [a] -> ([a], [a])
splitAt (Line
openlen Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
numtoks) (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
opendelim)
               ([Tok]
closetoks, [Tok]
closerest) =
                 Line -> [Tok] -> ([Tok], [Tok])
forall a. Line -> [a] -> ([a], [a])
splitAt Line
numtoks (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
closedelim)
               addnewopen :: [Chunk a] -> [Chunk a]
addnewopen = if [Tok] -> Bool
forall a. [a] -> 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 = openrest } Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)
               addnewclose :: [Chunk a] -> [Chunk a]
addnewclose = if [Tok] -> Bool
forall a. [a] -> 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 = 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 -> Line -> SourcePos
incSourceColumn (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
closedelim)
                                       Line
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 = moveRight newcursor
                , leftCursor = 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]
: Line -> String
forall a. Show a => a -> String
show ([Tok] -> Line
forall a. [a] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [Tok]
ts Line -> Line -> Line
forall a. Integral a => a -> a -> a
`mod` Line
3))) Map Text SourcePos
bottoms ->
                  DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
                  DState a
st{ leftCursor   = right
                    , rightCursor  = moveRight right
                    , stackBottoms =  M.insert
                        (T.pack ([c, if canopen then '1' else '0']
                                   ++ show (length ts `mod` 3)))
                        (chunkPos closedelim)
                        $ stackBottoms st
                    }

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

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

-- This only applies to emph delims, not []:
delimsMatch :: IsInline a
            => Chunk a -> Chunk a -> Bool
delimsMatch :: forall a. IsInline a => Chunk a -> Chunk a -> Bool
delimsMatch (Chunk open :: ChunkType a
open@Delim{} SourcePos
_ [Tok]
opents) (Chunk close :: ChunkType a
close@Delim{} SourcePos
_ [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 -> Line
forall a. ChunkType a -> Line
delimLength ChunkType a
close Line -> Line -> Line
forall a. Integral a => a -> a -> a
`mod` Line
3 Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
0 Bool -> Bool -> Bool
||
                     (ChunkType a -> Line
forall a. ChunkType a -> Line
delimLength ChunkType a
open Line -> Line -> Line
forall a. Num a => a -> a -> a
+ ChunkType a -> Line
forall a. ChunkType a -> Line
delimLength ChunkType a
close) Line -> Line -> Line
forall a. Integral a => a -> a -> a
`mod` Line
3 Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
/= Line
0
                else Bool
True) Bool -> Bool -> Bool
&&
    [Tok]
opents [Tok] -> [Tok] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Tok]
closets
delimsMatch Chunk a
_ Chunk a
_ = Bool
False

-- check for balanced `[]` brackets
bracketChunkToNumber :: Chunk a -> Int
bracketChunkToNumber :: forall a. Chunk a -> Line
bracketChunkToNumber (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } SourcePos
_ [Tok]
_) = Line
1
bracketChunkToNumber (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
']' } SourcePos
_ [Tok]
_) = -Line
1
bracketChunkToNumber Chunk a
_ = Line
0
bracketMatchedCount :: [Chunk a] -> Int
bracketMatchedCount :: forall a. [Chunk a] -> Line
bracketMatchedCount [Chunk a]
chunksinside = [Line] -> Line
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Line] -> Line) -> [Line] -> Line
forall a b. (a -> b) -> a -> b
$ (Chunk a -> Line) -> [Chunk a] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
map Chunk a -> Line
forall a. Chunk a -> Line
bracketChunkToNumber [Chunk a]
chunksinside

processBrackets :: IsInline a
                => [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets :: forall a.
IsInline a =>
[BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets [BracketedSpec a]
bracketedSpecs ReferenceMap
rm [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
'[' } SourcePos
_ [Tok]
_) -> Bool
True
               Chunk a
_ -> Bool
False) [Chunk a]
xs of
       ([Chunk a]
_,[]) -> [Chunk a]
xs
       ([Chunk a]
ys,Chunk a
z:[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
                 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
     { forall a. Cursor a -> Maybe a
center  :: Maybe a
     , forall a. Cursor a -> [a]
befores :: [a]
     , forall a. Cursor a -> [a]
afters  :: [a]
     }
     deriving Line -> Cursor a -> String -> String
[Cursor a] -> String -> String
Cursor a -> String
(Line -> Cursor a -> String -> String)
-> (Cursor a -> String)
-> ([Cursor a] -> String -> String)
-> Show (Cursor a)
forall a. Show a => Line -> Cursor a -> String -> String
forall a. Show a => [Cursor a] -> String -> String
forall a. Show a => Cursor a -> String
forall a.
(Line -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Line -> Cursor a -> String -> String
showsPrec :: Line -> Cursor a -> String -> String
$cshow :: forall a. Show a => Cursor a -> String
show :: Cursor a -> String
$cshowList :: forall a. Show a => [Cursor a] -> String -> String
showList :: [Cursor a] -> String -> String
Show

moveLeft :: Cursor a -> Cursor a
moveLeft :: forall a. Cursor a -> Cursor a
moveLeft (Cursor Maybe a
Nothing  []     [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 Maybe a
Nothing  (a
x:[a]
xs) [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 a
x) []     [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 a
x) (a
y:[a]
ys) [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 :: forall a. Cursor a -> Cursor a
moveRight (Cursor Maybe a
Nothing [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 Maybe a
Nothing [a]
zs  (a
x:[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 a
x) [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 a
x) [a]
zs (a
y:[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 :: forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs 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
       (Maybe (Chunk a)
_, Maybe (Chunk a)
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
                            Maybe (Chunk a)
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 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)

       (Maybe (Chunk a)
Nothing, Just 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 = moveRight right
                         , rightCursor = moveRight right
                         , absoluteBottom = chunkPos chunk
                         }

       (Just Chunk a
chunk, Just 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 = moveRight right
                          , rightCursor = moveRight right
                          , absoluteBottom = chunkPos chunk'
                          }

       (Just opener :: Chunk a
opener@(Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } SourcePos
_ [Tok]
_),
        Just closer :: Chunk a
closer@(Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
']'} SourcePos
closePos [Tok]
_)) ->
          let chunksinside :: [Chunk a]
chunksinside = (Chunk a -> Bool) -> [Chunk a] -> [Chunk a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\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' } SourcePos
_ [Tok]
_) =
                 Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
|| Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']'
              isBracket Chunk a
_ = 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 Text
""
                       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
                              Text
ks | Text -> Line
T.length Text
ks Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
<= Line
999 -> Text
ks
                              Text
_  -> Text
""
              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} SourcePos
_ [Tok
_] : [Chunk a]
_
                                    -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
                                 [Chunk a]
_  -> 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 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
                                Maybe Char
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 -> Line -> SourcePos
incSourceColumn SourcePos
closePos Line
1

          in case ([Chunk a] -> Line
forall a. [Chunk a] -> Line
bracketMatchedCount [Chunk a]
chunksinside, 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
                       (BracketedSpec a
spec, 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 (\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 a. a -> ParsecT [Tok] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (BracketedSpec a
spec, a -> a
constructor, SourcePos
pos)))
                 String
"" [Tok]
suffixToks) of
                   (Line
0, Left ParseError
_) -> -- 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 = moveLeft (leftCursor st)
                              , rightCursor = fixSingleQuote $
                                    moveRight (rightCursor st) }
                   (Line
0, Right ((BracketedSpec a
spec, a -> a
constructor, SourcePos
newpos), [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 Char
_  -> Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left
                                      Maybe Char
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 Char
_ -> ([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]
                                        Maybe Char
Nothing -> [Chunk a
opener]
                         openerPos :: SourcePos
openerPos = case [Chunk a]
openers of
                                          (Chunk a
x:[Chunk a]
_) -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
x
                                          [Chunk a]
_     -> 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 a. [a] -> 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 Nothing
                                          (eltchunk : befores left') [] }
                           (Chunk a
y:[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 (Just eltchunk) lbs (y:ys)
                                , rightCursor = fixSingleQuote $
                                    Cursor (Just y) (eltchunk:lbs) ys
                                , stackBottoms =
                                    -- if a link, we need to ensure that
                                    -- nothing matches as link containing it
                                    if bracketedNests spec
                                       then stackBottoms st
                                       else M.insert (bracketedName spec)
                                            (chunkPos opener)
                                            $ stackBottoms st
                                }
                  -- Bracket matched count /= 0
                  --
                  -- Links § 6.3 ¶ 2 • 2
                  -- Brackets are allowed in the link text only if (a) they are
                  -- backslash-escaped or (b) they appear as a matched pair of
                  -- brackets, with an open bracket [, a sequence of zero or more
                  -- inlines, and a close bracket ].
                   (Line,
 Either ParseError ((BracketedSpec a, a -> a, SourcePos), [Tok]))
_ ->
                         [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                            DState a
st{ leftCursor = moveLeft left }


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

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

       (Maybe (Chunk a)
_, Maybe (Chunk a)
_) -> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                DState a
st{ rightCursor = moveRight 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 :: forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote
  (Cursor (Just (Chunk d :: ChunkType a
d@Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'\'' } SourcePos
pos [Tok]
toks)) [Chunk a]
xs [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 = False } SourcePos
pos [Tok]
toks)) [Chunk a]
xs [Chunk a]
ys
fixSingleQuote Cursor (Chunk a)
cursor = Cursor (Chunk a)
cursor

pLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink :: forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm 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 :: forall (m :: * -> *) s. Monad m => 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 Char
'('
  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
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]
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 Text
"" (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 a b.
ParsecT [Tok] s m a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
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 Char
')'
  LinkInfo -> ParsecT [Tok] s m LinkInfo
forall a. a -> ParsecT [Tok] s m a
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
$! LinkInfo { linkDestination :: Text
linkDestination = Text
target
                    , linkTitle :: Text
linkTitle = Text
title
                    , linkAttributes :: Attributes
linkAttributes = Attributes
forall a. Monoid a => a
mempty
                    , linkPos :: Maybe SourcePos
linkPos = Maybe SourcePos
forall a. Maybe a
Nothing }

pLinkDestination :: Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination :: forall (m :: * -> *) s. Monad m => 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
<|> Line -> ParsecT [Tok] s m [Tok]
forall {m :: * -> *} {u}.
Monad m =>
Line -> ParsecT [Tok] u m [Tok]
pNormalDest Line
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 Char
'<'
      [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
'<', Char -> TokType
Symbol Char
'>', Char -> TokType
Symbol Char
'\\',
                               Char -> TokType
Symbol Char
'&', 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 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
pEntity 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 -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'&')
      Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
      [Tok] -> ParsecT [Tok] s m [Tok]
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res

    pNormalDest :: Line -> ParsecT [Tok] u m [Tok]
pNormalDest (Line
numparens :: Int) = do
      [Tok]
res <- Line -> ParsecT [Tok] u m [Tok]
forall {m :: * -> *} {a} {u}.
(Monad m, Num a, Ord a) =>
a -> ParsecT [Tok] u m [Tok]
pNormalDest' Line
numparens
      if [Tok] -> Bool
forall a. [a] -> 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 a b. a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m a
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 Char
')')
         else [Tok] -> ParsecT [Tok] u m [Tok]
forall a. a -> ParsecT [Tok] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res

    pNormalDest' :: a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens
     | a
numparens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
32 = ParsecT [Tok] u m [Tok]
forall a. ParsecT [Tok] u m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     | Bool
otherwise = (do
          Tok
t <- ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEntity 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 -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\case
                           Tok (Symbol Char
'\\') SourcePos
_ Text
_ -> Bool
True
                           Tok (Symbol Char
')') SourcePos
_ Text
_  -> a
numparens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1
                           Tok TokType
Spaces SourcePos
_ Text
_        -> Bool
False
                           Tok TokType
LineEnd SourcePos
_ Text
_       -> Bool
False
                           Tok
_                     -> Bool
True)
          case Tok
t of
            Tok (Symbol Char
'\\') SourcePos
_ Text
_ -> 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 Char
'(') SourcePos
_ Text
_ -> (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
+ a
1)
            Tok (Symbol Char
')') SourcePos
_ Text
_ -> (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
- a
1)
            Tok
_                    -> (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 a b. a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m a
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
== a
0))

-- parses backslash + escapable character, or just backslash
pEscaped :: Monad m => ParsecT [Tok] s m Tok
pEscaped :: forall (m :: * -> *) s. Monad m => 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 Char
'\\'
  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

-- parses backslash + punctuation, but not backslashed newline
pEscapedSymbol :: Monad m => ParsecT [Tok] s m Tok
pEscapedSymbol :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscapedSymbol = do
  Tok
bs <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\\'
  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

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

pLinkTitle :: Monad m => ParsecT [Tok] s m [Tok]
pLinkTitle :: forall (m :: * -> *) s. Monad m => 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 Char
'"' Char
'"' 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 Char
'\'' Char
'\'' 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 Char
'(' Char
')'

inbetween :: Monad m => Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween :: forall (m :: * -> *) s.
Monad m =>
Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween Char
op 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
pEscapedSymbol 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 :: forall (m :: * -> *) s. Monad m => 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
'[') (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']')
            (([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
']', Char -> TokType
Symbol Char
'[']))))
  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 -> Line
T.length Text
lab Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
<= Line
999
  Text -> ParsecT [Tok] s m Text
forall a. a -> ParsecT [Tok] s m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab

pReferenceLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink :: forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink ReferenceMap
rm 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 a. ParsecT [Tok] s Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero LinkInfo -> Parsec [Tok] s LinkInfo
forall a. a -> ParsecT [Tok] s Identity a
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