{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
Module      : Text.Pandoc.Parsing.General
Copyright   : © 2006-2024 John MacFarlane
License     : GPL-2.0-or-later
Maintainer  : John MacFarlane <jgm@berkeley.edu>

Parser combinators for pandoc format readers.
-}

module Text.Pandoc.Parsing.General
  ( (<+?>)
  , anyLine
  , anyLineNewline
  , blankline
  , blanklines
  , charRef
  , characterReference
  , charsInBalanced
  , countChar
  , emailAddress
  , enclosed
  , escaped
  , extractIdClass
  , gobbleAtMostSpaces
  , gobbleSpaces
  , indentWith
  , insertIncludedFile
  , isSpaceChar          -- not re-exported from T.P.Parsing
  , lineBlockLines
  , lineClump
  , many1Char
  , many1Till
  , many1TillChar
  , manyChar
  , manyTillChar
  , manyUntil
  , manyUntilChar
  , nonspaceChar
  , notFollowedBy'
  , oneOfStrings
  , oneOfStringsCI
  , parseFromString
  , parseFromString'
  , readWith
  , readWithM
  , registerHeader
  , sepBy1'
  , skipSpaces
  , spaceChar
  , stringAnyCase
  , testStringWith
  , textStr
  , token
  , trimInlinesF
  , uri
  , withHorizDisplacement
  , withRaw
  , fromParsecError
  )
where

import Control.Monad
  ( join
  , liftM
  , unless
  , void
  , when
  , MonadPlus(mzero)
  )
import Control.Monad.Except ( MonadError(throwError) )
import Control.Monad.Identity ( Identity(..) )
import Data.Char
  ( chr
  , isAlphaNum
  , isAscii
  , isAsciiUpper
  , isSpace
  , ord
  , toLower
  , toUpper
  )
import Data.Functor (($>))
import Data.List (intercalate, sortOn)
import Data.Ord (Down(..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy as TL
import Text.Pandoc.Asciify (toAsciiText)
import Text.Pandoc.Builder (Attr, Inline(Str), Inlines, trimInlines)
import Text.Pandoc.Class.PandocMonad (PandocMonad, readFileFromDirs, report)
import Text.Pandoc.Logging
  ( LogMessage(CouldNotLoadIncludeFile, DuplicateIdentifier) )
import Text.Pandoc.Options
  ( extensionEnabled
  , Extension(Ext_auto_identifiers, Ext_ascii_identifiers)
  , ReaderOptions(readerTabStop, readerExtensions) )
import Text.Pandoc.Shared (tshow, uniqueIdent)
import Text.Pandoc.URI (schemes, escapeURI)
import Text.Pandoc.Sources
import Text.Pandoc.XML (fromEntities, lookupEntity)
import Text.Parsec
  ( (<|>)
  , Parsec
  , ParsecT
  , SourcePos
  , sourceLine
  , sourceColumn
  , sourceName
  , ParseError
  , errorPos
  , Stream(..)
  , between
  , choice
  , count
  , getInput
  , getPosition
  , getState
  , lookAhead
  , many
  , many1
  , manyTill
  , notFollowedBy
  , option
  , runParserT
  , setInput
  , setPosition
  , skipMany
  , sourceColumn
  , sourceName
  , tokenPrim
  , try
  , unexpected
  , updateState
  )
import Text.Parsec.Pos (initialPos, newPos)
import Text.Pandoc.Error
  ( PandocError(PandocParseError) )
import Text.Pandoc.Parsing.Capabilities
import Text.Pandoc.Parsing.State
import Text.Pandoc.Parsing.Future (Future (..))
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
import qualified Data.Bifunctor as Bifunctor

-- | Remove whitespace from start and end; just like @'trimInlines'@,
-- but lifted into the 'Future' type.
trimInlinesF :: Future s Inlines -> Future s Inlines
trimInlinesF :: forall s. 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

-- | Like @count@, but packs its result
countChar :: (Stream s m Char, UpdateSourcePos s Char, Monad m)
          => Int
          -> ParsecT s st m Char
          -> ParsecT s st m Text
countChar :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
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 a b. (a -> b) -> ParsecT s st m a -> ParsecT s st m b
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, UpdateSourcePos s Char)
        => Text -> ParsecT s u m Text
textStr :: forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
Text -> ParsecT s u m Text
textStr Text
t = String -> ParsecT s u m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 any line of text, returning the contents without the
-- final newline.
anyLine :: Monad m => ParsecT Sources st m Text
anyLine :: forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine = do
  -- This is much faster than:
  -- manyTill anyChar newline
  Sources
inp <- ParsecT Sources st m Sources
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  case Sources
inp of
    Sources [] -> ParsecT Sources st m Text
forall a. ParsecT Sources st m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Sources ((SourcePos
fp,Text
t):[(SourcePos, Text)]
inps) ->
      -- we assume that lines don't span different input files
      case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') Text
t of
           (Text
this, Text
rest)
             | Text -> Bool
T.null Text
rest
             , Bool -> Bool
not ([(SourcePos, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SourcePos, Text)]
inps) ->
                -- line may span different input files, so do it
                 -- character by character
                 String -> Text
T.pack (String -> Text)
-> ParsecT Sources st m String -> ParsecT Sources st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m Char
-> ParsecT Sources st m Char -> ParsecT Sources 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 ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
             | Bool
otherwise -> do --  either end of inputs or newline in rest
                 Sources -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (Sources -> ParsecT Sources st m ())
-> Sources -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ [(SourcePos, Text)] -> Sources
Sources ((SourcePos
fp, Text
rest)(SourcePos, Text) -> [(SourcePos, Text)] -> [(SourcePos, Text)]
forall a. a -> [a] -> [a]
:[(SourcePos, Text)]
inps)
                 Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n' -- needed so parsec knows we won't match empty string
                           -- and so source pos is updated
                 Text -> ParsecT Sources st m Text
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
this

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

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

-- | Like @many1@, but packs its result.
many1Char :: Stream s m t
          => ParsecT s st m Char
          -> ParsecT s st m Text
many1Char :: forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char = (String -> Text) -> ParsecT s st m String -> ParsecT s st m Text
forall a b. (a -> b) -> ParsecT s st m a -> ParsecT s st m b
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
. 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]
many1

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

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

-- | Like @manyTill@, but also returns the result of end parser.
manyUntil :: ParsecT s u m a
          -> ParsecT s u m b
          -> ParsecT s u m ([a], b)
manyUntil :: forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m ([a], b)
manyUntil ParsecT s u m a
p ParsecT s u m b
end = ParsecT s u m ([a], b)
scan
  where scan :: ParsecT s u m ([a], b)
scan =
          (do b
e <- ParsecT s u m b
end
              ([a], b) -> ParsecT s u m ([a], b)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], b
e)
          ) ParsecT s u m ([a], b)
-> ParsecT s u m ([a], b) -> ParsecT 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 <- ParsecT s u m a
p
              ([a]
xs, b
e) <- ParsecT s u m ([a], b)
scan
              ([a], b) -> ParsecT s u m ([a], b)
forall a. a -> ParsecT s u m a
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 :: ParsecT s u m Char
              -> ParsecT s u m b
              -> ParsecT s u m (Text, b)
manyUntilChar :: forall s u (m :: * -> *) b.
ParsecT s u m Char -> ParsecT s u m b -> ParsecT s u m (Text, b)
manyUntilChar ParsecT s u m Char
p = ((String, b) -> (Text, b))
-> ParsecT s u m (String, b) -> ParsecT s u m (Text, b)
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m 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) -> ParsecT s u m (Text, b))
-> (ParsecT s u m b -> ParsecT s u m (String, b))
-> ParsecT s u m b
-> ParsecT s u m (Text, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT s u m Char -> ParsecT s u m b -> ParsecT s u m (String, b)
forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m ([a], b)
manyUntil ParsecT 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' :: 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 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 a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
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 a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
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) => ParsecT s st m b -> ParsecT s st m ()
notFollowedBy' :: forall b s (m :: * -> *) a st.
(Show b, Stream s m a) =>
ParsecT s st m b -> ParsecT s st m ()
notFollowedBy' ParsecT s st m b
p  = ParsecT s st m () -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s st m (ParsecT s st m ()) -> ParsecT s st m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ParsecT s st m (ParsecT s st m ()) -> ParsecT s st m ())
-> ParsecT s st m (ParsecT s st m ()) -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$  do  b
a <- ParsecT s st m b -> ParsecT s st m b
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m b
p
                                      ParsecT s st m () -> ParsecT s st m (ParsecT s st m ())
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT 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 (ParsecT s st m ())
-> ParsecT s st m (ParsecT s st m ())
-> ParsecT s st m (ParsecT s st m ())
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                  ParsecT s st m () -> ParsecT s st m (ParsecT s st m ())
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> ParsecT s st m ()
forall a. a -> ParsecT s st m a
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, UpdateSourcePos s Char)
               => (Char -> Char -> Bool) -> [Text] -> ParsecT s st m Text
oneOfStrings' :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Char -> Bool) -> [Text] -> ParsecT s st m Text
oneOfStrings' Char -> Char -> Bool
_ [] = String -> ParsecT s st m Text
forall a. String -> ParsecT s st m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"no strings to match"
oneOfStrings' Char -> Char -> Bool
matches [Text]
strs =
  LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TB.toLazyText (Builder -> Text) -> ParsecT s st m Builder -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Builder -> ParsecT s st m Builder
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Builder -> [Text] -> ParsecT s st m Builder
forall {s} {m :: * -> *} {u}.
(UpdateSourcePos s Char, Stream s m Char) =>
Builder -> [Text] -> ParsecT s u m Builder
go (Text -> Builder
TB.fromText Text
forall a. Monoid a => a
mempty) [Text]
strs)
 where
   go :: Builder -> [Text] -> ParsecT s u m Builder
go Builder
acc [Text]
strs' = do
     Char
c <- ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
     let strs'' :: [Text]
strs'' = [Text
t | Just (Char
d, Text
t) <- (Text -> Maybe (Char, Text)) -> [Text] -> [Maybe (Char, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe (Char, Text)
T.uncons [Text]
strs', Char -> Char -> Bool
matches Char
c Char
d]
     let !acc' :: Builder
acc' = Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
c
     case [Text]
strs'' of
       []  -> String -> ParsecT s u m Builder
forall a. String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"not found"
       [Text]
_   -> if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
T.null [Text]
strs''
                 then Builder -> ParsecT s u m Builder -> ParsecT s u m Builder
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Builder
acc' (ParsecT s u m Builder -> ParsecT s u m Builder
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Builder -> [Text] -> ParsecT s u m Builder
go Builder
acc' [Text]
strs''))
                 else Builder -> [Text] -> ParsecT s u m Builder
go Builder
acc' [Text]
strs''

-- | 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, UpdateSourcePos s Char)
             => [Text] -> ParsecT s st m Text
oneOfStrings :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Text] -> ParsecT s st m Text
oneOfStrings = (Char -> Char -> Bool) -> [Text] -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Char -> Bool) -> [Text] -> ParsecT 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, UpdateSourcePos s Char)
               => [Text] -> ParsecT s st m Text
oneOfStringsCI :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Text] -> ParsecT s st m Text
oneOfStringsCI = (Char -> Char -> Bool) -> [Text] -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Char -> Bool) -> [Text] -> ParsecT 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, UpdateSourcePos s Char)
          => ParsecT s st m Char
spaceChar :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar = (Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT s st m Char)
-> (Char -> Bool) -> ParsecT 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, UpdateSourcePos s Char)
             => ParsecT s st m Char
nonspaceChar :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
nonspaceChar = (Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpaceChar)

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, UpdateSourcePos s Char)
           => ParsecT s st m ()
skipSpaces :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m ()
skipSpaces = 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 :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
spaceChar

-- | Skips zero or more spaces or tabs, then reads a newline.
blankline :: (Stream s m Char, UpdateSourcePos s Char)
          => ParsecT s st m Char
blankline :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline = 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 (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 ()
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m ()
skipSpaces ParsecT s st m () -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline

-- | Parses one or more blank lines and returns a string of newlines.
blanklines :: (Stream s m Char, UpdateSourcePos s Char)
           => ParsecT s st m Text
blanklines :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines = 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 String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st 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 -> ParsecT Sources st m ()
gobbleSpaces :: forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParsecT Sources st m ()
gobbleSpaces Int
0 = () -> ParsecT Sources st m ()
forall a. a -> ParsecT Sources st m a
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 -> ParsecT Sources st m ()
forall a. HasCallStack => String -> a
error String
"gobbleSpaces called with negative number"
  | Bool
otherwise = ParsecT Sources st m () -> ParsecT Sources st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m () -> ParsecT Sources st m ())
-> ParsecT Sources st m () -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ do
      Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT Sources st m Char
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources st m Char
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParsecT Sources st m Char
eatOneSpaceOfTab
      Int -> ParsecT Sources st m ()
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParsecT Sources st m ()
gobbleSpaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

eatOneSpaceOfTab :: (HasReaderOptions st, Monad m) => ParsecT Sources st m Char
eatOneSpaceOfTab :: forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParsecT Sources st m Char
eatOneSpaceOfTab = do
  ParsecT Sources st m Char -> ParsecT Sources 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 Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\t')
  SourcePos
pos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Int
tabstop <- (ReaderOptions -> Int) -> ParsecT Sources st m Int
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Int
readerTabStop
  -- replace the tab on the input stream with spaces
  let numSpaces :: Int
numSpaces = Int
tabstop Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tabstop)
  Sources
inp <- ParsecT Sources st m Sources
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  Sources -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (Sources -> ParsecT Sources st m ())
-> Sources -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$
    case Sources
inp of
      Sources [] -> String -> Sources
forall a. HasCallStack => String -> a
error String
"eatOneSpaceOfTab - empty Sources list"
      Sources ((SourcePos
fp,Text
t):[(SourcePos, Text)]
rest) ->
        -- drop the tab and add spaces
        [(SourcePos, Text)] -> Sources
Sources ((SourcePos
fp, Int -> Text -> Text
T.replicate Int
numSpaces Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
t)(SourcePos, Text) -> [(SourcePos, Text)] -> [(SourcePos, Text)]
forall a. a -> [a] -> [a]
:[(SourcePos, Text)]
rest)
  Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char 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 -> ParsecT Sources st m Int
gobbleAtMostSpaces :: forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParsecT Sources st m Int
gobbleAtMostSpaces Int
0 = Int -> ParsecT Sources st m Int
forall a. a -> ParsecT Sources st m a
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 -> ParsecT Sources st m Int
forall a. HasCallStack => String -> a
error String
"gobbleAtMostSpaces called with negative number"
  | Bool
otherwise = Int -> ParsecT Sources st m Int -> ParsecT Sources 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 (ParsecT Sources st m Int -> ParsecT Sources st m Int)
-> ParsecT Sources st m Int -> ParsecT Sources st m Int
forall a b. (a -> b) -> a -> b
$ do
      Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT Sources st m Char
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources st m Char
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
ParsecT Sources st m Char
eatOneSpaceOfTab
      (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int)
-> ParsecT Sources st m Int -> ParsecT Sources st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Sources st m Int
forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
Int -> ParsecT Sources 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, UpdateSourcePos s Char)
         => ParsecT s st m t   -- ^ start parser
         -> ParsecT s st m end  -- ^ end parser
         -> ParsecT s st m a    -- ^ content parser (to be used repeatedly)
         -> ParsecT s st m [a]
enclosed :: forall end s (m :: * -> *) st t a.
(Show end, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m t
-> ParsecT s st m end -> ParsecT s st m a -> ParsecT s st m [a]
enclosed ParsecT s st m t
start ParsecT s st m end
end ParsecT s st m a
parser = ParsecT s st m [a] -> ParsecT s st m [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m [a] -> ParsecT s st m [a])
-> ParsecT s st m [a] -> ParsecT s st m [a]
forall a b. (a -> b) -> a -> b
$
  ParsecT s st m t
start ParsecT s st m t -> ParsecT s st m () -> ParsecT s st m ()
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space ParsecT s st m () -> ParsecT s st m [a] -> ParsecT s st m [a]
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ParsecT s st m a
parser ParsecT s st m end
end

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

-- TODO rewrite by just adding to Sources stream?
-- | Parse contents of 'str' using 'parser' and return result.
parseFromString :: Monad m
                => ParsecT Sources st m r
                -> Text
                -> ParsecT Sources st m r
parseFromString :: forall (m :: * -> *) st r.
Monad m =>
ParsecT Sources st m r -> Text -> ParsecT Sources st m r
parseFromString ParsecT Sources st m r
parser Text
str = do
  SourcePos
oldPos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Sources
oldInput <- ParsecT Sources st m Sources
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  Sources -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (Sources -> ParsecT Sources st m ())
-> Sources -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ Text -> Sources
forall a. ToSources a => a -> Sources
toSources Text
str
  SourcePos -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT Sources st m ())
-> SourcePos -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ String -> SourcePos
initialPos (String -> SourcePos) -> String -> SourcePos
forall a b. (a -> b) -> a -> b
$ SourcePos -> String
sourceName SourcePos
oldPos String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_chunk"
  r
result <- ParsecT Sources st m r
parser
  Sources -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Sources
oldInput
  SourcePos -> ParsecT Sources st m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
oldPos
  r -> ParsecT Sources st m r
forall a. a -> ParsecT Sources st m a
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' :: (Monad m, HasLastStrPosition u)
                 => ParsecT Sources u m a
                 -> Text
                 -> ParsecT Sources u m a
parseFromString' :: forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParsecT Sources u m a -> Text -> ParsecT Sources u m a
parseFromString' ParsecT Sources 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 Sources u m u -> ParsecT Sources u m (Maybe SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources u m u
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (u -> u) -> ParsecT Sources u m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((u -> u) -> ParsecT Sources u m ())
-> (u -> u) -> ParsecT Sources 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 <- ParsecT Sources u m a -> Text -> ParsecT Sources u m a
forall (m :: * -> *) st r.
Monad m =>
ParsecT Sources st m r -> Text -> ParsecT Sources st m r
parseFromString ParsecT Sources u m a
parser Text
str
  (u -> u) -> ParsecT Sources u m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((u -> u) -> ParsecT Sources u m ())
-> (u -> u) -> ParsecT Sources 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 -> ParsecT Sources u m a
forall a. a -> ParsecT Sources 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 => ParsecT Sources st m Text
lineClump :: forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
lineClump = ParsecT Sources st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
blanklines
          ParsecT Sources st m Text
-> ParsecT Sources st m Text -> ParsecT Sources 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 Sources st m [Text] -> ParsecT Sources st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m Text -> ParsecT Sources st m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources st m Char -> ParsecT Sources 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 Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
blankline ParsecT Sources st m ()
-> ParsecT Sources st m Text -> ParsecT Sources st m Text
forall a b.
ParsecT Sources st m a
-> ParsecT Sources st m b -> ParsecT Sources st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources st m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources 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 '(' ')' (Data.Text.singleton <$> anyChar)@ will parse
-- "(hello (there))" and return "hello (there)".
charsInBalanced :: (Stream s m Char, UpdateSourcePos s Char)
                => Char -> Char -> ParsecT s st m Text -> ParsecT s st m Text
charsInBalanced :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> Char -> ParsecT s st m Text -> ParsecT s st m Text
charsInBalanced Char
open Char
close ParsecT s st m Text
parser = ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Text -> ParsecT s st m Text)
-> ParsecT s st m Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
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 <- ParsecT 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 (ParsecT s st m Text -> ParsecT s st m [Text])
-> ParsecT s st m Text -> ParsecT s st m [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ParsecT s st m [Text] -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Text -> ParsecT s st m [Text]
forall s u (m :: * -> *) a. 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 -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDelim) ParsecT s st m () -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Text
parser)
             ParsecT s st m Text -> ParsecT s st m Text -> ParsecT 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 -> ParsecT s st m Text -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> Char -> ParsecT s st m Text -> ParsecT s st m Text
charsInBalanced Char
open Char
close ParsecT s st m Text
parser
                     Text -> ParsecT s st m Text
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT s st m Text) -> Text -> ParsecT 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 -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
close
  Text -> ParsecT s st m Text
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT s st m Text) -> Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
raw

-- Parsers for email addresses and URIs

-- | Parses an email address; returns original and corresponding
-- escaped mailto: URI.
emailAddress :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (Text, Text)
emailAddress :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (Text, Text)
emailAddress = ParsecT s st m (Text, Text) -> ParsecT s st m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m (Text, Text) -> ParsecT s st m (Text, Text))
-> ParsecT s st m (Text, Text) -> ParsecT 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 -> ParsecT s st m (Text, Text)
forall a b.
ParsecT s st m (a -> b) -> ParsecT s st m a -> ParsecT s st m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT s st m Char
-> ParsecT s st m String -> ParsecT s st m String
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 u (m :: * -> *) a. 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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
<|> (Char -> Bool) -> ParsecT s u m Char
forall {s} {m :: * -> *} {u}.
(UpdateSourcePos s Char, Stream s m Char) =>
(Char -> Bool) -> ParsecT s u m Char
innerPunct (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-')
       -- 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 :: (Char -> Bool) -> ParsecT s u m Char
innerPunct Char -> Bool
f      = 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
f
                                 ParsecT s u m Char -> ParsecT s u m () -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> 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 ()
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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum)))
       -- 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isEmailChar)
                              String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
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, UpdateSourcePos s Char) => ParsecT s st m Text
uriScheme :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
uriScheme = [Text] -> ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Text] -> ParsecT 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, UpdateSourcePos s Char) => ParsecT s st m (Text, Text)
uri :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (Text, Text)
uri = ParsecT s st m (Text, Text) -> ParsecT s st m (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m (Text, Text) -> ParsecT s st m (Text, Text))
-> ParsecT s st m (Text, Text) -> ParsecT s st m (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  Text
scheme <- ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
uriScheme
  Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'
  -- 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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] -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Text -> ParsecT s st m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> Char -> ParsecT s st m Text
forall {u}. Char -> Char -> ParsecT s u m Text
uriChunkBetween Char
'(' Char
')'
                        ParsecT s st m Text -> ParsecT s st m Text -> ParsecT 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 -> ParsecT s st m Text
forall {u}. Char -> Char -> ParsecT s u m Text
uriChunkBetween Char
'{' Char
'}'
                        ParsecT s st m Text -> ParsecT s st m Text -> ParsecT 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 -> ParsecT s st m Text
forall {u}. Char -> Char -> ParsecT s u m Text
uriChunkBetween Char
'[' Char
']'
                        ParsecT s st m Text -> ParsecT s st m Text -> ParsecT 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 -> ParsecT 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 -> ParsecT s st m Text -> ParsecT 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 (ParsecT s st m Text -> ParsecT s st m Text)
-> ParsecT s st m Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'/' ParsecT s st m Char -> ParsecT s st m Text -> ParsecT s st m Text
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT s st m Text
forall a. a -> ParsecT s st m a
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) -> ParsecT s st m (Text, Text)
forall a. a -> ParsecT s st m a
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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
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 u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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
$ Text -> String
T.unpack (Text -> String) -> ParsecT s u m Text -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
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 u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
',') ParsecT s 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 a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Char -> Bool) -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 u (m :: * -> *) a. 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 a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
l) (Char -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 a. a -> ParsecT s u m a
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])

-- | 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, UpdateSourcePos s Char)
                      => ParsecT s st m a  -- ^ Parsec to apply
                      -> ParsecT s st m (a, Int) -- ^ (result, displacement)
withHorizDisplacement :: forall s (m :: * -> *) st a.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m a -> ParsecT s st m (a, Int)
withHorizDisplacement ParsecT 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 <- ParsecT 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) -> ParsecT s st m (a, Int)
forall a. a -> ParsecT s st m a
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 Sources st m a
        -> ParsecT Sources st m (a, Text)
withRaw :: forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw ParsecT Sources st m a
parser = do
  Sources
inps1 <- ParsecT Sources st m Sources
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  a
result <- ParsecT Sources st m a
parser
  Sources
inps2 <- ParsecT Sources st m Sources
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  -- 'raw' is the difference between inps1 and inps2
  (a, Text) -> ParsecT Sources st m (a, Text)
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, Sources -> Sources -> Text
sourcesDifference Sources
inps1 Sources
inps2)

sourcesDifference :: Sources -> Sources -> Text
sourcesDifference :: Sources -> Sources -> Text
sourcesDifference (Sources [(SourcePos, Text)]
is1) (Sources [(SourcePos, Text)]
is2) = [(SourcePos, Text)] -> [(SourcePos, Text)] -> Text
forall {a}. Eq a => [(a, Text)] -> [(a, Text)] -> Text
go [(SourcePos, Text)]
is1 [(SourcePos, Text)]
is2
 where
   go :: [(a, Text)] -> [(a, Text)] -> Text
go [(a, Text)]
inps1 [(a, Text)]
inps2 =
    case ([(a, Text)]
inps1, [(a, Text)]
inps2) of
      ([], [(a, Text)]
_) -> Text
forall a. Monoid a => a
mempty
      ([(a, Text)]
_, []) -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((a, Text) -> Text) -> [(a, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (a, Text) -> Text
forall a b. (a, b) -> b
snd [(a, Text)]
inps1
      ((a
p1,Text
t1):[(a, Text)]
rest1, (a
p2, Text
t2):[(a, Text)]
rest2)
        | a
p1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
p2
        , Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2  -> [(a, Text)] -> [(a, Text)] -> Text
go [(a, Text)]
rest1 [(a, Text)]
rest2
        | a
p1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
p2
        , Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
t2  -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
t2 Text
t1
        | Bool
otherwise -> Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(a, Text)] -> [(a, Text)] -> Text
go [(a, Text)]
rest1 [(a, Text)]
inps2

-- | Parses backslash, then applies character parser.
escaped :: (Stream s m Char, UpdateSourcePos s Char)
        => ParsecT s st m Char  -- ^ Parsec for character to escape
        -> ParsecT s st m Char
escaped :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char -> ParsecT s st m Char
escaped ParsecT s st m Char
parser = 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 (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
$ Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
parser

-- | Parse character entity.
characterReference :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m Text
characterReference :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
characterReference = ParsecT s st m Text -> ParsecT s st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Text -> ParsecT s st m Text)
-> ParsecT s st m Text -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'&'
  Text
ent <- ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParsecT s st m Char -> ParsecT s st m end -> ParsecT s st m Text
many1TillChar ParsecT s st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Char
nonspaceChar (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
';')
  case Text -> Maybe Text
lookupEntity (Text
ent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";") of
       Just Text
t       -> Text -> ParsecT s st m Text
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
       Maybe Text
_            -> String -> ParsecT s st m Text
forall a. String -> ParsecT s st m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"entity not found"

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

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

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


-- | Removes the ParsecT layer from the monad transformer stack
readWithM :: (Monad m, ToSources t)
          => ParsecT Sources st m a  -- ^ parser
          -> st                      -- ^ initial state
          -> t                       -- ^ input
          -> m (Either PandocError a)
readWithM :: forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParsecT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM ParsecT Sources st m a
parser st
state t
input =
    (ParseError -> PandocError)
-> Either ParseError a -> Either PandocError a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first (Sources -> ParseError -> PandocError
fromParsecError Sources
sources)
      (Either ParseError a -> Either PandocError a)
-> m (Either ParseError a) -> m (Either PandocError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m a
-> st -> String -> Sources -> 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 ParsecT Sources st m a
parser st
state (Sources -> String
initialSourceName Sources
sources) Sources
sources
 where
   sources :: Sources
sources = t -> Sources
forall a. ToSources a => a -> Sources
toSources t
input


-- | Parse a string with a given parser and state
readWith :: ToSources t
         => Parsec Sources st a
         -> st
         -> t
         -> Either PandocError a
readWith :: forall t st a.
ToSources t =>
Parsec Sources st a -> st -> t -> Either PandocError a
readWith Parsec Sources st a
p st
t t
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
$ Parsec Sources st a -> st -> t -> Identity (Either PandocError a)
forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParsecT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM Parsec Sources st a
p st
t t
inp

-- | Parse a string with @parser@ (for testing).
testStringWith :: Show a
               => ParsecT Sources ParserState Identity a
               -> Text
               -> IO ()
testStringWith :: forall a.
Show a =>
ParsecT Sources ParserState Identity a -> Text -> IO ()
testStringWith ParsecT Sources 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
$
                            ParsecT Sources ParserState Identity a
-> ParserState -> Sources -> Either PandocError a
forall t st a.
ToSources t =>
Parsec Sources st a -> st -> t -> Either PandocError a
readWith ParsecT Sources ParserState Identity a
parser ParserState
defaultParserState (Text -> Sources
forall a. ToSources a => a -> Sources
toSources Text
str)

-- | 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 -> ParsecT s st m Attr
registerHeader :: forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Inlines -> ParsecT s st m Attr
registerHeader (Text
ident,[Text]
classes,[(Text, Text)]
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) -> ParsecT s st m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  if 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 Text -> Text
toAsciiText 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 -> ParsecT s st m Attr
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
id'',[Text]
classes,[(Text, Text)]
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 -> ParsecT 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 -> ParsecT s st m Attr
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
ident,[Text]
classes,[(Text, Text)]
kvs)

token :: (Stream s m t)
      => (t -> Text)
      -> (t -> SourcePos)
      -> (t -> Maybe a)
      -> ParsecT s st m a
token :: forall s (m :: * -> *) t a st.
Stream s m t =>
(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) => ParsecT s st m a -> ParsecT s st m a -> ParsecT s st m a
ParsecT s st m a
a <+?> :: forall a s st (m :: * -> *).
Monoid a =>
ParsecT s st m a -> ParsecT s st m a -> ParsecT s st m a
<+?> ParsecT s st m a
b = ParsecT s st m a
a ParsecT s st m a -> (a -> ParsecT s st m a) -> ParsecT s st m a
forall a b.
ParsecT s st m a -> (a -> ParsecT s st m b) -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((a -> a) -> ParsecT s st m a -> ParsecT s st m a)
-> ParsecT s st m a -> (a -> a) -> ParsecT s st m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> ParsecT s st m a -> ParsecT s st m a
forall a b. (a -> b) -> ParsecT s st m a -> ParsecT s st m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParsecT s st m a -> ParsecT s st m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s st m a
b ParsecT s st m a -> ParsecT s st m a -> ParsecT 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 -> ParsecT s st m a
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty) ((a -> a) -> ParsecT s st m a)
-> (a -> a -> a) -> a -> ParsecT 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, [(Text, Text)]
kvs) = (Text
ident', [Text]
cls', [(Text, Text)]
kvs')
  where
    ident' :: Text
ident' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
ident (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
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 -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [(Text, Text)]
kvs
    kvs' :: [(Text, Text)]
kvs'   = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
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") [(Text, Text)]
kvs

insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
                   => ParsecT a st m b -- ^ parser to apply
                   -> (Text -> a) -- ^ convert Text to stream type
                   -> [FilePath]  -- ^ search path (directories)
                   -> FilePath    -- ^ path of file to include
                   -> Maybe Int   -- ^ start line (negative counts from end)
                   -> Maybe Int   -- ^ end line (negative counts from end)
                   -> ParsecT a st m b
insertIncludedFile :: forall (m :: * -> *) st a b.
(PandocMonad m, HasIncludeFiles st) =>
ParsecT a st m b
-> (Text -> a)
-> [String]
-> String
-> Maybe Int
-> Maybe Int
-> ParsecT a st m b
insertIncludedFile ParsecT a st m b
parser Text -> a
toStream [String]
dirs String
f Maybe Int
mbstartline Maybe Int
mbendline = 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 a. Eq a => a -> [a] -> 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 a. PandocError -> ParsecT a st m a
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 a. a -> ParsecT a st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT a st m Text) -> Text -> ParsecT a st m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Text -> Text
exciseLines Maybe Int
mbstartline Maybe Int
mbendline 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 a. a -> ParsecT a st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
  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
toStream Text
contents
  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 -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mbstartline) Int
1
  b
result <- ParsecT a st m b
parser
  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
  b -> ParsecT a st m b
forall a. a -> ParsecT a st m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
result

exciseLines :: Maybe Int -> Maybe Int -> Text -> Text
exciseLines :: Maybe Int -> Maybe Int -> Text -> Text
exciseLines Maybe Int
Nothing Maybe Int
Nothing Text
t = Text
t
exciseLines Maybe Int
mbstartline Maybe Int
mbendline Text
t =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
endline' Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
startline' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
            ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
startline' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
contentLines
 where
  contentLines :: [Text]
contentLines = Text -> [Text]
T.lines Text
t
  numLines :: Int
numLines = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
contentLines
  startline' :: Int
startline' = case Maybe Int
mbstartline of
                 Maybe Int
Nothing -> Int
1
                 Just Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Int
x
                        | Bool
otherwise -> Int
numLines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x -- negative from end
  endline' :: Int
endline' = case Maybe Int
mbendline of
                 Maybe Int
Nothing -> Int
numLines
                 Just Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Int
x
                        | Bool
otherwise -> Int
numLines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x -- negative from end

fromParsecError :: Sources -> ParseError -> PandocError
fromParsecError :: Sources -> ParseError -> PandocError
fromParsecError (Sources [(SourcePos, Text)]
inputs) ParseError
err' = Text -> PandocError
PandocParseError Text
msg
 where
  msg :: Text
msg = Text
"Error at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParseError -> Text
forall a. Show a => a -> Text
tshow  ParseError
err' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errorContext
  errPos :: SourcePos
errPos = ParseError -> SourcePos
errorPos ParseError
err'
  errLine :: Int
errLine = SourcePos -> Int
sourceLine SourcePos
errPos
  errColumn :: Int
errColumn = SourcePos -> Int
sourceColumn SourcePos
errPos
  errFile :: String
errFile = SourcePos -> String
sourceName SourcePos
errPos
  errorContext :: Text
errorContext =
    case ((SourcePos, Text) -> Down Int)
-> [(SourcePos, Text)] -> [(SourcePos, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> ((SourcePos, Text) -> Int) -> (SourcePos, Text) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Int
sourceLine (SourcePos -> Int)
-> ((SourcePos, Text) -> SourcePos) -> (SourcePos, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, Text) -> SourcePos
forall a b. (a, b) -> a
fst)
            [ (SourcePos
pos,Text
t)
              | (SourcePos
pos,Text
t) <- [(SourcePos, Text)]
inputs
              , SourcePos -> String
sourceName SourcePos
pos String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
errFile
              , SourcePos -> Int
sourceLine SourcePos
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
errLine
            ] of
      []  -> Text
""
      ((SourcePos
pos,Text
txt):[(SourcePos, Text)]
_) ->
        let ls :: [Text]
ls = Text -> [Text]
T.lines Text
txt [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
""]
            ln :: Int
ln = (Int
errLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceLine SourcePos
pos) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
         in if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ln Bool -> Bool -> Bool
&& Int
ln Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
               then [Text] -> Text
T.concat [Text
"\n", [Text]
ls [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                             ,Text
"\n", Int -> Text -> Text
T.replicate (Int
errColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" "
                             ,Text
"^"]
               else Text
""