{-# 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)

-- import Debug.Trace

{-# 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
  Int
sline <- Parser ParserState Int
forall s. Parser s Int
sourceLine
  Int
scol <- Parser ParserState Int
forall s. Parser s Int
sourceColumn
  Inlines
res <- Parser ParserState Inlines
pInline'
  ParseOptions
opts <- ParserState -> ParseOptions
options (ParserState -> ParseOptions)
-> Parser ParserState ParserState
-> Parser ParserState ParseOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState ParserState
forall s. Parser s s
getState
  (case ParseOptions -> SourcePosOption
sourcePositions ParseOptions
opts of
     SourcePosOption
AllSourcePos -> do
       Int
eline <- Parser ParserState Int
forall s. Parser s Int
sourceLine
       Int
ecol <- Parser ParserState Int
forall s. Parser s Int
sourceColumn
       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
$ Pos -> Node Inline -> Node Inline
forall a. Pos -> Node a -> Node a
addPos (Int -> Int -> Int -> Int -> Pos
Pos Int
sline Int
scol Int
eline (Int
ecol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines
res
     SourcePosOption
_ -> Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
res) Parser ParserState Inlines
-> (Inlines -> Parser ParserState Inlines)
-> Parser ParserState Inlines
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
>>= Inlines -> Parser ParserState Inlines
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] -> 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
  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 Attr
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 ->
               -- attach attribute to last word
               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  -- ignore attr after whitespace
                     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 Char
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)
      Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
fails Parser ParserState ()
pCloser
      (case Char
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)
        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
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
  ParserState
st <- Parser ParserState ParserState
forall s. Parser s s
getState
  Char
c <- (Char -> Bool) -> Parser ParserState Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte (case ParserState -> InlineParseMode
mode ParserState
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 Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
     then Inlines -> Parser ParserState Inlines
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
     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 -> Inlines) -> ByteString -> Inlines
forall a b. (a -> b) -> a -> b
$ Char -> ByteString
B8.singleton Char
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
'\\'
  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 Char
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 -- assumes we've parsed \ already
  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
':'
  ByteString
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)))
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar 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
symbol ByteString
bs

pMath :: P Inlines
pMath :: Parser ParserState Inlines
pMath = do
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'$'
  MathStyle
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
  Inlines
verb <- Parser ParserState Inlines
pVerbatim
  case Inlines -> Seq (Node Inline)
forall a. Many a -> Seq a
unMany Inlines
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
  Set Delim
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 Delim -> Bool
forall a. Set a -> Bool
Set.null Set Delim
delims
     then Parser ParserState ()
forall a. Parser ParserState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     else do
       Bool
openerHadBrace <- [Parser ParserState Bool] -> Parser ParserState Bool
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser ParserState Bool] -> Parser ParserState Bool)
-> [Parser ParserState Bool] -> Parser ParserState Bool
forall a b. (a -> b) -> a -> b
$
         (Delim -> Parser ParserState Bool)
-> [Delim] -> [Parser ParserState Bool]
forall a b. (a -> b) -> [a] -> [b]
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) (Set Delim -> [Delim]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Set Delim
delims)
       Maybe Char
mblastc <- Parser ParserState (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
       let afterws :: Bool
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
       Bool -> Parser ParserState () -> Parser ParserState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Bool
afterws Bool -> Bool -> Bool
|| Bool
openerHadBrace ) (Parser ParserState () -> Parser ParserState ())
-> Parser ParserState () -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'}'

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
        Maybe Char
mblastc <- Parser s (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
        let afterws :: Bool
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
        Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
c
        if Bool
leftBrace
           then Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
'}'
           else Bool -> Parser s ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
afterws) 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
'}'
  Bool
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
  ByteString
starterBs <- (if Bool
leftBrace then (ByteString
"{" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) else ByteString -> ByteString
forall a. a -> a
id) (ByteString -> ByteString)
-> Parser ParserState ByteString -> Parser ParserState ByteString
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 (Bool -> Parser ParserState ()
forall {s}. Bool -> Parser s ()
starter Bool
leftBrace) Parser ParserState ByteString
-> Parser ParserState Attr -> Parser ParserState ByteString
forall s a b. Parser s a -> Parser s b -> Parser s a
`notFollowedBy` Parser ParserState Attr
forall s. Parser s Attr
pAttributes
                 -- don't let *{.foo} start emphasis, for example
  Set Delim
oldActiveDelims <- 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
  (ParserState -> ParserState) -> Parser ParserState ()
forall s. (s -> s) -> Parser s ()
updateState ((ParserState -> ParserState) -> Parser ParserState ())
-> (ParserState -> ParserState) -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ activeDelims = Set.insert (Delim leftBrace c)
                                             (activeDelims st) }
  Inlines
firstIl <- Parser ParserState Inlines
pInline 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
<|> Char -> (Inlines -> Inlines) -> Parser ParserState Inlines
pBetween Char
c Inlines -> Inlines
constructor -- to allow stacked cases like '**hi**'
  [Inlines]
restIls <- 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
  let ils :: Inlines
ils = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (Inlines
firstIlInlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:[Inlines]
restIls)
  (ParserState -> ParserState) -> Parser ParserState ()
forall s. (s -> s) -> Parser s ()
updateState ((ParserState -> ParserState) -> Parser ParserState ())
-> (ParserState -> ParserState) -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ activeDelims = oldActiveDelims }
  (Inlines -> Inlines
constructor 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
<$ Bool -> Parser ParserState ()
forall {s}. Bool -> Parser s ()
ender Bool
leftBrace) 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
starterBs Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils)

pTicks :: P Int
pTicks :: Parser ParserState Int
pTicks = do
  Int
sp <- Parser ParserState Int
forall s. Parser s Int
getOffset
  Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s ()
skipSome (Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'`')
  Int
ep <- Parser ParserState Int
forall s. Parser s Int
getOffset
  Int -> Parser ParserState Int
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
ep Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sp)

pVerbatim :: P Inlines
pVerbatim :: Parser ParserState Inlines
pVerbatim = do
  Int
numticks <- Parser ParserState Int
pTicks
  let ender :: Parser ParserState ()
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 ()
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
'`'))
  ByteString
bs <- ByteString -> ByteString
trimSpaces (ByteString -> ByteString)
-> Parser ParserState ByteString -> Parser ParserState ByteString
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 Parser ParserState ()
content) Parser ParserState ByteString
-> Parser ParserState () -> Parser ParserState ByteString
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 ()
ender 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 ()
forall s. Parser s ()
eof)
  (Format -> ByteString -> Inlines
rawInline (Format -> ByteString -> Inlines)
-> Parser ParserState Format
-> Parser ParserState (ByteString -> Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserState Format
pRawAttribute Parser ParserState (ByteString -> Inlines)
-> Parser ParserState ByteString -> Parser ParserState Inlines
forall a b.
Parser ParserState (a -> b)
-> Parser ParserState a -> Parser ParserState b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Parser ParserState ByteString
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs) 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
verbatim ByteString
bs)

-- Trim a leading space if first non-space character is `,
-- and similarly for trailing space/last non-space.
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
"{="
  Format
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))))
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'}'
  Format -> Parser ParserState Format
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
fmt

pFootnoteReference :: P Inlines
pFootnoteReference :: Parser ParserState Inlines
pFootnoteReference = do
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'['
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'^'
  ByteString
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))
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar 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
footnoteReference ByteString
label

-- returns Left with parsed content if no ] has been reached, otherwise Right
-- with inner contents.
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
']'
  ByteString
starterBs <- Parser ParserState () -> Parser ParserState ByteString
forall s a. Parser s a -> Parser s ByteString
byteStringOf Parser ParserState ()
forall s. Parser s ()
starter
  Set Delim
oldActiveDelims <- 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
  (ParserState -> ParserState) -> Parser ParserState ()
forall s. (s -> s) -> Parser s ()
updateState ((ParserState -> ParserState) -> Parser ParserState ())
-> (ParserState -> ParserState) -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ activeDelims = Set.insert (Delim False ']') (activeDelims st) }
  Inlines
ils <- [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
  (ParserState -> ParserState) -> Parser ParserState ()
forall s. (s -> s) -> Parser s ()
updateState ((ParserState -> ParserState) -> Parser ParserState ())
-> (ParserState -> ParserState) -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ activeDelims = oldActiveDelims }
  (Inlines -> Either Inlines Inlines
forall a b. b -> Either a b
Right Inlines
ils Either Inlines Inlines
-> Parser ParserState () -> P (Either Inlines 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 ()
ender) P (Either Inlines Inlines)
-> P (Either Inlines Inlines) -> P (Either Inlines Inlines)
forall a.
Parser ParserState a
-> Parser ParserState a -> Parser ParserState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either Inlines Inlines -> P (Either Inlines Inlines)
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> Either Inlines Inlines
forall a b. a -> Either a b
Left (ByteString -> Inlines
str ByteString
starterBs Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils))

pImage :: P Inlines
pImage :: Parser ParserState Inlines
pImage = do
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'!'
  (Either Inlines Inlines
res, ByteString
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 Either Inlines Inlines
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
'<'
  ByteString
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
'<')
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'>'
  let url :: ByteString
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 (Char -> Bool) -> ByteString -> Maybe Char
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
'.') ByteString
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
  (Either Inlines Inlines
res, ByteString
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 Either Inlines Inlines
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
"]")

-- We allow balanced pairs of parens inside.
pDestination :: P Target
pDestination :: Parser ParserState Target
pDestination = do
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'('
  ByteString
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
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
')'
  Target -> Parser ParserState Target
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Target -> Parser ParserState Target)
-> Target -> Parser ParserState Target
forall a b. (a -> b) -> a -> b
$ ByteString -> Target
Direct ((Bool, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (ByteString -> (Bool, ByteString)
handleEscapesAndNewlines ByteString
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 Int
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
*>
                               -- but see https://github.com/jgm/djot/discussions/247
                               (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
')')
       Int -> Parser ParserState ()
pInBalancedParens Int
lev

pReference :: ByteString -> P Target
pReference :: ByteString -> Parser ParserState Target
pReference ByteString
rawDescription = do
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'['
  ByteString
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
']')
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
']'
  let label :: ByteString
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
  Target -> Parser ParserState Target
forall a. a -> Parser ParserState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Target -> Parser ParserState Target)
-> Target -> Parser ParserState Target
forall a b. (a -> b) -> a -> b
$ ByteString -> Target
Reference ByteString
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
  Bool
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
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'"'
  Bool
rbrace <- (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
  Bool -> Parser ParserState ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ParserState ()) -> Bool -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ Bool
lbrace Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
rbrace

pCloseDoubleQuote :: P ()
pCloseDoubleQuote :: Parser ParserState ()
pCloseDoubleQuote = do
  Maybe Char
mblastc <- Parser ParserState (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
  let whitespaceBefore :: Bool
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
  Bool
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
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'"'
  Bool
rbrace <- (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
  Bool
whitespaceAfter <- (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
<$ Parser ParserState () -> Parser ParserState ()
forall s a. Parser s a -> Parser s a
lookahead ((Char -> Bool) -> Parser ParserState ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte Char -> Bool
isWs)) 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
  Bool -> Parser ParserState ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ParserState ()) -> Bool -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
lbrace Bool -> Bool -> Bool
&& (Bool
rbrace Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
whitespaceBefore Bool -> Bool -> Bool
|| Bool
whitespaceAfter)

pDoubleQuote :: P Inlines
pDoubleQuote :: Parser ParserState Inlines
pDoubleQuote = (do
  Parser ParserState ()
pOpenDoubleQuote
  Inlines
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)
  (Inlines -> Inlines
doubleQuoted Inlines
contents 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 ()
pCloseDoubleQuote)
    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
openDoubleQuote Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
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" -- utf8 0x201C
closeDoubleQuote :: Inlines
closeDoubleQuote = ByteString -> Inlines
str ByteString
"\226\128\157" -- utf8 0x201D

pOpenSingleQuote :: P ()
pOpenSingleQuote :: Parser ParserState ()
pOpenSingleQuote = do
  Char
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 :: Bool
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'
  Bool
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
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'\''
  Bool
rbrace <- (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
  Bool -> Parser ParserState ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ParserState ()) -> Bool -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ Bool
lbrace Bool -> Bool -> Bool
|| (Bool
openContext Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
rbrace)

pCloseSingleQuote :: P ()
pCloseSingleQuote :: Parser ParserState ()
pCloseSingleQuote = do
  Maybe Char
mblastc <- Parser ParserState (Maybe Char)
forall s. Parser s (Maybe Char)
peekBack
  let whitespaceBefore :: Bool
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
  Bool
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
  Char -> Parser ParserState ()
forall s. Char -> Parser s ()
asciiChar Char
'\''
  Bool
rbrace <- (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
  Bool
letterAfter <- (Bool
True Bool -> Parser ParserState Char -> Parser ParserState Bool
forall a b. a -> Parser ParserState b -> Parser ParserState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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
satisfy Char -> Bool
isLetter)) 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
  Bool -> Parser ParserState ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ParserState ()) -> Bool -> Parser ParserState ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
lbrace Bool -> Bool -> Bool
&& (Bool
rbrace Bool -> Bool -> Bool
|| Bool -> Bool
not (Bool
whitespaceBefore Bool -> Bool -> Bool
|| Bool
letterAfter))

pSingleQuote :: P Inlines
pSingleQuote :: Parser ParserState Inlines
pSingleQuote = (do
  Parser ParserState ()
pOpenSingleQuote
  Inlines
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)
  (Inlines -> Inlines
singleQuoted Inlines
contents 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 ()
pCloseSingleQuote)
    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
closeSingleQuote Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
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" -- utf8 0x2019

pHyphens :: P Inlines
pHyphens :: Parser ParserState Inlines
pHyphens = do
  Int
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
  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
$ Int -> ByteString
go Int
numHyphens
    where
     emdash :: ByteString
emdash = ByteString
"\226\128\148" -- utf8 0x2014
     endash :: ByteString
endash = ByteString
"\226\128\147" -- utf8 0x2013
     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" {- utf8 0x2026 -} 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