-- |
-- Module      :  Data.Text.Parser
-- License     :  CC0-1.0
--
-- Maintainer  :  mordae@anilinux.org
-- Stability   :  unstable
-- Portability :  non-portable (ghc)
--
-- This module provides a parser for unicode 'Text'.
--
--   * If you\'d like to parse ASCII text, you might want to take a look at
--     "Data.ByteString.Parser.Char8". It is much, much faster.
--
--   * If you\'d like to parse byte sequences, look instead at the
--     "Data.ByteString.Parser".
--

module Data.Text.Parser
  ( Parser(..)
  , Result(..)
  , parseOnly

    -- * Chars
  , char
  , notChar
  , anyChar
  , satisfy
  , space
  , isSpace
  , skipSpace
  , peekChar

    -- * Strings
  , string
  , stringCI
  , Data.Text.Parser.take
  , scan
  , runScanner
  , Data.Text.Parser.takeWhile
  , takeWhile1
  , takeTill
  , takeTill1

    -- * Numbers
  , signed
  , decimal
  , hexadecimal
  , octal
  , fractional

    -- * Combinators
  , provided
  , choice
  , branch
  , Snack.Combinators.count
  , optional
  , eitherP
  , option
  , many
  , many1
  , manyTill
  , sepBy
  , sepBy1
  , wrap
  , match
  , label
  , unlabel
  , validate

    -- * End Of Input
  , takeText
  , peekText
  , endOfInput
  , atEnd

    -- * Position
  , offset
  , position
  , explain
  , Explanation(..)

    -- * Miscelaneous
    -- |
    -- These are all generic methods, but since I sometimes forget about them,
    -- it is nice to have them listed here for reference what writing parsers.
  , Control.Applicative.empty
  , pure
  , guard
  , when
  , unless
  , void
  )
where
  import Prelude hiding (null, length, splitAt, take)

  import Control.Applicative
  import Control.Monad

  import Data.Char
  import Data.Maybe
  import Data.List qualified as List

  import Data.Text as T
  import Data.Text.Unsafe as T
  import Data.Text.Encoding as T

  import Data.ByteString qualified as BS
  import Data.ByteString.Lex.Fractional qualified as LF
  import Data.ByteString.Lex.Integral qualified as LI

  import Snack.Combinators


  -- |
  -- Result represents either success or some kind of failure.
  --
  -- You can find the problematic offset by subtracting length of the
  -- remainder from length of the original input.
  --
  data Result a
    = Success a {-# UNPACK #-} !Text
      -- ^ Parser successfully matched the input.
      --   Produces the parsing result and the remainder of the input.

    | Failure [String] {-# UNPACK #-} !Text
      -- ^ Parser failed to match the input.
      --   Produces list of expected inputs and the corresponding remainder.

    | Error String {-# UNPACK #-} !Text {-# UNPACK #-} !Int
      -- ^ Parser ran into an error. Either syntactic or a validation one.

    deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq, Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show)

  instance Functor Result where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Result a -> Result b
fmap a -> b
fn (Success a
res Text
more) = b -> Text -> Result b
forall a. a -> Text -> Result a
Success (a -> b
fn a
res) Text
more
    fmap a -> b
_  (Failure [String]
expected Text
more) = [String] -> Text -> Result b
forall a. [String] -> Text -> Result a
Failure [String]
expected Text
more
    fmap a -> b
_  (Error String
reason Text
more Int
len) = String -> Text -> Int -> Result b
forall a. String -> Text -> Int -> Result a
Error String
reason Text
more Int
len


  -- |
  -- Parser for 'Text' inputs.
  --
  newtype Parser a =
    Parser
      { Parser a -> Text -> Result a
runParser :: Text -> Result a
        -- ^ Run the parser on specified input.
      }

  instance Functor Parser where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
fn Parser{Text -> Result a
runParser :: Text -> Result a
runParser :: forall a. Parser a -> Text -> Result a
runParser} = (Text -> Result b) -> Parser b
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
      (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn (Text -> Result a
runParser Text
inp)

  instance Applicative Parser where
    {-# INLINE pure #-}
    pure :: a -> Parser a
pure a
x = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
x Text
inp

    {-# INLINE (<*>) #-}
    (Parser Text -> Result (a -> b)
runFn) <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> (Parser Text -> Result a
runArg) = (Text -> Result b) -> Parser b
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
      case Text -> Result (a -> b)
runFn Text
inp of
        Success a -> b
fn Text
rest -> (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn (Text -> Result a
runArg Text
rest)
        Failure [String]
expected Text
more -> [String] -> Text -> Result b
forall a. [String] -> Text -> Result a
Failure [String]
expected Text
more
        Error String
reason Text
more Int
len -> String -> Text -> Int -> Result b
forall a. String -> Text -> Int -> Result a
Error String
reason Text
more Int
len

  instance Alternative Parser where
    {-# INLINE empty #-}
    empty :: Parser a
empty = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [] Text
inp

    -- |
    -- Tries the right branch only if the left brach produces Failure.
    -- Does not mask Error.
    --
    {-# INLINE (<|>) #-}
    (Parser Text -> Result a
runLeft) <|> :: Parser a -> Parser a -> Parser a
<|> (Parser Text -> Result a
runRight) = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
      case Text -> Result a
runLeft Text
inp of
        Success a
res Text
more -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res Text
more
        Error String
reason Text
more Int
len -> String -> Text -> Int -> Result a
forall a. String -> Text -> Int -> Result a
Error String
reason Text
more Int
len
        Failure [String]
expected Text
more ->
          case Text -> Result a
runRight Text
inp of
            Success a
res' Text
more' -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res' Text
more'
            Error String
reason' Text
more' Int
len' -> String -> Text -> Int -> Result a
forall a. String -> Text -> Int -> Result a
Error String
reason' Text
more' Int
len'
            Failure [String]
expected' Text
more' ->
              -- Longer match (shorter remainder) wins.
              case Text -> Int
length Text
more Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text -> Int
length Text
more' of
                Ordering
LT -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [String]
expected Text
more
                Ordering
EQ -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure ([String]
expected [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
expected') Text
more
                Ordering
GT -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [String]
expected' Text
more'

  instance Monad Parser where
    {-# INLINE (>>=) #-}
    (Parser Text -> Result a
runLeft) >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
right = (Text -> Result b) -> Parser b
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
      case Text -> Result a
runLeft Text
inp of
        Success a
res Text
more -> Parser b -> Text -> Result b
forall a. Parser a -> Text -> Result a
runParser (a -> Parser b
right a
res) Text
more
        Failure [String]
expected Text
more -> [String] -> Text -> Result b
forall a. [String] -> Text -> Result a
Failure [String]
expected Text
more
        Error String
reason Text
more Int
len -> String -> Text -> Int -> Result b
forall a. String -> Text -> Int -> Result a
Error String
reason Text
more Int
len

  instance MonadPlus Parser


  -- |
  -- Accepts a single, matching character.
  --
  {-# INLINE CONLIKE char #-}
  char :: Char -> Parser Char
  char :: Char -> Parser Char
char Char
c = String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
label (Char -> String
forall a. Show a => a -> String
show Char
c) (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)


  -- |
  -- Accepts a single, differing character.
  --
  {-# INLINE CONLIKE notChar #-}
  notChar :: Char -> Parser Char
  notChar :: Char -> Parser Char
notChar Char
c = (Char -> Bool) -> Parser Char
satisfy (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=)


  -- |
  -- Discards the remaining input and returns just the parse result.
  -- You might want to combine it with 'endOfInput' for the best effect.
  --
  -- Example:
  --
  -- @
  -- parseOnly (pContacts \<* endOfInput) bstr
  -- @
  --
  {-# INLINE CONLIKE parseOnly #-}
  parseOnly :: Parser a -> Text -> Either String a
  parseOnly :: Parser a -> Text -> Either String a
parseOnly Parser a
par = \Text
inp ->
    case Parser a -> Text -> Result a
forall a. Parser a -> Text -> Result a
runParser Parser a
par Text
inp of
      Success a
res Text
_ -> a -> Either String a
forall a b. b -> Either a b
Right a
res
      Error String
reason Text
_ Int
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
reason
      Failure [String]
expected Text
_ ->
        case [String]
expected of
          [] -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Unexpected input."
          [String]
ex -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
ex String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."


  -- |
  -- Accepts a single character.
  --
  {-# INLINE anyChar #-}
  anyChar :: Parser Char
  anyChar :: Parser Char
anyChar = (Text -> Result Char) -> Parser Char
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    if Text -> Bool
null Text
inp
       then [String] -> Text -> Result Char
forall a. [String] -> Text -> Result a
Failure [String
"any char"] Text
inp
       else Char -> Text -> Result Char
forall a. a -> Text -> Result a
Success (Text -> Char
unsafeHead Text
inp) (Text -> Text
unsafeTail Text
inp)


  -- |
  -- Accepts a single character matching the predicate.
  --
  {-# INLINE CONLIKE satisfy #-}
  satisfy :: (Char -> Bool) -> Parser Char
  satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isOk = (Text -> Result Char) -> Parser Char
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    if Text -> Bool
null Text
inp
       then [String] -> Text -> Result Char
forall a. [String] -> Text -> Result a
Failure [String
"more input"] Text
inp
       else let c :: Char
c = Text -> Char
unsafeHead Text
inp
             in if Char -> Bool
isOk Char
c
                   then Char -> Text -> Result Char
forall a. a -> Text -> Result a
Success Char
c (Text -> Text
unsafeTail Text
inp)
                   else [String] -> Text -> Result Char
forall a. [String] -> Text -> Result a
Failure [] Text
inp


  -- |
  -- Accepts a single unicode white space character.
  -- See 'isSpace' for details.
  --
  {-# INLINE space #-}
  space :: Parser Char
  space :: Parser Char
space = String -> Parser Char -> Parser Char
forall a. String -> Parser a -> Parser a
label String
"space" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isSpace


  -- |
  -- Accepts multiple unicode white space characters.
  -- See 'isSpace' for details.
  --
  {-# INLINE skipSpace #-}
  skipSpace :: Parser ()
  skipSpace :: Parser ()
skipSpace = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text
Data.Text.Parser.takeWhile Char -> Bool
isSpace


  -- |
  -- Peeks ahead, but does not consume.
  --
  -- Be careful, peeking behind end of the input fails.
  -- You might want to check using 'atEnd' beforehand.
  --
  {-# INLINE peekChar #-}
  peekChar :: Parser Char
  peekChar :: Parser Char
peekChar = (Text -> Result Char) -> Parser Char
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    if Text -> Bool
null Text
inp
       then [String] -> Text -> Result Char
forall a. [String] -> Text -> Result a
Failure [String
"more input"] Text
inp
       else Char -> Text -> Result Char
forall a. a -> Text -> Result a
Success (Text -> Char
unsafeHead Text
inp) Text
inp


  -- |
  -- Accepts a matching string.
  --
  {-# INLINE CONLIKE string #-}
  string :: Text -> Parser Text
  string :: Text -> Parser Text
string Text
str = (Text -> Result Text) -> Parser Text
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    let (Text
pfx, Text
sfx) = Int -> Text -> (Text, Text)
splitAt (Text -> Int
length Text
str) Text
inp
     in case Text
pfx Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
str of
          Bool
True -> Text -> Text -> Result Text
forall a. a -> Text -> Result a
Success Text
pfx Text
sfx
          Bool
False -> [String] -> Text -> Result Text
forall a. [String] -> Text -> Result a
Failure [Text -> String
forall a. Show a => a -> String
show Text
str] Text
inp


  -- |
  -- Same as 'string', but case insensitive.
  --
  {-# INLINE CONLIKE stringCI #-}
  stringCI :: Text -> Parser Text
  stringCI :: Text -> Parser Text
stringCI Text
str = (Text -> Result Text) -> Parser Text
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    let (Text
pfx, Text
sfx) = Int -> Text -> (Text, Text)
splitAt (Text -> Int
length Text
str) Text
inp
     in case Text -> Text
toCaseFold Text
pfx Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
toCaseFold Text
str of
          Bool
True -> Text -> Text -> Result Text
forall a. a -> Text -> Result a
Success Text
pfx Text
sfx
          Bool
False -> [String] -> Text -> Result Text
forall a. [String] -> Text -> Result a
Failure [Text -> String
forall a. Show a => a -> String
show Text
str] Text
inp


  -- |
  -- Accepts given number of characters.
  -- Fails when not enough characters are available.
  --
  {-# INLINE CONLIKE take #-}
  take :: Int -> Parser Text
  take :: Int -> Parser Text
take Int
n = (Text -> Result Text) -> Parser Text
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
length Text
inp
       then [String] -> Text -> Result Text
forall a. [String] -> Text -> Result a
Failure [Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" more characters"] Text
inp
       else let (Text
pfx, Text
more) = Int -> Text -> (Text, Text)
splitAt Int
n Text
inp
             in Text -> Text -> Result Text
forall a. a -> Text -> Result a
Success Text
pfx Text
more


  -- |
  -- Scans ahead statefully and then accepts whatever characters the scanner liked.
  -- Scanner returns 'Nothing' to mark end of the acceptable extent.
  --
  {-# INLINE CONLIKE scan #-}
  scan :: s -> (s -> Char -> Maybe s) -> Parser Text
  scan :: s -> (s -> Char -> Maybe s) -> Parser Text
scan s
state s -> Char -> Maybe s
scanner = (Text, s) -> Text
forall a b. (a, b) -> a
fst ((Text, s) -> Text) -> Parser (Text, s) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> (s -> Char -> Maybe s) -> Parser (Text, s)
forall s. s -> (s -> Char -> Maybe s) -> Parser (Text, s)
runScanner s
state s -> Char -> Maybe s
scanner


  -- |
  -- Like 'scan', but also returns the final scanner state.
  --
  {-# INLINE CONLIKE runScanner #-}
  runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
  runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
runScanner s
state s -> Char -> Maybe s
scanner = (Text -> Result (Text, s)) -> Parser (Text, s)
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp -> Text -> s -> Int -> Result (Text, s)
loop Text
inp s
state Int
0
    where
      loop :: Text -> s -> Int -> Result (Text, s)
loop Text
inp !s
st !Int
n =
        case Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
lengthWord8 Text
inp of
          Bool
True -> (Text, s) -> Text -> Result (Text, s)
forall a. a -> Text -> Result a
Success (Text
inp, s
st) Text
forall a. Monoid a => a
mempty
          Bool
False ->
            case Text -> Int -> Iter
iter Text
inp Int
n of
              Iter Char
c Int
n' ->
                case s -> Char -> Maybe s
scanner s
st Char
c of
                  Maybe s
Nothing -> (Text, s) -> Text -> Result (Text, s)
forall a. a -> Text -> Result a
Success (Int -> Text -> Text
takeWord8 Int
n Text
inp, s
st) (Int -> Text -> Text
dropWord8 Int
n Text
inp)
                  Just s
st' -> Text -> s -> Int -> Result (Text, s)
loop Text
inp s
st' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n')


  -- |
  -- Efficiently consume as long as the input characters match the predicate.
  -- An inverse of 'takeTill'.
  --
  {-# INLINE CONLIKE takeWhile #-}
  takeWhile :: (Char -> Bool) -> Parser Text
  takeWhile :: (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
test = (Char -> Bool) -> Parser Text
takeTill (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
test)


  -- |
  -- Like 'Data.Text.Parser.takeWhile', but requires at least a single character.
  --
  {-# INLINE CONLIKE takeWhile1 #-}
  takeWhile1 :: (Char -> Bool) -> Parser Text
  takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
test = (Char -> Bool) -> Parser Text
Data.Text.Parser.takeWhile Char -> Bool
test Parser Text -> (Text -> Bool) -> Parser Text
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
m a -> (a -> Bool) -> m a
`provided` (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
null)


  -- |
  -- Efficiently consume until a character matching the predicate is found.
  -- An inverse of 'Data.Text.Parser.takeWhile'.
  --
  {-# INLINE CONLIKE takeTill #-}
  takeTill :: (Char -> Bool) -> Parser Text
  takeTill :: (Char -> Bool) -> Parser Text
takeTill Char -> Bool
test = (Text -> Result Text) -> Parser Text
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    let n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Text -> Int
length Text
inp) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Int
findIndex Char -> Bool
test Text
inp
        (Text
pfx, Text
more) = Int -> Text -> (Text, Text)
splitAt Int
n Text
inp
     in Text -> Text -> Result Text
forall a. a -> Text -> Result a
Success Text
pfx Text
more


  -- |
  -- Same as 'takeTill', but requires at least a single character.
  --
  {-# INLINE CONLIKE takeTill1 #-}
  takeTill1 :: (Char -> Bool) -> Parser Text
  takeTill1 :: (Char -> Bool) -> Parser Text
takeTill1 Char -> Bool
test = (Char -> Bool) -> Parser Text
Data.Text.Parser.takeTill Char -> Bool
test Parser Text -> (Text -> Bool) -> Parser Text
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
m a -> (a -> Bool) -> m a
`provided` (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
null)


  -- |
  -- Makes the parser not only return the result, but also the original
  -- matched extent.
  --
  {-# INLINE CONLIKE match #-}
  match :: Parser a -> Parser (Text, a)
  match :: Parser a -> Parser (Text, a)
match Parser a
par = (Text -> Result (Text, a)) -> Parser (Text, a)
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case Parser a -> Text -> Result a
forall a. Parser a -> Text -> Result a
runParser Parser a
par Text
inp of
      Failure [String]
expected Text
more -> [String] -> Text -> Result (Text, a)
forall a. [String] -> Text -> Result a
Failure [String]
expected Text
more
      Error String
reason Text
more Int
len -> String -> Text -> Int -> Result (Text, a)
forall a. String -> Text -> Int -> Result a
Error String
reason Text
more Int
len
      Success a
res Text
more ->
        let n :: Int
n = Text -> Int
length Text
more
         in (Text, a) -> Text -> Result (Text, a)
forall a. a -> Text -> Result a
Success (Int -> Text -> Text
T.take Int
n Text
inp, a
res) Text
more


  -- |
  -- Names an extent of the parser.
  --
  -- When the extent returns a Failure, details are discarded and replaced
  -- with the extent as a whole.
  --
  -- When the extent returns an Error, it is adjusted to cover the whole
  -- extent, but the reason is left intact.
  --
  -- You should strive to make labeled extents as small as possible,
  -- approximately of a typical token size. For example:
  --
  -- @
  -- pString = label \"string\" $ pStringContents \`wrap\` char \'\"\'
  -- @
  --
  {-# INLINE CONLIKE label #-}
  label :: String -> Parser a -> Parser a
  label :: String -> Parser a -> Parser a
label String
lbl Parser a
par = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case Parser a -> Text -> Result a
forall a. Parser a -> Text -> Result a
runParser Parser a
par Text
inp of
      Success a
res Text
more -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res Text
more
      Failure [String]
_expected Text
_more -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [String
lbl] Text
inp
      Error String
reason Text
more Int
len ->
        let len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Text -> Int
length Text
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
length Text
more)
         in String -> Text -> Int -> Result a
forall a. String -> Text -> Int -> Result a
Error String
reason Text
inp Int
len'


  -- |
  -- Un-names an extent of the parser.
  --
  -- Same as 'label', but removes any expected values upon Failure.
  -- Very useful to mark comments and optional whitespace with.
  --
  {-# INLINE CONLIKE unlabel #-}
  unlabel :: Parser a -> Parser a
  unlabel :: Parser a -> Parser a
unlabel Parser a
par = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case Parser a -> Text -> Result a
forall a. Parser a -> Text -> Result a
runParser Parser a
par Text
inp of
      Success a
res Text
more -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res Text
more
      Failure [String]
_expected Text
_more -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [] Text
inp
      Error String
reason Text
more Int
len ->
        let len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Text -> Int
length Text
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
length Text
more)
         in String -> Text -> Int -> Result a
forall a. String -> Text -> Int -> Result a
Error String
reason Text
inp Int
len'


  -- |
  -- Validate parser result and turn it into an Error upon failure.
  --
  {-# INLINE CONLIKE validate #-}
  validate :: (a -> Either String b) -> Parser a -> Parser b
  validate :: (a -> Either String b) -> Parser a -> Parser b
validate a -> Either String b
test Parser a
par = (Text -> Result b) -> Parser b
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case Parser a -> Text -> Result a
forall a. Parser a -> Text -> Result a
runParser Parser a
par Text
inp of
      Failure [String]
expected Text
more -> [String] -> Text -> Result b
forall a. [String] -> Text -> Result a
Failure [String]
expected Text
more
      Error String
reason Text
more Int
len -> String -> Text -> Int -> Result b
forall a. String -> Text -> Int -> Result a
Error String
reason Text
more Int
len
      Success a
res Text
more ->
        case a -> Either String b
test a
res of
          Right b
res' -> b -> Text -> Result b
forall a. a -> Text -> Result a
Success b
res' Text
more
          Left String
reason -> String -> Text -> Int -> Result b
forall a. String -> Text -> Int -> Result a
Error String
reason Text
inp (Text -> Int
length Text
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
length Text
more)


  -- |
  -- Given list of matchers and parsers, runs the first parser whose matcher
  -- succeeds on the input. This pattern makes for a simpler alternative to
  -- @try@ used in other parser combinator libraries.
  --
  -- Example:
  --
  -- @
  -- pProperty = branch [ ( string "public" <* skipSpace
  --                      , \_ -> Property Public <$> pToken
  --                      )
  --                    , ( string "private" <* skipSpace
  --                      , \_ -> Property Private <$> pToken
  --                      )
  --                    ]
  -- @
  --
  {-# INLINE CONLIKE branch #-}
  branch :: [(Parser a, a -> Parser b)] -> Parser b
  branch :: [(Parser a, a -> Parser b)] -> Parser b
branch [] = (Text -> Result b) -> Parser b
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp -> [String] -> Text -> Result b
forall a. [String] -> Text -> Result a
Failure [] Text
inp
  branch ((Parser Text -> Result a
test, a -> Parser b
finish) : [(Parser a, a -> Parser b)]
alts) =
    (Text -> Result b) -> Parser b
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
      case Text -> Result a
test Text
inp of
        Success a
res Text
more -> Parser b -> Text -> Result b
forall a. Parser a -> Text -> Result a
runParser (a -> Parser b
finish a
res) Text
more
        Error String
reason Text
more Int
len -> String -> Text -> Int -> Result b
forall a. String -> Text -> Int -> Result a
Error String
reason Text
more Int
len
        Failure [String]
_expected Text
_more -> Parser b -> Text -> Result b
forall a. Parser a -> Text -> Result a
runParser ([(Parser a, a -> Parser b)] -> Parser b
forall a b. [(Parser a, a -> Parser b)] -> Parser b
branch [(Parser a, a -> Parser b)]
alts) Text
inp


  -- |
  -- Accept whatever input remains.
  --
  {-# INLINE takeText #-}
  takeText :: Parser Text
  takeText :: Parser Text
takeText = (Text -> Result Text) -> Parser Text
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp -> Text -> Text -> Result Text
forall a. a -> Text -> Result a
Success Text
inp Text
forall a. Monoid a => a
mempty


  -- |
  -- Peek at whatever input remains.
  --
  {-# INLINE peekText #-}
  peekText :: Parser Text
  peekText :: Parser Text
peekText = (Text -> Result Text) -> Parser Text
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp -> Text -> Text -> Result Text
forall a. a -> Text -> Result a
Success Text
inp Text
inp


  -- |
  -- Accepts end of input and fails if we are not there yet.
  --
  {-# INLINE endOfInput #-}
  endOfInput :: Parser ()
  endOfInput :: Parser ()
endOfInput = (Text -> Result ()) -> Parser ()
forall a. (Text -> Result a) -> Parser a
Parser \case
    Text
inp | Text -> Bool
null Text
inp  -> () -> Text -> Result ()
forall a. a -> Text -> Result a
Success () Text
inp
    Text
inp             -> [String] -> Text -> Result ()
forall a. [String] -> Text -> Result a
Failure [String
"end of input"] Text
inp


  -- |
  -- Returns whether we are at the end of the input yet.
  --
  {-# INLINE atEnd #-}
  atEnd :: Parser Bool
  atEnd :: Parser Bool
atEnd = (Text -> Result Bool) -> Parser Bool
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp -> Bool -> Text -> Result Bool
forall a. a -> Text -> Result a
Success (Text -> Bool
null Text
inp) Text
inp


  -- |
  -- Accepts optional @\'+\'@ or @\'-\'@ character and then applies it to
  -- the following parser result.
  --
  {-# INLINE signed #-}
  signed :: (Num a) => Parser a -> Parser a
  signed :: Parser a -> Parser a
signed Parser a
runNumber = (Char -> Parser Char
char Char
'-' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate Parser a
runNumber)
                 Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'+' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
runNumber)
                 Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser a
runNumber)


  {-# INLINE CONLIKE unsafeWithUtf8 #-}
  unsafeWithUtf8 :: (BS.ByteString -> Maybe (a, BS.ByteString))
                 -> Text -> Maybe (a, Text)
  unsafeWithUtf8 :: (ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
unsafeWithUtf8 ByteString -> Maybe (a, ByteString)
bspar = \Text
inp ->
    let bstr :: ByteString
bstr = Text -> ByteString
encodeUtf8 Text
inp
     in case ByteString -> Maybe (a, ByteString)
bspar ByteString
bstr of
          Maybe (a, ByteString)
Nothing -> Maybe (a, Text)
forall a. Maybe a
Nothing
          Just (a
x, ByteString
more) ->
            -- This should be perfectly safe as long as the embedded
            -- parser returns the actual remaining input and not some
            -- random chunk of bytes.
            let n :: Int
n = Text -> Int
lengthWord8 Text
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
more
             in (a, Text) -> Maybe (a, Text)
forall a. a -> Maybe a
Just (a
x, Int -> Text -> Text
dropWord8 Int
n Text
inp)


  -- |
  -- Accepts an integral number in the decimal format.
  --
  {-# INLINE decimal #-}
  decimal :: (Integral a) => Parser a
  decimal :: Parser a
decimal = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case (ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
forall a.
(ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
unsafeWithUtf8 ByteString -> Maybe (a, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LI.readDecimal Text
inp of
      Just (a
res, Text
more) -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res Text
more
      Maybe (a, Text)
Nothing -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [String
"decimal"] Text
inp


  -- |
  -- Accepts an integral number in the hexadecimal format in either case.
  -- Does not look for @0x@ or similar prefixes.
  --
  {-# INLINE hexadecimal #-}
  hexadecimal :: (Integral a) => Parser a
  hexadecimal :: Parser a
hexadecimal = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case (ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
forall a.
(ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
unsafeWithUtf8 ByteString -> Maybe (a, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LI.readHexadecimal Text
inp of
      Just (a
res, Text
more) -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res Text
more
      Maybe (a, Text)
Nothing -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [String
"hexadecimal"] Text
inp


  -- |
  -- Accepts an integral number in the octal format.
  --
  {-# INLINE octal #-}
  octal :: (Integral a) => Parser a
  octal :: Parser a
octal = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case (ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
forall a.
(ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
unsafeWithUtf8 ByteString -> Maybe (a, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LI.readOctal Text
inp of
      Just (a
res, Text
more) -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res Text
more
      Maybe (a, Text)
Nothing -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [String
"octal"] Text
inp


  -- |
  -- Accepts a fractional number as a decimal optinally followed by a colon
  -- and the fractional part. Does not support exponentiation.
  --
  {-# INLINE fractional #-}
  fractional :: (Fractional a) => Parser a
  fractional :: Parser a
fractional = (Text -> Result a) -> Parser a
forall a. (Text -> Result a) -> Parser a
Parser \Text
inp ->
    case (ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
forall a.
(ByteString -> Maybe (a, ByteString)) -> Text -> Maybe (a, Text)
unsafeWithUtf8 ByteString -> Maybe (a, ByteString)
forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LF.readDecimal Text
inp of
      Just (a
res, Text
more) -> a -> Text -> Result a
forall a. a -> Text -> Result a
Success a
res Text
more
      Maybe (a, Text)
Nothing -> [String] -> Text -> Result a
forall a. [String] -> Text -> Result a
Failure [String
"fractional"] Text
inp



  -- |
  -- Calculate offset from the original input and the remainder.
  --
  offset :: Text -> Text -> Int
  offset :: Text -> Text -> Int
offset Text
inp Text
more = Text -> Int
length Text
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
length Text
more


  -- |
  -- Determine @(line, column)@ from the original input and the remainder.
  --
  -- Counts line feed characters leading to the 'offset', so only use it
  -- on your slow path. For example when describing parsing errors.
  --
  position :: Text -> Text -> (Int, Int)
  position :: Text -> Text -> (Int, Int)
position Text
inp Text
more = (Int -> Int
forall a. Enum a => a -> a
succ Int
line, Int -> Int
forall a. Enum a => a -> a
succ Int
column)
    where
      column :: Int
column = Text -> Int
length Text
lastLine
      lastLine :: Text
lastLine = (Char -> Bool) -> Text -> Text
takeWhileEnd (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) Text
leader
      line :: Int
line = HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"\n" Text
leader
      leader :: Text
leader = Int -> Text -> Text
dropEnd (Text -> Int
length Text
more) Text
inp


  -- |
  -- More precise 'Result' description produced by 'explain'.
  --
  data Explanation
    = Explanation
      { Explanation -> String
exSource       :: String
        -- ^ Name of the source file.
      , Explanation -> (Int, Int)
exSpanFrom     :: (Int, Int)
        -- ^ Line and column where the problem starts.
      , Explanation -> (Int, Int)
exSpanTo       :: (Int, Int)
        -- ^ Line and column where the problem ends.
      , Explanation -> String
exMessage      :: String
        -- ^ Message associated with the problem.
      }
    deriving (Explanation -> Explanation -> Bool
(Explanation -> Explanation -> Bool)
-> (Explanation -> Explanation -> Bool) -> Eq Explanation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Explanation -> Explanation -> Bool
$c/= :: Explanation -> Explanation -> Bool
== :: Explanation -> Explanation -> Bool
$c== :: Explanation -> Explanation -> Bool
Eq, Int -> Explanation -> ShowS
[Explanation] -> ShowS
Explanation -> String
(Int -> Explanation -> ShowS)
-> (Explanation -> String)
-> ([Explanation] -> ShowS)
-> Show Explanation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Explanation] -> ShowS
$cshowList :: [Explanation] -> ShowS
show :: Explanation -> String
$cshow :: Explanation -> String
showsPrec :: Int -> Explanation -> ShowS
$cshowsPrec :: Int -> Explanation -> ShowS
Show)


  -- |
  -- Process the result for showing it to the user.
  --
  explain :: String -> Text -> Result a -> Explanation
  explain :: String -> Text -> Result a -> Explanation
explain String
src Text
inp (Success a
_ Text
more) =
    Explanation :: String -> (Int, Int) -> (Int, Int) -> String -> Explanation
Explanation { exSource :: String
exSource   = String
src
                , exSpanFrom :: (Int, Int)
exSpanFrom = (Int, Int)
pos
                , exSpanTo :: (Int, Int)
exSpanTo   = (Int, Int)
pos
                , exMessage :: String
exMessage  = String
"Parsed successfully up to this point."
                }
      where
        pos :: (Int, Int)
pos = Text -> Text -> (Int, Int)
position Text
inp Text
more


  explain String
src Text
inp (Failure [String]
expected Text
more) =
    Explanation :: String -> (Int, Int) -> (Int, Int) -> String -> Explanation
Explanation { exSource :: String
exSource   = String
src
                , exSpanFrom :: (Int, Int)
exSpanFrom = (Int, Int)
pos
                , exSpanTo :: (Int, Int)
exSpanTo   = (Int, Int)
pos
                , exMessage :: String
exMessage =
                    case [String]
expected of
                      [] -> String
"Unexpected input."
                      [String]
ex -> String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
ex String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
                }
      where
        pos :: (Int, Int)
pos = Text -> Text -> (Int, Int)
position Text
inp Text
more

  explain String
src Text
inp (Error String
reason Text
more Int
len) =
    Explanation :: String -> (Int, Int) -> (Int, Int) -> String -> Explanation
Explanation { exSource :: String
exSource   = String
src
                , exSpanFrom :: (Int, Int)
exSpanFrom = (Int, Int)
from
                , exSpanTo :: (Int, Int)
exSpanTo   = (Int, Int)
to
                , exMessage :: String
exMessage  = String
reason
                }
      where
        from :: (Int, Int)
from = Text -> Text -> (Int, Int)
position Text
inp Text
more
        to :: (Int, Int)
to   = Text -> Text -> (Int, Int)
position Text
inp (Int -> Text -> Text
T.drop Int
len Text
more)


-- vim:set ft=haskell sw=2 ts=2 et: