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