{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
module Commonmark.Inlines
( mkInlineParser
, defaultInlineParser
, IPState
, InlineParser
, getReferenceMap
, FormattingSpec(..)
, defaultFormattingSpecs
, BracketedSpec(..)
, defaultBracketedSpecs
, imageSpec
, linkSpec
, pLinkLabel
, pLinkDestination
, pLinkTitle
, pEscaped
, processEmphasis
, processBrackets
, pBacktickSpan
, normalizeCodeSpan
, withAttributes
)
where
import Commonmark.Tag (htmlTag, Enders, defaultEnders)
import Commonmark.Tokens
import Commonmark.TokParsers
import Commonmark.ReferenceMap
import Commonmark.Types
import Control.Monad (guard, mzero)
import Control.Monad.Trans.State.Strict
import Data.List (foldl')
import Data.Char (isAscii, isLetter)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as M
import Data.Maybe (isJust, mapMaybe)
import qualified Data.Set as Set
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T
import Commonmark.Entity (unEntity, charEntity, numEntity)
import Text.Parsec hiding (State, space)
import Text.Parsec.Pos
mkInlineParser :: (Monad m, IsInline a)
=> [BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> [InlineParser m Attributes]
-> ReferenceMap
-> [Tok]
-> m (Either ParseError a)
mkInlineParser :: [BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> [InlineParser m Attributes]
-> ReferenceMap
-> [Tok]
-> m (Either ParseError a)
mkInlineParser [BracketedSpec a]
bracketedSpecs [FormattingSpec a]
formattingSpecs [InlineParser m a]
ilParsers [InlineParser m Attributes]
attrParsers ReferenceMap
rm [Tok]
toks = do
let iswhite :: Tok -> Bool
iswhite Tok
t = TokType -> Tok -> Bool
hasType TokType
Spaces Tok
t Bool -> Bool -> Bool
|| TokType -> Tok -> Bool
hasType TokType
LineEnd Tok
t
let attrParser :: InlineParser m Attributes
attrParser = [InlineParser m Attributes] -> InlineParser m Attributes
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [InlineParser m Attributes]
attrParsers
let toks' :: [Tok]
toks' = (Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Tok -> Bool
iswhite ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> [Tok]
forall a. [a] -> [a]
reverse ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Tok -> Bool
iswhite ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> [Tok]
forall a. [a] -> [a]
reverse ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok]
toks
Either ParseError [Chunk a]
res <- {-# SCC parseChunks #-} StateT Enders m (Either ParseError [Chunk a])
-> Enders -> m (Either ParseError [Chunk a])
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
([BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> InlineParser m Attributes
-> ReferenceMap
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
forall (m :: * -> *) a.
(Monad m, IsInline a) =>
[BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> InlineParser m Attributes
-> ReferenceMap
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
parseChunks [BracketedSpec a]
bracketedSpecs [FormattingSpec a]
formattingSpecs [InlineParser m a]
ilParsers
InlineParser m Attributes
attrParser ReferenceMap
rm [Tok]
toks') Enders
defaultEnders
Either ParseError a -> m (Either ParseError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError a -> m (Either ParseError a))
-> Either ParseError a -> m (Either ParseError a)
forall a b. (a -> b) -> a -> b
$!
case Either ParseError [Chunk a]
res of
Left ParseError
err -> ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
err
Right [Chunk a]
chunks ->
(a -> Either ParseError a
forall a b. b -> Either a b
Right (a -> Either ParseError a)
-> ([Chunk a] -> a) -> [Chunk a] -> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Chunk a] -> a
forall a. IsInline a => [Chunk a] -> a
unChunks ([Chunk a] -> a) -> ([Chunk a] -> [Chunk a]) -> [Chunk a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Chunk a] -> [Chunk a]
forall a. IsInline a => [Chunk a] -> [Chunk a]
processEmphasis ([Chunk a] -> [Chunk a])
-> ([Chunk a] -> [Chunk a]) -> [Chunk a] -> [Chunk a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
forall a.
IsInline a =>
[BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets [BracketedSpec a]
bracketedSpecs ReferenceMap
rm) [Chunk a]
chunks
defaultInlineParser :: (Monad m, IsInline a) => InlineParser m a
defaultInlineParser :: InlineParser m a
defaultInlineParser =
{-# SCC defaultInlineParser #-} InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
tok :: Tok
tok@(Tok TokType
toktype SourcePos
_ Text
t) <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
case TokType
toktype of
TokType
WordChars -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
TokType
LineEnd -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. IsInline a => a
softBreak
TokType
Spaces -> Int -> InlineParser m a
forall a (m :: * -> *) a s.
(Monad m, IsInline a, Num a, Ord a) =>
a -> ParsecT [Tok] s m a
doBreak (Text -> Int
T.length Text
t) InlineParser m a -> InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> a
forall a. IsInline a => Text -> a
str Text
t)
TokType
UnicodeSpace -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. IsInline a => Text -> a
str Text
t
Symbol Char
'\\' -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str Text
"\\") InlineParser m a
forall s. ParsecT [Tok] s (StateT Enders m) a
doEscape
Symbol Char
'`' -> Tok -> InlineParser m a
forall (m :: * -> *) b.
(Monad m, IsInline b) =>
Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) b
doCodeSpan Tok
tok
Symbol Char
'&' -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str Text
"&") InlineParser m a
forall s. ParsecT [Tok] s (StateT Enders m) a
doEntity
Symbol Char
'<' -> a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> a
forall a. IsInline a => Text -> a
str Text
"<") (InlineParser m a
doAutolink InlineParser m a -> InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Tok -> InlineParser m a
forall b (m :: * -> *) u.
(IsInline b, Monad m) =>
Tok -> ParsecT [Tok] u (StateT Enders m) b
doHtml Tok
tok)
TokType
_ -> InlineParser m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
doBreak :: a -> ParsecT [Tok] s m a
doBreak a
len
| a
len a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
2 = a
forall a. IsInline a => a
lineBreak a -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
LineEnd)
| Bool
otherwise = a
forall a. Monoid a => a
mempty a -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
LineEnd))
doEscape :: ParsecT [Tok] s (StateT Enders m) a
doEscape = do
Tok
tok <- (Tok -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok
(\case
Tok (Symbol Char
c) SourcePos
_ Text
_ -> Char -> Bool
isAscii Char
c
Tok TokType
LineEnd SourcePos
_ Text
_ -> Bool
True
Tok
_ -> Bool
False)
case Tok
tok of
Tok (Symbol Char
c) SourcePos
_ Text
_ -> a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] s (StateT Enders m) a)
-> a -> ParsecT [Tok] s (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$ Char -> a
forall a. IsInline a => Char -> a
escapedChar Char
c
Tok TokType
LineEnd SourcePos
_ Text
_ -> a -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. IsInline a => a
lineBreak
Tok
_ -> String -> ParsecT [Tok] s (StateT Enders m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Should not happen"
doEntity :: ParsecT [Tok] u (StateT Enders m) a
doEntity = do
[Tok]
ent <- ParsecT [Tok] u (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
numEntity ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u (StateT Enders m) [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
charEntity
a -> ParsecT [Tok] u (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> a
forall a. IsInline a => Text -> a
entity (Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
ent))
doAutolink :: InlineParser m a
doAutolink = InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
(Text
target, Text
lab) <- InlineParser m (Text, Text)
forall (m :: * -> *). Monad m => InlineParser m (Text, Text)
pUri InlineParser m (Text, Text)
-> InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> InlineParser m (Text, Text)
forall (m :: * -> *). Monad m => InlineParser m (Text, Text)
pEmail
Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> a -> a
forall a. IsInline a => Text -> Text -> a -> a
link Text
target Text
"" (Text -> a
forall a. IsInline a => Text -> a
str Text
lab)
doHtml :: Tok -> ParsecT [Tok] u (StateT Enders m) b
doHtml Tok
tok = Format -> Text -> b
forall a. IsInline a => Format -> Text -> a
rawInline (Text -> Format
Format Text
"html") (Text -> b) -> ([Tok] -> Text) -> [Tok] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Text) -> ([Tok] -> [Tok]) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok
tokTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> b)
-> ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT [Tok] u (StateT Enders m) [Tok]
-> ParsecT [Tok] u (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Tok] u (StateT Enders m) [Tok]
forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s (StateT Enders m) [Tok]
htmlTag
doCodeSpan :: Tok -> ParsecT [Tok] (IPState m) (StateT Enders m) b
doCodeSpan Tok
tok = Tok -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *).
Monad m =>
Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan Tok
tok InlineParser m (Either [Tok] [Tok])
-> (Either [Tok] [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\case
Left [Tok]
ticks -> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall a b. (a -> b) -> a -> b
$ Text -> b
forall a. IsInline a => Text -> a
str ([Tok] -> Text
untokenize [Tok]
ticks)
Right [Tok]
codetoks -> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> b -> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall a b. (a -> b) -> a -> b
$ Text -> b
forall a. IsInline a => Text -> a
code (Text -> b) -> ([Tok] -> Text) -> [Tok] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeCodeSpan (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> b) -> [Tok] -> b
forall a b. (a -> b) -> a -> b
$
[Tok]
codetoks
unChunks :: IsInline a => [Chunk a] -> a
unChunks :: [Chunk a] -> a
unChunks = {-# SCC unChunks #-} (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
forall a. Monoid a => a
mempty ([a] -> a) -> ([Chunk a] -> [a]) -> [Chunk a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk a] -> [a]
forall a. IsInline a => [Chunk a] -> [a]
go
where
go :: [Chunk a] -> [a]
go [] = []
go (Chunk a
c:[Chunk a]
cs) =
let (a -> a
f, [Chunk a]
rest) =
case [Chunk a]
cs of
(Chunk (AddAttributes attrs) _pos _ts : [Chunk a]
ds) ->
(Attributes -> a -> a
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs, [Chunk a]
ds)
[Chunk a]
_ -> (a -> a
forall a. a -> a
id, [Chunk a]
cs) in
case Chunk a -> ChunkType a
forall a. Chunk a -> ChunkType a
chunkType Chunk a
c of
AddAttributes Attributes
_ -> [Chunk a] -> [a]
go [Chunk a]
rest
Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
ch, delimSpec :: forall a. ChunkType a -> Maybe (FormattingSpec a)
delimSpec = Maybe (FormattingSpec a)
mbspec } -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Chunk a] -> [a]
go [Chunk a]
rest
where !x :: a
x = a -> a
f (SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged SourceRange
range (Text -> a
forall a. IsInline a => Text -> a
str Text
txt))
txt :: Text
txt = [Tok] -> Text
untokenize ([Tok] -> Text) -> [Tok] -> Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> [Tok]
alterToks ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall a b. (a -> b) -> a -> b
$ Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
c
alterToks :: [Tok] -> [Tok]
alterToks =
case FormattingSpec a -> Char
forall il. FormattingSpec il -> Char
formattingWhenUnmatched (FormattingSpec a -> Char)
-> Maybe (FormattingSpec a) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FormattingSpec a)
mbspec of
Just Char
ch' | Char
ch' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
ch ->
(Tok -> Tok) -> [Tok] -> [Tok]
forall a b. (a -> b) -> [a] -> [b]
map (\Tok
t -> Tok
t{ tokContents :: Text
tokContents =
(Char -> Char) -> Text -> Text
T.map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
ch') (Tok -> Text
tokContents Tok
t) })
Maybe Char
_ -> [Tok] -> [Tok]
forall a. a -> a
id
range :: SourceRange
range = [(SourcePos, SourcePos)] -> SourceRange
SourceRange
[(Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
c,
SourcePos -> Int -> SourcePos
incSourceColumn (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
c) (Text -> Int
T.length Text
txt))]
Parsed a
ils -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Chunk a] -> [a]
go [Chunk a]
rest
where !x :: a
x = a -> a
f a
ils
parseChunks :: (Monad m, IsInline a)
=> [BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> InlineParser m Attributes
-> ReferenceMap
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
parseChunks :: [BracketedSpec a]
-> [FormattingSpec a]
-> [InlineParser m a]
-> InlineParser m Attributes
-> ReferenceMap
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
parseChunks [BracketedSpec a]
bspecs [FormattingSpec a]
specs [InlineParser m a]
ilParsers InlineParser m Attributes
attrParser ReferenceMap
rm [Tok]
ts =
ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
-> IPState m
-> String
-> [Tok]
-> StateT Enders m (Either ParseError [Chunk a])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT
(do case [Tok]
ts of
Tok
t:[Tok]
_ -> SourcePos -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (Tok -> SourcePos
tokPos Tok
t)
[] -> () -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (Chunk a)
forall a (m :: * -> *).
(IsInline a, Monad m) =>
FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> InlineParser m (Chunk a)
pChunk FormattingSpecMap a
specmap InlineParser m Attributes
attrParser [InlineParser m a]
ilParsers Char -> Bool
isDelimChar) ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Chunk a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
IPState :: forall (m :: * -> *).
IntMap [SourcePos]
-> ReferenceMap
-> Map SourcePos TokType
-> InlineParser m Attributes
-> IPState m
IPState{ backtickSpans :: IntMap [SourcePos]
backtickSpans = [Tok] -> IntMap [SourcePos]
getBacktickSpans [Tok]
ts,
ipReferenceMap :: ReferenceMap
ipReferenceMap = ReferenceMap
rm,
precedingTokTypes :: Map SourcePos TokType
precedingTokTypes = Map SourcePos TokType
precedingTokTypeMap,
attributeParser :: InlineParser m Attributes
attributeParser = InlineParser m Attributes
attrParser }
String
"source" [Tok]
ts
where
isDelimChar :: Char -> Bool
isDelimChar = (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
delimcharset)
!delimcharset :: Set Char
delimcharset = String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList String
delimchars
delimchars :: String
delimchars = Char
'[' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
']' Char -> String -> String
forall a. a -> [a] -> [a]
: String
suffixchars String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
prefixchars String -> String -> String
forall a. [a] -> [a] -> [a]
++ FormattingSpecMap a -> String
forall k a. Map k a -> [k]
M.keys FormattingSpecMap a
specmap
specmap :: FormattingSpecMap a
specmap = [FormattingSpec a] -> FormattingSpecMap a
forall il. [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap [FormattingSpec a]
specs
prefixchars :: String
prefixchars = (BracketedSpec a -> Maybe Char) -> [BracketedSpec a] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix [BracketedSpec a]
bspecs
suffixchars :: String
suffixchars = (BracketedSpec a -> Maybe Char) -> [BracketedSpec a] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedSuffixEnd [BracketedSpec a]
bspecs
precedingTokTypeMap :: Map SourcePos TokType
precedingTokTypeMap = {-# SCC precedingTokTypeMap #-}(Map SourcePos TokType, TokType) -> Map SourcePos TokType
forall a b. (a, b) -> a
fst ((Map SourcePos TokType, TokType) -> Map SourcePos TokType)
-> (Map SourcePos TokType, TokType) -> Map SourcePos TokType
forall a b. (a -> b) -> a -> b
$! ((Map SourcePos TokType, TokType)
-> Tok -> (Map SourcePos TokType, TokType))
-> (Map SourcePos TokType, TokType)
-> [Tok]
-> (Map SourcePos TokType, TokType)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map SourcePos TokType, TokType)
-> Tok -> (Map SourcePos TokType, TokType)
forall a. (Map SourcePos a, a) -> Tok -> (Map SourcePos a, TokType)
go (Map SourcePos TokType
forall a. Monoid a => a
mempty, TokType
LineEnd) [Tok]
ts
go :: (Map SourcePos a, a) -> Tok -> (Map SourcePos a, TokType)
go (!Map SourcePos a
m, !a
prevTy) (Tok !TokType
ty !SourcePos
pos Text
_) =
case TokType
ty of
Symbol Char
c | Char -> Bool
isDelimChar Char
c -> (SourcePos -> a -> Map SourcePos a -> Map SourcePos a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SourcePos
pos a
prevTy Map SourcePos a
m, TokType
ty)
TokType
_ -> (Map SourcePos a
m, TokType
ty)
data Chunk a = Chunk
{ Chunk a -> ChunkType a
chunkType :: ChunkType a
, Chunk a -> SourcePos
chunkPos :: !SourcePos
, Chunk a -> [Tok]
chunkToks :: [Tok]
} deriving Int -> Chunk a -> String -> String
[Chunk a] -> String -> String
Chunk a -> String
(Int -> Chunk a -> String -> String)
-> (Chunk a -> String)
-> ([Chunk a] -> String -> String)
-> Show (Chunk a)
forall a. Show a => Int -> Chunk a -> String -> String
forall a. Show a => [Chunk a] -> String -> String
forall a. Show a => Chunk a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Chunk a] -> String -> String
$cshowList :: forall a. Show a => [Chunk a] -> String -> String
show :: Chunk a -> String
$cshow :: forall a. Show a => Chunk a -> String
showsPrec :: Int -> Chunk a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Chunk a -> String -> String
Show
data ChunkType a =
Delim{ ChunkType a -> Char
delimType :: !Char
, ChunkType a -> Bool
delimCanOpen :: !Bool
, ChunkType a -> Bool
delimCanClose :: !Bool
, ChunkType a -> Int
delimLength :: !Int
, ChunkType a -> Maybe (FormattingSpec a)
delimSpec :: Maybe (FormattingSpec a)
}
| Parsed a
| AddAttributes Attributes
deriving Int -> ChunkType a -> String -> String
[ChunkType a] -> String -> String
ChunkType a -> String
(Int -> ChunkType a -> String -> String)
-> (ChunkType a -> String)
-> ([ChunkType a] -> String -> String)
-> Show (ChunkType a)
forall a. Show a => Int -> ChunkType a -> String -> String
forall a. Show a => [ChunkType a] -> String -> String
forall a. Show a => ChunkType a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ChunkType a] -> String -> String
$cshowList :: forall a. Show a => [ChunkType a] -> String -> String
show :: ChunkType a -> String
$cshow :: forall a. Show a => ChunkType a -> String
showsPrec :: Int -> ChunkType a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> ChunkType a -> String -> String
Show
data IPState m = IPState
{ IPState m -> IntMap [SourcePos]
backtickSpans :: IntMap.IntMap [SourcePos]
, IPState m -> ReferenceMap
ipReferenceMap :: !ReferenceMap
, IPState m -> Map SourcePos TokType
precedingTokTypes :: M.Map SourcePos TokType
, IPState m -> InlineParser m Attributes
attributeParser :: InlineParser m Attributes
}
type InlineParser m = ParsecT [Tok] (IPState m) (StateT Enders m)
data FormattingSpec il = FormattingSpec
{ FormattingSpec il -> Char
formattingDelimChar :: !Char
, FormattingSpec il -> Bool
formattingIntraWord :: !Bool
, FormattingSpec il -> Bool
formattingIgnorePunctuation :: !Bool
, FormattingSpec il -> Maybe (il -> il)
formattingSingleMatch :: Maybe (il -> il)
, FormattingSpec il -> Maybe (il -> il)
formattingDoubleMatch :: Maybe (il -> il)
, FormattingSpec il -> Char
formattingWhenUnmatched :: !Char
}
instance Show (FormattingSpec il) where
show :: FormattingSpec il -> String
show FormattingSpec il
_ = String
"<FormattingSpec>"
type FormattingSpecMap il = M.Map Char (FormattingSpec il)
defaultFormattingSpecs :: IsInline il => [FormattingSpec il]
defaultFormattingSpecs :: [FormattingSpec il]
defaultFormattingSpecs =
[ Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
forall il.
Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
FormattingSpec Char
'*' Bool
True Bool
False ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
emph) ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
strong) Char
'*'
, Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
forall il.
Char
-> Bool
-> Bool
-> Maybe (il -> il)
-> Maybe (il -> il)
-> Char
-> FormattingSpec il
FormattingSpec Char
'_' Bool
False Bool
False ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
emph) ((il -> il) -> Maybe (il -> il)
forall a. a -> Maybe a
Just il -> il
forall a. IsInline a => a -> a
strong) Char
'_'
]
mkFormattingSpecMap :: [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap :: [FormattingSpec il] -> FormattingSpecMap il
mkFormattingSpecMap [FormattingSpec il]
fs = [(Char, FormattingSpec il)] -> FormattingSpecMap il
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FormattingSpec il -> Char
forall il. FormattingSpec il -> Char
formattingDelimChar FormattingSpec il
s, FormattingSpec il
s) | FormattingSpec il
s <- [FormattingSpec il]
fs]
data BracketedSpec il = BracketedSpec
{ BracketedSpec il -> Text
bracketedName :: !Text
, BracketedSpec il -> Bool
bracketedNests :: !Bool
, BracketedSpec il -> Maybe Char
bracketedPrefix :: Maybe Char
, BracketedSpec il -> Maybe Char
bracketedSuffixEnd :: Maybe Char
, BracketedSpec il
-> ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix :: ReferenceMap
-> Text
-> Parsec [Tok] () (il -> il)
}
instance Show (BracketedSpec il) where
show :: BracketedSpec il -> String
show BracketedSpec il
s = String
"<BracketedSpec " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (BracketedSpec il -> Text
forall il. BracketedSpec il -> Text
bracketedName BracketedSpec il
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
defaultBracketedSpecs :: IsInline il
=> [BracketedSpec il]
defaultBracketedSpecs :: [BracketedSpec il]
defaultBracketedSpecs =
[ BracketedSpec il
forall il. IsInline il => BracketedSpec il
imageSpec
, BracketedSpec il
forall il. IsInline il => BracketedSpec il
linkSpec
]
linkSpec :: IsInline il => BracketedSpec il
linkSpec :: BracketedSpec il
linkSpec = BracketedSpec :: forall il.
Text
-> Bool
-> Maybe Char
-> Maybe Char
-> (ReferenceMap -> Text -> Parsec [Tok] () (il -> il))
-> BracketedSpec il
BracketedSpec
{ bracketedName :: Text
bracketedName = Text
"Link"
, bracketedNests :: Bool
bracketedNests = Bool
False
, bracketedPrefix :: Maybe Char
bracketedPrefix = Maybe Char
forall a. Maybe a
Nothing
, bracketedSuffixEnd :: Maybe Char
bracketedSuffixEnd = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
')'
, bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix = ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
forall il s.
IsInline il =>
ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix
}
imageSpec :: IsInline il => BracketedSpec il
imageSpec :: BracketedSpec il
imageSpec = BracketedSpec :: forall il.
Text
-> Bool
-> Maybe Char
-> Maybe Char
-> (ReferenceMap -> Text -> Parsec [Tok] () (il -> il))
-> BracketedSpec il
BracketedSpec
{ bracketedName :: Text
bracketedName = Text
"Image"
, bracketedNests :: Bool
bracketedNests = Bool
True
, bracketedPrefix :: Maybe Char
bracketedPrefix = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'!'
, bracketedSuffixEnd :: Maybe Char
bracketedSuffixEnd = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
')'
, bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix = ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
forall il s.
IsInline il =>
ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pImageSuffix
}
pLinkSuffix :: IsInline il
=> ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix :: ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pLinkSuffix ReferenceMap
rm Text
key = do
LinkInfo Text
target Text
title Attributes
attrs <- ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm Text
key
(il -> il) -> Parsec [Tok] s (il -> il)
forall (m :: * -> *) a. Monad m => a -> m a
return ((il -> il) -> Parsec [Tok] s (il -> il))
-> (il -> il) -> Parsec [Tok] s (il -> il)
forall a b. (a -> b) -> a -> b
$! Attributes -> il -> il
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (il -> il) -> (il -> il) -> il -> il
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> il -> il
forall a. IsInline a => Text -> Text -> a -> a
link Text
target Text
title
pImageSuffix :: IsInline il
=> ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pImageSuffix :: ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
pImageSuffix ReferenceMap
rm Text
key = do
LinkInfo Text
target Text
title Attributes
attrs <- ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm Text
key
(il -> il) -> Parsec [Tok] s (il -> il)
forall (m :: * -> *) a. Monad m => a -> m a
return ((il -> il) -> Parsec [Tok] s (il -> il))
-> (il -> il) -> Parsec [Tok] s (il -> il)
forall a b. (a -> b) -> a -> b
$! Attributes -> il -> il
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (il -> il) -> (il -> il) -> il -> il
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> il -> il
forall a. IsInline a => Text -> Text -> a -> a
image Text
target Text
title
getBacktickSpans :: [Tok] -> IntMap.IntMap [SourcePos]
getBacktickSpans :: [Tok] -> IntMap [SourcePos]
getBacktickSpans = Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Int
0 (String -> SourcePos
initialPos String
"")
where
go :: Int -> SourcePos -> [Tok] -> IntMap.IntMap [SourcePos]
go :: Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Int
n SourcePos
pos []
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> [SourcePos] -> IntMap [SourcePos]
forall a. Int -> a -> IntMap a
IntMap.singleton Int
n [SourcePos
pos]
| Bool
otherwise = IntMap [SourcePos]
forall a. IntMap a
IntMap.empty
go Int
n SourcePos
pos (Tok
t:[Tok]
ts) =
case Tok -> TokType
tokType Tok
t of
Symbol Char
'`'
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SourcePos
pos [Tok]
ts
| Bool
otherwise -> Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Tok -> SourcePos
tokPos Tok
t) [Tok]
ts
TokType
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> (Maybe [SourcePos] -> Maybe [SourcePos])
-> Int -> IntMap [SourcePos] -> IntMap [SourcePos]
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter (\Maybe [SourcePos]
x ->
case Maybe [SourcePos]
x of
Maybe [SourcePos]
Nothing -> [SourcePos] -> Maybe [SourcePos]
forall a. a -> Maybe a
Just [SourcePos
pos]
Just [SourcePos]
ps -> [SourcePos] -> Maybe [SourcePos]
forall a. a -> Maybe a
Just (SourcePos
posSourcePos -> [SourcePos] -> [SourcePos]
forall a. a -> [a] -> [a]
:[SourcePos]
ps)) Int
n (IntMap [SourcePos] -> IntMap [SourcePos])
-> IntMap [SourcePos] -> IntMap [SourcePos]
forall a b. (a -> b) -> a -> b
$ Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Int
0 SourcePos
pos [Tok]
ts
| Bool
otherwise -> Int -> SourcePos -> [Tok] -> IntMap [SourcePos]
go Int
0 SourcePos
pos [Tok]
ts
pChunk :: (IsInline a, Monad m)
=> FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> InlineParser m (Chunk a)
pChunk :: FormattingSpecMap a
-> InlineParser m Attributes
-> [InlineParser m a]
-> (Char -> Bool)
-> InlineParser m (Chunk a)
pChunk FormattingSpecMap a
specmap InlineParser m Attributes
attrParser [InlineParser m a]
ilParsers Char -> Bool
isDelimChar =
do SourcePos
pos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(ChunkType a
res, [Tok]
ts) <- ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a, [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw (ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT
[Tok] (IPState m) (StateT Enders m) (ChunkType a, [Tok]))
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a, [Tok])
forall a b. (a -> b) -> a -> b
$
{-# SCC attrParser #-} (Attributes -> ChunkType a
forall a. Attributes -> ChunkType a
AddAttributes (Attributes -> ChunkType a)
-> InlineParser m Attributes
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineParser m Attributes
attrParser)
ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
{-# SCC pInline #-} (a -> ChunkType a
forall a. a -> ChunkType a
Parsed (a -> ChunkType a)
-> InlineParser m a
-> ParsecT [Tok] (IPState m) (StateT Enders m) (ChunkType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InlineParser m a] -> InlineParser m a
forall a (m :: * -> *).
(IsInline a, Monad m) =>
[InlineParser m a] -> InlineParser m a
pInline [InlineParser m a]
ilParsers)
Chunk a -> InlineParser m (Chunk a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> InlineParser m (Chunk a))
-> Chunk a -> InlineParser m (Chunk a)
forall a b. (a -> b) -> a -> b
$! ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk ChunkType a
res SourcePos
pos [Tok]
ts
InlineParser m (Chunk a)
-> InlineParser m (Chunk a) -> InlineParser m (Chunk a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> {-# SCC pDelimChunk #-} FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
forall a (m :: * -> *).
(IsInline a, Monad m) =>
FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
pDelimChunk FormattingSpecMap a
specmap Char -> Bool
isDelimChar
InlineParser m (Chunk a)
-> InlineParser m (Chunk a) -> InlineParser m (Chunk a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do Tok
t <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
SourcePos
endpos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Chunk a -> InlineParser m (Chunk a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> InlineParser m (Chunk a))
-> Chunk a -> InlineParser m (Chunk a)
forall a b. (a -> b) -> a -> b
$! ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk
(a -> ChunkType a
forall a. a -> ChunkType a
Parsed (a -> ChunkType a) -> a -> ChunkType a
forall a b. (a -> b) -> a -> b
$ SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged ([(SourcePos, SourcePos)] -> SourceRange
SourceRange [(Tok -> SourcePos
tokPos Tok
t,SourcePos
endpos)])
(Text -> a
forall a. IsInline a => Text -> a
str (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Tok -> Text
tokContents Tok
t))
(Tok -> SourcePos
tokPos Tok
t) [Tok
t])
pDelimChunk :: (IsInline a, Monad m)
=> FormattingSpecMap a
-> (Char -> Bool)
-> InlineParser m (Chunk a)
pDelimChunk :: FormattingSpecMap a -> (Char -> Bool) -> InlineParser m (Chunk a)
pDelimChunk FormattingSpecMap a
specmap Char -> Bool
isDelimChar = do
tok :: Tok
tok@(Tok (Symbol !Char
c) !SourcePos
pos Text
_) <-
(Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\case
Tok (Symbol Char
c) SourcePos
_ Text
_ -> Char -> Bool
isDelimChar Char
c
Tok
_ -> Bool
False)
let !mbspec :: Maybe (FormattingSpec a)
mbspec = Char -> FormattingSpecMap a -> Maybe (FormattingSpec a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
c FormattingSpecMap a
specmap
[Tok]
more <- if Maybe (FormattingSpec a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (FormattingSpec a)
mbspec
then ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c
else [Tok] -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return []
let toks :: [Tok]
toks = Tok
tokTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
more
IPState m
st <- ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
TokType
next <- TokType
-> ParsecT [Tok] (IPState m) (StateT Enders m) TokType
-> ParsecT [Tok] (IPState m) (StateT Enders m) TokType
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option TokType
LineEnd (Tok -> TokType
tokType (Tok -> TokType)
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) TokType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok)
let precedingTokType :: Maybe TokType
precedingTokType = SourcePos -> Map SourcePos TokType -> Maybe TokType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SourcePos
pos (IPState m -> Map SourcePos TokType
forall (m :: * -> *). IPState m -> Map SourcePos TokType
precedingTokTypes IPState m
st)
let precededByWhitespace :: Bool
precededByWhitespace = case Maybe TokType
precedingTokType of
Just TokType
Spaces -> Bool
True
Just TokType
UnicodeSpace -> Bool
True
Just TokType
LineEnd -> Bool
True
Maybe TokType
_ -> Bool
False
let precededByPunctuation :: Bool
precededByPunctuation =
case FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIgnorePunctuation (FormattingSpec a -> Bool)
-> Maybe (FormattingSpec a) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FormattingSpec a)
mbspec of
Just Bool
True -> Bool
False
Maybe Bool
_ -> case Maybe TokType
precedingTokType of
Just (Symbol Char
_) -> Bool
True
Maybe TokType
_ -> Bool
False
let followedByWhitespace :: Bool
followedByWhitespace = TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
Spaces Bool -> Bool -> Bool
||
TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
LineEnd Bool -> Bool -> Bool
||
TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
UnicodeSpace
let followedByPunctuation :: Bool
followedByPunctuation =
case FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIgnorePunctuation (FormattingSpec a -> Bool)
-> Maybe (FormattingSpec a) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FormattingSpec a)
mbspec of
Just Bool
True -> Bool
False
Maybe Bool
_ -> Bool -> Bool
not Bool
followedByWhitespace Bool -> Bool -> Bool
&& TokType
next TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
/= TokType
WordChars
let leftFlanking :: Bool
leftFlanking = Bool -> Bool
not Bool
followedByWhitespace Bool -> Bool -> Bool
&&
(Bool -> Bool
not Bool
followedByPunctuation Bool -> Bool -> Bool
||
Bool
precededByWhitespace Bool -> Bool -> Bool
||
Bool
precededByPunctuation)
let rightFlanking :: Bool
rightFlanking = Bool -> Bool
not Bool
precededByWhitespace Bool -> Bool -> Bool
&&
(Bool -> Bool
not Bool
precededByPunctuation Bool -> Bool -> Bool
||
Bool
followedByWhitespace Bool -> Bool -> Bool
||
Bool
followedByPunctuation)
let !canOpen :: Bool
canOpen =
Bool
leftFlanking Bool -> Bool -> Bool
&&
(Bool
-> (FormattingSpec a -> Bool) -> Maybe (FormattingSpec a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIntraWord Maybe (FormattingSpec a)
mbspec Bool -> Bool -> Bool
||
Bool -> Bool
not Bool
rightFlanking Bool -> Bool -> Bool
||
Bool
precededByPunctuation)
let !canClose :: Bool
canClose =
Bool
rightFlanking Bool -> Bool -> Bool
&&
(Bool
-> (FormattingSpec a -> Bool) -> Maybe (FormattingSpec a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True FormattingSpec a -> Bool
forall il. FormattingSpec il -> Bool
formattingIntraWord Maybe (FormattingSpec a)
mbspec Bool -> Bool -> Bool
||
Bool -> Bool
not Bool
leftFlanking Bool -> Bool -> Bool
||
Bool
followedByPunctuation)
let !len :: Int
len = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
toks
Chunk a -> InlineParser m (Chunk a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk a -> InlineParser m (Chunk a))
-> Chunk a -> InlineParser m (Chunk a)
forall a b. (a -> b) -> a -> b
$! ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk Delim :: forall a.
Char
-> Bool -> Bool -> Int -> Maybe (FormattingSpec a) -> ChunkType a
Delim{ delimType :: Char
delimType = Char
c
, delimCanOpen :: Bool
delimCanOpen = Bool
canOpen
, delimCanClose :: Bool
delimCanClose = Bool
canClose
, delimSpec :: Maybe (FormattingSpec a)
delimSpec = Maybe (FormattingSpec a)
mbspec
, delimLength :: Int
delimLength = Int
len
} SourcePos
pos [Tok]
toks
withAttributes :: (IsInline a, Monad m) => InlineParser m a -> InlineParser m a
withAttributes :: InlineParser m a -> InlineParser m a
withAttributes InlineParser m a
p = do
a
x <- InlineParser m a
p
InlineParser m Attributes
attrParser <- IPState m -> InlineParser m Attributes
forall (m :: * -> *). IPState m -> InlineParser m Attributes
attributeParser (IPState m -> InlineParser m Attributes)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
-> ParsecT
[Tok] (IPState m) (StateT Enders m) (InlineParser m Attributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
a -> InlineParser m a -> InlineParser m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
x (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ (\Attributes
attr -> Attributes -> a -> a
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attr a
x) (Attributes -> a) -> InlineParser m Attributes -> InlineParser m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineParser m Attributes
attrParser
pInline :: (IsInline a, Monad m)
=> [InlineParser m a]
-> InlineParser m a
pInline :: [InlineParser m a] -> InlineParser m a
pInline [InlineParser m a]
ilParsers =
[a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) [a]
-> InlineParser m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineParser m a -> ParsecT [Tok] (IPState m) (StateT Enders m) [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 InlineParser m a
oneInline
where
oneInline :: InlineParser m a
oneInline = InlineParser m a -> InlineParser m a
forall a (m :: * -> *).
(IsInline a, Monad m) =>
InlineParser m a -> InlineParser m a
withAttributes (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$ do
[Tok]
toks <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
a
res <- [InlineParser m a] -> InlineParser m a
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [InlineParser m a]
ilParsers
SourcePos
endpos <- ParsecT [Tok] (IPState m) (StateT Enders m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
let range :: SourceRange
range = [Tok] -> SourcePos -> SourceRange
rangeFromToks
((Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
endpos) (SourcePos -> Bool) -> (Tok -> SourcePos) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> SourcePos
tokPos) [Tok]
toks) SourcePos
endpos
a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$! SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged SourceRange
range a
res
rangeFromToks :: [Tok] -> SourcePos -> SourceRange
rangeFromToks :: [Tok] -> SourcePos -> SourceRange
rangeFromToks [] SourcePos
_ = [(SourcePos, SourcePos)] -> SourceRange
SourceRange [(SourcePos, SourcePos)]
forall a. Monoid a => a
mempty
rangeFromToks (!Tok
z:[Tok]
zs) !SourcePos
endpos
| SourcePos -> Int
sourceLine (Tok -> SourcePos
tokPos Tok
z) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
sourceLine SourcePos
endpos
= [(SourcePos, SourcePos)] -> SourceRange
SourceRange [(Tok -> SourcePos
tokPos Tok
z, SourcePos
endpos)]
| Bool
otherwise
= [(SourcePos, SourcePos)] -> SourceRange
SourceRange ([(SourcePos, SourcePos)] -> SourceRange)
-> [(SourcePos, SourcePos)] -> SourceRange
forall a b. (a -> b) -> a -> b
$ [Tok] -> [(SourcePos, SourcePos)]
go (Tok
zTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
zs)
where
go :: [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ts =
case (Tok -> Bool) -> [Tok] -> ([Tok], [Tok])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (TokType -> Tok -> Bool
hasType TokType
LineEnd) [Tok]
ts of
([], []) -> []
([], Tok
_:[Tok]
ys) -> [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ys
(!Tok
x:[Tok]
_, []) -> [(Tok -> SourcePos
tokPos Tok
x, SourcePos
endpos)]
(!Tok
x:[Tok]
_, !Tok
y:[Tok]
ys) ->
case [Tok]
ys of
(Tok TokType
_ !SourcePos
pos Text
_ : [Tok]
_) | SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> [Tok] -> [(SourcePos, SourcePos)]
go (Tok
xTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
ys)
[Tok]
_ -> (Tok -> SourcePos
tokPos Tok
x, Tok -> SourcePos
tokPos Tok
y) (SourcePos, SourcePos)
-> [(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)]
forall a. a -> [a] -> [a]
: [Tok] -> [(SourcePos, SourcePos)]
go [Tok]
ys
getReferenceMap :: Monad m => InlineParser m ReferenceMap
getReferenceMap :: InlineParser m ReferenceMap
getReferenceMap = IPState m -> ReferenceMap
forall (m :: * -> *). IPState m -> ReferenceMap
ipReferenceMap (IPState m -> ReferenceMap)
-> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
-> InlineParser m ReferenceMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
pBacktickSpan :: Monad m
=> Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan :: Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan Tok
tok = do
[Tok]
ts <- (Tok
tokTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'`')
let numticks :: Int
numticks = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts
IPState m
st' <- ParsecT [Tok] (IPState m) (StateT Enders m) (IPState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case (SourcePos -> Bool) -> [SourcePos] -> [SourcePos]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
<= Tok -> SourcePos
tokPos Tok
tok) ([SourcePos] -> [SourcePos])
-> Maybe [SourcePos] -> Maybe [SourcePos]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap [SourcePos] -> Maybe [SourcePos]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
numticks (IPState m -> IntMap [SourcePos]
forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans IPState m
st') of
Just (SourcePos
pos'':[SourcePos]
ps) -> do
[Tok]
codetoks <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\Tok
tok' -> Tok -> SourcePos
tokPos Tok
tok' SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
pos'')
[Tok]
backticks <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'`'))
Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
backticks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numticks
(IPState m -> IPState m)
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((IPState m -> IPState m)
-> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> (IPState m -> IPState m)
-> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ \IPState m
st ->
IPState m
st{ backtickSpans :: IntMap [SourcePos]
backtickSpans = Int -> [SourcePos] -> IntMap [SourcePos] -> IntMap [SourcePos]
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
numticks [SourcePos]
ps (IPState m -> IntMap [SourcePos]
forall (m :: * -> *). IPState m -> IntMap [SourcePos]
backtickSpans IPState m
st) }
Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok]))
-> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Either [Tok] [Tok]
forall a b. b -> Either a b
Right [Tok]
codetoks
Maybe [SourcePos]
_ -> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok]))
-> Either [Tok] [Tok] -> InlineParser m (Either [Tok] [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Either [Tok] [Tok]
forall a b. a -> Either a b
Left [Tok]
ts
normalizeCodeSpan :: Text -> Text
normalizeCodeSpan :: Text -> Text
normalizeCodeSpan = Text -> Text
removeSurroundingSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
nltosp
where
nltosp :: Char -> Char
nltosp Char
'\n' = Char
' '
nltosp Char
c = Char
c
removeSurroundingSpace :: Text -> Text
removeSurroundingSpace Text
s
| Bool -> Bool
not (Text -> Bool
T.null Text
s)
, Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
s)
, Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
, Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.dropEnd Int
1 Text
s
| Bool
otherwise = Text
s
pUri :: Monad m => InlineParser m (Text, Text)
pUri :: InlineParser m (Text, Text)
pUri = InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m (Text, Text) -> InlineParser m (Text, Text))
-> InlineParser m (Text, Text) -> InlineParser m (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
Text
s <- InlineParser m Text
forall (m :: * -> *). Monad m => InlineParser m Text
pScheme
Tok
_ <- Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':'
let isURITok :: Tok -> Bool
isURITok Tok
t =
case Tok -> TokType
tokType Tok
t of
TokType
Spaces -> Bool
False
TokType
LineEnd -> Bool
False
(Symbol Char
c) -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>'
TokType
_ -> Bool
True
[Tok]
ts <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
isURITok
let uri :: Text
uri = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
ts
(Text, Text) -> InlineParser m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
uri, Text
uri)
pScheme :: Monad m => InlineParser m Text
pScheme :: InlineParser m Text
pScheme = do
Tok
t <- (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> Bool
False
Just (Char
c,Text
rest) -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
rest)
[Tok]
ts <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ [TokType] -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
oneOfToks [TokType
WordChars, Char -> TokType
Symbol Char
'+', Char -> TokType
Symbol Char
'.', Char -> TokType
Symbol Char
'-']
let s :: Text
s = [Tok] -> Text
untokenize (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
ts)
let len :: Int
len = Text -> Int
T.length Text
s
Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ())
-> Bool -> ParsecT [Tok] (IPState m) (StateT Enders m) ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32
Text -> InlineParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
pEmail :: Monad m => InlineParser m (Text, Text)
pEmail :: InlineParser m (Text, Text)
pEmail = do
let isEmailSymbolTok :: Tok -> Bool
isEmailSymbolTok (Tok (Symbol Char
c) SourcePos
_ Text
_) =
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'^' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']'
isEmailSymbolTok Tok
_ = Bool
False
[Tok]
name <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii)
ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Tok -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
isEmailSymbolTok
Tok
_ <- Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'@'
let domainPart :: ParsecT [Tok] s (StateT Enders m) [Tok]
domainPart = do
Tok
x <- (Text -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii)
[Tok]
xs <- ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok])
-> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$ (Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
-> ParsecT [Tok] s (StateT Enders m) Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.'))
ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) Tok
-> ParsecT [Tok] s (StateT Enders m) Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Bool) -> ParsecT [Tok] s (StateT Enders m) Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii)
[Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok])
-> [Tok] -> ParsecT [Tok] s (StateT Enders m) [Tok]
forall a b. (a -> b) -> a -> b
$! (Tok
xTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[Tok]
xs)
[Tok]
d <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s. ParsecT [Tok] s (StateT Enders m) [Tok]
domainPart
[[Tok]]
ds <- ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) [[Tok]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.' ParsecT [Tok] (IPState m) (StateT Enders m) Tok
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
-> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
forall s. ParsecT [Tok] s (StateT Enders m) [Tok]
domainPart)
let addr :: Text
addr = [Tok] -> Text
untokenize [Tok]
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"." (([Tok] -> Text) -> [[Tok]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Tok] -> Text
untokenize ([Tok]
d[Tok] -> [[Tok]] -> [[Tok]]
forall a. a -> [a] -> [a]
:[[Tok]]
ds))
(Text, Text) -> InlineParser m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
addr, Text
addr)
data DState a = DState
{ DState a -> Cursor (Chunk a)
leftCursor :: Cursor (Chunk a)
, DState a -> Cursor (Chunk a)
rightCursor :: Cursor (Chunk a)
, DState a -> ReferenceMap
refmap :: ReferenceMap
, DState a -> Map Text SourcePos
stackBottoms :: M.Map Text SourcePos
, DState a -> SourcePos
absoluteBottom :: SourcePos
}
processEmphasis :: IsInline a => [Chunk a] -> [Chunk a]
processEmphasis :: [Chunk a] -> [Chunk a]
processEmphasis [Chunk a]
xs =
case (Chunk a -> Bool) -> [Chunk a] -> ([Chunk a], [Chunk a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\case
(Chunk Delim{ delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
True } SourcePos
_ [Tok]
_) -> Bool
True
Chunk a
_ -> Bool
False) [Chunk a]
xs of
([Chunk a]
_,[]) -> [Chunk a]
xs
([Chunk a]
ys,Chunk a
z:[Chunk a]
zs) ->
let startcursor :: Cursor (Chunk a)
startcursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
z) ([Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse [Chunk a]
ys) [Chunk a]
zs
in DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm DState :: forall a.
Cursor (Chunk a)
-> Cursor (Chunk a)
-> ReferenceMap
-> Map Text SourcePos
-> SourcePos
-> DState a
DState{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
startcursor
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a)
startcursor
, refmap :: ReferenceMap
refmap = ReferenceMap
emptyReferenceMap
, stackBottoms :: Map Text SourcePos
stackBottoms = Map Text SourcePos
forall a. Monoid a => a
mempty
, absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
z }
processEm :: IsInline a => DState a -> [Chunk a]
processEm :: DState a -> [Chunk a]
processEm DState a
st =
let left :: Cursor (Chunk a)
left = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
leftCursor DState a
st
right :: Cursor (Chunk a)
right = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st
bottoms :: Map Text SourcePos
bottoms = DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
in {-# SCC processEm #-} case
(Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
left, Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
right) of
(Maybe (Chunk a)
_, Maybe (Chunk a)
Nothing) -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse ([Chunk a] -> [Chunk a]) -> [Chunk a] -> [Chunk a]
forall a b. (a -> b) -> a -> b
$
case Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st) of
Maybe (Chunk a)
Nothing -> Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)
Just Chunk a
c -> Chunk a
c Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
: Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)
(Maybe (Chunk a)
Nothing, Just (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c
, delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True } SourcePos
pos [Tok]
ts)) ->
DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
right
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
, stackBottoms :: Map Text SourcePos
stackBottoms = Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
(String -> Text
T.pack (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3))) SourcePos
pos
(Map Text SourcePos -> Map Text SourcePos)
-> Map Text SourcePos -> Map Text SourcePos
forall a b. (a -> b) -> a -> b
$ DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
}
(Maybe (Chunk a)
Nothing, Just Chunk a
_) -> DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
right
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
}
(Just Chunk a
chunk, Just closedelim :: Chunk a
closedelim@(Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c,
delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True,
delimSpec :: forall a. ChunkType a -> Maybe (FormattingSpec a)
delimSpec = Just FormattingSpec a
spec}
SourcePos
closePos [Tok]
ts))
| Chunk a -> Chunk a -> Bool
forall a. IsInline a => Chunk a -> Chunk a -> Bool
delimsMatch Chunk a
chunk Chunk a
closedelim ->
let closelen :: Int
closelen = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts
opendelim :: Chunk a
opendelim = Chunk a
chunk
contents :: [Chunk a]
contents = (Chunk a -> Bool) -> [Chunk a] -> [Chunk a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Chunk a
ch -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
ch SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
/= SourcePos
closePos)
(Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
left)
openlen :: Int
openlen = [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
opendelim)
fallbackConstructor :: a -> a
fallbackConstructor a
x = Text -> a
forall a. IsInline a => Text -> a
str (Char -> Text
T.singleton Char
c) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
Text -> a
forall a. IsInline a => Text -> a
str (Char -> Text
T.singleton Char
c)
(a -> a
constructor, Int
numtoks) =
case (FormattingSpec a -> Maybe (a -> a)
forall il. FormattingSpec il -> Maybe (il -> il)
formattingSingleMatch FormattingSpec a
spec, FormattingSpec a -> Maybe (a -> a)
forall il. FormattingSpec il -> Maybe (il -> il)
formattingDoubleMatch FormattingSpec a
spec) of
(Maybe (a -> a)
_, Just a -> a
c2)
| Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
openlen Int
closelen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 -> (a -> a
c2, Int
2)
(Just a -> a
c1, Maybe (a -> a)
_) -> (a -> a
c1, Int
1)
(Maybe (a -> a), Maybe (a -> a))
_ -> (a -> a
forall a. IsInline a => a -> a
fallbackConstructor, Int
1)
([Tok]
openrest, [Tok]
opentoks) =
Int -> [Tok] -> ([Tok], [Tok])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
openlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numtoks) (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
opendelim)
([Tok]
closetoks, [Tok]
closerest) =
Int -> [Tok] -> ([Tok], [Tok])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
numtoks (Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks Chunk a
closedelim)
addnewopen :: [Chunk a] -> [Chunk a]
addnewopen = if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
openrest
then [Chunk a] -> [Chunk a]
forall a. a -> a
id
else (Chunk a
opendelim{ chunkToks :: [Tok]
chunkToks = [Tok]
openrest } Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)
addnewclose :: [Chunk a] -> [Chunk a]
addnewclose = if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
closerest
then [Chunk a] -> [Chunk a]
forall a. a -> a
id
else (Chunk a
closedelim{ chunkToks :: [Tok]
chunkToks = [Tok]
closerest } Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)
emphtoks :: [Tok]
emphtoks = [Tok]
opentoks [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ (Chunk a -> [Tok]) -> [Chunk a] -> [Tok]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks [Chunk a]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
closetoks
newelt :: Chunk a
newelt = ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk
(a -> ChunkType a
forall a. a -> ChunkType a
Parsed (a -> ChunkType a) -> a -> ChunkType a
forall a b. (a -> b) -> a -> b
$
SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged ([Tok] -> SourcePos -> SourceRange
rangeFromToks [Tok]
emphtoks
(SourcePos -> Int -> SourcePos
incSourceColumn (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
closedelim)
Int
numtoks)) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
a -> a
constructor (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [Chunk a] -> a
forall a. IsInline a => [Chunk a] -> a
unChunks [Chunk a]
contents)
(Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk)
[Tok]
emphtoks
newcursor :: Cursor (Chunk a)
newcursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
newelt)
([Chunk a] -> [Chunk a]
addnewopen (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left))
([Chunk a] -> [Chunk a]
addnewclose (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
right))
in DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
newcursor
, leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
newcursor
}
| SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just (Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk) Maybe SourcePos -> Maybe SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
<=
Text -> Map Text SourcePos -> Maybe SourcePos
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> Text
T.pack (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3))) Map Text SourcePos
bottoms ->
DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
right
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
, stackBottoms :: Map Text SourcePos
stackBottoms = Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
(String -> Text
T.pack (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3)))
(Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
closedelim)
(Map Text SourcePos -> Map Text SourcePos)
-> Map Text SourcePos -> Map Text SourcePos
forall a b. (a -> b) -> a -> b
$ DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
}
| Bool
otherwise -> DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left }
(Maybe (Chunk a), Maybe (Chunk a))
_ -> DState a -> [Chunk a]
forall a. IsInline a => DState a -> [Chunk a]
processEm
DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
, leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
left }
delimsMatch :: IsInline a
=> Chunk a -> Chunk a -> Bool
delimsMatch :: Chunk a -> Chunk a -> Bool
delimsMatch (Chunk open :: ChunkType a
open@Delim{} SourcePos
_ [Tok]
opents) (Chunk close :: ChunkType a
close@Delim{} SourcePos
_ [Tok]
closets) =
ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
open Bool -> Bool -> Bool
&& ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanClose ChunkType a
close Bool -> Bool -> Bool
&&
(ChunkType a -> Char
forall a. ChunkType a -> Char
delimType ChunkType a
open Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkType a -> Char
forall a. ChunkType a -> Char
delimType ChunkType a
close Bool -> Bool -> Bool
&&
if (ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
open Bool -> Bool -> Bool
&& ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanClose ChunkType a
open) Bool -> Bool -> Bool
||
(ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanOpen ChunkType a
close Bool -> Bool -> Bool
&& ChunkType a -> Bool
forall a. ChunkType a -> Bool
delimCanClose ChunkType a
close)
then ChunkType a -> Int
forall a. ChunkType a -> Int
delimLength ChunkType a
close Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
||
(ChunkType a -> Int
forall a. ChunkType a -> Int
delimLength ChunkType a
open Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ChunkType a -> Int
forall a. ChunkType a -> Int
delimLength ChunkType a
close) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
else Bool
True) Bool -> Bool -> Bool
&&
[Tok]
opents [Tok] -> [Tok] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Tok]
closets
delimsMatch Chunk a
_ Chunk a
_ = Bool
False
processBrackets :: IsInline a
=> [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets :: [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]
processBrackets [BracketedSpec a]
bracketedSpecs ReferenceMap
rm [Chunk a]
xs =
case (Chunk a -> Bool) -> [Chunk a] -> ([Chunk a], [Chunk a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\case
(Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } SourcePos
_ [Tok]
_) -> Bool
True
Chunk a
_ -> Bool
False) [Chunk a]
xs of
([Chunk a]
_,[]) -> [Chunk a]
xs
([Chunk a]
ys,Chunk a
z:[Chunk a]
zs) ->
let startcursor :: Cursor (Chunk a)
startcursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
z) ([Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse [Chunk a]
ys) [Chunk a]
zs
in [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
DState :: forall a.
Cursor (Chunk a)
-> Cursor (Chunk a)
-> ReferenceMap
-> Map Text SourcePos
-> SourcePos
-> DState a
DState{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
startcursor
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a)
startcursor
, refmap :: ReferenceMap
refmap = ReferenceMap
rm
, stackBottoms :: Map Text SourcePos
stackBottoms = Map Text SourcePos
forall a. Monoid a => a
mempty
, absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
z
}
data Cursor a = Cursor
{ Cursor a -> Maybe a
center :: Maybe a
, Cursor a -> [a]
befores :: [a]
, Cursor a -> [a]
afters :: [a]
}
deriving Int -> Cursor a -> String -> String
[Cursor a] -> String -> String
Cursor a -> String
(Int -> Cursor a -> String -> String)
-> (Cursor a -> String)
-> ([Cursor a] -> String -> String)
-> Show (Cursor a)
forall a. Show a => Int -> Cursor a -> String -> String
forall a. Show a => [Cursor a] -> String -> String
forall a. Show a => Cursor a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cursor a] -> String -> String
$cshowList :: forall a. Show a => [Cursor a] -> String -> String
show :: Cursor a -> String
$cshow :: forall a. Show a => Cursor a -> String
showsPrec :: Int -> Cursor a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Cursor a -> String -> String
Show
moveLeft :: Cursor a -> Cursor a
moveLeft :: Cursor a -> Cursor a
moveLeft (Cursor Maybe a
Nothing [] [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing [] [a]
zs
moveLeft (Cursor Maybe a
Nothing (a
x:[a]
xs) [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [a]
xs [a]
zs
moveLeft (Cursor (Just a
x) [] [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing [] (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs)
moveLeft (Cursor (Just a
x) (a
y:[a]
ys) [a]
zs) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
y) [a]
ys (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs)
{-# INLINE moveLeft #-}
moveRight :: Cursor a -> Cursor a
moveRight :: Cursor a -> Cursor a
moveRight (Cursor Maybe a
Nothing [a]
zs []) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing [a]
zs []
moveRight (Cursor Maybe a
Nothing [a]
zs (a
x:[a]
xs)) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [a]
zs [a]
xs
moveRight (Cursor (Just a
x) [a]
zs []) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe a
forall a. Maybe a
Nothing (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) []
moveRight (Cursor (Just a
x) [a]
zs (a
y:[a]
ys)) = Maybe a -> [a] -> [a] -> Cursor a
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (a -> Maybe a
forall a. a -> Maybe a
Just a
y) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) [a]
ys
{-# INLINE moveRight #-}
processBs :: IsInline a
=> [BracketedSpec a] -> DState a -> [Chunk a]
processBs :: [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs DState a
st =
let left :: Cursor (Chunk a)
left = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
leftCursor DState a
st
right :: Cursor (Chunk a)
right = DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st
bottoms :: Map Text SourcePos
bottoms = DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
bottom :: SourcePos
bottom = DState a -> SourcePos
forall a. DState a -> SourcePos
absoluteBottom DState a
st
in {-# SCC processBs #-} case (Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
left, Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
right) of
(Maybe (Chunk a)
_, Maybe (Chunk a)
Nothing) -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a]
reverse ([Chunk a] -> [Chunk a]) -> [Chunk a] -> [Chunk a]
forall a b. (a -> b) -> a -> b
$
case Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st) of
Maybe (Chunk a)
Nothing -> Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)
Just Chunk a
c -> Chunk a
c Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
: Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st)
(Maybe (Chunk a)
Nothing, Just Chunk a
chunk) ->
[BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
, absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk
}
(Just Chunk a
chunk, Just Chunk a
chunk')
| Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
bottom ->
[BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
DState a
st { leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right
, absoluteBottom :: SourcePos
absoluteBottom = Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
chunk'
}
(Just opener :: Chunk a
opener@(Chunk Delim{ delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
True, delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } SourcePos
_ [Tok]
_),
Just closer :: Chunk a
closer@(Chunk Delim{ delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True, delimType :: forall a. ChunkType a -> Char
delimType = Char
']'} SourcePos
closePos [Tok]
_)) ->
let chunksinside :: [Chunk a]
chunksinside = (Chunk a -> Bool) -> [Chunk a] -> [Chunk a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Chunk a
ch -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
ch SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
/= SourcePos
closePos)
(Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
left)
isBracket :: Chunk a -> Bool
isBracket (Chunk Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
c' } SourcePos
_ [Tok]
_) =
Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
|| Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']'
isBracket Chunk a
_ = Bool
False
key :: Text
key = if (Chunk a -> Bool) -> [Chunk a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Chunk a -> Bool
forall a. Chunk a -> Bool
isBracket [Chunk a]
chunksinside
then Text
""
else
case [Tok] -> Text
untokenize ((Chunk a -> [Tok]) -> [Chunk a] -> [Tok]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks [Chunk a]
chunksinside) of
Text
ks | Text -> Int
T.length Text
ks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
999 -> Text
ks
Text
_ -> Text
""
prefixChar :: Maybe Char
prefixChar = case Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left of
Chunk Delim{delimType :: forall a. ChunkType a -> Char
delimType = Char
c} SourcePos
_ [Tok
_] : [Chunk a]
_
-> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
[Chunk a]
_ -> Maybe Char
forall a. Maybe a
Nothing
rm :: ReferenceMap
rm = DState a -> ReferenceMap
forall a. DState a -> ReferenceMap
refmap DState a
st
specs :: [BracketedSpec a]
specs = [BracketedSpec a
s | BracketedSpec a
s <- [BracketedSpec a]
bracketedSpecs
, case BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix BracketedSpec a
s of
Just Char
c -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Char
prefixChar
Maybe Char
Nothing -> Bool
True
, Bool -> (SourcePos -> Bool) -> Maybe SourcePos -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
opener)
(Text -> Map Text SourcePos -> Maybe SourcePos
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (BracketedSpec a -> Text
forall il. BracketedSpec il -> Text
bracketedName BracketedSpec a
s) Map Text SourcePos
bottoms) ]
suffixToks :: [Tok]
suffixToks = [[Tok]] -> [Tok]
forall a. Monoid a => [a] -> a
mconcat ((Chunk a -> [Tok]) -> [Chunk a] -> [[Tok]]
forall a b. (a -> b) -> [a] -> [b]
map Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks (Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
right))
suffixPos :: SourcePos
suffixPos = SourcePos -> Int -> SourcePos
incSourceColumn SourcePos
closePos Int
1
in case Parsec [Tok] () ((BracketedSpec a, a -> a, SourcePos), [Tok])
-> String
-> [Tok]
-> Either ParseError ((BracketedSpec a, a -> a, SourcePos), [Tok])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse
(ParsecT [Tok] () Identity (BracketedSpec a, a -> a, SourcePos)
-> Parsec [Tok] () ((BracketedSpec a, a -> a, SourcePos), [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw
(do SourcePos -> ParsecT [Tok] () Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
suffixPos
(BracketedSpec a
spec, a -> a
constructor) <- [ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a))
-> [ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a)
forall a b. (a -> b) -> a -> b
$
(BracketedSpec a
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a))
-> [BracketedSpec a]
-> [ParsecT [Tok] () Identity (BracketedSpec a, a -> a)]
forall a b. (a -> b) -> [a] -> [b]
map (\BracketedSpec a
s -> (BracketedSpec a
s,) ((a -> a) -> (BracketedSpec a, a -> a))
-> ParsecT [Tok] () Identity (a -> a)
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BracketedSpec a
-> ReferenceMap -> Text -> ParsecT [Tok] () Identity (a -> a)
forall il.
BracketedSpec il
-> ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix BracketedSpec a
s ReferenceMap
rm Text
key)
[BracketedSpec a]
specs
SourcePos
pos <- ParsecT [Tok] () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(BracketedSpec a, a -> a, SourcePos)
-> ParsecT [Tok] () Identity (BracketedSpec a, a -> a, SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (BracketedSpec a
spec, a -> a
constructor, SourcePos
pos)))
String
"" [Tok]
suffixToks of
Left ParseError
_ ->
[BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
leftCursor DState a
st)
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote (Cursor (Chunk a) -> Cursor (Chunk a))
-> Cursor (Chunk a) -> Cursor (Chunk a)
forall a b. (a -> b) -> a -> b
$
Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight (DState a -> Cursor (Chunk a)
forall a. DState a -> Cursor (Chunk a)
rightCursor DState a
st) }
Right ((BracketedSpec a
spec, a -> a
constructor, SourcePos
newpos), [Tok]
desttoks) ->
let left' :: Cursor (Chunk a)
left' = case BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix BracketedSpec a
spec of
Just Char
_ -> Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left
Maybe Char
Nothing -> Cursor (Chunk a)
left
openers :: [Chunk a]
openers = case BracketedSpec a -> Maybe Char
forall il. BracketedSpec il -> Maybe Char
bracketedPrefix BracketedSpec a
spec of
Just Char
_ -> ([Chunk a] -> [Chunk a])
-> (Chunk a -> [Chunk a] -> [Chunk a])
-> Maybe (Chunk a)
-> [Chunk a]
-> [Chunk a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chunk a] -> [Chunk a]
forall a. a -> a
id (:) (Cursor (Chunk a) -> Maybe (Chunk a)
forall a. Cursor a -> Maybe a
center Cursor (Chunk a)
left')
[Chunk a
opener]
Maybe Char
Nothing -> [Chunk a
opener]
openerPos :: SourcePos
openerPos = case [Chunk a]
openers of
(Chunk a
x:[Chunk a]
_) -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
x
[Chunk a]
_ -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
opener
elttoks :: [Tok]
elttoks = (Chunk a -> [Tok]) -> [Chunk a] -> [Tok]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk a -> [Tok]
forall a. Chunk a -> [Tok]
chunkToks
([Chunk a]
openers [Chunk a] -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a] -> [a]
++ [Chunk a]
chunksinside [Chunk a] -> [Chunk a] -> [Chunk a]
forall a. [a] -> [a] -> [a]
++ [Chunk a
closer])
[Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
desttoks
elt :: a
elt = SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged ([Tok] -> SourcePos -> SourceRange
rangeFromToks [Tok]
elttoks SourcePos
newpos)
(a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
constructor (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [Chunk a] -> a
forall a. IsInline a => [Chunk a] -> a
unChunks ([Chunk a] -> a) -> [Chunk a] -> a
forall a b. (a -> b) -> a -> b
$
[Chunk a] -> [Chunk a]
forall a. IsInline a => [Chunk a] -> [Chunk a]
processEmphasis [Chunk a]
chunksinside
eltchunk :: Chunk a
eltchunk = ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk (a -> ChunkType a
forall a. a -> ChunkType a
Parsed a
elt) SourcePos
openerPos [Tok]
elttoks
afterchunks :: [Chunk a]
afterchunks = (Chunk a -> Bool) -> [Chunk a] -> [Chunk a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
newpos) (SourcePos -> Bool) -> (Chunk a -> SourcePos) -> Chunk a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos)
(Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
afters Cursor (Chunk a)
right)
afterchunkpos :: SourcePos
afterchunkpos = case [Chunk a]
afterchunks of
[] -> SourcePos
newpos
(Chunk a
ch:[Chunk a]
_) -> Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
ch
missingtoks :: [Tok]
missingtoks =
[Tok
t | Tok
t <- [Tok]
suffixToks
, Tok -> SourcePos
tokPos Tok
t SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
afterchunkpos
, Tok -> SourcePos
tokPos Tok
t SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
>= SourcePos
newpos]
addMissing :: [Chunk a] -> [Chunk a]
addMissing =
if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
missingtoks
then [Chunk a] -> [Chunk a]
forall a. a -> a
id
else (ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk (a -> ChunkType a
forall a. a -> ChunkType a
Parsed (SourceRange -> a -> a
forall a. Rangeable a => SourceRange -> a -> a
ranged
([Tok] -> SourcePos -> SourceRange
rangeFromToks [Tok]
missingtoks SourcePos
newpos)
(Text -> a
forall a. IsInline a => Text -> a
str ([Tok] -> Text
untokenize [Tok]
missingtoks))))
SourcePos
newpos [Tok]
missingtoks Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:)
in case [Chunk a] -> [Chunk a]
addMissing [Chunk a]
afterchunks of
[] -> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor Maybe (Chunk a)
forall a. Maybe a
Nothing
(Chunk a
eltchunk Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
: Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left') [] }
(Chunk a
y:[Chunk a]
ys) ->
let lbs :: [Chunk a]
lbs = Cursor (Chunk a) -> [Chunk a]
forall a. Cursor a -> [a]
befores Cursor (Chunk a)
left'
in [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs DState a
st{
leftCursor :: Cursor (Chunk a)
leftCursor =
Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
eltchunk) [Chunk a]
lbs (Chunk a
yChunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:[Chunk a]
ys)
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote (Cursor (Chunk a) -> Cursor (Chunk a))
-> Cursor (Chunk a) -> Cursor (Chunk a)
forall a b. (a -> b) -> a -> b
$
Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just Chunk a
y) (Chunk a
eltchunkChunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
:[Chunk a]
lbs) [Chunk a]
ys
, stackBottoms :: Map Text SourcePos
stackBottoms =
if BracketedSpec a -> Bool
forall il. BracketedSpec il -> Bool
bracketedNests BracketedSpec a
spec
then DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
else Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (BracketedSpec a -> Text
forall il. BracketedSpec il -> Text
bracketedName BracketedSpec a
spec)
(Chunk a -> SourcePos
forall a. Chunk a -> SourcePos
chunkPos Chunk a
opener)
(Map Text SourcePos -> Map Text SourcePos)
-> Map Text SourcePos -> Map Text SourcePos
forall a b. (a -> b) -> a -> b
$ DState a -> Map Text SourcePos
forall a. DState a -> Map Text SourcePos
stackBottoms DState a
st
}
(Maybe (Chunk a)
_, Just (Chunk Delim{ delimCanClose :: forall a. ChunkType a -> Bool
delimCanClose = Bool
True, delimType :: forall a. ChunkType a -> Char
delimType = Char
']' } SourcePos
_ [Tok]
_))
-> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveLeft Cursor (Chunk a)
left }
(Just Chunk a
_, Just (Chunk Delim{ delimCanOpen :: forall a. ChunkType a -> Bool
delimCanOpen = Bool
True, delimType :: forall a. ChunkType a -> Char
delimType = Char
'[' } SourcePos
_ [Tok]
_))
-> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
DState a
st{ leftCursor :: Cursor (Chunk a)
leftCursor = Cursor (Chunk a)
right
, rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right }
(Maybe (Chunk a)
_, Maybe (Chunk a)
_) -> [BracketedSpec a] -> DState a -> [Chunk a]
forall a. IsInline a => [BracketedSpec a] -> DState a -> [Chunk a]
processBs [BracketedSpec a]
bracketedSpecs
DState a
st{ rightCursor :: Cursor (Chunk a)
rightCursor = Cursor (Chunk a) -> Cursor (Chunk a)
forall a. Cursor a -> Cursor a
moveRight Cursor (Chunk a)
right }
fixSingleQuote :: Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote :: Cursor (Chunk a) -> Cursor (Chunk a)
fixSingleQuote
(Cursor (Just (Chunk d :: ChunkType a
d@(Delim{ delimType :: forall a. ChunkType a -> Char
delimType = Char
'\'' }) SourcePos
pos [Tok]
toks)) [Chunk a]
xs [Chunk a]
ys) =
Maybe (Chunk a) -> [Chunk a] -> [Chunk a] -> Cursor (Chunk a)
forall a. Maybe a -> [a] -> [a] -> Cursor a
Cursor (Chunk a -> Maybe (Chunk a)
forall a. a -> Maybe a
Just (ChunkType a -> SourcePos -> [Tok] -> Chunk a
forall a. ChunkType a -> SourcePos -> [Tok] -> Chunk a
Chunk ChunkType a
d{ delimCanOpen :: Bool
delimCanOpen = Bool
False } SourcePos
pos [Tok]
toks)) [Chunk a]
xs [Chunk a]
ys
fixSingleQuote Cursor (Chunk a)
cursor = Cursor (Chunk a)
cursor
pLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pLink ReferenceMap
rm Text
key = do
Parsec [Tok] s LinkInfo
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m LinkInfo
pInlineLink Parsec [Tok] s LinkInfo
-> Parsec [Tok] s LinkInfo -> Parsec [Tok] s LinkInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
forall s. ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink ReferenceMap
rm Text
key
pInlineLink :: Monad m => ParsecT [Tok] s m LinkInfo
pInlineLink :: ParsecT [Tok] s m LinkInfo
pInlineLink = ParsecT [Tok] s m LinkInfo -> ParsecT [Tok] s m LinkInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m LinkInfo -> ParsecT [Tok] s m LinkInfo)
-> ParsecT [Tok] s m LinkInfo -> ParsecT [Tok] s m LinkInfo
forall a b. (a -> b) -> a -> b
$ do
Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'('
ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
Text
target <- [Tok] -> Text
unEntity ([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination
ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
Text
title <- Text -> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text)
-> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall a b. (a -> b) -> a -> b
$
[Tok] -> Text
unEntity ([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkTitle ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m () -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')'
LinkInfo -> ParsecT [Tok] s m LinkInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkInfo -> ParsecT [Tok] s m LinkInfo)
-> LinkInfo -> ParsecT [Tok] s m LinkInfo
forall a b. (a -> b) -> a -> b
$! LinkInfo :: Text -> Text -> Attributes -> LinkInfo
LinkInfo { linkDestination :: Text
linkDestination = Text
target
, linkTitle :: Text
linkTitle = Text
title
, linkAttributes :: Attributes
linkAttributes = Attributes
forall a. Monoid a => a
mempty }
pLinkDestination :: Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination :: ParsecT [Tok] s m [Tok]
pLinkDestination = ParsecT [Tok] s m [Tok]
forall s. ParsecT [Tok] s m [Tok]
pAngleDest ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m [Tok]
pNormalDest Int
0
where
pAngleDest :: ParsecT [Tok] s m [Tok]
pAngleDest = do
Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'<'
[Tok]
res <- ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [Char -> TokType
Symbol Char
'<', Char -> TokType
Symbol Char
'>', Char -> TokType
Symbol Char
'\\',
TokType
LineEnd] ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped)
Tok
_ <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
[Tok] -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res
pNormalDest :: Int -> ParsecT [Tok] u m [Tok]
pNormalDest (Int
numparens :: Int) = do
[Tok]
res <- Int -> ParsecT [Tok] u m [Tok]
forall (m :: * -> *) a u.
(Monad m, Num a, Ord a) =>
a -> ParsecT [Tok] u m [Tok]
pNormalDest' Int
numparens
if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
res
then [Tok]
res [Tok] -> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')')
else [Tok] -> ParsecT [Tok] u m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return [Tok]
res
pNormalDest' :: a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens
| a
numparens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
32 = ParsecT [Tok] u m [Tok]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
| Bool
otherwise = (do
Tok
t <- (Tok -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\case
Tok (Symbol Char
'\\') SourcePos
_ Text
_ -> Bool
True
Tok (Symbol Char
')') SourcePos
_ Text
_ -> a
numparens a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1
Tok TokType
Spaces SourcePos
_ Text
_ -> Bool
False
Tok TokType
LineEnd SourcePos
_ Text
_ -> Bool
False
Tok
_ -> Bool
True)
case Tok
t of
Tok (Symbol Char
'\\') SourcePos
_ Text
_ -> do
Tok
t' <- Tok -> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Tok
t (ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok)
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
asciiSymbol
(Tok
t'Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens
Tok (Symbol Char
'(') SourcePos
_ Text
_ -> (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' (a
numparens a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
Tok (Symbol Char
')') SourcePos
_ Text
_ -> (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' (a
numparens a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
Tok
_ -> (Tok
tTok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ParsecT [Tok] u m [Tok]
pNormalDest' a
numparens)
ParsecT [Tok] u m [Tok]
-> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([] [Tok] -> ParsecT [Tok] u m () -> ParsecT [Tok] u m [Tok]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> ParsecT [Tok] u m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
numparens a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0))
pEscaped :: Monad m => ParsecT [Tok] s m Tok
pEscaped :: ParsecT [Tok] s m Tok
pEscaped = do
Tok
bs <- Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\\'
Tok -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Tok
bs (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok)
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok Tok -> Bool
asciiSymbol ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
asciiSymbol :: Tok -> Bool
asciiSymbol :: Tok -> Bool
asciiSymbol (Tok (Symbol Char
c) SourcePos
_ Text
_) = Char -> Bool
isAscii Char
c
asciiSymbol Tok
_ = Bool
False
pLinkTitle :: Monad m => ParsecT [Tok] s m [Tok]
pLinkTitle :: ParsecT [Tok] s m [Tok]
pLinkTitle = Char -> Char -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s.
Monad m =>
Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween Char
'"' Char
'"' ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s.
Monad m =>
Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween Char
'\'' Char
'\'' ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s.
Monad m =>
Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween Char
'(' Char
')'
inbetween :: Monad m => Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween :: Char -> Char -> ParsecT [Tok] s m [Tok]
inbetween Char
op Char
cl =
ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
op) (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
cl)
(ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [Char -> TokType
Symbol Char
op, Char -> TokType
Symbol Char
cl]))
pLinkLabel :: Monad m => ParsecT [Tok] s m Text
pLinkLabel :: ParsecT [Tok] s m Text
pLinkLabel = ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text)
-> ParsecT [Tok] s m Text -> ParsecT [Tok] s m Text
forall a b. (a -> b) -> a -> b
$ do
Text
lab <- [Tok] -> Text
untokenize
([Tok] -> Text)
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'[') (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']')
(([Tok], [Tok]) -> [Tok]
forall a b. (a, b) -> b
snd (([Tok], [Tok]) -> [Tok])
-> ParsecT [Tok] s m ([Tok], [Tok]) -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ([Tok], [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
(ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [TokType] -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [Char -> TokType
Symbol Char
']', Char -> TokType
Symbol Char
'[']))))
Bool -> ParsecT [Tok] s m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s m ()) -> Bool -> ParsecT [Tok] s m ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
lab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
999
Text -> ParsecT [Tok] s m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
lab
pReferenceLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink :: ReferenceMap -> Text -> Parsec [Tok] s LinkInfo
pReferenceLink ReferenceMap
rm Text
key = do
Text
lab <- Text
-> ParsecT [Tok] s Identity Text -> ParsecT [Tok] s Identity Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
key ParsecT [Tok] s Identity Text
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Text
pLinkLabel
let key' :: Text
key' = if Text -> Bool
T.null Text
lab
then Text
key
else Text
lab
Parsec [Tok] s LinkInfo
-> (LinkInfo -> Parsec [Tok] s LinkInfo)
-> Maybe LinkInfo
-> Parsec [Tok] s LinkInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parsec [Tok] s LinkInfo
forall (m :: * -> *) a. MonadPlus m => m a
mzero LinkInfo -> Parsec [Tok] s LinkInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LinkInfo -> Parsec [Tok] s LinkInfo)
-> Maybe LinkInfo -> Parsec [Tok] s LinkInfo
forall a b. (a -> b) -> a -> b
$! Text -> ReferenceMap -> Maybe LinkInfo
forall a. Typeable a => Text -> ReferenceMap -> Maybe a
lookupReference Text
key' ReferenceMap
rm