{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
Module      : Text.Pandoc.Parsing.General
Copyright   : © 2006-2023 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 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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1

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

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

-- | Parses one of a list of strings.  If the list contains
-- two strings one of which is a prefix of the other, the longer
-- string will be matched if possible.
oneOfStrings :: (Stream s m Char, 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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) 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 (m :: * -> *) t u a.
Stream s m t =>
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 '(' ')' 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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Char -> 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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT s u m Char -> ParsecT s u m String)
-> ParsecT s u m Char -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char
forall (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}.
(Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) t u a.
Stream s m t =>
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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall (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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT s u m Char
forall (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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall {u}. ParsecT s u m Char
wordChar
           ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall {u}. ParsecT s u m String
percentEscaped
           ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall {u}. ParsecT s u m String
entity
           ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String
forall {u}. ParsecT s u m String
punct ParsecT s u m String -> ParsecT s u m () -> ParsecT s u m String
forall 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 (m :: * -> *) t u a.
Stream s m t =>
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
""