{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Parsing.Smart
( apostrophe
, dash
, doubleCloseQuote
, doubleQuoteEnd
, doubleQuoteStart
, doubleQuoted
, ellipses
, singleQuoteEnd
, singleQuoteStart
, singleQuoted
, smartPunctuation
)
where
import Control.Monad (guard , void)
import Text.Pandoc.Builder (Inlines)
import Text.Pandoc.Options
( extensionEnabled
, Extension(Ext_old_dashes, Ext_smart)
, ReaderOptions(readerExtensions) )
import Text.Pandoc.Sources
import Text.Pandoc.Parsing.Capabilities
import Text.Pandoc.Parsing.General
import Text.Parsec
( (<|>)
, Stream(..)
, ParsecT
, choice
, lookAhead
, manyTill
, notFollowedBy
, try
)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
smartPunctuation :: (HasReaderOptions st, HasLastStrPosition st,
HasQuoteContext st m,
Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
-> ParsecT s st m Inlines
smartPunctuation :: forall st (m :: * -> *) s.
(HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m,
Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
smartPunctuation ParsecT s st m Inlines
inlineParser = do
Extension -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_smart
[ParsecT s st m Inlines] -> ParsecT s st m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParsecT s st m Inlines -> ParsecT s st m Inlines
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
quoted ParsecT s st m Inlines
inlineParser, ParsecT s st m Inlines
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
apostrophe, ParsecT s st m Inlines
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
doubleCloseQuote, ParsecT s st m Inlines
forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
dash, ParsecT s st m Inlines
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
ellipses ]
quoted :: (HasLastStrPosition st, HasQuoteContext st m,
Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
-> ParsecT s st m Inlines
quoted :: forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
quoted ParsecT s st m Inlines
inlineParser = ParsecT s st m Inlines -> ParsecT s st m Inlines
forall st (m :: * -> *) s.
(HasQuoteContext st m, HasLastStrPosition st, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
doubleQuoted ParsecT s st m Inlines
inlineParser ParsecT s st m Inlines
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
singleQuoted ParsecT s st m Inlines
inlineParser
singleQuoted :: (HasLastStrPosition st, HasQuoteContext st m,
Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
-> ParsecT s st m Inlines
singleQuoted :: forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
singleQuoted ParsecT s st m Inlines
inlineParser = do
ParsecT s st m ()
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m ()
singleQuoteStart
(Inlines -> Inlines
B.singleQuoted (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT s st m [Inlines] -> ParsecT s st m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT s st m [Inlines] -> ParsecT s st m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
(QuoteContext
-> ParsecT s st m [Inlines] -> ParsecT s st m [Inlines]
forall s a. QuoteContext -> ParsecT s st m a -> ParsecT s st m a
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InSingleQuote (ParsecT s st m Inlines
-> ParsecT s st m () -> ParsecT s st m [Inlines]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ParsecT s st m Inlines
inlineParser ParsecT s st m ()
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m ()
singleQuoteEnd)))
ParsecT s st m Inlines
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
"\8217"
doubleQuoted :: (HasQuoteContext st m, HasLastStrPosition st,
Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
-> ParsecT s st m Inlines
doubleQuoted :: forall st (m :: * -> *) s.
(HasQuoteContext st m, HasLastStrPosition st, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
doubleQuoted ParsecT s st m Inlines
inlineParser = do
ParsecT s st m ()
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m ()
doubleQuoteStart
(Inlines -> Inlines
B.doubleQuoted (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT s st m [Inlines] -> ParsecT s st m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT s st m [Inlines] -> ParsecT s st m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
(QuoteContext
-> ParsecT s st m [Inlines] -> ParsecT s st m [Inlines]
forall s a. QuoteContext -> ParsecT s st m a -> ParsecT s st m a
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InDoubleQuote (ParsecT s st m Inlines
-> ParsecT s st m () -> ParsecT s st m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT s st m Inlines
inlineParser ParsecT s st m ()
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m ()
doubleQuoteEnd)))
ParsecT s st m Inlines
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Inlines
B.str Text
"\8220")
charOrRef :: (Stream s m Char, UpdateSourcePos s Char) => [Char] -> ParsecT s st m Char
charOrRef :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s st m Char
charOrRef [Char]
cs =
[Char] -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
cs ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do Text
t <- ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
characterReference
case Text -> [Char]
T.unpack Text
t of
[Char
c] | Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
cs -> Char -> ParsecT s st m Char
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
[Char]
_ -> [Char] -> ParsecT s st m Char
forall a. [Char] -> ParsecT s st m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"unexpected character reference")
singleQuoteStart :: (HasLastStrPosition st, HasQuoteContext st m,
Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m ()
singleQuoteStart :: forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m ()
singleQuoteStart = do
QuoteContext -> ParsecT s st m ()
forall st (m :: * -> *) s t.
(HasQuoteContext st m, Stream s m t) =>
QuoteContext -> ParsecT s st m ()
failIfInQuoteContext QuoteContext
InSingleQuote
Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT s st m ())
-> ParsecT s st m Bool -> ParsecT s st m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT s st m Bool
forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParsecT s st m Bool
notAfterString
ParsecT s st m () -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s st m Char
charOrRef [Char]
"'\8216\145"
ParsecT s st m Char -> ParsecT s st m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT s st m Char -> ParsecT s st m ())
-> ParsecT s st m Char -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char -> ParsecT s st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpaceChar))
singleQuoteEnd :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m ()
singleQuoteEnd :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m ()
singleQuoteEnd = ParsecT s st m () -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s st m Char
charOrRef [Char]
"'\8217\146"
ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum
doubleQuoteStart :: (HasLastStrPosition st,
HasQuoteContext st m,
Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m ()
doubleQuoteStart :: forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char,
UpdateSourcePos s Char) =>
ParsecT s st m ()
doubleQuoteStart = do
QuoteContext -> ParsecT s st m ()
forall st (m :: * -> *) s t.
(HasQuoteContext st m, Stream s m t) =>
QuoteContext -> ParsecT s st m ()
failIfInQuoteContext QuoteContext
InDoubleQuote
Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT s st m ())
-> ParsecT s st m Bool -> ParsecT s st m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT s st m Bool
forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParsecT s st m Bool
notAfterString
ParsecT s st m () -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ do [Char] -> ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s st m Char
charOrRef [Char]
"\"\8220\147"
ParsecT s st m Char -> ParsecT s st m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT s st m Char -> ParsecT s st m ())
-> ParsecT s st m Char -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char -> ParsecT s st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpaceChar))
doubleQuoteEnd :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m ()
doubleQuoteEnd :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m ()
doubleQuoteEnd = ParsecT s st m Char -> ParsecT s st m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s st m Char
charOrRef [Char]
"\"\8221\148")
apostrophe :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
apostrophe :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
apostrophe = (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\8217') ParsecT s st m Char
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8217")
doubleCloseQuote :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
doubleCloseQuote :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
doubleCloseQuote = Text -> Inlines
B.str Text
"\8221" Inlines -> ParsecT s st m Char -> ParsecT s st m Inlines
forall a b. a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
ellipses :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
ellipses :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
ellipses = ParsecT s st m Inlines -> ParsecT s st m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT s st m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"..." ParsecT s st m [Char]
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8230"))
dash :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m Inlines
dash :: forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines
dash = ParsecT s st m Inlines -> ParsecT s st m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Inlines -> ParsecT s st m Inlines)
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall a b. (a -> b) -> a -> b
$ do
Bool
oldDashes <- Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_old_dashes (Extensions -> Bool)
-> ParsecT s st m Extensions -> ParsecT s st m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderOptions -> Extensions) -> ParsecT s st m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
if Bool
oldDashes
then do
Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-'
(Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT s st m Char
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8212"))
ParsecT s st m Inlines
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s st m Char -> ParsecT s st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit ParsecT s st m Char
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8211"))
else do
[Char] -> ParsecT s st m [Char]
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m [Char]
string [Char]
"--"
(Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT s st m Char
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8212"))
ParsecT s st m Inlines
-> ParsecT s st m Inlines -> ParsecT s st m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Inlines -> ParsecT s st m Inlines
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8211")