{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE BinaryLiterals #-}
module Djot.Inlines
( parseInlines
, parseTableCells
)
where
import Data.Char (isAscii, isLetter, isAlphaNum, isSymbol, isPunctuation)
import Control.Monad (guard, when, mzero)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Djot.Parse
import Djot.Options (ParseOptions(..), SourcePosOption(..))
import Djot.Attributes (pAttributes)
import Djot.AST
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.ByteString (ByteString)
import Data.Foldable as F
import Control.Applicative
import Data.Maybe (fromMaybe)
{-# INLINE isSpecial #-}
isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial Char
c = 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
'`' 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
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
parseInlines :: ParseOptions -> Seq Chunk -> Either String Inlines
parseInlines :: ParseOptions -> Seq Chunk -> Either String Inlines
parseInlines ParseOptions
opts Seq Chunk
chunks = do
case Parser ParserState Inlines
-> ParserState -> [Chunk] -> Maybe Inlines
forall s a. Parser s a -> s -> [Chunk] -> Maybe a
parse (Parser ParserState Inlines
pInlines Parser ParserState Inlines
-> Parser ParserState () -> Parser ParserState Inlines
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ParserState ()
forall s. Parser s ()
eof) ParserState{ mode :: InlineParseMode
mode = InlineParseMode
NormalMode
, activeDelims :: Set Delim
activeDelims = Set Delim
forall a. Monoid a => a
mempty
, options :: ParseOptions
options = ParseOptions
opts }
(Seq Chunk -> [Chunk]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Chunk -> Seq Chunk
stripEndChunks Seq Chunk
chunks)) of
Just Inlines
ils -> Inlines -> Either String Inlines
forall a b. b -> Either a b
Right Inlines
ils
Maybe Inlines
Nothing -> String -> Either String Inlines
forall a b. a -> Either a b
Left (String -> Either String Inlines)
-> String -> Either String Inlines
forall a b. (a -> b) -> a -> b
$ String
"parseInlines failed on input: "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ((Chunk -> ByteString) -> Seq Chunk -> ByteString
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Chunk -> ByteString
chunkBytes Seq Chunk
chunks)
parseTableCells :: ParseOptions -> Chunk -> Either String [Inlines]
parseTableCells :: ParseOptions -> Chunk -> Either String [Inlines]
parseTableCells ParseOptions
opts Chunk
chunk = do
case Parser ParserState [Inlines]
-> ParserState -> [Chunk] -> Maybe [Inlines]
forall s a. Parser s a -> s -> [Chunk] -> Maybe a
parse (Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'|'
Parser ParserState ()
-> Parser ParserState [Inlines] -> Parser ParserState [Inlines]
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ParserState Inlines -> Parser ParserState [Inlines]
forall a. Parser ParserState a -> Parser ParserState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Inlines -> Inlines
removeFinalWs (Inlines -> Inlines)
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState Inlines
pInlines Parser ParserState Inlines
-> Parser ParserState () -> Parser ParserState Inlines
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'|')
Parser ParserState [Inlines]
-> Parser ParserState () -> Parser ParserState [Inlines]
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany Parser ParserState ()
forall s. Parser s ()
ws
Parser ParserState [Inlines]
-> Parser ParserState () -> Parser ParserState [Inlines]
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ParserState ()
forall s. Parser s ()
eof)
ParserState{ mode :: InlineParseMode
mode = InlineParseMode
TableCellMode
, activeDelims :: Set Delim
activeDelims = Set Delim
forall a. Monoid a => a
mempty
, options :: ParseOptions
options = ParseOptions
opts }
[Item [Chunk]
Chunk
chunk] of
Just [Inlines]
cells -> [Inlines] -> Either String [Inlines]
forall a b. b -> Either a b
Right [Inlines]
cells
Maybe [Inlines]
Nothing -> String -> Either String [Inlines]
forall a b. a -> Either a b
Left (String -> Either String [Inlines])
-> String -> Either String [Inlines]
forall a b. (a -> b) -> a -> b
$ String
"parseTableCells failed on input: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Chunk -> String
forall a. Show a => a -> String
show Chunk
chunk
removeFinalWs :: Inlines -> Inlines
removeFinalWs :: Inlines -> Inlines
removeFinalWs (Many Seq (Node Inline)
ils) = Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many (Seq (Node Inline) -> Inlines) -> Seq (Node Inline) -> Inlines
forall a b. (a -> b) -> a -> b
$
case Seq (Node Inline) -> ViewR (Node Inline)
forall a. Seq a -> ViewR a
Seq.viewr Seq (Node Inline)
ils of
Seq (Node Inline)
rest Seq.:> Node Pos
pos Attr
attr (Str ByteString
bs)
| Int -> ByteString -> ByteString
B8.takeEnd Int
1 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
" "
-> case (Char -> Bool) -> ByteString -> ByteString
B8.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
bs of
ByteString
"" -> Seq (Node Inline)
rest
ByteString
bs' -> Seq (Node Inline)
rest Seq (Node Inline) -> Node Inline -> Seq (Node Inline)
forall a. Seq a -> a -> Seq a
Seq.|> Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr (ByteString -> Inline
Str ByteString
bs')
ViewR (Node Inline)
_ -> Seq (Node Inline)
ils
data InlineParseMode =
NormalMode | TableCellMode
deriving (Int -> InlineParseMode -> String -> String
[InlineParseMode] -> String -> String
InlineParseMode -> String
(Int -> InlineParseMode -> String -> String)
-> (InlineParseMode -> String)
-> ([InlineParseMode] -> String -> String)
-> Show InlineParseMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> InlineParseMode -> String -> String
showsPrec :: Int -> InlineParseMode -> String -> String
$cshow :: InlineParseMode -> String
show :: InlineParseMode -> String
$cshowList :: [InlineParseMode] -> String -> String
showList :: [InlineParseMode] -> String -> String
Show, Eq InlineParseMode
Eq InlineParseMode =>
(InlineParseMode -> InlineParseMode -> Ordering)
-> (InlineParseMode -> InlineParseMode -> Bool)
-> (InlineParseMode -> InlineParseMode -> Bool)
-> (InlineParseMode -> InlineParseMode -> Bool)
-> (InlineParseMode -> InlineParseMode -> Bool)
-> (InlineParseMode -> InlineParseMode -> InlineParseMode)
-> (InlineParseMode -> InlineParseMode -> InlineParseMode)
-> Ord InlineParseMode
InlineParseMode -> InlineParseMode -> Bool
InlineParseMode -> InlineParseMode -> Ordering
InlineParseMode -> InlineParseMode -> InlineParseMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InlineParseMode -> InlineParseMode -> Ordering
compare :: InlineParseMode -> InlineParseMode -> Ordering
$c< :: InlineParseMode -> InlineParseMode -> Bool
< :: InlineParseMode -> InlineParseMode -> Bool
$c<= :: InlineParseMode -> InlineParseMode -> Bool
<= :: InlineParseMode -> InlineParseMode -> Bool
$c> :: InlineParseMode -> InlineParseMode -> Bool
> :: InlineParseMode -> InlineParseMode -> Bool
$c>= :: InlineParseMode -> InlineParseMode -> Bool
>= :: InlineParseMode -> InlineParseMode -> Bool
$cmax :: InlineParseMode -> InlineParseMode -> InlineParseMode
max :: InlineParseMode -> InlineParseMode -> InlineParseMode
$cmin :: InlineParseMode -> InlineParseMode -> InlineParseMode
min :: InlineParseMode -> InlineParseMode -> InlineParseMode
Ord, InlineParseMode -> InlineParseMode -> Bool
(InlineParseMode -> InlineParseMode -> Bool)
-> (InlineParseMode -> InlineParseMode -> Bool)
-> Eq InlineParseMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InlineParseMode -> InlineParseMode -> Bool
== :: InlineParseMode -> InlineParseMode -> Bool
$c/= :: InlineParseMode -> InlineParseMode -> Bool
/= :: InlineParseMode -> InlineParseMode -> Bool
Eq)
data ParserState =
ParserState
{ ParserState -> InlineParseMode
mode :: InlineParseMode
, ParserState -> Set Delim
activeDelims :: Set Delim
, ParserState -> ParseOptions
options :: ParseOptions }
deriving (Int -> ParserState -> String -> String
[ParserState] -> String -> String
ParserState -> String
(Int -> ParserState -> String -> String)
-> (ParserState -> String)
-> ([ParserState] -> String -> String)
-> Show ParserState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ParserState -> String -> String
showsPrec :: Int -> ParserState -> String -> String
$cshow :: ParserState -> String
show :: ParserState -> String
$cshowList :: [ParserState] -> String -> String
showList :: [ParserState] -> String -> String
Show)
data Delim = Delim Bool Char
deriving (Int -> Delim -> String -> String
[Delim] -> String -> String
Delim -> String
(Int -> Delim -> String -> String)
-> (Delim -> String) -> ([Delim] -> String -> String) -> Show Delim
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Delim -> String -> String
showsPrec :: Int -> Delim -> String -> String
$cshow :: Delim -> String
show :: Delim -> String
$cshowList :: [Delim] -> String -> String
showList :: [Delim] -> String -> String
Show, Eq Delim
Eq Delim =>
(Delim -> Delim -> Ordering)
-> (Delim -> Delim -> Bool)
-> (Delim -> Delim -> Bool)
-> (Delim -> Delim -> Bool)
-> (Delim -> Delim -> Bool)
-> (Delim -> Delim -> Delim)
-> (Delim -> Delim -> Delim)
-> Ord Delim
Delim -> Delim -> Bool
Delim -> Delim -> Ordering
Delim -> Delim -> Delim
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Delim -> Delim -> Ordering
compare :: Delim -> Delim -> Ordering
$c< :: Delim -> Delim -> Bool
< :: Delim -> Delim -> Bool
$c<= :: Delim -> Delim -> Bool
<= :: Delim -> Delim -> Bool
$c> :: Delim -> Delim -> Bool
> :: Delim -> Delim -> Bool
$c>= :: Delim -> Delim -> Bool
>= :: Delim -> Delim -> Bool
$cmax :: Delim -> Delim -> Delim
max :: Delim -> Delim -> Delim
$cmin :: Delim -> Delim -> Delim
min :: Delim -> Delim -> Delim
Ord, Delim -> Delim -> Bool
(Delim -> Delim -> Bool) -> (Delim -> Delim -> Bool) -> Eq Delim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Delim -> Delim -> Bool
== :: Delim -> Delim -> Bool
$c/= :: Delim -> Delim -> Bool
/= :: Delim -> Delim -> Bool
Eq)
type P = Parser ParserState
pInlines :: P Inlines
pInlines :: Parser ParserState Inlines
pInlines = Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany Parser ParserState ()
forall s. Parser s ()
ws Parser ParserState ()
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> Parser ParserState [Inlines] -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState Inlines -> Parser ParserState [Inlines]
forall a. Parser ParserState a -> Parser ParserState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ParserState Inlines
pInline)
pInline :: P Inlines
pInline :: Parser ParserState Inlines
pInline = do
sline <- Parser ParserState Int
forall s. Parser s Int
sourceLine
scol <- sourceColumn
res <- pInline'
opts <- options <$> getState
(case sourcePositions opts of
SourcePosOption
AllSourcePos -> do
eline <- Parser ParserState Int
forall s. Parser s Int
sourceLine
ecol <- sourceColumn
pure $ addPos (Pos sline scol eline (ecol - 1)) <$> res
SourcePosOption
_ -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
res) >>= pOptionalAttributes
pOptionalAttributes :: Inlines -> P Inlines
pOptionalAttributes :: Inlines -> Parser ParserState Inlines
pOptionalAttributes (Many Seq (Node Inline)
ils) = Inlines -> Parser ParserState Inlines
pAddAttributes (Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many Seq (Node Inline)
ils) Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many Seq (Node Inline)
ils)
pAddAttributes :: Inlines -> P Inlines
pAddAttributes :: Inlines -> Parser ParserState Inlines
pAddAttributes (Many Seq (Node Inline)
ils) = do
attr <- [Attr] -> Attr
forall a. Monoid a => [a] -> a
mconcat ([Attr] -> Attr)
-> Parser ParserState [Attr] -> Parser ParserState Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState Attr -> Parser ParserState [Attr]
forall a. Parser ParserState a -> Parser ParserState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser ParserState Attr
forall s. Parser s Attr
pAttributes
pure $
case attr of
Attr [] -> Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many Seq (Node Inline)
ils
Attr
_ -> case Seq (Node Inline) -> ViewR (Node Inline)
forall a. Seq a -> ViewR a
Seq.viewr Seq (Node Inline)
ils of
ViewR (Node Inline)
Seq.EmptyR -> Inlines
forall a. Monoid a => a
mempty
Seq (Node Inline)
ils' Seq.:> Node Pos
pos Attr
attr' (Str ByteString
bs)
| (Char -> Bool) -> ByteString -> Bool
B8.any Char -> Bool
isWs ByteString
bs ->
let (ByteString
front, ByteString
lastword) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.breakEnd Char -> Bool
isWs ByteString
bs
in if ByteString -> Bool
B.null ByteString
lastword
then Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many Seq (Node Inline)
ils
else
let (Pos
pos1, Pos
pos2) =
case Pos
pos of
Pos
NoPos -> (Pos
NoPos, Pos
NoPos)
Pos Int
sl Int
sc Int
el Int
ec ->
let frontlen :: Int
frontlen = ByteString -> Int
B8.length
((Char -> Bool) -> ByteString -> ByteString
B8.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\128' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\192') ByteString
front)
in (Int -> Int -> Int -> Int -> Pos
Pos Int
sl Int
sc Int
sl (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
frontlen),
Int -> Int -> Int -> Int -> Pos
Pos Int
sl (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
frontlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
el Int
ec)
in Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many (Seq (Node Inline)
ils' Seq (Node Inline) -> Node Inline -> Seq (Node Inline)
forall a. Seq a -> a -> Seq a
Seq.|>
Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos1 Attr
attr' (ByteString -> Inline
Str ByteString
front) Seq (Node Inline) -> Node Inline -> Seq (Node Inline)
forall a. Seq a -> a -> Seq a
Seq.|>
Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos2 Attr
attr (ByteString -> Inline
Str ByteString
lastword))
Seq (Node Inline)
ils' Seq.:> Node Pos
pos Attr
attr' Inline
il ->
Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many (Seq (Node Inline)
ils' Seq (Node Inline) -> Node Inline -> Seq (Node Inline)
forall a. Seq a -> a -> Seq a
Seq.|> Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos (Attr
attr' Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr) Inline
il)
pInline' :: P Inlines
pInline' :: Parser ParserState Inlines
pInline' = do
(do c <- Parser ParserState Char -> Parser ParserState Char
forall s a. Parser s a -> Parser s a
lookahead ((Char -> Bool) -> Parser ParserState Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte Char -> Bool
isSpecial)
fails pCloser
(case c of
Char
'\\' -> Parser ParserState Inlines
pEscaped
Char
'[' -> Parser ParserState Inlines
pFootnoteReference
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pLinkOrSpan
Char
'<' -> Parser ParserState Inlines
pAutolink
Char
'!' -> Parser ParserState Inlines
pImage
Char
'_' -> Parser ParserState Inlines
pEmph
Char
'*' -> Parser ParserState Inlines
pStrong
Char
'^' -> Parser ParserState Inlines
pSuperscript
Char
'~' -> Parser ParserState Inlines
pSubscript
Char
'{' -> Parser ParserState Inlines
pEmph
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pStrong
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pHighlight
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pInsert
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pDelete
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pSuperscript
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pSubscript
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pDoubleQuote
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pSingleQuote
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines
forall a. Monoid a => a
mempty Inlines -> Parser ParserState Attr -> Parser ParserState Inlines
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ParserState Attr
forall s. Parser s Attr
pAttributes)
Char
'`' -> Parser ParserState Inlines
pVerbatim
Char
':' -> Parser ParserState Inlines
pSymbol
Char
'$' -> Parser ParserState Inlines
pMath
Char
'"' -> Parser ParserState Inlines
pDoubleQuote
Char
'\'' -> Parser ParserState Inlines
pSingleQuote
Char
'-' -> Parser ParserState Inlines
pHyphens
Char
'.' -> Parser ParserState Inlines
pEllipses
Char
'\n' -> Parser ParserState Inlines
pSoftBreak
Char
_ -> Parser ParserState Inlines
forall a. Parser ParserState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
<|> pSpecial
) Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParserState Inlines
pWords
pSpecial :: P Inlines
pSpecial :: Parser ParserState Inlines
pSpecial = do
st <- Parser ParserState ParserState
forall s. Parser s s
getState
c <- satisfyByte (case mode st of
InlineParseMode
TableCellMode -> \Char
d -> Char -> Bool
isSpecial Char
d Bool -> Bool -> Bool
&& Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|'
InlineParseMode
_ -> Char -> Bool
isSpecial)
if c == '\r'
then pure mempty
else pure $ str $ B8.singleton c
pWords :: P Inlines
pWords :: Parser ParserState Inlines
pWords = ByteString -> Inlines
str (ByteString -> Inlines)
-> Parser ParserState ByteString -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf (Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipSome ((Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpecial)))
pEscaped :: P Inlines
pEscaped :: Parser ParserState Inlines
pEscaped = do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'\\'
c <- (Char -> Bool) -> Parser ParserState Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte (\Char
d ->
Char -> Bool
isAscii Char
d Bool -> Bool -> Bool
&&
(Char -> Bool
isSymbol Char
d Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
d Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'))
Parser ParserState Char
-> Parser ParserState Char -> Parser ParserState Char
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char
'\n' Char -> Parser ParserState () -> Parser ParserState Char
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ParserState ()
forall s. Parser s ()
endline)
Parser ParserState Char
-> Parser ParserState Char -> Parser ParserState Char
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ParserState Char
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\\'
case c of
Char
'\n' -> Inlines
hardBreak Inlines -> Parser ParserState () -> Parser ParserState Inlines
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany Parser ParserState ()
forall s. Parser s ()
spaceOrTab
Char
_ | 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
'\t' -> Parser ParserState Inlines
pHardBreak
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
then Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
nonBreakingSpace
else Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> Parser ParserState Inlines)
-> Inlines -> Parser ParserState Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
str ByteString
"\\\t"
Char
_ -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> Parser ParserState Inlines)
-> Inlines -> Parser ParserState Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
str (ByteString -> Inlines) -> ByteString -> Inlines
forall a b. (a -> b) -> a -> b
$ Char -> ByteString
B8.singleton Char
c
pHardBreak :: P Inlines
pHardBreak :: Parser ParserState Inlines
pHardBreak = do
Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany Parser ParserState ()
forall s. Parser s ()
spaceOrTab
Parser ParserState ()
forall s. Parser s ()
endline
Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany Parser ParserState ()
forall s. Parser s ()
spaceOrTab
Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
hardBreak
pSoftBreak :: P Inlines
pSoftBreak :: Parser ParserState Inlines
pSoftBreak = do
Parser ParserState ()
forall s. Parser s ()
endline
Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany Parser ParserState ()
forall s. Parser s ()
spaceOrTab
(Inlines
forall a. Monoid a => a
mempty Inlines -> Parser ParserState () -> Parser ParserState Inlines
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ParserState ()
forall s. Parser s ()
eof) Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
softBreak
pSymbol :: P Inlines
pSymbol :: Parser ParserState Inlines
pSymbol = do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
':'
bs <- Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf (Parser ParserState () -> Parser ParserState ByteString)
-> Parser ParserState () -> Parser ParserState ByteString
forall a b. (a -> b) -> a -> b
$ Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipSome ((Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte
(\Char
c -> 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 -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c)))
asciiChar ':'
pure $ symbol bs
pMath :: P Inlines
pMath :: Parser ParserState Inlines
pMath = do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'$'
mathStyle <- (MathStyle
DisplayMath MathStyle -> Parser ParserState () -> Parser ParserState MathStyle
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'$') Parser ParserState MathStyle
-> Parser ParserState MathStyle -> Parser ParserState MathStyle
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MathStyle -> Parser ParserState MathStyle
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MathStyle
InlineMath
verb <- pVerbatim
case unMany verb of
[Node Pos
pos Attr
attr (Verbatim ByteString
bs)] ->
Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> Parser ParserState Inlines)
-> Inlines -> Parser ParserState Inlines
forall a b. (a -> b) -> a -> b
$ Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many (Seq (Node Inline) -> Inlines) -> Seq (Node Inline) -> Inlines
forall a b. (a -> b) -> a -> b
$ Node Inline -> Seq (Node Inline)
forall a. a -> Seq a
Seq.singleton (Node Inline -> Seq (Node Inline))
-> Node Inline -> Seq (Node Inline)
forall a b. (a -> b) -> a -> b
$ Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr (MathStyle -> ByteString -> Inline
Math MathStyle
mathStyle ByteString
bs)
Seq (Node Inline)
_ -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> Parser ParserState Inlines)
-> Inlines -> Parser ParserState Inlines
forall a b. (a -> b) -> a -> b
$ (case MathStyle
mathStyle of
MathStyle
DisplayMath -> ByteString -> Inlines
str ByteString
"$$"
MathStyle
_ -> ByteString -> Inlines
str ByteString
"$") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
verb
{-# INLINE bracesRequired #-}
bracesRequired :: Char -> Bool
bracesRequired :: Char -> Bool
bracesRequired Char
'=' = Bool
True
bracesRequired Char
'+' = Bool
True
bracesRequired Char
'-' = Bool
True
bracesRequired Char
_ = Bool
False
pCloser :: P ()
pCloser :: Parser ParserState ()
pCloser = do
delims <- ParserState -> Set Delim
activeDelims (ParserState -> Set Delim)
-> Parser ParserState ParserState -> Parser ParserState (Set Delim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState ParserState
forall s. Parser s s
getState
if Set.null delims
then mzero
else do
openerHadBrace <- asum $
map (\(Delim Bool
hadBrace Char
c) -> Bool
hadBrace Bool -> Parser ParserState () -> Parser ParserState Bool
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
c) (F.toList delims)
mblastc <- peekBack
let afterws = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isWs Maybe Char
mblastc
when ( afterws || openerHadBrace ) $ asciiChar '}'
pEmph, pStrong, pSuperscript, pSubscript :: P Inlines
pEmph :: Parser ParserState Inlines
pEmph = Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
'_' Inlines -> Inlines
emph
pStrong :: Parser ParserState Inlines
pStrong = Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
'*' Inlines -> Inlines
strong
pSuperscript :: Parser ParserState Inlines
pSuperscript = Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
'^' Inlines -> Inlines
superscript
pSubscript :: Parser ParserState Inlines
pSubscript = Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
'~' Inlines -> Inlines
subscript
pHighlight, pInsert, pDelete :: P Inlines
pHighlight :: Parser ParserState Inlines
pHighlight = Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
'=' Inlines -> Inlines
highlight
pInsert :: Parser ParserState Inlines
pInsert = Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
'+' Inlines -> Inlines
insert
pDelete :: Parser ParserState Inlines
pDelete = Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
'-' Inlines -> Inlines
delete
pBetween :: Char -> (Inlines -> Inlines) -> P Inlines
pBetween :: Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
c Inlines -> Inlines
constructor = do
let starter :: Bool -> Parser s ()
starter Bool
leftBrace = do
case Bool
leftBrace of
Bool
False
| Char -> Bool
bracesRequired Char
c -> Parser s ()
forall a. Parser s a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
| Bool
otherwise -> Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
c Parser s () -> Parser s () -> Parser s ()
forall s a b. Parser s a -> Parser s b -> Parser s a
`notFollowedBy`
(Parser s ()
forall s. Parser s ()
ws Parser s () -> Parser s () -> Parser s ()
forall a. Parser s a -> Parser s a -> Parser s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
'}')
Bool
True -> Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
c Parser s () -> Parser s () -> Parser s ()
forall s a b. Parser s a -> Parser s b -> Parser s a
`notFollowedBy` Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
'}'
let ender :: Bool -> Parser s ()
ender Bool
leftBrace = do
mblastc <- Parser s (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
let afterws = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isWs Maybe Char
mblastc
asciiChar c
if leftBrace
then asciiChar '}'
else guard (not afterws) `notFollowedBy` asciiChar '}'
leftBrace <- (Bool
True Bool -> Parser ParserState () -> Parser ParserState Bool
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'{') Parser ParserState Bool
-> Parser ParserState Bool -> Parser ParserState Bool
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ParserState Bool
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
starterBs <- (if leftBrace then ("{" <>) else id) <$>
byteStringOf (starter leftBrace) `notFollowedBy` pAttributes
oldActiveDelims <- activeDelims <$> getState
updateState $ \ParserState
st -> ParserState
st{ activeDelims = Set.insert (Delim leftBrace c)
(activeDelims st) }
firstIl <- pInline <|> pBetween c constructor
restIls <- many pInline
let ils = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (Inlines
firstIlInlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:[Inlines]
restIls)
updateState $ \ParserState
st -> ParserState
st{ activeDelims = oldActiveDelims }
(constructor ils <$ ender leftBrace) <|> pure (str starterBs <> ils)
pTicks :: P Int
pTicks :: Parser ParserState Int
pTicks = do
sp <- Parser ParserState Int
forall s. Parser s Int
getOffset
skipSome (asciiChar '`')
ep <- getOffset
pure (ep - sp)
pVerbatim :: P Inlines
pVerbatim :: Parser ParserState Inlines
pVerbatim = do
numticks <- Parser ParserState Int
pTicks
let ender = Parser ParserState Int
pTicks Parser ParserState Int
-> (Int -> Parser ParserState ()) -> Parser ParserState ()
forall a b.
Parser ParserState a
-> (a -> Parser ParserState b) -> Parser ParserState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Parser ParserState ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ParserState ())
-> (Int -> Bool) -> Int -> Parser ParserState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numticks)
let content = Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipSome ((Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte (\Char
c -> 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
'\\')) Parser ParserState ()
-> Parser ParserState () -> Parser ParserState ()
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'\\' Parser ParserState ()
-> Parser ParserState Char -> Parser ParserState ()
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ParserState Char
forall s. Parser s Char
anyChar) Parser ParserState ()
-> Parser ParserState () -> Parser ParserState ()
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
fails Parser ParserState ()
ender Parser ParserState ()
-> Parser ParserState () -> Parser ParserState ()
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipSome (Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'`'))
bs <- trimSpaces <$> byteStringOf (skipMany content) <* (ender <|> eof)
(rawInline <$> pRawAttribute <*> pure bs) <|> pure (verbatim bs)
trimSpaces :: ByteString -> ByteString
trimSpaces :: ByteString -> ByteString
trimSpaces = ByteString -> ByteString
trimSpaceFront (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
trimSpaceBack
where
trimSpaceFront :: ByteString -> ByteString
trimSpaceFront ByteString
bs =
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
bs of
(ByteString
a, ByteString
b) | Int -> ByteString -> ByteString
B8.take Int
1 ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"`"
, Bool -> Bool
not (ByteString -> Bool
B8.null ByteString
a)
-> Int -> ByteString -> ByteString
B8.drop Int
1 ByteString
bs
(ByteString, ByteString)
_ -> ByteString
bs
trimSpaceBack :: ByteString -> ByteString
trimSpaceBack ByteString
bs =
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.spanEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
bs of
(ByteString
a, ByteString
b) | Int -> ByteString -> ByteString
B8.takeEnd Int
1 ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"`"
, Bool -> Bool
not (ByteString -> Bool
B8.null ByteString
b)
-> Int -> ByteString -> ByteString
B8.dropEnd Int
1 ByteString
bs
(ByteString, ByteString)
_ -> ByteString
bs
pRawAttribute :: P Format
pRawAttribute :: Parser ParserState Format
pRawAttribute = do
ByteString -> Parser ParserState ()
forall s. ByteString -> Parser s ()
byteString ByteString
"{="
fmt <- ByteString -> Format
Format (ByteString -> Format)
-> Parser ParserState ByteString -> Parser ParserState Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf (Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany ((Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}' Bool -> Bool -> Bool
&&
Bool -> Bool
not (Char -> Bool
isWs Char
c))))
asciiChar '}'
pure fmt
pFootnoteReference :: P Inlines
= do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'['
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'^'
label <- Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf (Parser ParserState () -> Parser ParserState ByteString)
-> Parser ParserState () -> Parser ParserState ByteString
forall a b. (a -> b) -> a -> b
$ Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipMany (Parser ParserState () -> Parser ParserState ())
-> Parser ParserState () -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isWs Char
c))
asciiChar ']'
pure $ footnoteReference label
pBracketed :: P (Either Inlines Inlines)
pBracketed :: P (Either Inlines Inlines)
pBracketed = do
let starter :: Parser s ()
starter = Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
'['
let ender :: Parser s ()
ender = Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
']'
starterBs <- Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf Parser ParserState ()
forall s. Parser s ()
starter
oldActiveDelims <- activeDelims <$> getState
updateState $ \ParserState
st -> ParserState
st{ activeDelims = Set.insert (Delim False ']') (activeDelims st) }
ils <- mconcat <$> many pInline
updateState $ \ParserState
st -> ParserState
st{ activeDelims = oldActiveDelims }
(Right ils <$ ender) <|> pure (Left (str starterBs <> ils))
pImage :: P Inlines
pImage :: Parser ParserState Inlines
pImage = do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'!'
(res, raw) <- P (Either Inlines Inlines)
-> Parser ParserState (Either Inlines Inlines, ByteString)
forall s a. Parser s a -> Parser s (a, ByteString)
withByteString P (Either Inlines Inlines)
pBracketed
case res of
Left Inlines
ils -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Inlines
str ByteString
"!" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils)
Right Inlines
ils ->
((ByteString -> Inlines
str ByteString
"!" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> Parser ParserState Inlines
pAddAttributes (Inlines -> Inlines
span_ Inlines
ils))
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines -> Target -> Inlines
image Inlines
ils (Target -> Inlines)
-> Parser ParserState Target -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ParserState Target
pDestination Parser ParserState Target
-> Parser ParserState Target -> Parser ParserState Target
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ParserState Target
pReference ByteString
raw))
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Inlines
str ByteString
"![" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> ByteString -> Inlines
str ByteString
"]")
pAutolink :: P Inlines
pAutolink :: Parser ParserState Inlines
pAutolink = do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'<'
res <- Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf (Parser ParserState () -> Parser ParserState ByteString)
-> Parser ParserState () -> Parser ParserState ByteString
forall a b. (a -> b) -> a -> b
$ Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipSome (Parser ParserState () -> Parser ParserState ())
-> Parser ParserState () -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte (\Char
c -> 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
'<')
asciiChar '>'
let url = (Char -> Bool) -> ByteString -> ByteString
B8.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') ByteString
res
case B8.find (\Char
c -> 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
'.') url of
Just Char
'@' -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> Parser ParserState Inlines)
-> Inlines -> Parser ParserState Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
emailLink ByteString
url
Just Char
_ -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> Parser ParserState Inlines)
-> Inlines -> Parser ParserState Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
urlLink ByteString
url
Maybe Char
Nothing -> Parser ParserState Inlines
forall a. Parser ParserState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
pLinkOrSpan :: P Inlines
pLinkOrSpan :: Parser ParserState Inlines
pLinkOrSpan = do
(res, raw) <- P (Either Inlines Inlines)
-> Parser ParserState (Either Inlines Inlines, ByteString)
forall s a. Parser s a -> Parser s (a, ByteString)
withByteString P (Either Inlines Inlines)
pBracketed
case res of
Left Inlines
ils -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
ils
Right Inlines
ils ->
(Inlines -> Inlines
span_ Inlines
ils Inlines -> Parser ParserState () -> Parser ParserState Inlines
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s a
lookahead (Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'{'))
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines -> Target -> Inlines
link Inlines
ils (Target -> Inlines)
-> Parser ParserState Target -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ParserState Target
pDestination Parser ParserState Target
-> Parser ParserState Target -> Parser ParserState Target
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ParserState Target
pReference ByteString
raw))
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Inlines
str ByteString
"[" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> ByteString -> Inlines
str ByteString
"]")
pDestination :: P Target
pDestination :: Parser ParserState Target
pDestination = do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'('
res <- Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf (Parser ParserState () -> Parser ParserState ByteString)
-> Parser ParserState () -> Parser ParserState ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Parser ParserState ()
pInBalancedParens Int
0
asciiChar ')'
pure $ Direct (snd (handleEscapesAndNewlines res))
where
handleEscapesAndNewlines :: ByteString -> (Bool, ByteString)
handleEscapesAndNewlines = ((Bool, ByteString) -> Char -> (Bool, ByteString))
-> (Bool, ByteString) -> ByteString -> (Bool, ByteString)
forall a. (a -> Char -> a) -> a -> ByteString -> a
B8.foldl' (Bool, ByteString) -> Char -> (Bool, ByteString)
go (Bool
False, ByteString
forall a. Monoid a => a
mempty)
go :: (Bool, ByteString) -> Char -> (Bool, ByteString)
go (Bool
esc, ByteString
bs) Char
'\n' = (Bool
esc, ByteString
bs)
go (Bool
esc, ByteString
bs) Char
'\r' = (Bool
esc, ByteString
bs)
go (Bool
True, ByteString
bs) Char
c = (Bool
False, ByteString
bs ByteString -> Char -> ByteString
`B8.snoc` Char
c)
go (Bool
False, ByteString
bs) Char
'\\' = (Bool
True, ByteString
bs)
go (Bool
False, ByteString
bs) Char
c = (Bool
False, ByteString
bs ByteString -> Char -> ByteString
`B8.snoc` Char
c)
pInBalancedParens :: Int -> P ()
pInBalancedParens :: Int -> Parser ParserState ()
pInBalancedParens Int
nestlevel =
(Bool -> Parser ParserState ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
nestlevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Parser ParserState ()
-> Parser ParserState () -> Parser ParserState ()
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s a
lookahead (Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
')')) Parser ParserState ()
-> Parser ParserState () -> Parser ParserState ()
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
do lev <- (Int
nestlevel Int -> Parser ParserState () -> Parser ParserState Int
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
fails Parser ParserState ()
pCloser Parser ParserState ()
-> Parser ParserState () -> Parser ParserState ()
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte
(\Char
c -> 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
'\\')))
Parser ParserState Int
-> Parser ParserState Int -> Parser ParserState Int
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int
nestlevel Int -> Parser ParserState () -> Parser ParserState Int
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'\\' Parser ParserState ()
-> Parser ParserState Char -> Parser ParserState ()
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ParserState Char
forall s. Parser s Char
anyChar))
Parser ParserState Int
-> Parser ParserState Int -> Parser ParserState Int
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Int
nestlevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Parser ParserState () -> Parser ParserState Int
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'(')
Parser ParserState Int
-> Parser ParserState Int -> Parser ParserState Int
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Int
nestlevel Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Parser ParserState () -> Parser ParserState Int
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
')')
pInBalancedParens lev
pReference :: ByteString -> P Target
pReference :: ByteString -> Parser ParserState Target
pReference ByteString
rawDescription = do
Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'['
bs <- Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf (Parser ParserState () -> Parser ParserState ByteString)
-> Parser ParserState () -> Parser ParserState ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Parser ParserState () -> Parser ParserState ()
pAtMost Int
400 (Parser ParserState () -> Parser ParserState ())
-> Parser ParserState () -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte
(\Char
c -> 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
']')
asciiChar ']'
let label = ByteString -> ByteString
normalizeLabel (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
if ByteString -> Bool
B.null ByteString
bs
then Int -> ByteString -> ByteString
B.drop Int
1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.dropEnd Int
1
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B8.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ByteString
rawDescription
else ByteString
bs
pure $ Reference label
pAtMost :: Int -> P () -> P ()
pAtMost :: Int -> Parser ParserState () -> Parser ParserState ()
pAtMost Int
n Parser ParserState ()
pa = Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
optional_ (Parser ParserState ()
pa Parser ParserState ()
-> Parser ParserState () -> Parser ParserState ()
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser ParserState () -> Parser ParserState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Parser ParserState () -> Parser ParserState ()
pAtMost ( Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 ) Parser ParserState ()
pa))
pOpenDoubleQuote :: P ()
pOpenDoubleQuote :: Parser ParserState ()
pOpenDoubleQuote = do
lbrace <- (Bool
True Bool -> Parser ParserState () -> Parser ParserState Bool
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'{') Parser ParserState Bool
-> Parser ParserState Bool -> Parser ParserState Bool
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ParserState Bool
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
asciiChar '"'
rbrace <- (True <$ asciiChar '}') <|> pure False
guard $ lbrace || not rbrace
pCloseDoubleQuote :: P ()
pCloseDoubleQuote :: Parser ParserState ()
pCloseDoubleQuote = do
mblastc <- Parser ParserState (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
let whitespaceBefore = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isWs Maybe Char
mblastc
lbrace <- (True <$ asciiChar '{') <|> pure False
asciiChar '"'
rbrace <- (True <$ asciiChar '}') <|> pure False
whitespaceAfter <- (True <$ lookahead (skipSatisfyByte isWs)) <|> pure False
guard $ not lbrace && (rbrace || not whitespaceBefore || whitespaceAfter)
pDoubleQuote :: P Inlines
pDoubleQuote :: Parser ParserState Inlines
pDoubleQuote = (do
Parser ParserState ()
pOpenDoubleQuote
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> Parser ParserState [Inlines] -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState Inlines -> Parser ParserState [Inlines]
forall a. Parser ParserState a -> Parser ParserState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
fails Parser ParserState ()
pCloseDoubleQuote Parser ParserState ()
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ParserState Inlines
pInline)
(doubleQuoted contents <$ pCloseDoubleQuote)
<|> pure (openDoubleQuote <> contents))
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines
closeDoubleQuote Inlines -> Parser ParserState () -> Parser ParserState Inlines
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'"')
openDoubleQuote, closeDoubleQuote :: Inlines
openDoubleQuote :: Inlines
openDoubleQuote = ByteString -> Inlines
str ByteString
"\226\128\156"
closeDoubleQuote :: Inlines
closeDoubleQuote = ByteString -> Inlines
str ByteString
"\226\128\157"
pOpenSingleQuote :: P ()
pOpenSingleQuote :: Parser ParserState ()
pOpenSingleQuote = do
lastc <- Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
'\n' (Maybe Char -> Char)
-> Parser ParserState (Maybe Char) -> Parser ParserState Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
let openContext = Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
||
Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
||
Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
||
Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
|| Char
lastc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0'
lbrace <- (True <$ asciiChar '{') <|> pure False
asciiChar '\''
rbrace <- (True <$ asciiChar '}') <|> pure False
guard $ lbrace || (openContext && not rbrace)
pCloseSingleQuote :: P ()
pCloseSingleQuote :: Parser ParserState ()
pCloseSingleQuote = do
mblastc <- Parser ParserState (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
let whitespaceBefore = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isWs Maybe Char
mblastc
lbrace <- (True <$ asciiChar '{') <|> pure False
asciiChar '\''
rbrace <- (True <$ asciiChar '}') <|> pure False
letterAfter <- (True <$ lookahead (satisfy isLetter)) <|> pure False
guard $ not lbrace && (rbrace || not (whitespaceBefore || letterAfter))
pSingleQuote :: P Inlines
pSingleQuote :: Parser ParserState Inlines
pSingleQuote = (do
Parser ParserState ()
pOpenSingleQuote
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> Parser ParserState [Inlines] -> Parser ParserState Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState Inlines -> Parser ParserState [Inlines]
forall a. Parser ParserState a -> Parser ParserState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
fails Parser ParserState ()
pCloseSingleQuote Parser ParserState ()
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a b.
Parser ParserState a
-> Parser ParserState b -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ParserState Inlines
pInline)
(singleQuoted contents <$ pCloseSingleQuote)
<|> pure (closeSingleQuote <> contents))
Parser ParserState Inlines
-> Parser ParserState Inlines -> Parser ParserState Inlines
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines
closeSingleQuote Inlines -> Parser ParserState () -> Parser ParserState Inlines
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'\'')
closeSingleQuote :: Inlines
closeSingleQuote :: Inlines
closeSingleQuote = ByteString -> Inlines
str ByteString
"\226\128\153"
pHyphens :: P Inlines
pHyphens :: Parser ParserState Inlines
pHyphens = do
numHyphens <- [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([()] -> Int) -> Parser ParserState [()] -> Parser ParserState Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState () -> Parser ParserState [()]
forall a. Parser ParserState a -> Parser ParserState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser ParserState ()
forall s. Parser s ()
hyphen
pure $ str $ go numHyphens
where
emdash :: ByteString
emdash = ByteString
"\226\128\148"
endash :: ByteString
endash = ByteString
"\226\128\147"
hyphen :: Parser s ()
hyphen = Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
'-' Parser s () -> Parser s () -> Parser s ()
forall s a b. Parser s a -> Parser s b -> Parser s a
`notFollowedBy` Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
'}'
go :: Int -> ByteString
go Int
1 = ByteString
"-"
go Int
n | Int
n 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
= [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat (Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`Prelude.div` Int
3) ByteString
emdash)
| Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
= [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat (Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`Prelude.div` Int
2) ByteString
endash)
| Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
= [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat (Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`Prelude.div` Int
3) ByteString
emdash) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
endash
| Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
= [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat (Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`Prelude.div` Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
emdash) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
ByteString
endash ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
endash
| Bool
otherwise
= ByteString
emdash ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)
pEllipses :: P Inlines
pEllipses :: Parser ParserState Inlines
pEllipses = ByteString -> Inlines
str ByteString
"\226\128\166" Inlines -> Parser ParserState () -> Parser ParserState Inlines
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ParserState ()
forall s. ByteString -> Parser s ()
byteString ByteString
"..."
stripEndChunks :: Seq Chunk -> Seq Chunk
stripEndChunks :: Seq Chunk -> Seq Chunk
stripEndChunks Seq Chunk
cs =
case Seq Chunk -> ViewR Chunk
forall a. Seq a -> ViewR a
Seq.viewr Seq Chunk
cs of
Seq Chunk
initial Seq.:> Chunk
c ->
Seq Chunk
initial Seq Chunk -> Chunk -> Seq Chunk
forall a. Seq a -> a -> Seq a
Seq.|> Chunk
c{ chunkBytes = B8.dropWhileEnd isWs (chunkBytes c) }
ViewR Chunk
_ -> Seq Chunk
cs