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

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

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

mkInlineParser :: (Monad m, IsInline a)
               => [BracketedSpec a]
               -> [FormattingSpec a]
               -> [InlineParser m a]
               -> [InlineParser m Attributes]
               -> ReferenceMap
               -> [Tok]
               -> m (Either ParseError a)
mkInlineParser :: [BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> [InlineParser m Attributes]
-> ReferenceMap
-> [Tok]
-> m (Either ParseError a)
mkInlineParser [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 (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 :: InlineParser m a
defaultInlineParser =
  {-# SCC defaultInlineParser #-} InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
    tok :: Tok
tok@(Tok TokType
toktype 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 -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
        TokType
LineEnd      -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. IsInline a => a
softBreak
        TokType
Spaces       -> Int -> InlineParser m a
forall a (m :: * -> *) a s.
(Monad m, IsInline a, Num a, Ord a) =>
a -> ParsecT [Tok] s m a
doBreak (Text -> Int
T.length Text
t) InlineParser m a -> InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> a
forall a. IsInline a => Text -> a
str Text
t)
        TokType
UnicodeSpace -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
        Symbol Char
'\\'  -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str Text
"\\") InlineParser m a
forall s. ParsecT [Tok] s (StateT Enders m) a
doEscape
        Symbol Char
'`'   -> Tok -> InlineParser m a
forall (m :: * -> *) b.
(Monad m, IsInline b) =>
Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) b
doCodeSpan Tok
tok
        Symbol Char
'&'   -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str Text
"&") InlineParser m a
forall s. ParsecT [Tok] s (StateT Enders m) a
doEntity
        Symbol Char
'<'   -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str Text
"<") (InlineParser m a
doAutolink InlineParser m a -> InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Tok -> InlineParser m a
forall b (m :: * -> *) u.
(IsInline b, Monad m) =>
Tok -> ParsecT [Tok] u (StateT Enders m) b
doHtml Tok
tok)
        TokType
_            -> InlineParser 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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
LineEnd)
       | Bool
otherwise = a
forall a. Monoid a => a
mempty a -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
LineEnd))
     doEscape :: ParsecT [Tok] s (StateT Enders m) a
doEscape = do
       Tok
tok <- (Tok -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok
                    (\case
                      Tok (Symbol 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 (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 (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 (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 (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 :: InlineParser m a
doAutolink = InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
       (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 -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> a -> a
forall a. IsInline a => Text -> Text -> a -> a
link Text
target Text
"" (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall a b. (a -> b) -> a -> b
$ Text -> b
forall a. IsInline a => Text -> a
code (Text -> b) -> ([Tok] -> Text) -> [Tok] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeCodeSpan (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> b) -> [Tok] -> b
forall a b. (a -> b) -> a -> b
$
                                    [Tok]
codetoks

unChunks :: IsInline a => [Chunk a] -> a
unChunks :: [Chunk a] -> a
unChunks = {-# SCC unChunks #-} (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
forall a. Monoid a => a
mempty ([a] -> a) -> ([Chunk a] -> [a]) -> [Chunk a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk a] -> [a]
forall a. IsInline a => [Chunk a] -> [a]
go
    where
      go :: [Chunk a] -> [a]
go []     = []
      go (Chunk a
c:[Chunk a]
cs) =
        let (a -> a
f, [Chunk a]
rest) =
             case [Chunk a]
cs of
               (Chunk (AddAttributes attrs) _pos _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 :: Text
tokContents =
                                         (Char -> Char) -> Text -> Text
T.map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
ch') (Tok -> Text
tokContents Tok
t) })
                        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 -> Int -> SourcePos
incSourceColumn (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
c) (Text -> Int
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 :: [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 (m :: * -> *) a. Monad m => a -> m a
return ()
         ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
forall a (m :: * -> *).
(IsInline a, Monad m) =>
FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> InlineParser m (Chunk a)
pChunk FormattingSpecMap a
specmap InlineParser m Attributes
attrParser [InlineParser m a]
ilParsers Char -> Bool
isDelimChar) ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
     IPState :: forall (m :: * -> *).
IntMap [SourcePos]
-> ReferenceMap
-> Map SourcePos TokType
-> InlineParser m Attributes
-> IPState m
IPState{ backtickSpans :: IntMap [SourcePos]
backtickSpans = [Tok] -> IntMap [SourcePos]
getBacktickSpans [Tok]
ts,
              ipReferenceMap :: ReferenceMap
ipReferenceMap = ReferenceMap
rm,
              precedingTokTypes :: Map SourcePos TokType
precedingTokTypes = Map SourcePos TokType
precedingTokTypeMap,
              attributeParser :: InlineParser m Attributes
attributeParser = InlineParser m Attributes
attrParser }
     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 (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
     { Chunk a -> ChunkType a
chunkType :: ChunkType a
     , Chunk a -> SourcePos
chunkPos  :: !SourcePos
     , Chunk a -> [Tok]
chunkToks :: [Tok]
     } deriving Int -> Chunk a -> String -> String
[Chunk a] -> String -> String
Chunk a -> String
(Int -> Chunk a -> String -> String)
-> (Chunk a -> String)
-> ([Chunk a] -> String -> String)
-> Show (Chunk a)
forall a. Show a => Int -> Chunk a -> String -> String
forall a. Show a => [Chunk a] -> String -> String
forall a. Show a => Chunk a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Chunk a] -> String -> String
$cshowList :: forall a. Show a => [Chunk a] -> String -> String
show :: Chunk a -> String
$cshow :: forall a. Show a => Chunk a -> String
showsPrec :: Int -> Chunk a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Chunk a -> String -> String
Show

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

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

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

--- Formatting specs:

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

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

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

defaultFormattingSpecs :: IsInline il => [FormattingSpec il]
defaultFormattingSpecs :: [FormattingSpec il]
defaultFormattingSpecs =
  [ Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
forall il.
Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
FormattingSpec 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 :: [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap [FormattingSpec il]
fs = [(Char, FormattingSpec il)] -> FormattingSpecMap il
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FormattingSpec il -> Char
forall il. FormattingSpec il -> Char
formattingDelimChar FormattingSpec il
s, FormattingSpec il
s) | FormattingSpec il
s <- [FormattingSpec il]
fs]

--- Bracketed specs:

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

instance Show (BracketedSpec il) where
  show :: BracketedSpec il -> String
show 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 :: [BracketedSpec il]
defaultBracketedSpecs =
  [ BracketedSpec il
forall il. IsInline il => BracketedSpec il
imageSpec
  , BracketedSpec il
forall il. IsInline il => BracketedSpec il
linkSpec
  ]

linkSpec :: IsInline il => BracketedSpec il
linkSpec :: BracketedSpec il
linkSpec = BracketedSpec :: forall il.
Text
-> Bool
-> Maybe Char
-> Maybe Char
-> (ReferenceMap -> Text -> Parsec [Tok] () (il -> il))
-> BracketedSpec il
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 :: BracketedSpec il
imageSpec = BracketedSpec :: forall il.
Text
-> Bool
-> Maybe Char
-> Maybe Char
-> (ReferenceMap -> Text -> Parsec [Tok] () (il -> il))
-> BracketedSpec il
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 :: ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix ReferenceMap
rm Text
key = do
  LinkInfo Text
target Text
title Attributes
attrs <- ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm Text
key
  (il -> il) -> Parsec [Tok] s (il -> il)
forall (m :: * -> *) a. Monad m => a -> m a
return ((il -> il) -> Parsec [Tok] s (il -> il))
-> (il -> il) -> Parsec [Tok] s (il -> il)
forall a b. (a -> b) -> a -> b
$! Attributes -> il -> il
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (il -> il) -> (il -> il) -> il -> il
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> il -> il
forall a. IsInline a => Text -> Text -> a -> a
link Text
target Text
title

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

---

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

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

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

withAttributes :: (IsInline a, Monad m) => InlineParser m a -> InlineParser m a
withAttributes :: InlineParser m a -> InlineParser m a
withAttributes 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
attr -> Attributes -> a -> a
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attr a
x) (Attributes -> a) -> InlineParser m Attributes -> InlineParser m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineParser m Attributes
attrParser

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

rangeFromToks :: [Tok] -> SourcePos -> SourceRange
rangeFromToks :: [Tok] -> SourcePos -> SourceRange
rangeFromToks [] SourcePos
_ = [(SourcePos, SourcePos)] -> SourceRange
SourceRange [(SourcePos, SourcePos)]
forall a. Monoid a => a
mempty
rangeFromToks (!Tok
z:[Tok]
zs) !SourcePos
endpos
  | SourcePos -> Int
sourceLine (Tok -> SourcePos
tokPos Tok
z) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
sourceLine SourcePos
endpos
    = [(SourcePos, SourcePos)] -> SourceRange
SourceRange [(Tok -> SourcePos
tokPos Tok
z, SourcePos
endpos)]
  | Bool
otherwise
    = [(SourcePos, SourcePos)] -> SourceRange
SourceRange ([(SourcePos, SourcePos)] -> SourceRange)
-> [(SourcePos, SourcePos)] -> SourceRange
forall a b. (a -> b) -> a -> b
$ [Tok] -> [(SourcePos, SourcePos)]
go (Tok
zTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
zs)
       where
        go :: [Tok] -> [(SourcePos, SourcePos)]
go [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 -> Int
sourceColumn SourcePos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 :: InlineParser m ReferenceMap
getReferenceMap = IPState m -> ReferenceMap
forall (m :: * -> *). IPState m -> ReferenceMap
ipReferenceMap (IPState m -> ReferenceMap)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
-> InlineParser m ReferenceMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

pBacktickSpan :: Monad m
              => Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan :: Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan Tok
tok = 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 :: Int
numticks = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts
  IPState m
st' <- ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case (SourcePos -> Bool) -> [SourcePos] -> [SourcePos]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
<= Tok -> SourcePos
tokPos Tok
tok) ([SourcePos] -> [SourcePos])
-> Maybe [SourcePos] -> Maybe [SourcePos]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap [SourcePos] -> Maybe [SourcePos]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
numticks (IPState m -> IntMap [SourcePos]
forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans IPState m
st') of
     Just (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] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
backticks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numticks
          (IPState m -> IPState m)
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((IPState m -> IPState m)
 -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> (IPState m -> IPState m)
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ \IPState m
st ->
            IPState m
st{ backtickSpans :: IntMap [SourcePos]
backtickSpans = Int -> [SourcePos] -> IntMap [SourcePos] -> IntMap [SourcePos]
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
numticks [SourcePos]
ps (IPState m -> IntMap [SourcePos]
forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans IPState m
st) }
          Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok]))
-> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Either [Tok] [Tok]
forall a b. b -> Either a b
Right [Tok]
codetoks
     Maybe [SourcePos]
_ -> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok]))
-> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Either [Tok] [Tok]
forall a b. a -> Either a b
Left [Tok]
ts

normalizeCodeSpan :: Text -> Text
normalizeCodeSpan :: Text -> Text
normalizeCodeSpan = Text -> Text
removeSurroundingSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
nltosp
  where
   nltosp :: Char -> Char
nltosp 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)
     , Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
     , Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.dropEnd Int
1 Text
s
     | Bool
otherwise = Text
s

pUri :: Monad m => InlineParser m (Text, Text)
pUri :: InlineParser m (Text, Text)
pUri = InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m (Text, Text) -> InlineParser m (Text, Text))
-> InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  Text
s <- InlineParser m Text
forall (m :: * -> *). Monad m => InlineParser m Text
pScheme
  Tok
_ <- Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol 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) -> InlineParser m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
uri, Text
uri)

pScheme :: Monad m => InlineParser m Text
pScheme :: InlineParser m Text
pScheme = do
  Tok
t <- (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\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
isLetter Char
c Bool -> Bool -> Bool
&&
                                                (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
rest)
  [Tok]
ts <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
 -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ [TokType] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
oneOfToks [TokType
WordChars, Char -> TokType
Symbol Char
'+', 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 :: Int
len = Text -> Int
T.length Text
s
  Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32
  Text -> InlineParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

pEmail :: Monad m => InlineParser m (Text, Text)
pEmail :: InlineParser m (Text, Text)
pEmail = do
  let isEmailSymbolTok :: Tok -> Bool
isEmailSymbolTok (Tok (Symbol 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol 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 (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 (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 (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
     { DState a -> Cursor (Chunk a)
leftCursor     :: Cursor (Chunk a)
     , DState a -> Cursor (Chunk a)
rightCursor    :: Cursor (Chunk a)
     , DState a -> ReferenceMap
refmap         :: ReferenceMap
     , DState a -> Map Text SourcePos
stackBottoms   :: M.Map Text SourcePos
     , DState a -> SourcePos
absoluteBottom :: SourcePos
     }


processEmphasis :: IsInline a => [Chunk a] -> [Chunk a]
processEmphasis :: [Chunk a] -> [Chunk a]
processEmphasis [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 :: forall a.
Cursor (Chunk a)
-> Cursor (Chunk a)
-> ReferenceMap
-> Map Text SourcePos
-> SourcePos
-> DState a
DState{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
startcursor
                               , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a)
startcursor
                               , refmap :: ReferenceMap
refmap = ReferenceMap
emptyReferenceMap
                               , stackBottoms :: Map Text SourcePos
stackBottoms = Map Text SourcePos
forall a. Monoid a => a
mempty
                               , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
z }

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

processEm :: IsInline a => DState a -> [Chunk a]
processEm :: DState a -> [Chunk a]
processEm 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 } SourcePos
pos [Tok]
ts)) ->
           DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
           DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor   = Cursor (Chunk a)
right
             , rightCursor :: Cursor (Chunk a)
rightCursor  = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
             , stackBottoms :: Map Text SourcePos
stackBottoms = Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
                   (String -> Text
T.pack (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3))) SourcePos
pos
                   (Map Text SourcePos -> Map Text SourcePos)
-> Map Text SourcePos -> Map Text SourcePos
forall a b. (a -> b) -> a -> b
$ DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
             }

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

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

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

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

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

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

processBrackets :: IsInline a
                => [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets :: [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 :: forall a.
Cursor (Chunk a)
-> Cursor (Chunk a)
-> ReferenceMap
-> Map Text SourcePos
-> SourcePos
-> DState a
DState{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
startcursor
                       , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a)
startcursor
                       , refmap :: ReferenceMap
refmap = ReferenceMap
rm
                       , stackBottoms :: Map Text SourcePos
stackBottoms = Map Text SourcePos
forall a. Monoid a => a
mempty
                       , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
z
                       }

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

moveLeft :: Cursor a -> Cursor a
moveLeft :: Cursor a -> Cursor a
moveLeft (Cursor 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 :: 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 :: [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 :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                         , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                         , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk
                         }

       (Just Chunk 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 :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                          , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                          , absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk'
                          }

       (Just opener :: Chunk a
opener@(Chunk Delim{ delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
True, delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } SourcePos
_ [Tok]
_),
        Just closer :: Chunk a
closer@(Chunk Delim{ delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True, 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 -> Int
T.length Text
ks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 -> Int -> SourcePos
incSourceColumn SourcePos
closePos Int
1

          in case Parsec [Tok] () ((BracketedSpec a, a -> a, SourcePos), [Tok])
-> String
-> [Tok]
-> Either ParseError ((BracketedSpec a, a -> a, SourcePos), [Tok])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse
                 (ParsecT [Tok] () Identity (BracketedSpec a, a -> a, SourcePos)
-> Parsec [Tok] () ((BracketedSpec a, a -> a, SourcePos), [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw
                   (do SourcePos -> ParsecT [Tok] () Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
suffixPos
                       (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 (m :: * -> *) a. Monad m => a -> m a
return (BracketedSpec a
spec, a -> a
constructor, SourcePos
pos)))
                 String
"" [Tok]
suffixToks of
                   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 :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
leftCursor DState a
st)
                              , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote (Cursor (Chunk a) -> Cursor (Chunk a))
-> Cursor (Chunk a) -> Cursor (Chunk a)
forall a b. (a -> b) -> a -> b
$
                                    Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st) }
                   Right ((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)
                         afterchunkpos :: SourcePos
afterchunkpos = case [Chunk a]
afterchunks of
                                           [] -> SourcePos
newpos
                                           (Chunk a
ch:[Chunk a]
_) -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
ch
                         -- 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
afterchunkpos
                              , Tok -> SourcePos
tokPos Tok
t SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
>= SourcePos
newpos]
                         addMissing :: [Chunk a] -> [Chunk a]
addMissing =
                           if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
missingtoks
                              then [Chunk a] -> [Chunk a]
forall a. a -> a
id
                              else (ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk (a -> ChunkType a
forall a. a -> ChunkType a
Parsed (SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged
                                       ([Tok] -> SourcePos -> SourceRange
rangeFromToks [Tok]
missingtoks SourcePos
newpos)
                                       (Text -> a
forall a. IsInline a => Text -> a
str ([Tok] -> Text
untokenize [Tok]
missingtoks))))
                                    SourcePos
newpos [Tok]
missingtoks Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)

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


       (Maybe (Chunk a)
_, Just (Chunk Delim{ delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True, 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 :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left }

       (Just Chunk a
_, Just (Chunk Delim{ delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
True, 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 :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
right
                  , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right }

       (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 :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right }


-- This just changes a single quote Delim that occurs
-- after ) or ] so that canOpen = False.  This is an ad hoc
-- way to prevent "[a]'s dog'" from being parsed wrong.
-- Ideally there'd be a way to put this restriction in
-- the FormattingSpec for smart ', but currently there
-- isn't.
fixSingleQuote :: Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote :: Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote
  (Cursor (Just (Chunk d :: ChunkType a
d@(Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'\'' }) 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 :: Bool
delimCanOpen = Bool
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 :: 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 :: 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
unEntity ([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination
  ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Text
title <- Text -> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option 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 (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 (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 :: Text -> Text -> Attributes -> LinkInfo
LinkInfo { linkDestination :: Text
linkDestination = Text
target
                    , linkTitle :: Text
linkTitle = Text
title
                    , linkAttributes :: Attributes
linkAttributes = Attributes
forall a. Monoid a => a
mempty }

pLinkDestination :: Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination :: ParsecT [Tok] s m [Tok]
pLinkDestination = ParsecT [Tok] s m [Tok]
forall s. ParsecT [Tok] s m [Tok]
pAngleDest ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m [Tok]
pNormalDest Int
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
'\\',
                                TokType
LineEnd] ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped)
      Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
      [Tok] -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res

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

    pNormalDest' :: a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens
     | a
numparens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
32 = ParsecT [Tok] u m [Tok]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     | Bool
otherwise = (do
          Tok
t <- (Tok -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\case
                           Tok (Symbol 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 (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 :: 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

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 :: 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 :: 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
pEscaped ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [Char -> TokType
Symbol Char
op, Char -> TokType
Symbol Char
cl]))

pLinkLabel :: Monad m => ParsecT [Tok] s m Text
pLinkLabel :: ParsecT [Tok] s m Text
pLinkLabel = ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text)
-> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall a b. (a -> b) -> a -> b
$ do
  Text
lab <- [Tok] -> Text
untokenize
      ([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'[') (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 -> Int
T.length Text
lab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
999
  Text -> ParsecT [Tok] s m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab

pReferenceLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink 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 (m :: * -> *) a. MonadPlus m => m a
mzero LinkInfo -> Parsec [Tok] s LinkInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LinkInfo -> Parsec [Tok] s LinkInfo)
-> Maybe LinkInfo -> Parsec [Tok] s LinkInfo
forall a b. (a -> b) -> a -> b
$! Text -> ReferenceMap -> Maybe LinkInfo
forall a. Typeable a => Text -> ReferenceMap -> Maybe a
lookupReference Text
key' ReferenceMap
rm