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

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

import           Commonmark.Tag             (htmlTag, Enders, defaultEnders)
import           Commonmark.Tokens
import Commonmark.TokParsers
    ( lineEnd,
      noneOfToks,
      whitespace,
      oneOfToks,
      satisfyWord,
      withRaw,
      symbol,
      satisfyTok,
      anyTok,
      hasType )
import           Commonmark.ReferenceMap
import           Commonmark.Types
import           Control.Monad              (guard, mzero, mplus)
import           Control.Monad.Trans.State.Strict
import           Data.List                  (foldl')
import           Unicode.Char               (isAscii, isAlpha)
import qualified Data.IntMap.Strict         as IntMap
import qualified Data.Map.Strict            as M
import           Data.Maybe                 (isJust, mapMaybe, listToMaybe)
import qualified Data.Set                   as Set
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import           Commonmark.Entity          (unEntity, charEntity, numEntity)
import           Text.Parsec                hiding (State, space)
import           Text.Parsec.Pos

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

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

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

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

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

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

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

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

--- Formatting specs:

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

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

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

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

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

--- Bracketed specs:

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

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

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

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

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

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

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

---

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

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

pDelimChunk :: (IsInline a, Monad m)
            => FormattingSpecMap a
            -> (Char -> Bool)
            -> InlineParser m (Chunk a)
pDelimChunk :: forall a (m :: * -> *).
(IsInline a, Monad m) =>
FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
pDelimChunk FormattingSpecMap a
specmap Char -> Bool
isDelimChar = do
  tok :: Tok
tok@(Tok (Symbol !Char
c) !SourcePos
pos Text
_) <-
      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 = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
c FormattingSpecMap a
specmap
  [Tok]
more <- if forall a. Maybe a -> Bool
isJust Maybe (FormattingSpec a)
mbspec
             then forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c
             else forall (m :: * -> *) a. Monad m => a -> m a
return []
  let toks :: [Tok]
toks = Tok
tokforall a. a -> [a] -> [a]
:[Tok]
more
  IPState m
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  TokType
next <- 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok)
  let precedingTokType :: Maybe TokType
precedingTokType = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SourcePos
pos (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 forall il. FormattingSpec il -> Bool
formattingIgnorePunctuation 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 forall a. Eq a => a -> a -> Bool
== TokType
Spaces Bool -> Bool -> Bool
||
                             TokType
next forall a. Eq a => a -> a -> Bool
== TokType
LineEnd Bool -> Bool -> Bool
||
                             TokType
next forall a. Eq a => a -> a -> Bool
== TokType
UnicodeSpace
  let followedByPunctuation :: Bool
followedByPunctuation =
       case forall il. FormattingSpec il -> Bool
formattingIgnorePunctuation 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 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
&&
          (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True 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
&&
          (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True forall il. FormattingSpec il -> Bool
formattingIntraWord Maybe (FormattingSpec a)
mbspec Bool -> Bool -> Bool
||
           Bool -> Bool
not Bool
leftFlanking Bool -> Bool -> Bool
||
           Bool
followedByPunctuation)

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

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

pInline :: (IsInline a, Monad m)
        => [InlineParser m a]
        -> InlineParser m a
pInline :: forall a (m :: * -> *).
(IsInline a, Monad m) =>
[InlineParser m a] -> InlineParser m a
pInline [InlineParser m a]
ilParsers =
  forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
withAttributes forall a b. (a -> b) -> a -> b
$ do
       [Tok]
toks <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
       a
res <- 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 <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
       let range :: SourceRange
range = [Tok] -> SourcePos -> SourceRange
rangeFromToks
                 (forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
< SourcePos
endpos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> SourcePos
tokPos) [Tok]
toks) SourcePos
endpos
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 forall a. Monoid a => a
mempty
rangeFromToks (Tok
z:[Tok]
zs) !SourcePos
endpos
  | SourcePos -> Line
sourceLine (Tok -> SourcePos
tokPos Tok
z) forall a. Eq a => a -> a -> Bool
== SourcePos -> Line
sourceLine SourcePos
endpos
    = [(SourcePos, SourcePos)] -> SourceRange
SourceRange [(Tok -> SourcePos
tokPos Tok
z, SourcePos
endpos)]
  | Bool
otherwise
    = [(SourcePos, SourcePos)] -> SourceRange
SourceRange forall a b. (a -> b) -> a -> b
$ [Tok] -> [(SourcePos, SourcePos)]
go (Tok
zforall a. a -> [a] -> [a]
:[Tok]
zs)
       where
        go :: [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ts =
          case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (TokType -> Tok -> Bool
hasType TokType
LineEnd) [Tok]
ts of
             ([], [])     -> []
             ([], Tok
_:[Tok]
ys)   -> [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ys
             (Tok
x:[Tok]
_, [])   -> [(Tok -> SourcePos
tokPos Tok
x, SourcePos
endpos)]
             (Tok
x:[Tok]
_, Tok
y:[Tok]
ys) ->
               case [Tok]
ys of
                 (Tok TokType
_ !SourcePos
pos Text
_ : [Tok]
_) | SourcePos -> Line
sourceColumn SourcePos
pos forall a. Eq a => a -> a -> Bool
== Line
1 -> [Tok] -> [(SourcePos, SourcePos)]
go (Tok
xforall a. a -> [a] -> [a]
:[Tok]
ys)
                 [Tok]
_ -> (Tok -> SourcePos
tokPos Tok
x, Tok -> SourcePos
tokPos Tok
y) forall a. a -> [a] -> [a]
: [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ys

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

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

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

pUri :: Monad m => InlineParser m (Text, Text)
pUri :: forall (m :: * -> *). Monad m => InlineParser m (Text, Text)
pUri = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
s <- forall (m :: * -> *). Monad m => InlineParser m Text
pScheme
  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 forall a. Ord a => a -> a -> Bool
> Char
' ' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'>'
            TokType
_          -> Bool
True
  [Tok]
ts <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
isURITok
  let uri :: Text
uri = Text
s forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
ts
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
uri, Text
uri)

pScheme :: Monad m => InlineParser m Text
pScheme :: forall (m :: * -> *). Monad m => InlineParser m Text
pScheme = do
  Tok
t <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
                               Maybe (Char, Text)
Nothing -> Bool
False
                               Just (Char
c,Text
rest) -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&&
                                                (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
rest)
  [Tok]
ts <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ 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
tforall a. a -> [a] -> [a]
:[Tok]
ts)
  let len :: Line
len = Text -> Line
T.length Text
s
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Line
len forall a. Ord a => a -> a -> Bool
>= Line
2 Bool -> Bool -> Bool
&& Line
len forall a. Ord a => a -> a -> Bool
<= Line
32
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

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

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


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

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

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

       (Maybe (Chunk a)
Nothing, Just (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c
                                  , delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True
                                  , delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
canopen } SourcePos
pos [Tok]
ts)) ->
           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  = forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
             , stackBottoms :: Map Text SourcePos
stackBottoms = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
                   (String -> Text
T.pack ([Char
c, if Bool
canopen then Char
'1' else Char
'0']
                              forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Line
length [Tok]
ts forall a. Integral a => a -> a -> a
`mod` Line
3))) SourcePos
pos
                   forall a b. (a -> b) -> a -> b
$ forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
             }

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

         | forall a. a -> Maybe a
Just (forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk) forall a. Ord a => a -> a -> Bool
<=
             forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> Text
T.pack (Char
cforall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Line
length [Tok]
ts forall a. Integral a => a -> a -> a
`mod` Line
3))) Map Text SourcePos
bottoms ->
                  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  = forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
                    , stackBottoms :: Map Text SourcePos
stackBottoms =  forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
                        (String -> Text
T.pack ([Char
c, if Bool
canopen then Char
'1' else Char
'0']
                                   forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Line
length [Tok]
ts forall a. Integral a => a -> a -> a
`mod` Line
3)))
                        (forall a. Chunk a -> SourcePos
chunkPos Chunk a
closedelim)
                        forall a b. (a -> b) -> a -> b
$ forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
                    }

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

       (Maybe (Chunk a), Maybe (Chunk a))
_ -> forall a. IsInline a => DState a -> [Chunk a]
processEm
            DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
              , leftCursor :: Cursor (Chunk a)
leftCursor  = 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 :: forall a. IsInline a => Chunk a -> Chunk a -> Bool
delimsMatch (Chunk open :: ChunkType a
open@Delim{} SourcePos
_ [Tok]
opents) (Chunk close :: ChunkType a
close@Delim{} SourcePos
_ [Tok]
closets) =
  forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
open Bool -> Bool -> Bool
&& forall a. ChunkType a -> Bool
delimCanClose ChunkType a
close Bool -> Bool -> Bool
&&
      (forall a. ChunkType a -> Char
delimType ChunkType a
open forall a. Eq a => a -> a -> Bool
== forall a. ChunkType a -> Char
delimType ChunkType a
close Bool -> Bool -> Bool
&&
           if (forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
open Bool -> Bool -> Bool
&& forall a. ChunkType a -> Bool
delimCanClose ChunkType a
open) Bool -> Bool -> Bool
||
                (forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
close Bool -> Bool -> Bool
&& forall a. ChunkType a -> Bool
delimCanClose ChunkType a
close)
                then forall a. ChunkType a -> Line
delimLength ChunkType a
close forall a. Integral a => a -> a -> a
`mod` Line
3 forall a. Eq a => a -> a -> Bool
== Line
0 Bool -> Bool -> Bool
||
                     (forall a. ChunkType a -> Line
delimLength ChunkType a
open forall a. Num a => a -> a -> a
+ forall a. ChunkType a -> Line
delimLength ChunkType a
close) forall a. Integral a => a -> a -> a
`mod` Line
3 forall a. Eq a => a -> a -> Bool
/= Line
0
                else Bool
True) Bool -> Bool -> Bool
&&
    [Tok]
opents 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 :: forall a.
IsInline a =>
[BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets [BracketedSpec a]
bracketedSpecs ReferenceMap
rm [Chunk a]
xs =
  case 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 = forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (forall a. a -> Maybe a
Just Chunk a
z) (forall a. [a] -> [a]
reverse [Chunk a]
ys) [Chunk a]
zs
          in   forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                 DState{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
startcursor
                       , rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a)
startcursor
                       , refmap :: ReferenceMap
refmap = ReferenceMap
rm
                       , stackBottoms :: Map Text SourcePos
stackBottoms = forall a. Monoid a => a
mempty
                       , absoluteBottom :: SourcePos
absoluteBottom = forall a. Chunk a -> SourcePos
chunkPos Chunk a
z
                       }

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

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

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

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

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

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

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

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

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

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

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

                     in case [Chunk a] -> [Chunk a]
addMissing [Chunk a]
afterchunks of
                           []     -> forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                                      DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor forall a. Maybe a
Nothing
                                          (Chunk a
eltchunk forall a. a -> [a] -> [a]
: forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left') [] }
                           (Chunk a
y:[Chunk a]
ys) ->
                             let lbs :: [Chunk a]
lbs = forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left'
                             in forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs DState a
st{
                                  leftCursor :: Cursor (Chunk a)
leftCursor =
                                    forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (forall a. a -> Maybe a
Just Chunk a
eltchunk) [Chunk a]
lbs (Chunk a
yforall a. a -> [a] -> [a]
:[Chunk a]
ys)
                                , rightCursor :: Cursor (Chunk a)
rightCursor = forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote forall a b. (a -> b) -> a -> b
$
                                    forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (forall a. a -> Maybe a
Just Chunk a
y) (Chunk a
eltchunkforall 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 forall il. BracketedSpec il -> Bool
bracketedNests BracketedSpec a
spec
                                       then forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
                                       else forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall il. BracketedSpec il -> Text
bracketedName BracketedSpec a
spec)
                                            (forall a. Chunk a -> SourcePos
chunkPos Chunk a
opener)
                                            forall a b. (a -> b) -> a -> b
$ forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
                                }


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

       (Just Chunk a
_, Just (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } SourcePos
_ [Tok]
_))
          -> 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 = forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right }

       (Maybe (Chunk a)
_, Maybe (Chunk a)
_) -> forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
                DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = 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 :: forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote
  (Cursor (Just (Chunk d :: ChunkType a
d@Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'\'' } SourcePos
pos [Tok]
toks)) [Chunk a]
xs [Chunk a]
ys) =
  forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (forall a. a -> Maybe a
Just (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 :: forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm Text
key = do
  forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m LinkInfo
pInlineLink forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink ReferenceMap
rm Text
key

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

pLinkDestination :: Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination = forall {s}. ParsecT [Tok] s m [Tok]
pAngleDest forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {m :: * -> *} {u}.
Monad m =>
Line -> ParsecT [Tok] u m [Tok]
pNormalDest Line
0
  where
    pAngleDest :: ParsecT [Tok] s m [Tok]
pAngleDest = do
      Tok
_ <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'<'
      [Tok]
res <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (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] forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped)
      Tok
_ <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
      forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res

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

    pNormalDest' :: a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens
     | a
numparens forall a. Ord a => a -> a -> Bool
> a
32 = forall (m :: * -> *) a. MonadPlus m => m a
mzero
     | Bool
otherwise = (do
          Tok
t <- 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 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' <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Tok
t forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
asciiSymbol
              (Tok
t'forall a. a -> [a] -> [a]
:) 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
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' (a
numparens forall a. Num a => a -> a -> a
+ a
1)
            Tok (Symbol Char
')') SourcePos
_ Text
_ -> (Tok
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' (a
numparens forall a. Num a => a -> a -> a
- a
1)
            Tok
_                    -> (Tok
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens)
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
numparens forall a. Eq a => a -> a -> Bool
== a
0))

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

-- parses backslash + punctuation, but not backslashed newline
pEscapedSymbol :: Monad m => ParsecT [Tok] s m Tok
pEscapedSymbol :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscapedSymbol = do
  Tok
bs <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\\'
  forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Tok
bs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
asciiSymbol

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

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

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

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

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