{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ExplicitForAll             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE IncoherentInstances        #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ViewPatterns               #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Parsing
   Copyright   : Copyright (C) 2006-2021 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

A utility library with parsers used in pandoc readers.
-}

module Text.Pandoc.Parsing ( take1WhileP,
                             takeP,
                             countChar,
                             textStr,
                             anyLine,
                             anyLineNewline,
                             indentWith,
                             manyChar,
                             many1Char,
                             manyTillChar,
                             many1TillChar,
                             many1Till,
                             manyUntil,
                             manyUntilChar,
                             sepBy1',
                             notFollowedBy',
                             oneOfStrings,
                             oneOfStringsCI,
                             spaceChar,
                             nonspaceChar,
                             skipSpaces,
                             blankline,
                             blanklines,
                             gobbleSpaces,
                             gobbleAtMostSpaces,
                             enclosed,
                             stringAnyCase,
                             parseFromString,
                             parseFromString',
                             lineClump,
                             charsInBalanced,
                             romanNumeral,
                             emailAddress,
                             uri,
                             mathInline,
                             mathDisplay,
                             withHorizDisplacement,
                             withRaw,
                             escaped,
                             characterReference,
                             upperRoman,
                             lowerRoman,
                             decimal,
                             lowerAlpha,
                             upperAlpha,
                             anyOrderedListMarker,
                             orderedListMarker,
                             charRef,
                             lineBlockLines,
                             tableWith,
                             widthsFromIndices,
                             gridTableWith,
                             gridTableWith',
                             readWith,
                             readWithM,
                             testStringWith,
                             guardEnabled,
                             guardDisabled,
                             updateLastStrPos,
                             notAfterString,
                             logMessage,
                             reportLogMessages,
                             ParserState (..),
                             HasReaderOptions (..),
                             HasIdentifierList (..),
                             HasMacros (..),
                             HasLogMessages (..),
                             HasLastStrPosition (..),
                             HasIncludeFiles (..),
                             defaultParserState,
                             HeaderType (..),
                             ParserContext (..),
                             QuoteContext (..),
                             HasQuoteContext (..),
                             NoteTable,
                             NoteTable',
                             KeyTable,
                             SubstTable,
                             Key (..),
                             toKey,
                             registerHeader,
                             smartPunctuation,
                             singleQuoteStart,
                             singleQuoteEnd,
                             doubleQuoteStart,
                             doubleQuoteEnd,
                             ellipses,
                             apostrophe,
                             dash,
                             nested,
                             citeKey,
                             Parser,
                             ParserT,
                             F,
                             Future(..),
                             runF,
                             askF,
                             asksF,
                             returnF,
                             trimInlinesF,
                             token,
                             (<+?>),
                             extractIdClass,
                             insertIncludedFile,
                             insertIncludedFileF,
                             -- * Re-exports from Text.Parsec
                             Stream,
                             runParser,
                             runParserT,
                             parse,
                             tokenPrim,
                             anyToken,
                             getInput,
                             setInput,
                             unexpected,
                             char,
                             letter,
                             digit,
                             alphaNum,
                             skipMany,
                             skipMany1,
                             spaces,
                             space,
                             anyChar,
                             satisfy,
                             newline,
                             string,
                             count,
                             eof,
                             noneOf,
                             oneOf,
                             lookAhead,
                             notFollowedBy,
                             many,
                             many1,
                             manyTill,
                             (<|>),
                             (<?>),
                             choice,
                             try,
                             sepBy,
                             sepBy1,
                             sepEndBy,
                             sepEndBy1,
                             endBy,
                             endBy1,
                             option,
                             optional,
                             optionMaybe,
                             getState,
                             setState,
                             updateState,
                             SourcePos,
                             getPosition,
                             setPosition,
                             sourceColumn,
                             sourceLine,
                             setSourceColumn,
                             setSourceLine,
                             incSourceColumn,
                             incSourceLine,
                             newPos,
                             initialPos,
                             Line,
                             Column,
                             ParseError
                             )
where

import Control.Monad.Identity
import Control.Monad.Reader
import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper, isAsciiLower,
                  isPunctuation, isSpace, ord, toLower, toUpper)
import Data.Default
import Data.Functor (($>))
import Data.List (intercalate, transpose)
import qualified Data.Map as M
import Data.Maybe (mapMaybe, fromMaybe)
import qualified Data.Set as Set
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc.Asciify (toAsciiChar)
import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, readFileFromDirs, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Readers.LaTeX.Types (Macro)
import Text.Pandoc.Shared
import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
import Text.Pandoc.XML (fromEntities)
import Text.Parsec hiding (token)
import Text.Parsec.Pos (initialPos, newPos, updatePosString)

import Control.Monad.Except
import Text.Pandoc.Error

type Parser t s = Parsec t s

type ParserT = ParsecT

-- | Reader monad wrapping the parser state. This is used to possibly delay
-- evaluation until all relevant information has been parsed and made available
-- in the parser state.
newtype Future s a = Future { Future s a -> Reader s a
runDelayed :: Reader s a }
  deriving (Applicative (Future s)
a -> Future s a
Applicative (Future s)
-> (forall a b. Future s a -> (a -> Future s b) -> Future s b)
-> (forall a b. Future s a -> Future s b -> Future s b)
-> (forall a. a -> Future s a)
-> Monad (Future s)
Future s a -> (a -> Future s b) -> Future s b
Future s a -> Future s b -> Future s b
forall s. Applicative (Future s)
forall a. a -> Future s a
forall s a. a -> Future s a
forall a b. Future s a -> Future s b -> Future s b
forall a b. Future s a -> (a -> Future s b) -> Future s b
forall s a b. Future s a -> Future s b -> Future s b
forall s a b. Future s a -> (a -> Future s b) -> Future s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Future s a
$creturn :: forall s a. a -> Future s a
>> :: Future s a -> Future s b -> Future s b
$c>> :: forall s a b. Future s a -> Future s b -> Future s b
>>= :: Future s a -> (a -> Future s b) -> Future s b
$c>>= :: forall s a b. Future s a -> (a -> Future s b) -> Future s b
$cp1Monad :: forall s. Applicative (Future s)
Monad, Functor (Future s)
a -> Future s a
Functor (Future s)
-> (forall a. a -> Future s a)
-> (forall a b. Future s (a -> b) -> Future s a -> Future s b)
-> (forall a b c.
    (a -> b -> c) -> Future s a -> Future s b -> Future s c)
-> (forall a b. Future s a -> Future s b -> Future s b)
-> (forall a b. Future s a -> Future s b -> Future s a)
-> Applicative (Future s)
Future s a -> Future s b -> Future s b
Future s a -> Future s b -> Future s a
Future s (a -> b) -> Future s a -> Future s b
(a -> b -> c) -> Future s a -> Future s b -> Future s c
forall s. Functor (Future s)
forall a. a -> Future s a
forall s a. a -> Future s a
forall a b. Future s a -> Future s b -> Future s a
forall a b. Future s a -> Future s b -> Future s b
forall a b. Future s (a -> b) -> Future s a -> Future s b
forall s a b. Future s a -> Future s b -> Future s a
forall s a b. Future s a -> Future s b -> Future s b
forall s a b. Future s (a -> b) -> Future s a -> Future s b
forall a b c.
(a -> b -> c) -> Future s a -> Future s b -> Future s c
forall s a b c.
(a -> b -> c) -> Future s a -> Future s b -> Future s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Future s a -> Future s b -> Future s a
$c<* :: forall s a b. Future s a -> Future s b -> Future s a
*> :: Future s a -> Future s b -> Future s b
$c*> :: forall s a b. Future s a -> Future s b -> Future s b
liftA2 :: (a -> b -> c) -> Future s a -> Future s b -> Future s c
$cliftA2 :: forall s a b c.
(a -> b -> c) -> Future s a -> Future s b -> Future s c
<*> :: Future s (a -> b) -> Future s a -> Future s b
$c<*> :: forall s a b. Future s (a -> b) -> Future s a -> Future s b
pure :: a -> Future s a
$cpure :: forall s a. a -> Future s a
$cp1Applicative :: forall s. Functor (Future s)
Applicative, a -> Future s b -> Future s a
(a -> b) -> Future s a -> Future s b
(forall a b. (a -> b) -> Future s a -> Future s b)
-> (forall a b. a -> Future s b -> Future s a)
-> Functor (Future s)
forall a b. a -> Future s b -> Future s a
forall a b. (a -> b) -> Future s a -> Future s b
forall s a b. a -> Future s b -> Future s a
forall s a b. (a -> b) -> Future s a -> Future s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Future s b -> Future s a
$c<$ :: forall s a b. a -> Future s b -> Future s a
fmap :: (a -> b) -> Future s a -> Future s b
$cfmap :: forall s a b. (a -> b) -> Future s a -> Future s b
Functor)

type F = Future ParserState

runF :: Future s a -> s -> a
runF :: Future s a -> s -> a
runF = Reader s a -> s -> a
forall r a. Reader r a -> r -> a
runReader (Reader s a -> s -> a)
-> (Future s a -> Reader s a) -> Future s a -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Future s a -> Reader s a
forall s a. Future s a -> Reader s a
runDelayed

askF :: Future s s
askF :: Future s s
askF = Reader s s -> Future s s
forall s a. Reader s a -> Future s a
Future Reader s s
forall r (m :: * -> *). MonadReader r m => m r
ask

asksF :: (s -> a) -> Future s a
asksF :: (s -> a) -> Future s a
asksF s -> a
f = Reader s a -> Future s a
forall s a. Reader s a -> Future s a
Future (Reader s a -> Future s a) -> Reader s a -> Future s a
forall a b. (a -> b) -> a -> b
$ (s -> a) -> Reader s a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks s -> a
f

returnF :: Monad m => a -> m (Future s a)
returnF :: a -> m (Future s a)
returnF = Future s a -> m (Future s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future s a -> m (Future s a))
-> (a -> Future s a) -> a -> m (Future s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Future s a
forall (m :: * -> *) a. Monad m => a -> m a
return

trimInlinesF :: Future s Inlines -> Future s Inlines
trimInlinesF :: Future s Inlines -> Future s Inlines
trimInlinesF = (Inlines -> Inlines) -> Future s Inlines -> Future s Inlines
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Inlines -> Inlines
trimInlines

instance Semigroup a => Semigroup (Future s a) where
  <> :: Future s a -> Future s a -> Future s a
(<>) = (a -> a -> a) -> Future s a -> Future s a -> Future s a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Semigroup a, Monoid a) => Monoid (Future s a) where
  mempty :: Future s a
mempty = a -> Future s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
  mappend :: Future s a -> Future s a -> Future s a
mappend = Future s a -> Future s a -> Future s a
forall a. Semigroup a => a -> a -> a
(<>)

-- | Like @count@, but packs its result
countChar :: (Stream s m Char, Monad m)
          => Int
          -> ParsecT s st m Char
          -> ParsecT s st m Text
countChar :: Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
n = (String -> Text) -> ParsecT s st m String -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParsecT s st m Text)
-> (ParsecT s st m Char -> ParsecT s st m String)
-> ParsecT s st m Char
-> ParsecT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n

-- | Like @string@, but uses @Text@.
textStr :: Stream s m Char => Text -> ParsecT s u m Text
textStr :: Text -> ParsecT s u m Text
textStr Text
t = String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Text -> String
T.unpack Text
t) ParsecT s u m String -> Text -> ParsecT s u m Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
t

-- | Parse characters while a predicate is true.
take1WhileP :: Monad m
           => (Char -> Bool)
           -> ParserT Text st m Text
take1WhileP :: (Char -> Bool) -> ParserT Text st m Text
take1WhileP Char -> Bool
f = do
  -- needed to persuade parsec that this won't match an empty string:
  Char
c <- (Char -> Bool) -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
f
  Text
inp <- ParserT Text st m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  SourcePos
pos <- ParsecT Text st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let (Text
t, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
f Text
inp
  Text -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Text
rest
  SourcePos -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Text st m ())
-> SourcePos -> ParsecT Text st m ()
forall a b. (a -> b) -> a -> b
$
    if Char -> Bool
f Char
'\t' Bool -> Bool -> Bool
|| Char -> Bool
f Char
'\n'
       then SourcePos -> String -> SourcePos
updatePosString SourcePos
pos (String -> SourcePos) -> String -> SourcePos
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
       else SourcePos -> Int -> SourcePos
incSourceColumn SourcePos
pos (Text -> Int
T.length Text
t)
  Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT Text st m Text) -> Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

-- Parse n characters of input (or the rest of the input if
-- there aren't n characters).
takeP :: Monad m => Int -> ParserT Text st m Text
takeP :: Int -> ParserT Text st m Text
takeP Int
n = do
  Bool -> ParsecT Text st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
  -- faster than 'count n anyChar'
  Text
inp <- ParserT Text st m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  SourcePos
pos <- ParsecT Text st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let (Text
xs, Text
rest) = Int -> Text -> (Text, Text)
T.splitAt Int
n Text
inp
  -- needed to persuade parsec that this won't match an empty string:
  ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
  Text -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Text
rest
  SourcePos -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Text st m ())
-> SourcePos -> ParsecT Text st m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> String -> SourcePos
updatePosString SourcePos
pos (String -> SourcePos) -> String -> SourcePos
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
xs
  Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
xs

-- | Parse any line of text
anyLine :: Monad m => ParserT Text st m Text
anyLine :: ParserT Text st m Text
anyLine = do
  -- This is much faster than:
  -- manyTill anyChar newline
  Text
inp <- ParserT Text st m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  SourcePos
pos <- ParsecT Text st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') Text
inp of
       (Text
this, Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'\n', Text
rest)) -> do
         -- needed to persuade parsec that this won't match an empty string:
         ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
         Text -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Text
rest
         SourcePos -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Text st m ())
-> SourcePos -> ParsecT Text st m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> Int -> SourcePos
incSourceLine (SourcePos -> Int -> SourcePos
setSourceColumn SourcePos
pos Int
1) Int
1
         Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
this
       (Text, Text)
_ -> ParserT Text st m Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Parse any line, include the final newline in the output
anyLineNewline :: Monad m => ParserT Text st m Text
anyLineNewline :: ParserT Text st m Text
anyLineNewline = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text -> Text) -> ParserT Text st m Text -> ParserT Text st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine

-- | Parse indent by specified number of spaces (or equiv. tabs)
indentWith :: Stream s m Char
           => HasReaderOptions st
           => Int -> ParserT s st m Text
indentWith :: Int -> ParserT s st m Text
indentWith Int
num = do
  Int
tabStop <- (ReaderOptions -> Int) -> ParserT s st m Int
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Int
readerTabStop
  if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tabStop
     then Int -> ParsecT s st m Char -> ParserT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
num (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')
     else [ParserT s st m Text] -> ParserT s st m Text
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Int -> ParsecT s st m Char -> ParserT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
num (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '))
                 , ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\t' ParsecT s st m Char -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParserT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, HasReaderOptions st) =>
Int -> ParserT s st m Text
indentWith (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tabStop)) ]

-- | Like @many@, but packs its result.
manyChar :: Stream s m t
         => ParserT s st m Char
         -> ParserT s st m Text
manyChar :: ParserT s st m Char -> ParserT s st m Text
manyChar = (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> (ParserT s st m Char -> ParsecT s st m String)
-> ParserT s st m Char
-> ParserT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many

-- | Like @many1@, but packs its result.
many1Char :: Stream s m t
          => ParserT s st m Char
          -> ParserT s st m Text
many1Char :: ParserT s st m Char -> ParserT s st m Text
many1Char = (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> (ParserT s st m Char -> ParsecT s st m String)
-> ParserT s st m Char
-> ParserT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1

-- | Like @manyTill@, but packs its result.
manyTillChar :: Stream s m t
             => ParserT s st m Char
             -> ParserT s st m a
             -> ParserT s st m Text
manyTillChar :: ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParserT s st m Char
p = (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> (ParserT s st m a -> ParsecT s st m String)
-> ParserT s st m a
-> ParserT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT s st m Char -> ParserT s st m a -> ParsecT s st m String
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 ParserT s st m Char
p

-- | Like @manyTill@, but reads at least one item.
many1Till :: (Show end, Stream s m t)
          => ParserT s st m a
          -> ParserT s st m end
          -> ParserT s st m [a]
many1Till :: ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParserT s st m a
p ParserT s st m end
end = do
         ParserT s st m end -> ParserT s st m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT s st m end
end
         a
first <- ParserT s st m a
p
         [a]
rest <- ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
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 ParserT s st m a
p ParserT s st m end
end
         [a] -> ParserT s st m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
firsta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)

-- | Like @many1Till@, but packs its result
many1TillChar :: (Show end, Stream s m t)
              => ParserT s st m Char
              -> ParserT s st m end
              -> ParserT s st m Text
many1TillChar :: ParserT s st m Char -> ParserT s st m end -> ParserT s st m Text
many1TillChar ParserT s st m Char
p = (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> (ParserT s st m end -> ParsecT s st m String)
-> ParserT s st m end
-> ParserT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT s st m Char -> ParserT s st m end -> ParsecT s st m String
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParserT s st m Char
p

-- | Like @manyTill@, but also returns the result of end parser.
manyUntil :: ParserT s u m a
          -> ParserT s u m b
          -> ParserT s u m ([a], b)
manyUntil :: ParserT s u m a -> ParserT s u m b -> ParserT s u m ([a], b)
manyUntil ParserT s u m a
p ParserT s u m b
end = ParserT s u m ([a], b)
scan
  where scan :: ParserT s u m ([a], b)
scan =
          (do b
e <- ParserT s u m b
end
              ([a], b) -> ParserT s u m ([a], b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], b
e)
          ) ParserT s u m ([a], b)
-> ParserT s u m ([a], b) -> ParserT s u m ([a], b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          (do a
x <- ParserT s u m a
p
              ([a]
xs, b
e) <- ParserT s u m ([a], b)
scan
              ([a], b) -> ParserT s u m ([a], b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, b
e))

-- | Like @manyUntil@, but also packs its result.
manyUntilChar :: ParserT s u m Char
              -> ParserT s u m b
              -> ParserT s u m (Text, b)
manyUntilChar :: ParserT s u m Char -> ParserT s u m b -> ParserT s u m (Text, b)
manyUntilChar ParserT s u m Char
p = ((String, b) -> (Text, b))
-> ParsecT s u m (String, b) -> ParserT s u m (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, b) -> (Text, b)
forall b. (String, b) -> (Text, b)
go (ParsecT s u m (String, b) -> ParserT s u m (Text, b))
-> (ParserT s u m b -> ParsecT s u m (String, b))
-> ParserT s u m b
-> ParserT s u m (Text, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT s u m Char -> ParserT s u m b -> ParsecT s u m (String, b)
forall s u (m :: * -> *) a b.
ParserT s u m a -> ParserT s u m b -> ParserT s u m ([a], b)
manyUntil ParserT s u m Char
p
  where
    go :: (String, b) -> (Text, b)
go (String
x, b
y) = (String -> Text
T.pack String
x, b
y)

-- | Like @sepBy1@ from Parsec,
-- but does not fail if it @sep@ succeeds and @p@ fails.
sepBy1' :: ParsecT s u m a
        -> ParsecT s u m sep
        -> ParsecT s u m [a]
sepBy1' :: ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1' ParsecT s u m a
p ParsecT s u m sep
sep = (:) (a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a
p ParsecT s u m ([a] -> [a])
-> ParsecT s u m [a] -> ParsecT s u m [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s u m a -> ParsecT s u m [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m a -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ ParsecT s u m sep
sep ParsecT s u m sep -> ParsecT s u m a -> ParsecT s u m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m a
p)

-- | A more general form of @notFollowedBy@.  This one allows any
-- type of parser to be specified, and succeeds only if that parser fails.
-- It does not consume any input.
notFollowedBy' :: (Show b, Stream s m a) => ParserT s st m b -> ParserT s st m ()
notFollowedBy' :: ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT s st m b
p  = ParserT s st m () -> ParserT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m () -> ParserT s st m ())
-> ParserT s st m () -> ParserT s st m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s st m (ParserT s st m ()) -> ParserT s st m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ParsecT s st m (ParserT s st m ()) -> ParserT s st m ())
-> ParsecT s st m (ParserT s st m ()) -> ParserT s st m ()
forall a b. (a -> b) -> a -> b
$  do  b
a <- ParserT s st m b -> ParserT s st m b
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParserT s st m b
p
                                      ParserT s st m () -> ParsecT s st m (ParserT s st m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParserT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (b -> String
forall a. Show a => a -> String
show b
a))
                                  ParsecT s st m (ParserT s st m ())
-> ParsecT s st m (ParserT s st m ())
-> ParsecT s st m (ParserT s st m ())
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                  ParserT s st m () -> ParsecT s st m (ParserT s st m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> ParserT s st m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
-- (This version due to Andrew Pimlott on the Haskell mailing list.)

oneOfStrings' :: Stream s m Char => (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
oneOfStrings' :: (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
oneOfStrings' Char -> Char -> Bool
f = (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> ([Text] -> ParsecT s st m String)
-> [Text]
-> ParserT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> [String] -> ParsecT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
(Char -> Char -> Bool) -> [String] -> ParserT s st m String
oneOfStrings'' Char -> Char -> Bool
f ([String] -> ParsecT s st m String)
-> ([Text] -> [String]) -> [Text] -> ParsecT s st m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack

-- TODO: This should be re-implemented in a Text-aware way
oneOfStrings'' :: Stream s m Char => (Char -> Char -> Bool) -> [String] -> ParserT s st m String
oneOfStrings'' :: (Char -> Char -> Bool) -> [String] -> ParserT s st m String
oneOfStrings'' Char -> Char -> Bool
_ []   = String -> ParserT s st m String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"no strings"
oneOfStrings'' Char -> Char -> Bool
matches [String]
strs = ParserT s st m String -> ParserT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m String -> ParserT s st m String)
-> ParserT s st m String -> ParserT s st m String
forall a b. (a -> b) -> a -> b
$ do
  Char
c <- ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
  let strs' :: [String]
strs' = [String
xs | (Char
x:String
xs) <- [String]
strs, Char
x Char -> Char -> Bool
`matches` Char
c]
  case [String]
strs' of
       []  -> String -> ParserT s st m String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"not found"
       [String]
_   -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> ParserT s st m String -> ParserT s st m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Char -> Bool) -> [String] -> ParserT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
(Char -> Char -> Bool) -> [String] -> ParserT s st m String
oneOfStrings'' Char -> Char -> Bool
matches [String]
strs'
               ParserT s st m String
-> ParserT s st m String -> ParserT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> if String
"" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
strs'
                      then String -> ParserT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]
                      else String -> ParserT s st m String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"not found"

-- | Parses one of a list of strings.  If the list contains
-- two strings one of which is a prefix of the other, the longer
-- string will be matched if possible.
oneOfStrings :: Stream s m Char => [Text] -> ParserT s st m Text
oneOfStrings :: [Text] -> ParserT s st m Text
oneOfStrings = (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
(Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
oneOfStrings' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Parses one of a list of strings (tried in order), case insensitive.

-- TODO: This will not be accurate with general Unicode (neither
-- Text.toLower nor Text.toCaseFold can be implemented with a map)
oneOfStringsCI :: Stream s m Char => [Text] -> ParserT s st m Text
oneOfStringsCI :: [Text] -> ParserT s st m Text
oneOfStringsCI = (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
(Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
oneOfStrings' Char -> Char -> Bool
ciMatch
  where ciMatch :: Char -> Char -> Bool
ciMatch Char
x Char
y = Char -> Char
toLower' Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower' Char
y
        -- this optimizes toLower by checking common ASCII case
        -- first, before calling the expensive unicode-aware
        -- function:
        toLower' :: Char -> Char
toLower' Char
c | Char -> Bool
isAsciiUpper Char
c = Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32)
                   | Char -> Bool
isAscii Char
c = Char
c
                   | Bool
otherwise = Char -> Char
toLower Char
c

-- | Parses a space or tab.
spaceChar :: Stream s m Char => ParserT s st m Char
spaceChar :: ParserT s st m Char
spaceChar = (Char -> Bool) -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParserT s st m Char)
-> (Char -> Bool) -> ParserT s st m Char
forall a b. (a -> b) -> a -> b
$ \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
'\t'

-- | Parses a nonspace, nonnewline character.
nonspaceChar :: Stream s m Char => ParserT s st m Char
nonspaceChar :: ParserT s st m Char
nonspaceChar = (Char -> Bool) -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m 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)

isSpaceChar :: Char -> Bool
isSpaceChar :: Char -> Bool
isSpaceChar Char
' '  = Bool
True
isSpaceChar Char
'\t' = Bool
True
isSpaceChar Char
'\n' = Bool
True
isSpaceChar Char
'\r' = Bool
True
isSpaceChar Char
_    = Bool
False

-- | Skips zero or more spaces or tabs.
skipSpaces :: Stream s m Char => ParserT s st m ()
skipSpaces :: ParserT s st m ()
skipSpaces = ParsecT s st m Char -> ParserT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar

-- | Skips zero or more spaces or tabs, then reads a newline.
blankline :: Stream s m Char => ParserT s st m Char
blankline :: ParserT s st m Char
blankline = ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Char -> ParserT s st m Char)
-> ParserT s st m Char -> ParserT s st m Char
forall a b. (a -> b) -> a -> b
$ ParserT s st m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
skipSpaces ParserT s st m () -> ParserT s st m Char -> ParserT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

-- | Parses one or more blank lines and returns a string of newlines.
blanklines :: Stream s m Char => ParserT s st m Text
blanklines :: ParserT s st m Text
blanklines = String -> Text
T.pack (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline

-- | Gobble n spaces; if tabs are encountered, expand them
-- and gobble some or all of their spaces, leaving the rest.
gobbleSpaces :: (HasReaderOptions st, Monad m)
             => Int -> ParserT Text st m ()
gobbleSpaces :: Int -> ParserT Text st m ()
gobbleSpaces Int
0 = () -> ParserT Text st m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
gobbleSpaces Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = String -> ParserT Text st m ()
forall a. HasCallStack => String -> a
error String
"gobbleSpaces called with negative number"
  | Bool
otherwise = ParserT Text st m () -> ParserT Text st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m () -> ParserT Text st m ())
-> ParserT Text st m () -> ParserT Text st m ()
forall a b. (a -> b) -> a -> b
$ do
      Char -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT Text st m Char
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text st m Char
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Text st m Char
eatOneSpaceOfTab
      Int -> ParserT Text st m ()
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParserT Text st m ()
gobbleSpaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

eatOneSpaceOfTab :: (HasReaderOptions st, Monad m) => ParserT Text st m Char
eatOneSpaceOfTab :: ParserT Text st m Char
eatOneSpaceOfTab = do
  Char -> ParserT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\t'
  Int
tabstop <- (ReaderOptions -> Int) -> ParserT Text st m Int
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Int
readerTabStop
  Text
inp <- ParsecT Text st m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  Text -> ParsecT Text st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (Text -> ParsecT Text st m ()) -> Text -> ParsecT Text st m ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int
tabstop Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inp
  Char -> ParserT Text st m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
' '

-- | Gobble up to n spaces; if tabs are encountered, expand them
-- and gobble some or all of their spaces, leaving the rest.
gobbleAtMostSpaces :: (HasReaderOptions st, Monad m)
                   => Int -> ParserT Text st m Int
gobbleAtMostSpaces :: Int -> ParserT Text st m Int
gobbleAtMostSpaces Int
0 = Int -> ParserT Text st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
gobbleAtMostSpaces Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = String -> ParserT Text st m Int
forall a. HasCallStack => String -> a
error String
"gobbleAtMostSpaces called with negative number"
  | Bool
otherwise = Int -> ParserT Text st m Int -> ParserT Text st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT Text st m Int -> ParserT Text st m Int)
-> ParserT Text st m Int -> ParserT Text st m Int
forall a b. (a -> b) -> a -> b
$ do
      Char -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT Text st m Char
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text st m Char
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParserT Text st m Char
eatOneSpaceOfTab
      (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> ParserT Text st m Int -> ParserT Text st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParserT Text st m Int
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParserT Text st m Int
gobbleAtMostSpaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Parses material enclosed between start and end parsers.
enclosed :: (Show end, Stream s  m Char) => ParserT s st m t   -- ^ start parser
         -> ParserT s st m end  -- ^ end parser
         -> ParserT s st m a    -- ^ content parser (to be used repeatedly)
         -> ParserT s st m [a]
enclosed :: ParserT s st m t
-> ParserT s st m end -> ParserT s st m a -> ParserT s st m [a]
enclosed ParserT s st m t
start ParserT s st m end
end ParserT s st m a
parser = ParserT s st m [a] -> ParserT s st m [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m [a] -> ParserT s st m [a])
-> ParserT s st m [a] -> ParserT s st m [a]
forall a b. (a -> b) -> a -> b
$
  ParserT s st m t
start ParserT s st m t -> ParsecT s st m () -> ParsecT s st m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT s st m () -> ParserT s st m [a] -> ParserT s st m [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParserT s st m a
parser ParserT s st m end
end

-- | Parse string, case insensitive.
stringAnyCase :: Stream s m Char => Text -> ParserT s st m Text
stringAnyCase :: Text -> ParserT s st m Text
stringAnyCase = (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> (Text -> ParsecT s st m String) -> Text -> ParserT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
stringAnyCase' (String -> ParsecT s st m String)
-> (Text -> String) -> Text -> ParsecT s st m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

stringAnyCase' :: Stream s m Char => String -> ParserT s st m String
stringAnyCase' :: String -> ParserT s st m String
stringAnyCase' [] = String -> ParserT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
""
stringAnyCase' (Char
x:String
xs) = do
  Char
firstChar <- Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toUpper Char
x) 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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toLower Char
x)
  String
rest <- String -> ParserT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
stringAnyCase' String
xs
  String -> ParserT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
firstCharChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest)

-- | Parse contents of 'str' using 'parser' and return result.
parseFromString :: (Stream s m Char, IsString s)
                => ParserT s st m r
                -> Text
                -> ParserT s st m r
parseFromString :: ParserT s st m r -> Text -> ParserT s st m r
parseFromString ParserT s st m r
parser Text
str = do
  SourcePos
oldPos <- ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  SourcePos -> ParsecT s st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT s st m ()) -> SourcePos -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ String -> SourcePos
initialPos String
"chunk"
  s
oldInput <- ParsecT s st m s
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  s -> ParsecT s st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (s -> ParsecT s st m ()) -> s -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> String -> s
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str
  r
result <- ParserT s st m r
parser
  ParsecT s st m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
spaces
  ParsecT s st m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  s -> ParsecT s st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput s
oldInput
  SourcePos -> ParsecT s st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
oldPos
  r -> ParserT s st m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
result

-- | Like 'parseFromString' but specialized for 'ParserState'.
-- This resets 'stateLastStrPos', which is almost always what we want.
parseFromString' :: (Stream s m Char, IsString s, HasLastStrPosition u)
                 => ParserT s u m a
                 -> Text
                 -> ParserT s u m a
parseFromString' :: ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT s u m a
parser Text
str = do
  Maybe SourcePos
oldLastStrPos <- u -> Maybe SourcePos
forall st. HasLastStrPosition st => st -> Maybe SourcePos
getLastStrPos (u -> Maybe SourcePos)
-> ParsecT s u m u -> ParsecT s u m (Maybe SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m u
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (u -> u) -> ParsecT s u m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((u -> u) -> ParsecT s u m ()) -> (u -> u) -> ParsecT s u m ()
forall a b. (a -> b) -> a -> b
$ Maybe SourcePos -> u -> u
forall st. HasLastStrPosition st => Maybe SourcePos -> st -> st
setLastStrPos Maybe SourcePos
forall a. Maybe a
Nothing
  a
res <- ParserT s u m a -> Text -> ParserT s u m a
forall s (m :: * -> *) st r.
(Stream s m Char, IsString s) =>
ParserT s st m r -> Text -> ParserT s st m r
parseFromString ParserT s u m a
parser Text
str
  (u -> u) -> ParsecT s u m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((u -> u) -> ParsecT s u m ()) -> (u -> u) -> ParsecT s u m ()
forall a b. (a -> b) -> a -> b
$ Maybe SourcePos -> u -> u
forall st. HasLastStrPosition st => Maybe SourcePos -> st -> st
setLastStrPos Maybe SourcePos
oldLastStrPos
  a -> ParserT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

-- | Parse raw line block up to and including blank lines.
lineClump :: Monad m => ParserT Text st m Text
lineClump :: ParserT Text st m Text
lineClump = ParserT Text st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
          ParserT Text st m Text
-> ParserT Text st m Text -> ParserT Text st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Text] -> Text
T.unlines ([Text] -> Text)
-> ParsecT Text st m [Text] -> ParserT Text st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text st m Text -> ParsecT Text st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text st m Char -> ParsecT Text 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 Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline ParsecT Text st m ()
-> ParserT Text st m Text -> ParserT Text st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine))

-- | Parse a string of characters between an open character
-- and a close character, including text between balanced
-- pairs of open and close, which must be different. For example,
-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"
-- and return "hello (there)".
charsInBalanced :: Stream s m Char => Char -> Char -> ParserT s st m Char
                -> ParserT s st m Text
charsInBalanced :: Char -> Char -> ParserT s st m Char -> ParserT s st m Text
charsInBalanced Char
open Char
close ParserT s st m Char
parser = ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Text -> ParserT s st m Text)
-> ParserT s st m Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
open
  let isDelim :: Char -> Bool
isDelim Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
open Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
close
  [Text]
raw <- ParserT s st m Text -> ParsecT s st m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParserT s st m Text -> ParsecT s st m [Text])
-> ParserT s st m Text -> ParsecT s st m [Text]
forall a b. (a -> b) -> a -> b
$  String -> Text
T.pack (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParserT 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 ((Char -> Bool) -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDelim) ParsecT s st m () -> ParserT s st m Char -> ParserT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT s st m Char
parser)
             ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do Text
res <- Char -> Char -> ParserT s st m Char -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Char -> Char -> ParserT s st m Char -> ParserT s st m Text
charsInBalanced Char
open Char
close ParserT s st m Char
parser
                     Text -> ParserT s st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT s st m Text) -> Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
res Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
close)
  Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
close
  Text -> ParserT s st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT s st m Text) -> Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
raw

-- old charsInBalanced would be:
-- charsInBalanced open close (noneOf "\n" <|> char '\n' >> notFollowedBy blankline)
-- old charsInBalanced' would be:
-- charsInBalanced open close anyChar

-- Auxiliary functions for romanNumeral:

-- | Parses a roman numeral (uppercase or lowercase), returns number.
romanNumeral :: Stream s m Char => Bool                  -- ^ Uppercase if true
             -> ParserT s st m Int
romanNumeral :: Bool -> ParserT s st m Int
romanNumeral Bool
upperCase = do
    let rchar :: Char -> ParsecT s u m Char
rchar Char
uc = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> ParsecT s u m Char) -> Char -> ParsecT s u m Char
forall a b. (a -> b) -> a -> b
$ if Bool
upperCase then Char
uc else Char -> Char
toLower Char
uc
    let one :: ParsecT s u m Char
one         = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'I'
    let five :: ParsecT s u m Char
five        = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'V'
    let ten :: ParsecT s u m Char
ten         = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'X'
    let fifty :: ParsecT s u m Char
fifty       = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'L'
    let hundred :: ParsecT s u m Char
hundred     = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'C'
    let fivehundred :: ParsecT s u m Char
fivehundred = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'D'
    let thousand :: ParsecT s u m Char
thousand    = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'M'
    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 -> ParsecT s st m Char)
-> ParsecT s st m Char -> ParsecT s st m Char
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
choice [ParsecT s st m Char
forall u. ParsecT s u m Char
one, ParsecT s st m Char
forall u. ParsecT s u m Char
five, ParsecT s st m Char
forall u. ParsecT s u m Char
ten, ParsecT s st m Char
forall u. ParsecT s u m Char
fifty, ParsecT s st m Char
forall u. ParsecT s u m Char
hundred, ParsecT s st m Char
forall u. ParsecT s u m Char
fivehundred, ParsecT s st m Char
forall u. ParsecT s u m Char
thousand]
    Int
thousands <- (Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ParsecT s st m String -> ParserT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall u. ParsecT s u m Char
thousand
    Int
ninehundreds <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParserT s st m Int -> ParserT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
thousand ParsecT s st m Char -> ParserT s st m Int -> ParserT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParserT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
900
    Int
fivehundreds <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ Int
500 Int -> ParsecT s st m Char -> ParserT s st m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s st m Char
forall u. ParsecT s u m Char
fivehundred
    Int
fourhundreds <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParserT s st m Int -> ParserT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
fivehundred ParsecT s st m Char -> ParserT s st m Int -> ParserT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParserT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
400
    Int
hundreds <- (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ParsecT s st m String -> ParserT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall u. ParsecT s u m Char
hundred
    Int
nineties <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParserT s st m Int -> ParserT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
hundred ParsecT s st m Char -> ParserT s st m Int -> ParserT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParserT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
90
    Int
fifties <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (Int
50 Int -> ParsecT s st m Char -> ParserT s st m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s st m Char
forall u. ParsecT s u m Char
fifty)
    Int
forties <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParserT s st m Int -> ParserT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
fifty ParsecT s st m Char -> ParserT s st m Int -> ParserT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParserT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
40
    Int
tens <- (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ParsecT s st m String -> ParserT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall u. ParsecT s u m Char
ten
    Int
nines <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParserT s st m Int -> ParserT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
one ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
ten ParsecT s st m Char -> ParserT s st m Int -> ParserT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParserT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
9
    Int
fives <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (Int
5 Int -> ParsecT s st m Char -> ParserT s st m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s st m Char
forall u. ParsecT s u m Char
five)
    Int
fours <- Int -> ParserT s st m Int -> ParserT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParserT s st m Int -> ParserT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Int -> ParserT s st m Int)
-> ParserT s st m Int -> ParserT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
one ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall u. ParsecT s u m Char
five ParsecT s st m Char -> ParserT s st m Int -> ParserT s st m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParserT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
    Int
ones <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ParsecT s st m String -> ParserT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall u. ParsecT s u m Char
one
    let total :: Int
total = Int
thousands Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ninehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fivehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fourhundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                Int
hundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nineties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fifties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nines Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                Int
fives Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fours Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ones
    if Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
       then String -> ParserT s st m Int
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"not a roman numeral"
       else Int -> ParserT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
total

-- Parsers for email addresses and URIs

-- | Parses an email address; returns original and corresponding
-- escaped mailto: URI.
emailAddress :: Stream s m Char => ParserT s st m (Text, Text)
emailAddress :: ParserT s st m (Text, Text)
emailAddress = ParserT s st m (Text, Text) -> ParserT s st m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m (Text, Text) -> ParserT s st m (Text, Text))
-> ParserT s st m (Text, Text) -> ParserT s st m (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> String -> (Text, Text)
toResult (String -> String -> (Text, Text))
-> ParsecT s st m String -> ParsecT s st m (String -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m String
forall u. ParsecT s u m String
mailbox ParsecT s st m (String -> (Text, Text))
-> ParsecT s st m String -> ParserT s st m (Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT s st m Char
-> ParsecT s st m String -> ParsecT s st m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s st m String
forall u. ParsecT s u m String
domain)
 where toResult :: String -> String -> (Text, Text)
toResult String
mbox String
dom = let full :: Text
full = Text -> Text
fromEntities (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
mbox String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'@'Char -> String -> String
forall a. a -> [a] -> [a]
:String
dom
                           in  (Text
full, Text -> Text
escapeURI (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
full)
       mailbox :: ParsecT s u m String
mailbox           = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT s u m String
forall u. ParsecT s u m String
emailWord ParsecT s u m String
-> ParsecT s u m Char -> ParsecT s u m [String]
forall s u (m :: * -> *) a sep.
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1'` ParsecT s u m Char
forall u. ParsecT s u m Char
dot)
       domain :: ParsecT s u m String
domain            = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT s u m String
forall u. ParsecT s u m String
subdomain ParsecT s u m String
-> ParsecT s u m Char -> ParsecT s u m [String]
forall s u (m :: * -> *) a sep.
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1'` ParsecT s u m Char
forall u. ParsecT s u m Char
dot)
       dot :: ParsecT s u m Char
dot               = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
       subdomain :: ParsecT s u m String
subdomain         = ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT s u m Char -> ParsecT s u m String)
-> ParsecT s u m Char -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall u. ParsecT s u m Char
innerPunct
       -- this excludes some valid email addresses, since an
       -- email could contain e.g. '__', but gives better results
       -- for our purposes, when combined with markdown parsing:
       innerPunct :: ParsecT s u m Char
innerPunct        = ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isEmailPunct Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@')
                                 ParsecT s u m Char -> ParsecT s u m () -> ParsecT s u m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char -> ParsecT s u 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 u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                                 ParsecT s u m Char -> ParsecT s u m () -> ParsecT s u m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char -> ParsecT s u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isPunctuation))
       -- technically an email address could begin with a symbol,
       -- but allowing this creates too many problems.
       -- See e.g. https://github.com/jgm/pandoc/issues/2940
       emailWord :: ParsecT s u m String
emailWord         = do Char
x <- (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaNum
                              String
xs <- ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isEmailChar)
                              String -> ParsecT s u m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
       isEmailChar :: Char -> Bool
isEmailChar Char
c     = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isEmailPunct Char
c
       isEmailPunct :: Char -> Bool
isEmailPunct Char
c    = (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
"!\"#$%&'*+-/=?^_{|}~;"


uriScheme :: Stream s m Char => ParserT s st m Text
uriScheme :: ParserT s st m Text
uriScheme = [Text] -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
[Text] -> ParserT s st m Text
oneOfStringsCI (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
schemes)

-- | Parses a URI. Returns pair of original and URI-escaped version.
uri :: Stream s m Char => ParserT s st m (Text, Text)
uri :: ParserT s st m (Text, Text)
uri = ParserT s st m (Text, Text) -> ParserT s st m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m (Text, Text) -> ParserT s st m (Text, Text))
-> ParserT s st m (Text, Text) -> ParserT s st m (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  Text
scheme <- ParserT s st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
uriScheme
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  -- Avoid parsing e.g. "**Notes:**" as a raw URI:
  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 -> ParsecT s st m ())
-> ParsecT s st m Char -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\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
']')
  -- We allow sentence punctuation except at the end, since
  -- we don't want the trailing '.' in 'http://google.com.' We want to allow
  -- http://en.wikipedia.org/wiki/State_of_emergency_(disambiguation)
  -- as a URL, while NOT picking up the closing paren in
  -- (http://wikipedia.org). So we include balanced parens in the URL.
  Text
str <- [Text] -> Text
T.concat ([Text] -> Text) -> ParsecT s st m [Text] -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT s st m Text -> ParsecT s st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> Char -> ParserT s st m Text
forall u. Char -> Char -> ParsecT s u m Text
uriChunkBetween Char
'(' Char
')'
                        ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> ParserT s st m Text
forall u. Char -> Char -> ParsecT s u m Text
uriChunkBetween Char
'{' Char
'}'
                        ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> ParserT s st m Text
forall u. Char -> Char -> ParsecT s u m Text
uriChunkBetween Char
'[' Char
']'
                        ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Text
T.pack (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m String
forall u. ParsecT s u m String
uriChunk)
  Text
str' <- Text -> ParserT s st m Text -> ParserT s st m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
str (ParserT s st m Text -> ParserT s st m Text)
-> ParserT s st m Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/' ParsecT s st m Char -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParserT s st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/")
  let uri' :: Text
uri' = Text
scheme Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
fromEntities Text
str'
  (Text, Text) -> ParserT s st m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
uri', Text -> Text
escapeURI Text
uri')
  where
    isWordChar :: Char -> Bool
isWordChar Char
'#' = Bool
True
    isWordChar Char
'$' = Bool
True
    isWordChar Char
'%' = Bool
True
    isWordChar Char
'+' = Bool
True
    isWordChar Char
'/' = Bool
True
    isWordChar Char
'@' = Bool
True
    isWordChar Char
'\\' = Bool
True
    isWordChar Char
'_' = Bool
True
    isWordChar Char
'-' = Bool
True
    isWordChar Char
'&' = Bool
True
    isWordChar Char
'=' = Bool
True
    isWordChar Char
c   = Char -> Bool
isAlphaNum Char
c

    wordChar :: ParsecT s u m Char
wordChar = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isWordChar
    percentEscaped :: ParsecT s u m String
percentEscaped = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ (:) (Char -> String -> String)
-> ParsecT s u m Char -> ParsecT s u m (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT s u m (String -> String)
-> ParsecT s u m String -> ParsecT s u m String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
    entity :: ParsecT s u m String
entity = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> ParsecT s u m Char -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
characterReference
    punct :: ParsecT s u m String
punct = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> String) -> ParsecT s u m Char -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c) 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
'>'))
    uriChunk :: ParsecT s u m String
uriChunk = ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall u. ParsecT s u m Char
wordChar
           ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall u. ParsecT s u m String
percentEscaped
           ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall u. ParsecT s u m String
entity
           ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String
forall u. ParsecT s u m String
punct ParsecT s u m String -> ParsecT s u m () -> ParsecT s u m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m () -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT s u m Char -> ParsecT s u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT s u m Char
forall u. ParsecT s u m Char
wordChar ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String -> ParsecT s u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT s u m String
forall u. ParsecT s u m String
percentEscaped))
    uriChunkBetween :: Char -> Char -> ParsecT s u m Text
uriChunkBetween Char
l Char
r = ParsecT s u m Text -> ParsecT s u m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m Text -> ParsecT s u m Text)
-> ParsecT s u m Text -> ParsecT s u m Text
forall a b. (a -> b) -> a -> b
$ do String
chunk <- ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m String
-> ParsecT s u m String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
l) (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
r) ParsecT s u m String
forall u. ParsecT s u m String
uriChunk
                                   Text -> ParsecT s u m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [Char
l] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
chunk String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
r])

mathInlineWith :: Stream s m Char  => Text -> Text -> ParserT s st m Text
mathInlineWith :: Text -> Text -> ParserT s st m Text
mathInlineWith Text
op Text
cl = ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Text -> ParserT s st m Text)
-> ParserT s st m Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ do
  Text -> ParserT s st m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr Text
op
  Bool -> ParsecT s st m () -> ParsecT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"$") (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ 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 s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  [Text]
words' <- ParserT s st m Text -> ParserT s st m Text -> ParserT s st m [Text]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till (
                       (Char -> Text
T.singleton (Char -> Text) -> ParsecT s st m Char -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (Char -> Bool) -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpaceChar Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')))
                   ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s st m Char -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           -- This next clause is needed because \text{..} can
                           -- contain $, \(\), etc.
                           (ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"text" ParsecT s st m String -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                 ((Text
"\\text" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ParserT s st m Text -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Text -> ParserT s st m Text
inBalancedBraces Int
0 Text
""))
                            ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>  (\Char
c -> String -> Text
T.pack [Char
'\\',Char
c]) (Char -> Text) -> ParsecT s st m Char -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))
                   ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do (ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline ParsecT s st m Char -> ParsecT s st m () -> ParsecT s st m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char -> ParsecT s st m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline) 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
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT s st m Char -> ParsecT s st m () -> ParsecT s st m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar)
                          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 (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$')
                          Text -> ParserT s st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
                    ) (ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Text -> ParserT s st m Text)
-> ParserT s st m Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ Text -> ParserT s st m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr Text
cl)
  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 s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit  -- to prevent capture of $5
  Text -> ParserT s st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT s st m Text) -> Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimMath (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
words'
 where
  inBalancedBraces :: Stream s m Char => Int -> Text -> ParserT s st m Text
  inBalancedBraces :: Int -> Text -> ParserT s st m Text
inBalancedBraces Int
n = (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> (Text -> ParsecT s st m String) -> Text -> ParserT s st m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ParsecT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> String -> ParserT s st m String
inBalancedBraces' Int
n (String -> ParsecT s st m String)
-> (Text -> String) -> Text -> ParsecT s st m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

  inBalancedBraces' :: Stream s m Char => Int -> String -> ParserT s st m String
  inBalancedBraces' :: Int -> String -> ParserT s st m String
inBalancedBraces' Int
0 String
"" = do
    Char
c <- ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'
       then Int -> String -> ParserT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> String -> ParserT s st m String
inBalancedBraces' Int
1 String
"{"
       else ParserT s st m String
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  inBalancedBraces' Int
0 String
s = String -> ParserT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParserT s st m String)
-> String -> ParserT s st m String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
s
  inBalancedBraces' Int
numOpen (Char
'\\':String
xs) = do
    Char
c <- ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
    Int -> String -> ParserT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> String -> ParserT s st m String
inBalancedBraces' Int
numOpen (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
  inBalancedBraces' Int
numOpen String
xs = do
    Char
c <- ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
    case Char
c of
         Char
'}' -> Int -> String -> ParserT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> String -> ParserT s st m String
inBalancedBraces' (Int
numOpen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
         Char
'{' -> Int -> String -> ParserT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> String -> ParserT s st m String
inBalancedBraces' (Int
numOpen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
         Char
_   -> Int -> String -> ParserT s st m String
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> String -> ParserT s st m String
inBalancedBraces' Int
numOpen (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)

mathDisplayWith :: Stream s m Char => Text -> Text -> ParserT s st m Text
mathDisplayWith :: Text -> Text -> ParserT s st m Text
mathDisplayWith Text
op Text
cl = ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Text -> ParserT s st m Text)
-> ParserT s st m Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> ParsecT s st m String -> ParserT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParserT s st m Text)
-> ParsecT s st m String -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ do
  Text -> ParserT s st m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr Text
op
  ParserT s st m Char -> ParserT s st m Text -> ParsecT s st m String
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ((Char -> Bool) -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ParserT s st m Char -> ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParserT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParserT s st m Char -> ParsecT s st m () -> ParserT s st m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT s st m Char -> ParsecT s st m ()
forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParserT s st m b -> ParserT s st m ()
notFollowedBy' ParserT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline))
            (ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Text -> ParserT s st m Text)
-> ParserT s st m Text -> ParserT s st m Text
forall a b. (a -> b) -> a -> b
$ Text -> ParserT s st m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr Text
cl)

mathDisplay :: (HasReaderOptions st, Stream s m Char)
            => ParserT s st m Text
mathDisplay :: ParserT s st m Text
mathDisplay =
      (Extension -> ParserT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_tex_math_dollars ParserT s st m () -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Text -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Text -> Text -> ParserT s st m Text
mathDisplayWith Text
"$$" Text
"$$")
  ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParserT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_tex_math_single_backslash ParserT s st m () -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Text -> Text -> ParserT s st m Text
mathDisplayWith Text
"\\[" Text
"\\]")
  ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParserT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_tex_math_double_backslash ParserT s st m () -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Text -> Text -> ParserT s st m Text
mathDisplayWith Text
"\\\\[" Text
"\\\\]")

mathInline :: (HasReaderOptions st , Stream s m Char)
           => ParserT s st m Text
mathInline :: ParserT s st m Text
mathInline =
      (Extension -> ParserT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_tex_math_dollars ParserT s st m () -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Text -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Text -> Text -> ParserT s st m Text
mathInlineWith Text
"$" Text
"$")
  ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParserT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_tex_math_single_backslash ParserT s st m () -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Text -> Text -> ParserT s st m Text
mathInlineWith Text
"\\(" Text
"\\)")
  ParserT s st m Text -> ParserT s st m Text -> ParserT s st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Extension -> ParserT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_tex_math_double_backslash ParserT s st m () -> ParserT s st m Text -> ParserT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Text -> Text -> ParserT s st m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Text -> Text -> ParserT s st m Text
mathInlineWith Text
"\\\\(" Text
"\\\\)")

-- | Applies a parser, returns tuple of its results and its horizontal
-- displacement (the difference between the source column at the end
-- and the source column at the beginning). Vertical displacement
-- (source row) is ignored.
withHorizDisplacement :: Stream s m Char
                      => ParserT s st m a  -- ^ Parser to apply
                      -> ParserT s st m (a, Int) -- ^ (result, displacement)
withHorizDisplacement :: ParserT s st m a -> ParserT s st m (a, Int)
withHorizDisplacement ParserT s st m a
parser = do
  SourcePos
pos1 <- ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  a
result <- ParserT s st m a
parser
  SourcePos
pos2 <- ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  (a, Int) -> ParserT s st m (a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, SourcePos -> Int
sourceColumn SourcePos
pos2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
pos1)

-- | Applies a parser and returns the raw string that was parsed,
-- along with the value produced by the parser.
withRaw :: Monad m
        => ParsecT Text st m a
        -> ParsecT Text st m (a, Text)
withRaw :: ParsecT Text st m a -> ParsecT Text st m (a, Text)
withRaw ParsecT Text st m a
parser = do
  SourcePos
pos1 <- ParsecT Text st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
inp <- ParsecT Text st m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  a
result <- ParsecT Text st m a
parser
  SourcePos
pos2 <- ParsecT Text st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let (Int
l1,Int
c1) = (SourcePos -> Int
sourceLine SourcePos
pos1, SourcePos -> Int
sourceColumn SourcePos
pos1)
  let (Int
l2,Int
c2) = (SourcePos -> Int
sourceLine SourcePos
pos2, SourcePos -> Int
sourceColumn SourcePos
pos2)
  let inplines :: [Text]
inplines = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ((Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
inp
  let raw :: Text
raw = case [Text]
inplines of
                []  -> Text
""
                [Text
l] -> Int -> Text -> Text
T.take (Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c1) Text
l
                [Text]
ls  -> [Text] -> Text
T.unlines ([Text] -> [Text]
forall a. [a] -> [a]
init [Text]
ls) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take (Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Text] -> Text
forall a. [a] -> a
last [Text]
ls)
  (a, Text) -> ParsecT Text st m (a, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, Text
raw)

-- | Parses backslash, then applies character parser.
escaped :: Stream s m Char
        => ParserT s st m Char  -- ^ Parser for character to escape
        -> ParserT s st m Char
escaped :: ParserT s st m Char -> ParserT s st m Char
escaped ParserT s st m Char
parser = ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Char -> ParserT s st m Char)
-> ParserT s st m Char -> ParserT s st m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParserT s st m Char -> ParserT s st m Char -> ParserT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT s st m Char
parser

-- | Parse character entity.
characterReference :: Stream s m Char => ParserT s st m Char
characterReference :: ParserT s st m Char
characterReference = ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Char -> ParserT s st m Char)
-> ParserT s st m Char -> ParserT s st m Char
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&'
  String
ent <- ParserT s st m Char -> ParserT s st m Char -> ParserT s st m String
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParserT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
nonspaceChar (Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';')
  let ent' :: String
ent' = case String
ent of
                  Char
'#':Char
'X':String
xs -> Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'x'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs  -- workaround tagsoup bug
                  Char
'#':String
_      -> String
ent
                  String
_          -> String
ent String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
  case String -> Maybe String
lookupEntity String
ent' of
       Just (Char
c : String
_) -> Char -> ParserT s st m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
       Maybe String
_            -> String -> ParserT s st m Char
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"entity not found"

-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
upperRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
upperRoman :: ParserT s st m (ListNumberStyle, Int)
upperRoman = do
  Int
num <- Bool -> ParserT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Bool -> ParserT s st m Int
romanNumeral Bool
True
  (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
UpperRoman, Int
num)

-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
lowerRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
lowerRoman :: ParserT s st m (ListNumberStyle, Int)
lowerRoman = do
  Int
num <- Bool -> ParserT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Bool -> ParserT s st m Int
romanNumeral Bool
False
  (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
LowerRoman, Int
num)

-- | Parses a decimal numeral and returns (Decimal, number).
decimal :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
decimal :: ParserT s st m (ListNumberStyle, Int)
decimal = do
  String
num <- ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
Decimal, Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
num)

-- | Parses a '@' and optional label and
-- returns (DefaultStyle, [next example number]).  The next
-- example number is incremented in parser state, and the label
-- (if present) is added to the label table.
exampleNum :: Stream s m Char
           => ParserT s ParserState m (ListNumberStyle, Int)
exampleNum :: ParserT s ParserState m (ListNumberStyle, Int)
exampleNum = do
  Char -> ParsecT s ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
  Text
lab <- [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([String] -> [Text]) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> Text)
-> ParsecT s ParserState m [String] -> ParsecT s ParserState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    ParsecT s ParserState m String -> ParsecT s ParserState m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s ParserState m Char -> ParsecT s ParserState m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT s ParserState m String
-> ParsecT s ParserState m String -> ParsecT s ParserState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                          ParsecT s ParserState m String -> ParsecT s ParserState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do Char
c <- Char -> ParsecT s ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' ParsecT s ParserState m Char
-> ParsecT s ParserState m Char -> ParsecT s ParserState 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 ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
                                  String
cs <- ParsecT s ParserState m Char -> ParsecT s ParserState m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
                                  String -> ParsecT s ParserState m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)))
  ParserState
st <- ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let num :: Int
num = ParserState -> Int
stateNextExample ParserState
st
  let newlabels :: Map Text Int
newlabels = if Text -> Bool
T.null Text
lab
                     then ParserState -> Map Text Int
stateExamples ParserState
st
                     else Text -> Int -> Map Text Int -> Map Text Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
lab Int
num (Map Text Int -> Map Text Int) -> Map Text Int -> Map Text Int
forall a b. (a -> b) -> a -> b
$ ParserState -> Map Text Int
stateExamples ParserState
st
  (ParserState -> ParserState) -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT s ParserState m ())
-> (ParserState -> ParserState) -> ParsecT s ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s{ stateNextExample :: Int
stateNextExample = Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                       , stateExamples :: Map Text Int
stateExamples    = Map Text Int
newlabels }
  (ListNumberStyle, Int)
-> ParserT s ParserState m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
Example, Int
num)

-- | Parses a '#' returns (DefaultStyle, 1).
defaultNum :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
defaultNum :: ParserT s st m (ListNumberStyle, Int)
defaultNum = do
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
DefaultStyle, Int
1)

-- | Parses a lowercase letter and returns (LowerAlpha, number).
lowerAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
lowerAlpha :: ParserT s st m (ListNumberStyle, Int)
lowerAlpha = do
  Char
ch <- (Char -> Bool) -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAsciiLower
  (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
LowerAlpha, Char -> Int
ord Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Parses an uppercase letter and returns (UpperAlpha, number).
upperAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
upperAlpha :: ParserT s st m (ListNumberStyle, Int)
upperAlpha = do
  Char
ch <- (Char -> Bool) -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAsciiUpper
  (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
UpperAlpha, Char -> Int
ord Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Parses a roman numeral i or I
romanOne :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
romanOne :: ParserT s st m (ListNumberStyle, Int)
romanOne = (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i' ParsecT s st m Char
-> ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
LowerRoman, Int
1)) ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m (ListNumberStyle, Int)
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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'I' ParsecT s st m Char
-> ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ListNumberStyle, Int) -> ParserT s st m (ListNumberStyle, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
UpperRoman, Int
1))

-- | Parses an ordered list marker and returns list attributes.
anyOrderedListMarker :: Stream s m Char => ParserT s ParserState m ListAttributes
anyOrderedListMarker :: ParserT s ParserState m ListAttributes
anyOrderedListMarker = [ParserT s ParserState m ListAttributes]
-> ParserT s ParserState m ListAttributes
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
  [ParserT s ParserState m (ListNumberStyle, Int)
-> ParserT s ParserState m ListAttributes
delimParser ParserT s ParserState m (ListNumberStyle, Int)
numParser | ParserT s ParserState m (ListNumberStyle, Int)
-> ParserT s ParserState m ListAttributes
delimParser <- [ParserT s ParserState m (ListNumberStyle, Int)
-> ParserT s ParserState m ListAttributes
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inPeriod, ParserT s ParserState m (ListNumberStyle, Int)
-> ParserT s ParserState m ListAttributes
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inOneParen, ParserT s ParserState m (ListNumberStyle, Int)
-> ParserT s ParserState m ListAttributes
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inTwoParens],
                           ParserT s ParserState m (ListNumberStyle, Int)
numParser <- [ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
decimal, ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *).
Stream s m Char =>
ParserT s ParserState m (ListNumberStyle, Int)
exampleNum, ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
defaultNum, ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
romanOne,
                           ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
lowerAlpha, ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
lowerRoman, ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
upperAlpha, ParserT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
upperRoman]]

-- | Parses a list number (num) followed by a period, returns list attributes.
inPeriod :: Stream s m Char
         => ParserT s st m (ListNumberStyle, Int)
         -> ParserT s st m ListAttributes
inPeriod :: ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inPeriod ParserT s st m (ListNumberStyle, Int)
num = ParserT s st m ListAttributes -> ParserT s st m ListAttributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m ListAttributes -> ParserT s st m ListAttributes)
-> ParserT s st m ListAttributes -> ParserT s st m ListAttributes
forall a b. (a -> b) -> a -> b
$ do
  (ListNumberStyle
style, Int
start) <- ParserT s st m (ListNumberStyle, Int)
num
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  let delim :: ListNumberDelim
delim = if ListNumberStyle
style ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle
                 then ListNumberDelim
DefaultDelim
                 else ListNumberDelim
Period
  ListAttributes -> ParserT s st m ListAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start, ListNumberStyle
style, ListNumberDelim
delim)

-- | Parses a list number (num) followed by a paren, returns list attributes.
inOneParen :: Stream s m Char
           => ParserT s st m (ListNumberStyle, Int)
           -> ParserT s st m ListAttributes
inOneParen :: ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inOneParen ParserT s st m (ListNumberStyle, Int)
num = ParserT s st m ListAttributes -> ParserT s st m ListAttributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m ListAttributes -> ParserT s st m ListAttributes)
-> ParserT s st m ListAttributes -> ParserT s st m ListAttributes
forall a b. (a -> b) -> a -> b
$ do
  (ListNumberStyle
style, Int
start) <- ParserT s st m (ListNumberStyle, Int)
num
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
  ListAttributes -> ParserT s st m ListAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start, ListNumberStyle
style, ListNumberDelim
OneParen)

-- | Parses a list number (num) enclosed in parens, returns list attributes.
inTwoParens :: Stream s m Char
            => ParserT s st m (ListNumberStyle, Int)
            -> ParserT s st m ListAttributes
inTwoParens :: ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inTwoParens ParserT s st m (ListNumberStyle, Int)
num = ParserT s st m ListAttributes -> ParserT s st m ListAttributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m ListAttributes -> ParserT s st m ListAttributes)
-> ParserT s st m ListAttributes -> ParserT s st m ListAttributes
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
  (ListNumberStyle
style, Int
start) <- ParserT s st m (ListNumberStyle, Int)
num
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
  ListAttributes -> ParserT s st m ListAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start, ListNumberStyle
style, ListNumberDelim
TwoParens)

-- | Parses an ordered list marker with a given style and delimiter,
-- returns number.
orderedListMarker :: Stream s m Char
                  => ListNumberStyle
                  -> ListNumberDelim
                  -> ParserT s ParserState m Int
orderedListMarker :: ListNumberStyle -> ListNumberDelim -> ParserT s ParserState m Int
orderedListMarker ListNumberStyle
style ListNumberDelim
delim = do
  let num :: ParsecT s ParserState m (ListNumberStyle, Int)
num = ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
defaultNum ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m (ListNumberStyle, Int)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>  -- # can continue any kind of list
            case ListNumberStyle
style of
               ListNumberStyle
DefaultStyle -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
decimal
               ListNumberStyle
Example      -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *).
Stream s m Char =>
ParserT s ParserState m (ListNumberStyle, Int)
exampleNum
               ListNumberStyle
Decimal      -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
decimal
               ListNumberStyle
UpperRoman   -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
upperRoman
               ListNumberStyle
LowerRoman   -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
lowerRoman
               ListNumberStyle
UpperAlpha   -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
upperAlpha
               ListNumberStyle
LowerAlpha   -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
lowerAlpha
  let context :: ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
context = case ListNumberDelim
delim of
               ListNumberDelim
DefaultDelim -> ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inPeriod
               ListNumberDelim
Period       -> ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inPeriod
               ListNumberDelim
OneParen     -> ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inOneParen
               ListNumberDelim
TwoParens    -> ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
inTwoParens
  (Int
start, ListNumberStyle
_, ListNumberDelim
_) <- ParsecT s ParserState m (ListNumberStyle, Int)
-> ParserT s ParserState m ListAttributes
forall st.
ParserT s st m (ListNumberStyle, Int)
-> ParserT s st m ListAttributes
context ParsecT s ParserState m (ListNumberStyle, Int)
num
  Int -> ParserT s ParserState m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
start

-- | Parses a character reference and returns a Str element.
charRef :: Stream s m Char => ParserT s st m Inline
charRef :: ParserT s st m Inline
charRef = Text -> Inline
Str (Text -> Inline) -> (Char -> Text) -> Char -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Inline) -> ParsecT s st m Char -> ParserT s st m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
characterReference

lineBlockLine :: Monad m => ParserT Text st m Text
lineBlockLine :: ParserT Text st m Text
lineBlockLine = ParserT Text st m Text -> ParserT Text st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m Text -> ParserT Text st m Text)
-> ParserT Text st m Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
  Char -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
  Text
white <- String -> Text
T.pack (String -> Text)
-> ParsecT Text st m String -> ParserT Text st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text st m Char -> ParsecT Text st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text st m Char
-> ParsecT Text st m Char -> ParsecT Text st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text st m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\160')
  ParsecT Text st m Char -> ParsecT Text 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 Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  Text
line <- ParserT Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine
  [Text]
continuations <- ParserT Text st m Text -> ParsecT Text st m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParserT Text st m Text -> ParserT Text st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m Text -> ParserT Text st m Text)
-> ParserT Text st m Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT Text st m Char
-> ParserT Text st m Text -> ParserT Text st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine)
  Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT Text st m Text) -> Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ Text
white Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (Text
line Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
continuations)

blankLineBlockLine :: Stream s m Char => ParserT s st m Char
blankLineBlockLine :: ParserT s st m Char
blankLineBlockLine = ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParserT s st m Char -> ParserT s st m Char -> ParserT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline)

-- | Parses an RST-style line block and returns a list of strings.
lineBlockLines :: Monad m => ParserT Text st m [Text]
lineBlockLines :: ParserT Text st m [Text]
lineBlockLines = ParserT Text st m [Text] -> ParserT Text st m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m [Text] -> ParserT Text st m [Text])
-> ParserT Text st m [Text] -> ParserT Text st m [Text]
forall a b. (a -> b) -> a -> b
$ do
  [Text]
lines' <- ParsecT Text st m Text -> ParserT Text st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
lineBlockLine ParsecT Text st m Text
-> ParsecT Text st m Text -> ParsecT Text st m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Text
T.singleton (Char -> Text) -> ParsecT Text st m Char -> ParsecT Text st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankLineBlockLine))
  ParsecT Text st m Char -> ParsecT Text st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline
  [Text] -> ParserT Text st m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
lines'

-- | Parse a table using 'headerParser', 'rowParser',
-- 'lineParser', and 'footerParser'.
tableWith :: (Stream s m Char, HasReaderOptions st, Monad mf)
          => ParserT s st m (mf [Blocks], [Alignment], [Int])
          -> ([Int] -> ParserT s st m (mf [Blocks]))
          -> ParserT s st m sep
          -> ParserT s st m end
          -> ParserT s st m (mf Blocks)
tableWith :: ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf Blocks)
tableWith ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser [Int] -> ParserT s st m (mf [Blocks])
rowParser ParserT s st m sep
lineParser ParserT s st m end
footerParser = ParserT s st m (mf Blocks) -> ParserT s st m (mf Blocks)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m (mf Blocks) -> ParserT s st m (mf Blocks))
-> ParserT s st m (mf Blocks) -> ParserT s st m (mf Blocks)
forall a b. (a -> b) -> a -> b
$ do
  ([Alignment]
aligns, [Double]
widths, mf [Row]
heads, mf [Row]
rows) <- ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m ([Alignment], [Double], mf [Row], mf [Row])
forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, HasReaderOptions st, Monad mf) =>
ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (TableComponents mf)
tableWith' ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser [Int] -> ParserT s st m (mf [Blocks])
rowParser
                                                ParserT s st m sep
lineParser ParserT s st m end
footerParser
  let th :: mf TableHead
th = Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> mf [Row] -> mf TableHead
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf [Row]
heads
      tb :: mf [TableBody]
tb = (TableBody -> [TableBody] -> [TableBody]
forall a. a -> [a] -> [a]
:[]) (TableBody -> [TableBody])
-> ([Row] -> TableBody) -> [Row] -> [TableBody]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> [TableBody]) -> mf [Row] -> mf [TableBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf [Row]
rows
      tf :: mf TableFoot
tf = TableFoot -> mf TableFoot
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableFoot -> mf TableFoot) -> TableFoot -> mf TableFoot
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr []
  mf Blocks -> ParserT s st m (mf Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return (mf Blocks -> ParserT s st m (mf Blocks))
-> mf Blocks -> ParserT s st m (mf Blocks)
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
B.table Caption
B.emptyCaption ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns ((Double -> ColWidth) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> [a] -> [b]
map Double -> ColWidth
fromWidth [Double]
widths)) (TableHead -> [TableBody] -> TableFoot -> Blocks)
-> mf TableHead -> mf ([TableBody] -> TableFoot -> Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf TableHead
th mf ([TableBody] -> TableFoot -> Blocks)
-> mf [TableBody] -> mf (TableFoot -> Blocks)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> mf [TableBody]
tb mf (TableFoot -> Blocks) -> mf TableFoot -> mf Blocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> mf TableFoot
tf
  where
    fromWidth :: Double -> ColWidth
fromWidth Double
n
      | Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0     = Double -> ColWidth
ColWidth Double
n
      | Bool
otherwise = ColWidth
ColWidthDefault

type TableComponents mf = ([Alignment], [Double], mf [Row], mf [Row])

tableWith' :: (Stream s m Char, HasReaderOptions st, Monad mf)
           => ParserT s st m (mf [Blocks], [Alignment], [Int])
           -> ([Int] -> ParserT s st m (mf [Blocks]))
           -> ParserT s st m sep
           -> ParserT s st m end
           -> ParserT s st m (TableComponents mf)
tableWith' :: ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (TableComponents mf)
tableWith' ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser [Int] -> ParserT s st m (mf [Blocks])
rowParser ParserT s st m sep
lineParser ParserT s st m end
footerParser = ParserT s st m (TableComponents mf)
-> ParserT s st m (TableComponents mf)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m (TableComponents mf)
 -> ParserT s st m (TableComponents mf))
-> ParserT s st m (TableComponents mf)
-> ParserT s st m (TableComponents mf)
forall a b. (a -> b) -> a -> b
$ do
    (mf [Blocks]
heads, [Alignment]
aligns, [Int]
indices) <- ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser
    mf [[Blocks]]
lines' <- [mf [Blocks]] -> mf [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf [Blocks]] -> mf [[Blocks]])
-> ParsecT s st m [mf [Blocks]] -> ParsecT s st m (mf [[Blocks]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> ParserT s st m (mf [Blocks])
rowParser [Int]
indices ParserT s st m (mf [Blocks])
-> ParserT s st m sep -> ParsecT s st m [mf [Blocks]]
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]
`sepEndBy1` ParserT s st m sep
lineParser
    ParserT s st m end
footerParser
    Int
numColumns <- (ReaderOptions -> Int) -> ParserT s st m Int
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Int
readerColumns
    let widths :: [Double]
widths = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
indices
                    then Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns) Double
0.0
                    else Int -> [Int] -> [Double]
widthsFromIndices Int
numColumns [Int]
indices
    let toRow :: [Blocks] -> Row
toRow =  Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
        toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
    TableComponents mf -> ParserT s st m (TableComponents mf)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Alignment]
aligns, [Double]
widths, [Blocks] -> [Row]
toHeaderRow ([Blocks] -> [Row]) -> mf [Blocks] -> mf [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf [Blocks]
heads, ([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow ([[Blocks]] -> [Row]) -> mf [[Blocks]] -> mf [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf [[Blocks]]
lines')

-- Calculate relative widths of table columns, based on indices
widthsFromIndices :: Int      -- Number of columns on terminal
                  -> [Int]    -- Indices
                  -> [Double] -- Fractional relative sizes of columns
widthsFromIndices :: Int -> [Int] -> [Double]
widthsFromIndices Int
_ [] = []
widthsFromIndices Int
numColumns' [Int]
indices =
  let numColumns :: Int
numColumns = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
numColumns' (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
indices then Int
0 else [Int] -> Int
forall a. [a] -> a
last [Int]
indices)
      lengths' :: [Int]
lengths' = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
indices (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
indices)
      lengths :: [Int]
lengths  = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
                 case [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
lengths' of
                      []       -> []
                      [Int
x]      -> [Int
x]
                      -- compensate for the fact that intercolumn
                      -- spaces are counted in widths of all columns
                      -- but the last...
                      (Int
x:Int
y:[Int]
zs) -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y Bool -> Bool -> Bool
&& Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2
                                     then Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs
                                     else Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs
      totLength :: Int
totLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
lengths
      quotient :: Double
quotient = if Int
totLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
numColumns
                   then Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totLength
                   else Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numColumns
      fracs :: [Double]
fracs = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
quotient) [Int]
lengths in
  [Double] -> [Double]
forall a. [a] -> [a]
tail [Double]
fracs

---

-- Parse a grid table:  starts with row of '-' on top, then header
-- (which may be grid), then the rows,
-- which may be grid, separated by blank lines, and
-- ending with a footer (dashed line followed by blank line).
gridTableWith :: (Stream s m Char, HasReaderOptions st, HasLastStrPosition st,
                  Monad mf, IsString s)
              => ParserT s st m (mf Blocks)  -- ^ Block list parser
              -> Bool                        -- ^ Headerless table
              -> ParserT s st m (mf Blocks)
gridTableWith :: ParserT s st m (mf Blocks) -> Bool -> ParserT s st m (mf Blocks)
gridTableWith ParserT s st m (mf Blocks)
blocks Bool
headless =
  ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m Char
-> ParserT s st m ()
-> ParserT s st m (mf Blocks)
forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, HasReaderOptions st, Monad mf) =>
ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf Blocks)
tableWith (Bool
-> ParserT s st m (mf Blocks)
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
forall s (m :: * -> *) (mf :: * -> *) st.
(Stream s m Char, Monad mf, IsString s, HasLastStrPosition st) =>
Bool
-> ParserT s st m (mf Blocks)
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
headless ParserT s st m (mf Blocks)
blocks) (ParserT s st m (mf Blocks) -> [Int] -> ParserT s st m (mf [Blocks])
forall s (m :: * -> *) (mf :: * -> *) st.
(Stream s m Char, Monad mf, IsString s, HasLastStrPosition st) =>
ParserT s st m (mf Blocks) -> [Int] -> ParserT s st m (mf [Blocks])
gridTableRow ParserT s st m (mf Blocks)
blocks)
            (Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
gridTableSep Char
'-') ParserT s st m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
gridTableFooter

gridTableWith' :: (Stream s m Char, HasReaderOptions st, HasLastStrPosition st,
                   Monad mf, IsString s)
               => ParserT s st m (mf Blocks)  -- ^ Block list parser
               -> Bool                        -- ^ Headerless table
               -> ParserT s st m (TableComponents mf)
gridTableWith' :: ParserT s st m (mf Blocks)
-> Bool -> ParserT s st m (TableComponents mf)
gridTableWith' ParserT s st m (mf Blocks)
blocks Bool
headless =
  ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m Char
-> ParserT s st m ()
-> ParserT s st m (TableComponents mf)
forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, HasReaderOptions st, Monad mf) =>
ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (TableComponents mf)
tableWith' (Bool
-> ParserT s st m (mf Blocks)
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
forall s (m :: * -> *) (mf :: * -> *) st.
(Stream s m Char, Monad mf, IsString s, HasLastStrPosition st) =>
Bool
-> ParserT s st m (mf Blocks)
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
headless ParserT s st m (mf Blocks)
blocks) (ParserT s st m (mf Blocks) -> [Int] -> ParserT s st m (mf [Blocks])
forall s (m :: * -> *) (mf :: * -> *) st.
(Stream s m Char, Monad mf, IsString s, HasLastStrPosition st) =>
ParserT s st m (mf Blocks) -> [Int] -> ParserT s st m (mf [Blocks])
gridTableRow ParserT s st m (mf Blocks)
blocks)
             (Char -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
gridTableSep Char
'-') ParserT s st m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
gridTableFooter

gridTableSplitLine :: [Int] -> Text -> [Text]
gridTableSplitLine :: [Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices Text
line = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
removeFinalBar ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
  [Int] -> Text -> [Text]
splitTextByIndices ([Int] -> [Int]
forall a. [a] -> [a]
init [Int]
indices) (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimr Text
line

gridPart :: Stream s m Char => Char -> ParserT s st m ((Int, Int), Alignment)
gridPart :: Char -> ParserT s st m ((Int, Int), Alignment)
gridPart Char
ch = do
  Bool
leftColon <- Bool -> ParsecT s st m Bool -> ParsecT s st m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> ParsecT s st m Char -> ParsecT s st m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
  String
dashes <- ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ch)
  Bool
rightColon <- Bool -> ParsecT s st m Bool -> ParsecT s st m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> ParsecT s st m Char -> ParsecT s st m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
  let lengthDashes :: Int
lengthDashes = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dashes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
leftColon then Int
1 else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                       (if Bool
rightColon then Int
1 else Int
0)
  let alignment :: Alignment
alignment = case (Bool
leftColon, Bool
rightColon) of
                       (Bool
True, Bool
True)   -> Alignment
AlignCenter
                       (Bool
True, Bool
False)  -> Alignment
AlignLeft
                       (Bool
False, Bool
True)  -> Alignment
AlignRight
                       (Bool
False, Bool
False) -> Alignment
AlignDefault
  ((Int, Int), Alignment) -> ParserT s st m ((Int, Int), Alignment)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
lengthDashes, Int
lengthDashes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Alignment
alignment)

gridDashedLines :: Stream s m Char => Char -> ParserT s st m [((Int, Int), Alignment)]
gridDashedLines :: Char -> ParserT s st m [((Int, Int), Alignment)]
gridDashedLines Char
ch = ParserT s st m [((Int, Int), Alignment)]
-> ParserT s st m [((Int, Int), Alignment)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m [((Int, Int), Alignment)]
 -> ParserT s st m [((Int, Int), Alignment)])
-> ParserT s st m [((Int, Int), Alignment)]
-> ParserT s st m [((Int, Int), Alignment)]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT s st m Char
-> ParserT s st m [((Int, Int), Alignment)]
-> ParserT s st m [((Int, Int), Alignment)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m ((Int, Int), Alignment)
-> ParserT s st m [((Int, Int), Alignment)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT s st m ((Int, Int), Alignment)
forall s (m :: * -> *) st.
Stream s m Char =>
Char -> ParserT s st m ((Int, Int), Alignment)
gridPart Char
ch) ParserT s st m [((Int, Int), Alignment)]
-> ParsecT s st m Char -> ParserT s st m [((Int, Int), Alignment)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
blankline

removeFinalBar :: Text -> Text
removeFinalBar :: Text -> Text
removeFinalBar = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
go (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|')
  where
    go :: Char -> Bool
go Char
c = (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
" \t"

-- | Separator between rows of grid table.
gridTableSep :: Stream s m Char => Char -> ParserT s st m Char
gridTableSep :: Char -> ParserT s st m Char
gridTableSep Char
ch = ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Char -> ParserT s st m Char)
-> ParserT s st m Char -> ParserT s st m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParserT s st m [((Int, Int), Alignment)]
forall s (m :: * -> *) st.
Stream s m Char =>
Char -> ParserT s st m [((Int, Int), Alignment)]
gridDashedLines Char
ch ParserT s st m [((Int, Int), Alignment)]
-> ParserT s st m Char -> ParserT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParserT s st m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'

-- | Parse header for a grid table.
gridTableHeader :: (Stream s m Char, Monad mf, IsString s, HasLastStrPosition st)
                => Bool -- ^ Headerless table
                -> ParserT s st m (mf Blocks)
                -> ParserT s st m (mf [Blocks], [Alignment], [Int])
gridTableHeader :: Bool
-> ParserT s st m (mf Blocks)
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
True ParserT s st m (mf Blocks)
_ = do
  ParsecT s st m Text -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
  [((Int, Int), Alignment)]
dashes <- Char -> ParserT s st m [((Int, Int), Alignment)]
forall s (m :: * -> *) st.
Stream s m Char =>
Char -> ParserT s st m [((Int, Int), Alignment)]
gridDashedLines Char
'-'
  let aligns :: [Alignment]
aligns = (((Int, Int), Alignment) -> Alignment)
-> [((Int, Int), Alignment)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), Alignment) -> Alignment
forall a b. (a, b) -> b
snd [((Int, Int), Alignment)]
dashes
  let lines' :: [Int]
lines'   = (((Int, Int), Alignment) -> Int)
-> [((Int, Int), Alignment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int)
-> (((Int, Int), Alignment) -> (Int, Int))
-> ((Int, Int), Alignment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), Alignment) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), Alignment)]
dashes
  let indices :: [Int]
indices  = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
lines'
  (mf [Blocks], [Alignment], [Int])
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks] -> mf [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return [], [Alignment]
aligns, [Int]
indices)
gridTableHeader Bool
False ParserT s st m (mf Blocks)
blocks = ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m (mf [Blocks], [Alignment], [Int])
 -> ParserT s st m (mf [Blocks], [Alignment], [Int]))
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
forall a b. (a -> b) -> a -> b
$ do
  ParsecT s st m Text -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines
  [((Int, Int), Alignment)]
dashes <- Char -> ParserT s st m [((Int, Int), Alignment)]
forall s (m :: * -> *) st.
Stream s m Char =>
Char -> ParserT s st m [((Int, Int), Alignment)]
gridDashedLines Char
'-'
  [Text]
rawContent  <- ParsecT s st m Text -> ParsecT s st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (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 (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
gridTableSep Char
'=') ParsecT s st m () -> ParsecT s st m Char -> ParsecT s st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT s st m Char -> ParsecT s st m Text -> ParsecT s st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           String -> Text
T.pack (String -> Text) -> ParsecT s st m String -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m String
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline)
  [((Int, Int), Alignment)]
underDashes <- Char -> ParserT s st m [((Int, Int), Alignment)]
forall s (m :: * -> *) st.
Stream s m Char =>
Char -> ParserT s st m [((Int, Int), Alignment)]
gridDashedLines Char
'='
  Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT s st m ()) -> Bool -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ [((Int, Int), Alignment)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((Int, Int), Alignment)]
dashes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [((Int, Int), Alignment)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((Int, Int), Alignment)]
underDashes
  let lines' :: [Int]
lines'   = (((Int, Int), Alignment) -> Int)
-> [((Int, Int), Alignment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int)
-> (((Int, Int), Alignment) -> (Int, Int))
-> ((Int, Int), Alignment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), Alignment) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), Alignment)]
underDashes
  let indices :: [Int]
indices  = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
lines'
  let aligns :: [Alignment]
aligns   = (((Int, Int), Alignment) -> Alignment)
-> [((Int, Int), Alignment)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), Alignment) -> Alignment
forall a b. (a, b) -> b
snd [((Int, Int), Alignment)]
underDashes
  let rawHeads :: [Text]
rawHeads = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim) ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose
                       ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices) [Text]
rawContent
  mf [Blocks]
heads <- [mf Blocks] -> mf [Blocks]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf Blocks] -> mf [Blocks])
-> ParsecT s st m [mf Blocks] -> ParsecT s st m (mf [Blocks])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParserT s st m (mf Blocks))
-> [Text] -> ParsecT s st m [mf Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT s st m (mf Blocks) -> Text -> ParserT s st m (mf Blocks)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT s st m (mf Blocks)
blocks (Text -> ParserT s st m (mf Blocks))
-> (Text -> Text) -> Text -> ParserT s st m (mf Blocks)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) [Text]
rawHeads
  (mf [Blocks], [Alignment], [Int])
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (mf [Blocks]
heads, [Alignment]
aligns, [Int]
indices)

gridTableRawLine :: Stream s m Char => [Int] -> ParserT s st m [Text]
gridTableRawLine :: [Int] -> ParserT s st m [Text]
gridTableRawLine [Int]
indices = do
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
  String
line <- ParsecT s st m Char -> ParsecT s st m Char -> ParserT s st m String
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  [Text] -> ParserT s st m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
line)

-- | Parse row of grid table.
gridTableRow :: (Stream s m Char, Monad mf, IsString s, HasLastStrPosition st)
             => ParserT s st m (mf Blocks)
             -> [Int]
             -> ParserT s st m (mf [Blocks])
gridTableRow :: ParserT s st m (mf Blocks) -> [Int] -> ParserT s st m (mf [Blocks])
gridTableRow ParserT s st m (mf Blocks)
blocks [Int]
indices = do
  [[Text]]
colLines <- ParsecT s st m [Text] -> ParsecT s st m [[Text]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Int] -> ParsecT s st m [Text]
forall s (m :: * -> *) st.
Stream s m Char =>
[Int] -> ParserT s st m [Text]
gridTableRawLine [Int]
indices)
  let cols :: [Text]
cols = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
removeOneLeadingSpace) ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$
               [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose [[Text]]
colLines
      compactifyCell :: Blocks -> Blocks
compactifyCell Blocks
bs = case [Blocks] -> [Blocks]
compactify [Blocks
bs] of
                            []  -> Blocks
forall a. Monoid a => a
mempty
                            Blocks
x:[Blocks]
_ -> Blocks
x
  mf [Blocks]
cells <- [mf Blocks] -> mf [Blocks]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf Blocks] -> mf [Blocks])
-> ParsecT s st m [mf Blocks] -> ParserT s st m (mf [Blocks])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParserT s st m (mf Blocks))
-> [Text] -> ParsecT s st m [mf Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT s st m (mf Blocks) -> Text -> ParserT s st m (mf Blocks)
forall s (m :: * -> *) u a.
(Stream s m Char, IsString s, HasLastStrPosition u) =>
ParserT s u m a -> Text -> ParserT s u m a
parseFromString' ParserT s st m (mf Blocks)
blocks) [Text]
cols
  mf [Blocks] -> ParserT s st m (mf [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (mf [Blocks] -> ParserT s st m (mf [Blocks]))
-> mf [Blocks] -> ParserT s st m (mf [Blocks])
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> [Blocks]) -> mf [Blocks] -> mf [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Blocks
compactifyCell) mf [Blocks]
cells

removeOneLeadingSpace :: [Text] -> [Text]
removeOneLeadingSpace :: [Text] -> [Text]
removeOneLeadingSpace [Text]
xs =
  if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
startsWithSpace [Text]
xs
     then (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
1) [Text]
xs
     else [Text]
xs
   where startsWithSpace :: Text -> Bool
startsWithSpace Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
           Maybe (Char, Text)
Nothing     -> Bool
True
           Just (Char
c, Text
_) -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '

-- | Parse footer for a grid table.
gridTableFooter :: Stream s m Char => ParserT s st m ()
gridTableFooter :: ParserT s st m ()
gridTableFooter = ParsecT s st m Text -> ParserT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s st m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
blanklines

---

-- | Removes the ParsecT layer from the monad transformer stack
readWithM :: (Stream s m Char, ToText s)
          => ParserT s st m a    -- ^ parser
          -> st                  -- ^ initial state
          -> s                   -- ^ input
          -> m (Either PandocError a)
readWithM :: ParserT s st m a -> st -> s -> m (Either PandocError a)
readWithM ParserT s st m a
parser st
state s
input =
    (ParseError -> PandocError)
-> Either ParseError a -> Either PandocError a
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft (Text -> ParseError -> PandocError
PandocParsecError (Text -> ParseError -> PandocError)
-> Text -> ParseError -> PandocError
forall a b. (a -> b) -> a -> b
$ s -> Text
forall a. ToText a => a -> Text
toText s
input) (Either ParseError a -> Either PandocError a)
-> m (Either ParseError a) -> m (Either PandocError a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParserT s st m a -> st -> String -> s -> m (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParserT s st m a
parser st
state String
"source" s
input

-- | Parse a string with a given parser and state
readWith :: Parser Text st a
         -> st
         -> Text
         -> Either PandocError a
readWith :: Parser Text st a -> st -> Text -> Either PandocError a
readWith Parser Text st a
p st
t Text
inp = Identity (Either PandocError a) -> Either PandocError a
forall a. Identity a -> a
runIdentity (Identity (Either PandocError a) -> Either PandocError a)
-> Identity (Either PandocError a) -> Either PandocError a
forall a b. (a -> b) -> a -> b
$ Parser Text st a -> st -> Text -> Identity (Either PandocError a)
forall s (m :: * -> *) st a.
(Stream s m Char, ToText s) =>
ParserT s st m a -> st -> s -> m (Either PandocError a)
readWithM Parser Text st a
p st
t Text
inp

-- | Parse a string with @parser@ (for testing).
testStringWith :: Show a
               => ParserT Text ParserState Identity a
               -> Text
               -> IO ()
testStringWith :: ParserT Text ParserState Identity a -> Text -> IO ()
testStringWith ParserT Text ParserState Identity a
parser Text
str = Text -> IO ()
UTF8.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Either PandocError a -> Text
forall a. Show a => a -> Text
tshow (Either PandocError a -> Text) -> Either PandocError a -> Text
forall a b. (a -> b) -> a -> b
$
                            ParserT Text ParserState Identity a
-> ParserState -> Text -> Either PandocError a
forall st a. Parser Text st a -> st -> Text -> Either PandocError a
readWith ParserT Text ParserState Identity a
parser ParserState
defaultParserState Text
str

-- | Parsing options.
data ParserState = ParserState
    { ParserState -> ReaderOptions
stateOptions           :: ReaderOptions, -- ^ User options
      ParserState -> ParserContext
stateParserContext     :: ParserContext, -- ^ Inside list?
      ParserState -> QuoteContext
stateQuoteContext      :: QuoteContext,  -- ^ Inside quoted environment?
      ParserState -> Bool
stateAllowLinks        :: Bool,          -- ^ Allow parsing of links
      ParserState -> Bool
stateAllowLineBreaks   :: Bool,          -- ^ Allow parsing of line breaks
      ParserState -> Int
stateMaxNestingLevel   :: Int,           -- ^ Max # of nested Strong/Emph
      ParserState -> Maybe SourcePos
stateLastStrPos        :: Maybe SourcePos, -- ^ Position after last str parsed
      ParserState -> KeyTable
stateKeys              :: KeyTable,      -- ^ List of reference keys
      ParserState -> KeyTable
stateHeaderKeys        :: KeyTable,      -- ^ List of implicit header ref keys
      ParserState -> SubstTable
stateSubstitutions     :: SubstTable,    -- ^ List of substitution references
      ParserState -> NoteTable
stateNotes             :: NoteTable,     -- ^ List of notes (raw bodies)
      ParserState -> NoteTable'
stateNotes'            :: NoteTable',    -- ^ List of notes (parsed bodies)
      ParserState -> Set Text
stateNoteRefs          :: Set.Set Text, -- ^ List of note references used
      ParserState -> Bool
stateInNote            :: Bool,          -- ^ True if parsing note contents
      ParserState -> Int
stateNoteNumber        :: Int,           -- ^ Last note number for citations
      ParserState -> Meta
stateMeta              :: Meta,          -- ^ Document metadata
      ParserState -> F Meta
stateMeta'             :: F Meta,        -- ^ Document metadata
      ParserState -> Map Text Text
stateCitations         :: M.Map Text Text, -- ^ RST-style citations
      ParserState -> [HeaderType]
stateHeaderTable       :: [HeaderType],  -- ^ Ordered list of header types used
      ParserState -> Set Text
stateIdentifiers       :: Set.Set Text, -- ^ Header identifiers used
      ParserState -> Int
stateNextExample       :: Int,           -- ^ Number of next example
      ParserState -> Map Text Int
stateExamples          :: M.Map Text Int, -- ^ Map from example labels to numbers
      ParserState -> Map Text Macro
stateMacros            :: M.Map Text Macro, -- ^ Table of macros defined so far
      ParserState -> Text
stateRstDefaultRole    :: Text,        -- ^ Current rST default interpreted text role
      ParserState -> Maybe Text
stateRstHighlight      :: Maybe Text,  -- ^ Current rST literal block language
      ParserState -> Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles    :: M.Map Text (Text, Maybe Text, Attr), -- ^ Current rST custom text roles
      -- Triple represents: 1) Base role, 2) Optional format (only for :raw:
      -- roles), 3) Additional classes (rest of Attr is unused)).
      ParserState -> Maybe Inlines
stateCaption           :: Maybe Inlines, -- ^ Caption in current environment
      ParserState -> Maybe Text
stateInHtmlBlock       :: Maybe Text,  -- ^ Tag type of HTML block being parsed
      ParserState -> Int
stateFencedDivLevel    :: Int,           -- ^ Depth of fenced div
      ParserState -> [Text]
stateContainers        :: [Text],      -- ^ parent include files
      ParserState -> [LogMessage]
stateLogMessages       :: [LogMessage],  -- ^ log messages
      ParserState -> Bool
stateMarkdownAttribute :: Bool         -- ^ True if in markdown=1 context
    }

instance Default ParserState where
  def :: ParserState
def = ParserState
defaultParserState

instance HasMeta ParserState where
  setMeta :: Text -> b -> ParserState -> ParserState
setMeta Text
field b
val ParserState
st =
    ParserState
st{ stateMeta :: Meta
stateMeta = Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field b
val (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ ParserState -> Meta
stateMeta ParserState
st }
  deleteMeta :: Text -> ParserState -> ParserState
deleteMeta Text
field ParserState
st =
    ParserState
st{ stateMeta :: Meta
stateMeta = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ ParserState -> Meta
stateMeta ParserState
st }

class HasReaderOptions st where
  extractReaderOptions :: st -> ReaderOptions
  getOption            :: (Stream s m t) => (ReaderOptions -> b) -> ParserT s st m b
  -- default
  getOption  ReaderOptions -> b
f         = ReaderOptions -> b
f (ReaderOptions -> b) -> (st -> ReaderOptions) -> st -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> ReaderOptions
forall st. HasReaderOptions st => st -> ReaderOptions
extractReaderOptions (st -> b) -> ParsecT s st m st -> ParserT s st m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

instance HasReaderOptions ParserState where
  extractReaderOptions :: ParserState -> ReaderOptions
extractReaderOptions = ParserState -> ReaderOptions
stateOptions

class HasQuoteContext st m where
  getQuoteContext :: (Stream s m t) => ParsecT s st m QuoteContext
  withQuoteContext :: QuoteContext -> ParsecT s st m a -> ParsecT s st m a

instance Monad m => HasQuoteContext ParserState m where
  getQuoteContext :: ParsecT s ParserState m QuoteContext
getQuoteContext = ParserState -> QuoteContext
stateQuoteContext (ParserState -> QuoteContext)
-> ParsecT s ParserState m ParserState
-> ParsecT s ParserState m QuoteContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  withQuoteContext :: QuoteContext
-> ParsecT s ParserState m a -> ParsecT s ParserState m a
withQuoteContext QuoteContext
context ParsecT s ParserState m a
parser = do
    ParserState
oldState <- ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let oldQuoteContext :: QuoteContext
oldQuoteContext = ParserState -> QuoteContext
stateQuoteContext ParserState
oldState
    ParserState -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ParserState
oldState { stateQuoteContext :: QuoteContext
stateQuoteContext = QuoteContext
context }
    a
result <- ParsecT s ParserState m a
parser
    ParserState
newState <- ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    ParserState -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ParserState
newState { stateQuoteContext :: QuoteContext
stateQuoteContext = QuoteContext
oldQuoteContext }
    a -> ParsecT s ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

class HasIdentifierList st where
  extractIdentifierList  :: st -> Set.Set Text
  updateIdentifierList   :: (Set.Set Text -> Set.Set Text) -> st -> st

instance HasIdentifierList ParserState where
  extractIdentifierList :: ParserState -> Set Text
extractIdentifierList     = ParserState -> Set Text
stateIdentifiers
  updateIdentifierList :: (Set Text -> Set Text) -> ParserState -> ParserState
updateIdentifierList Set Text -> Set Text
f ParserState
st = ParserState
st{ stateIdentifiers :: Set Text
stateIdentifiers = Set Text -> Set Text
f (Set Text -> Set Text) -> Set Text -> Set Text
forall a b. (a -> b) -> a -> b
$ ParserState -> Set Text
stateIdentifiers ParserState
st }

class HasMacros st where
  extractMacros         :: st -> M.Map Text Macro
  updateMacros          :: (M.Map Text Macro -> M.Map Text Macro) -> st -> st

instance HasMacros ParserState where
  extractMacros :: ParserState -> Map Text Macro
extractMacros        = ParserState -> Map Text Macro
stateMacros
  updateMacros :: (Map Text Macro -> Map Text Macro) -> ParserState -> ParserState
updateMacros Map Text Macro -> Map Text Macro
f ParserState
st    = ParserState
st{ stateMacros :: Map Text Macro
stateMacros = Map Text Macro -> Map Text Macro
f (Map Text Macro -> Map Text Macro)
-> Map Text Macro -> Map Text Macro
forall a b. (a -> b) -> a -> b
$ ParserState -> Map Text Macro
stateMacros ParserState
st }

class HasLastStrPosition st where
  setLastStrPos  :: Maybe SourcePos -> st -> st
  getLastStrPos  :: st -> Maybe SourcePos

instance HasLastStrPosition ParserState where
  setLastStrPos :: Maybe SourcePos -> ParserState -> ParserState
setLastStrPos Maybe SourcePos
pos ParserState
st = ParserState
st{ stateLastStrPos :: Maybe SourcePos
stateLastStrPos = Maybe SourcePos
pos }
  getLastStrPos :: ParserState -> Maybe SourcePos
getLastStrPos ParserState
st     = ParserState -> Maybe SourcePos
stateLastStrPos ParserState
st

class HasLogMessages st where
  addLogMessage :: LogMessage -> st -> st
  getLogMessages :: st -> [LogMessage]

instance HasLogMessages ParserState where
  addLogMessage :: LogMessage -> ParserState -> ParserState
addLogMessage LogMessage
msg ParserState
st = ParserState
st{ stateLogMessages :: [LogMessage]
stateLogMessages = LogMessage
msg LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: ParserState -> [LogMessage]
stateLogMessages ParserState
st }
  getLogMessages :: ParserState -> [LogMessage]
getLogMessages ParserState
st = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> a -> b
$ ParserState -> [LogMessage]
stateLogMessages ParserState
st

class HasIncludeFiles st where
  getIncludeFiles :: st -> [Text]
  addIncludeFile :: Text -> st -> st
  dropLatestIncludeFile :: st -> st

instance HasIncludeFiles ParserState where
  getIncludeFiles :: ParserState -> [Text]
getIncludeFiles = ParserState -> [Text]
stateContainers
  addIncludeFile :: Text -> ParserState -> ParserState
addIncludeFile Text
f ParserState
s = ParserState
s{ stateContainers :: [Text]
stateContainers = Text
f Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ParserState -> [Text]
stateContainers ParserState
s }
  dropLatestIncludeFile :: ParserState -> ParserState
dropLatestIncludeFile ParserState
s = ParserState
s { stateContainers :: [Text]
stateContainers = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ParserState -> [Text]
stateContainers ParserState
s }

defaultParserState :: ParserState
defaultParserState :: ParserState
defaultParserState =
    ParserState :: ReaderOptions
-> ParserContext
-> QuoteContext
-> Bool
-> Bool
-> Int
-> Maybe SourcePos
-> KeyTable
-> KeyTable
-> SubstTable
-> NoteTable
-> NoteTable'
-> Set Text
-> Bool
-> Int
-> Meta
-> F Meta
-> Map Text Text
-> [HeaderType]
-> Set Text
-> Int
-> Map Text Int
-> Map Text Macro
-> Text
-> Maybe Text
-> Map Text (Text, Maybe Text, Attr)
-> Maybe Inlines
-> Maybe Text
-> Int
-> [Text]
-> [LogMessage]
-> Bool
-> ParserState
ParserState { stateOptions :: ReaderOptions
stateOptions         = ReaderOptions
forall a. Default a => a
def,
                  stateParserContext :: ParserContext
stateParserContext   = ParserContext
NullState,
                  stateQuoteContext :: QuoteContext
stateQuoteContext    = QuoteContext
NoQuote,
                  stateAllowLinks :: Bool
stateAllowLinks      = Bool
True,
                  stateAllowLineBreaks :: Bool
stateAllowLineBreaks = Bool
True,
                  stateMaxNestingLevel :: Int
stateMaxNestingLevel = Int
6,
                  stateLastStrPos :: Maybe SourcePos
stateLastStrPos      = Maybe SourcePos
forall a. Maybe a
Nothing,
                  stateKeys :: KeyTable
stateKeys            = KeyTable
forall k a. Map k a
M.empty,
                  stateHeaderKeys :: KeyTable
stateHeaderKeys      = KeyTable
forall k a. Map k a
M.empty,
                  stateSubstitutions :: SubstTable
stateSubstitutions   = SubstTable
forall k a. Map k a
M.empty,
                  stateNotes :: NoteTable
stateNotes           = [],
                  stateNotes' :: NoteTable'
stateNotes'          = NoteTable'
forall k a. Map k a
M.empty,
                  stateNoteRefs :: Set Text
stateNoteRefs        = Set Text
forall a. Set a
Set.empty,
                  stateInNote :: Bool
stateInNote          = Bool
False,
                  stateNoteNumber :: Int
stateNoteNumber      = Int
0,
                  stateMeta :: Meta
stateMeta            = Meta
nullMeta,
                  stateMeta' :: F Meta
stateMeta'           = Meta -> F Meta
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
nullMeta,
                  stateCitations :: Map Text Text
stateCitations       = Map Text Text
forall k a. Map k a
M.empty,
                  stateHeaderTable :: [HeaderType]
stateHeaderTable     = [],
                  stateIdentifiers :: Set Text
stateIdentifiers     = Set Text
forall a. Set a
Set.empty,
                  stateNextExample :: Int
stateNextExample     = Int
1,
                  stateExamples :: Map Text Int
stateExamples        = Map Text Int
forall k a. Map k a
M.empty,
                  stateMacros :: Map Text Macro
stateMacros          = Map Text Macro
forall k a. Map k a
M.empty,
                  stateRstDefaultRole :: Text
stateRstDefaultRole  = Text
"title-reference",
                  stateRstHighlight :: Maybe Text
stateRstHighlight    = Maybe Text
forall a. Maybe a
Nothing,
                  stateRstCustomRoles :: Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles  = Map Text (Text, Maybe Text, Attr)
forall k a. Map k a
M.empty,
                  stateCaption :: Maybe Inlines
stateCaption         = Maybe Inlines
forall a. Maybe a
Nothing,
                  stateInHtmlBlock :: Maybe Text
stateInHtmlBlock     = Maybe Text
forall a. Maybe a
Nothing,
                  stateFencedDivLevel :: Int
stateFencedDivLevel  = Int
0,
                  stateContainers :: [Text]
stateContainers      = [],
                  stateLogMessages :: [LogMessage]
stateLogMessages     = [],
                  stateMarkdownAttribute :: Bool
stateMarkdownAttribute = Bool
False
                  }

-- | Add a log message.
logMessage :: (Stream s m a, HasLogMessages st)
           => LogMessage -> ParserT s st m ()
logMessage :: LogMessage -> ParserT s st m ()
logMessage LogMessage
msg = (st -> st) -> ParserT s st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (LogMessage -> st -> st
forall st. HasLogMessages st => LogMessage -> st -> st
addLogMessage LogMessage
msg)

-- | Report all the accumulated log messages, according to verbosity level.
reportLogMessages :: (PandocMonad m, HasLogMessages st) => ParserT s st m ()
reportLogMessages :: ParserT s st m ()
reportLogMessages = do
  [LogMessage]
msgs <- st -> [LogMessage]
forall st. HasLogMessages st => st -> [LogMessage]
getLogMessages (st -> [LogMessage])
-> ParsecT s st m st -> ParsecT s st m [LogMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (LogMessage -> ParserT s st m ())
-> [LogMessage] -> ParserT s st m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LogMessage -> ParserT s st m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report [LogMessage]
msgs

-- | Succeed only if the extension is enabled.
guardEnabled :: (Stream s m a,  HasReaderOptions st) => Extension -> ParserT s st m ()
guardEnabled :: Extension -> ParserT s st m ()
guardEnabled Extension
ext = (ReaderOptions -> Extensions) -> ParserT s st m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions ParserT s st m Extensions
-> (Extensions -> ParserT s st m ()) -> ParserT s st m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParserT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParserT s st m ())
-> (Extensions -> Bool) -> Extensions -> ParserT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> Extensions -> Bool
extensionEnabled Extension
ext

-- | Succeed only if the extension is disabled.
guardDisabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()
guardDisabled :: Extension -> ParserT s st m ()
guardDisabled Extension
ext = (ReaderOptions -> Extensions) -> ParserT s st m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions ParserT s st m Extensions
-> (Extensions -> ParserT s st m ()) -> ParserT s st m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParserT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParserT s st m ())
-> (Extensions -> Bool) -> Extensions -> ParserT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Extensions -> Bool) -> Extensions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> Extensions -> Bool
extensionEnabled Extension
ext

-- | Update the position on which the last string ended.
updateLastStrPos :: (Stream s m a, HasLastStrPosition st) => ParserT s st m ()
updateLastStrPos :: ParserT s st m ()
updateLastStrPos = ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT s st m SourcePos
-> (SourcePos -> ParserT s st m ()) -> ParserT s st m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (st -> st) -> ParserT s st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((st -> st) -> ParserT s st m ())
-> (SourcePos -> st -> st) -> SourcePos -> ParserT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourcePos -> st -> st
forall st. HasLastStrPosition st => Maybe SourcePos -> st -> st
setLastStrPos (Maybe SourcePos -> st -> st)
-> (SourcePos -> Maybe SourcePos) -> SourcePos -> st -> st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just

-- | Whether we are right after the end of a string.
notAfterString :: (Stream s m a, HasLastStrPosition st) => ParserT s st m Bool
notAfterString :: ParserT s st m Bool
notAfterString = do
  SourcePos
pos <- ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  st
st  <- ParsecT s st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> ParserT s st m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ParserT s st m Bool) -> Bool -> ParserT s st m Bool
forall a b. (a -> b) -> a -> b
$ st -> Maybe SourcePos
forall st. HasLastStrPosition st => st -> Maybe SourcePos
getLastStrPos st
st Maybe SourcePos -> Maybe SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
/= SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
pos

data HeaderType
    = SingleHeader Char  -- ^ Single line of characters underneath
    | DoubleHeader Char  -- ^ Lines of characters above and below
    deriving (HeaderType -> HeaderType -> Bool
(HeaderType -> HeaderType -> Bool)
-> (HeaderType -> HeaderType -> Bool) -> Eq HeaderType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderType -> HeaderType -> Bool
$c/= :: HeaderType -> HeaderType -> Bool
== :: HeaderType -> HeaderType -> Bool
$c== :: HeaderType -> HeaderType -> Bool
Eq, Int -> HeaderType -> String -> String
[HeaderType] -> String -> String
HeaderType -> String
(Int -> HeaderType -> String -> String)
-> (HeaderType -> String)
-> ([HeaderType] -> String -> String)
-> Show HeaderType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HeaderType] -> String -> String
$cshowList :: [HeaderType] -> String -> String
show :: HeaderType -> String
$cshow :: HeaderType -> String
showsPrec :: Int -> HeaderType -> String -> String
$cshowsPrec :: Int -> HeaderType -> String -> String
Show)

data ParserContext
    = ListItemState   -- ^ Used when running parser on list item contents
    | NullState       -- ^ Default state
    deriving (ParserContext -> ParserContext -> Bool
(ParserContext -> ParserContext -> Bool)
-> (ParserContext -> ParserContext -> Bool) -> Eq ParserContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserContext -> ParserContext -> Bool
$c/= :: ParserContext -> ParserContext -> Bool
== :: ParserContext -> ParserContext -> Bool
$c== :: ParserContext -> ParserContext -> Bool
Eq, Int -> ParserContext -> String -> String
[ParserContext] -> String -> String
ParserContext -> String
(Int -> ParserContext -> String -> String)
-> (ParserContext -> String)
-> ([ParserContext] -> String -> String)
-> Show ParserContext
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ParserContext] -> String -> String
$cshowList :: [ParserContext] -> String -> String
show :: ParserContext -> String
$cshow :: ParserContext -> String
showsPrec :: Int -> ParserContext -> String -> String
$cshowsPrec :: Int -> ParserContext -> String -> String
Show)

data QuoteContext
    = InSingleQuote   -- ^ Used when parsing inside single quotes
    | InDoubleQuote   -- ^ Used when parsing inside double quotes
    | NoQuote         -- ^ Used when not parsing inside quotes
    deriving (QuoteContext -> QuoteContext -> Bool
(QuoteContext -> QuoteContext -> Bool)
-> (QuoteContext -> QuoteContext -> Bool) -> Eq QuoteContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuoteContext -> QuoteContext -> Bool
$c/= :: QuoteContext -> QuoteContext -> Bool
== :: QuoteContext -> QuoteContext -> Bool
$c== :: QuoteContext -> QuoteContext -> Bool
Eq, Int -> QuoteContext -> String -> String
[QuoteContext] -> String -> String
QuoteContext -> String
(Int -> QuoteContext -> String -> String)
-> (QuoteContext -> String)
-> ([QuoteContext] -> String -> String)
-> Show QuoteContext
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [QuoteContext] -> String -> String
$cshowList :: [QuoteContext] -> String -> String
show :: QuoteContext -> String
$cshow :: QuoteContext -> String
showsPrec :: Int -> QuoteContext -> String -> String
$cshowsPrec :: Int -> QuoteContext -> String -> String
Show)

type NoteTable = [(Text, Text)]

type NoteTable' = M.Map Text (SourcePos, F Blocks)
-- used in markdown reader

newtype Key = Key Text deriving (Int -> Key -> String -> String
[Key] -> String -> String
Key -> String
(Int -> Key -> String -> String)
-> (Key -> String) -> ([Key] -> String -> String) -> Show Key
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Key] -> String -> String
$cshowList :: [Key] -> String -> String
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> String -> String
$cshowsPrec :: Int -> Key -> String -> String
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS Key
Read, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord)

toKey :: Text -> Key
toKey :: Text -> Key
toKey = Text -> Key
Key (Text -> Key) -> (Text -> Text) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unbracket
  where unbracket :: Text -> Text
unbracket Text
t
          | Just (Char
'[', Text
t') <- Text -> Maybe (Char, Text)
T.uncons Text
t
          , Just (Text
t'', Char
']') <- Text -> Maybe (Text, Char)
T.unsnoc Text
t'
          = Text
t''
          | Bool
otherwise
          = Text
t

type KeyTable = M.Map Key (Target, Attr)

type SubstTable = M.Map Key Inlines

--  | Add header to the list of headers in state, together
--  with its associated identifier.  If the identifier is null
--  and the auto_identifiers extension is set, generate a new
--  unique identifier, and update the list of identifiers
--  in state.  Issue a warning if an explicit identifier
--  is encountered that duplicates an earlier identifier
--  (explicit or automatically generated).
registerHeader :: (Stream s m a, HasReaderOptions st,
                   HasLogMessages st, HasIdentifierList st)
               => Attr -> Inlines -> ParserT s st m Attr
registerHeader :: Attr -> Inlines -> ParserT s st m Attr
registerHeader (Text
ident,[Text]
classes,NoteTable
kvs) Inlines
header' = do
  Set Text
ids <- st -> Set Text
forall st. HasIdentifierList st => st -> Set Text
extractIdentifierList (st -> Set Text) -> ParsecT s st m st -> ParsecT s st m (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Extensions
exts <- (ReaderOptions -> Extensions) -> ParserT s st m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  if Text -> Bool
T.null Text
ident Bool -> Bool -> Bool
&& Extension
Ext_auto_identifiers Extension -> Extensions -> Bool
`extensionEnabled` Extensions
exts
     then do
       let id' :: Text
id' = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts (Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
header') Set Text
ids
       let id'' :: Text
id'' = if Extension
Ext_ascii_identifiers Extension -> Extensions -> Bool
`extensionEnabled` Extensions
exts
                     then String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Maybe Char) -> String -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
toAsciiChar (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
id'
                     else Text
id'
       (st -> st) -> ParsecT s st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((st -> st) -> ParsecT s st m ())
-> (st -> st) -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ (Set Text -> Set Text) -> st -> st
forall st.
HasIdentifierList st =>
(Set Text -> Set Text) -> st -> st
updateIdentifierList ((Set Text -> Set Text) -> st -> st)
-> (Set Text -> Set Text) -> st -> st
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
id'
       (st -> st) -> ParsecT s st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((st -> st) -> ParsecT s st m ())
-> (st -> st) -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ (Set Text -> Set Text) -> st -> st
forall st.
HasIdentifierList st =>
(Set Text -> Set Text) -> st -> st
updateIdentifierList ((Set Text -> Set Text) -> st -> st)
-> (Set Text -> Set Text) -> st -> st
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
id''
       Attr -> ParserT s st m Attr
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
id'',[Text]
classes,NoteTable
kvs)
     else do
        Bool -> ParsecT s st m () -> ParsecT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
ident) (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> ParsecT s st m () -> ParsecT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
ident Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
ids) (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ do
            SourcePos
pos <- ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
            LogMessage -> ParsecT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage (LogMessage -> ParsecT s st m ())
-> LogMessage -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
DuplicateIdentifier Text
ident SourcePos
pos
          (st -> st) -> ParsecT s st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((st -> st) -> ParsecT s st m ())
-> (st -> st) -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ (Set Text -> Set Text) -> st -> st
forall st.
HasIdentifierList st =>
(Set Text -> Set Text) -> st -> st
updateIdentifierList ((Set Text -> Set Text) -> st -> st)
-> (Set Text -> Set Text) -> st -> st
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
ident
        Attr -> ParserT s st m Attr
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
ident,[Text]
classes,NoteTable
kvs)

smartPunctuation :: (HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
                 => ParserT s st m Inlines
                 -> ParserT s st m Inlines
smartPunctuation :: ParserT s st m Inlines -> ParserT s st m Inlines
smartPunctuation ParserT s st m Inlines
inlineParser = do
  Extension -> ParserT s st m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_smart
  [ParserT s st m Inlines] -> ParserT 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 [ ParserT s st m Inlines -> ParserT s st m Inlines
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char) =>
ParserT s st m Inlines -> ParserT s st m Inlines
quoted ParserT s st m Inlines
inlineParser, ParserT s st m Inlines
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m Inlines
apostrophe, ParserT s st m Inlines
forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char) =>
ParserT s st m Inlines
dash, ParserT s st m Inlines
forall s (m :: * -> *) st.
Stream s m Char =>
ParserT s st m Inlines
ellipses ]

apostrophe :: Stream s m Char => ParserT s st m Inlines
apostrophe :: ParserT s st m Inlines
apostrophe = (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m 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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\8217') ParsecT s st m Char
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\x2019")

quoted :: (HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
       => ParserT s st m Inlines
       -> ParserT s st m Inlines
quoted :: ParserT s st m Inlines -> ParserT s st m Inlines
quoted ParserT s st m Inlines
inlineParser = ParserT s st m Inlines -> ParserT s st m Inlines
forall st (m :: * -> *) s.
(HasQuoteContext st m, Stream s m Char) =>
ParserT s st m Inlines -> ParserT s st m Inlines
doubleQuoted ParserT s st m Inlines
inlineParser ParserT s st m Inlines
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParserT s st m Inlines -> ParserT s st m Inlines
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char) =>
ParserT s st m Inlines -> ParserT s st m Inlines
singleQuoted ParserT s st m Inlines
inlineParser

singleQuoted :: (HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
             => ParserT s st m Inlines
             -> ParserT s st m Inlines
singleQuoted :: ParserT s st m Inlines -> ParserT s st m Inlines
singleQuoted ParserT s st m Inlines
inlineParser = ParserT s st m Inlines -> ParserT s st m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Inlines -> ParserT s st m Inlines)
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall a b. (a -> b) -> a -> b
$ 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 () -> ParsecT s st m ([Inlines] -> Inlines)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  ParsecT s st m ()
forall st (m :: * -> *) s.
(HasLastStrPosition st, HasQuoteContext st m, Stream s m Char) =>
ParserT s st m ()
singleQuoteStart
  ParsecT s st m ([Inlines] -> Inlines)
-> ParsecT s st m [Inlines] -> ParserT s st m Inlines
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QuoteContext
-> ParsecT s st m [Inlines] -> ParsecT s st m [Inlines]
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InSingleQuote (ParserT 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) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParserT s st m Inlines
inlineParser ParsecT s st m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
singleQuoteEnd)

doubleQuoted :: (HasQuoteContext st m, Stream s m Char)
             => ParserT s st m Inlines
             -> ParserT s st m Inlines
doubleQuoted :: ParserT s st m Inlines -> ParserT s st m Inlines
doubleQuoted ParserT s st m Inlines
inlineParser = ParserT s st m Inlines -> ParserT s st m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Inlines -> ParserT s st m Inlines)
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall a b. (a -> b) -> a -> b
$ 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 () -> ParsecT s st m ([Inlines] -> Inlines)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  ParsecT s st m ()
forall st (m :: * -> *) s.
(HasQuoteContext st m, Stream s m Char) =>
ParserT s st m ()
doubleQuoteStart
  ParsecT s st m ([Inlines] -> Inlines)
-> ParsecT s st m [Inlines] -> ParserT s st m Inlines
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QuoteContext
-> ParsecT s st m [Inlines] -> ParsecT s st m [Inlines]
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InDoubleQuote (ParserT 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 ParserT s st m Inlines
inlineParser ParsecT s st m ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
doubleQuoteEnd)

failIfInQuoteContext :: (HasQuoteContext st m, Stream s m t)
                     => QuoteContext
                     -> ParserT s st m ()
failIfInQuoteContext :: QuoteContext -> ParserT s st m ()
failIfInQuoteContext QuoteContext
context = do
  QuoteContext
context' <- ParsecT s st m QuoteContext
forall st (m :: * -> *) s t.
(HasQuoteContext st m, Stream s m t) =>
ParsecT s st m QuoteContext
getQuoteContext
  Bool -> ParserT s st m () -> ParserT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (QuoteContext
context' QuoteContext -> QuoteContext -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteContext
context) (ParserT s st m () -> ParserT s st m ())
-> ParserT s st m () -> ParserT s st m ()
forall a b. (a -> b) -> a -> b
$ String -> ParserT s st m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"already inside quotes"

charOrRef :: Stream s m Char => [Char] -> ParserT s st m Char
charOrRef :: String -> ParserT s st m Char
charOrRef String
cs =
  String -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
cs ParserT s st m Char -> ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParserT s st m Char -> ParserT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do Char
c <- ParserT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
characterReference
                       Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
cs)
                       Char -> ParserT s st m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c)

singleQuoteStart :: (HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
                 => ParserT s st m ()
singleQuoteStart :: ParserT s st m ()
singleQuoteStart = do
  QuoteContext -> ParserT s st m ()
forall st (m :: * -> *) s t.
(HasQuoteContext st m, Stream s m t) =>
QuoteContext -> ParserT s st m ()
failIfInQuoteContext QuoteContext
InSingleQuote
  -- single quote start can't be right after str
  Bool -> ParserT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParserT s st m ())
-> ParsecT s st m Bool -> ParserT 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) =>
ParserT s st m Bool
notAfterString
  ParserT s st m () -> ParserT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m () -> ParserT s st m ())
-> ParserT s st m () -> ParserT s st m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
charOrRef String
"'\8216\145"
    ParserT s st m Char -> ParserT 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 (String -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ', Char
'\t', Char
'\n'])

singleQuoteEnd :: Stream s m Char
               => ParserT s st m ()
singleQuoteEnd :: ParserT s st m ()
singleQuoteEnd = ParserT s st m () -> ParserT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m () -> ParserT s st m ())
-> ParserT s st m () -> ParserT s st m ()
forall a b. (a -> b) -> a -> b
$ do
  String -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
charOrRef String
"'\8217\146"
  ParserT s st m Char -> ParserT 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 ParserT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum

doubleQuoteStart :: (HasQuoteContext st m, Stream s m Char)
                 => ParserT s st m ()
doubleQuoteStart :: ParserT s st m ()
doubleQuoteStart = do
  QuoteContext -> ParserT s st m ()
forall st (m :: * -> *) s t.
(HasQuoteContext st m, Stream s m t) =>
QuoteContext -> ParserT s st m ()
failIfInQuoteContext QuoteContext
InDoubleQuote
  ParserT s st m () -> ParserT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m () -> ParserT s st m ())
-> ParserT s st m () -> ParserT s st m ()
forall a b. (a -> b) -> a -> b
$ do String -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
charOrRef String
"\"\8220\147"
           ParserT s st m Char -> ParserT 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 (String -> ParserT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ', Char
'\t', Char
'\n'])

doubleQuoteEnd :: Stream s m Char
               => ParserT s st m ()
doubleQuoteEnd :: ParserT s st m ()
doubleQuoteEnd = ParsecT s st m Char -> ParserT s st m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
charOrRef String
"\"\8221\148")

ellipses :: Stream s m Char
         => ParserT s st m Inlines
ellipses :: ParserT s st m Inlines
ellipses = ParserT s st m Inlines -> ParserT s st m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"..." ParsecT s st m String
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8230"))

dash :: (HasReaderOptions st, Stream s m Char)
     => ParserT s st m Inlines
dash :: ParserT s st m Inlines
dash = ParserT s st m Inlines -> ParserT s st m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m Inlines -> ParserT s st m Inlines)
-> ParserT s st m Inlines -> ParserT 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) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  if Bool
oldDashes
     then do
       Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
       (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT s st m Char
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8212"))
         ParserT s st m Inlines
-> ParserT s st m Inlines -> ParserT 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 s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT s st m Char
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8211"))
     else do
       String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"--"
       (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT s st m Char
-> ParserT s st m Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> ParserT s st m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8212"))
         ParserT s st m Inlines
-> ParserT s st m Inlines -> ParserT 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 -> ParserT s st m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
B.str Text
"\8211")

-- This is used to prevent exponential blowups for things like:
-- a**a*a**a*a**a*a**a*a**a*a**a*a**
nested :: Stream s m a
       => ParserT s ParserState m a
       -> ParserT s ParserState m a
nested :: ParserT s ParserState m a -> ParserT s ParserState m a
nested ParserT s ParserState m a
p = do
  Int
nestlevel <- ParserState -> Int
stateMaxNestingLevel (ParserState -> Int)
-> ParsecT s ParserState m ParserState
-> ParsecT s ParserState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> ParsecT s ParserState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT s ParserState m ())
-> Bool -> ParsecT s ParserState m ()
forall a b. (a -> b) -> a -> b
$ Int
nestlevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  (ParserState -> ParserState) -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT s ParserState m ())
-> (ParserState -> ParserState) -> ParsecT s ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ stateMaxNestingLevel :: Int
stateMaxNestingLevel = ParserState -> Int
stateMaxNestingLevel ParserState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
  a
res <- ParserT s ParserState m a
p
  (ParserState -> ParserState) -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT s ParserState m ())
-> (ParserState -> ParserState) -> ParsecT s ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st{ stateMaxNestingLevel :: Int
stateMaxNestingLevel = Int
nestlevel }
  a -> ParserT s ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

citeKey :: (Stream s m Char, HasLastStrPosition st)
        => ParserT s st m (Bool, Text)
citeKey :: ParserT s st m (Bool, Text)
citeKey = ParserT s st m (Bool, Text) -> ParserT s st m (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT s st m (Bool, Text) -> ParserT s st m (Bool, Text))
-> ParserT s st m (Bool, Text) -> ParserT s st m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
  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) =>
ParserT s st m Bool
notAfterString
  Bool
suppress_author <- Bool -> ParsecT s st m Bool -> ParsecT s st m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> ParsecT s st m Char -> ParsecT s st m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
  Char
firstChar <- ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum 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 s (m :: * -> *) u.
Stream s m 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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' -- @* for wildcard in nocite
  let regchar :: ParsecT s u m Char
regchar = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
  let internal :: ParsecT s u m a -> ParsecT s u m a
internal ParsecT s u m a
p = ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m a -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ ParsecT s u m a
p ParsecT s u m a -> ParsecT s u m Char -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char -> ParsecT s u 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 u m Char
forall u. ParsecT s u m Char
regchar
  String
rest <- ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s st m Char -> ParsecT s st m String)
-> ParsecT s st m Char -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall u. ParsecT s u m Char
regchar 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 t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m a
internal (String -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
":.#$%&-+?<>~/") 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 (String -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
":/" ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'))
  let key :: String
key = Char
firstCharChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest
  (Bool, Text) -> ParserT s st m (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
suppress_author, String -> Text
T.pack String
key)


token :: (Stream s m t)
      => (t -> Text)
      -> (t -> SourcePos)
      -> (t -> Maybe a)
      -> ParsecT s st m a
token :: (t -> Text)
-> (t -> SourcePos) -> (t -> Maybe a) -> ParsecT s st m a
token t -> Text
pp t -> SourcePos
pos t -> Maybe a
match = (t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s st m a
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim (Text -> String
T.unpack (Text -> String) -> (t -> Text) -> t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
pp) (\SourcePos
_ t
t s
_ -> t -> SourcePos
pos t
t) t -> Maybe a
match

infixr 5 <+?>
(<+?>) :: (Monoid a) => ParserT s st m a -> ParserT s st m a -> ParserT s st m a
ParserT s st m a
a <+?> :: ParserT s st m a -> ParserT s st m a -> ParserT s st m a
<+?> ParserT s st m a
b = ParserT s st m a
a ParserT s st m a -> (a -> ParserT s st m a) -> ParserT s st m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((a -> a) -> ParserT s st m a -> ParserT s st m a)
-> ParserT s st m a -> (a -> a) -> ParserT s st m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> ParserT s st m a -> ParserT s st m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParserT s st m a -> ParserT s st m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParserT s st m a
b ParserT s st m a -> ParserT s st m a -> ParserT s st m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> a -> ParserT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty) ((a -> a) -> ParserT s st m a)
-> (a -> a -> a) -> a -> ParserT s st m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Monoid a => a -> a -> a
mappend

extractIdClass :: Attr -> Attr
extractIdClass :: Attr -> Attr
extractIdClass (Text
ident, [Text]
cls, NoteTable
kvs) = (Text
ident', [Text]
cls', NoteTable
kvs')
  where
    ident' :: Text
ident' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
ident (Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" NoteTable
kvs)
    cls' :: [Text]
cls'   = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text]
cls Text -> [Text]
T.words (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> NoteTable -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" NoteTable
kvs
    kvs' :: NoteTable
kvs'   = ((Text, Text) -> Bool) -> NoteTable -> NoteTable
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"id" Bool -> Bool -> Bool
|| Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"class") NoteTable
kvs

insertIncludedFile' :: (PandocMonad m, HasIncludeFiles st)
                    => ParserT a st m (mf Blocks)
                    -> (Text -> a)
                    -> [FilePath] -> FilePath
                    -> ParserT a st m (mf Blocks)
insertIncludedFile' :: ParserT a st m (mf Blocks)
-> (Text -> a) -> [String] -> String -> ParserT a st m (mf Blocks)
insertIncludedFile' ParserT a st m (mf Blocks)
blocks Text -> a
totoks [String]
dirs String
f = do
  SourcePos
oldPos <- ParsecT a st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  a
oldInput <- ParsecT a st m a
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  [Text]
containers <- st -> [Text]
forall st. HasIncludeFiles st => st -> [Text]
getIncludeFiles (st -> [Text]) -> ParsecT a st m st -> ParsecT a st m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT a st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> ParsecT a st m () -> ParsecT a st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Text
T.pack String
f Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
containers) (ParsecT a st m () -> ParsecT a st m ())
-> ParsecT a st m () -> ParsecT a st m ()
forall a b. (a -> b) -> a -> b
$
    PandocError -> ParsecT a st m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ParsecT a st m ())
-> PandocError -> ParsecT a st m ()
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Include file loop at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SourcePos -> String
forall a. Show a => a -> String
show SourcePos
oldPos
  (st -> st) -> ParsecT a st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((st -> st) -> ParsecT a st m ())
-> (st -> st) -> ParsecT a st m ()
forall a b. (a -> b) -> a -> b
$ Text -> st -> st
forall st. HasIncludeFiles st => Text -> st -> st
addIncludeFile (Text -> st -> st) -> Text -> st -> st
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
f
  Maybe Text
mbcontents <- [String] -> String -> ParsecT a st m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[String] -> String -> m (Maybe Text)
readFileFromDirs [String]
dirs String
f
  Text
contents <- case Maybe Text
mbcontents of
                   Just Text
s -> Text -> ParsecT a st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
                   Maybe Text
Nothing -> do
                     LogMessage -> ParsecT a st m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT a st m ())
-> LogMessage -> ParsecT a st m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile (String -> Text
T.pack String
f) SourcePos
oldPos
                     Text -> ParsecT a st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
  SourcePos -> ParsecT a st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT a st m ()) -> SourcePos -> ParsecT a st m ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> SourcePos
newPos String
f Int
1 Int
1
  a -> ParsecT a st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (a -> ParsecT a st m ()) -> a -> ParsecT a st m ()
forall a b. (a -> b) -> a -> b
$ Text -> a
totoks Text
contents
  mf Blocks
bs <- ParserT a st m (mf Blocks)
blocks
  a -> ParsecT a st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput a
oldInput
  SourcePos -> ParsecT a st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
oldPos
  (st -> st) -> ParsecT a st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState st -> st
forall st. HasIncludeFiles st => st -> st
dropLatestIncludeFile
  mf Blocks -> ParserT a st m (mf Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return mf Blocks
bs

-- | Parse content of include file as blocks. Circular includes result in an
-- @PandocParseError@.
insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
                   => ParserT [a] st m Blocks
                   -> (Text -> [a])
                   -> [FilePath] -> FilePath
                   -> ParserT [a] st m Blocks
insertIncludedFile :: ParserT [a] st m Blocks
-> (Text -> [a]) -> [String] -> String -> ParserT [a] st m Blocks
insertIncludedFile ParserT [a] st m Blocks
blocks Text -> [a]
totoks [String]
dirs String
f =
  Identity Blocks -> Blocks
forall a. Identity a -> a
runIdentity (Identity Blocks -> Blocks)
-> ParsecT [a] st m (Identity Blocks) -> ParserT [a] st m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [a] st m (Identity Blocks)
-> (Text -> [a])
-> [String]
-> String
-> ParsecT [a] st m (Identity Blocks)
forall (m :: * -> *) st a (mf :: * -> *).
(PandocMonad m, HasIncludeFiles st) =>
ParserT a st m (mf Blocks)
-> (Text -> a) -> [String] -> String -> ParserT a st m (mf Blocks)
insertIncludedFile' (Blocks -> Identity Blocks
forall a. a -> Identity a
Identity (Blocks -> Identity Blocks)
-> ParserT [a] st m Blocks -> ParsecT [a] st m (Identity Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT [a] st m Blocks
blocks) Text -> [a]
totoks [String]
dirs String
f

-- | Parse content of include file as future blocks. Circular includes result in
-- an @PandocParseError@.
insertIncludedFileF :: (PandocMonad m, HasIncludeFiles st)
                    => ParserT Text st m (Future st Blocks)
                    -> [FilePath] -> FilePath
                    -> ParserT Text st m (Future st Blocks)
insertIncludedFileF :: ParserT Text st m (Future st Blocks)
-> [String] -> String -> ParserT Text st m (Future st Blocks)
insertIncludedFileF ParserT Text st m (Future st Blocks)
p = ParserT Text st m (Future st Blocks)
-> (Text -> Text)
-> [String]
-> String
-> ParserT Text st m (Future st Blocks)
forall (m :: * -> *) st a (mf :: * -> *).
(PandocMonad m, HasIncludeFiles st) =>
ParserT a st m (mf Blocks)
-> (Text -> a) -> [String] -> String -> ParserT a st m (mf Blocks)
insertIncludedFile' ParserT Text st m (Future st Blocks)
p Text -> Text
forall a. a -> a
id