{-# LANGUAGE GADTs #-}

-- |
--
-- Module      :  Distribution.Deprecated.ReadP
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- This is a library of parser combinators, originally written by Koen Claessen.
-- It parses all alternatives in parallel, so it never keeps hold of
-- the beginning of the input string, a common source of space leaks with
-- other parsers.  The '(+++)' choice combinator is genuinely commutative;
-- it makes no difference which branch is \"shorter\".
--
-- See also Koen's paper /Parallel Parsing Processes/
-- (<http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.19.9217>).
--
-- This version of ReadP has been locally hacked to make it H98, by
-- Martin Sj&#xF6;gren <mailto:msjogren@gmail.com>
--
-- The unit tests have been moved to UnitTest.Distribution.Deprecated.ReadP, by
-- Mark Lentczner <mailto:mark@glyphic.com>
module Distribution.Deprecated.ReadP
  ( -- * The 'ReadP' type
    ReadP -- :: * -> *; instance Functor, Monad, MonadPlus

    -- * Primitive operations
  , get -- :: ReadP Char
  , look -- :: ReadP String
  , (+++) -- :: ReadP a -> ReadP a -> ReadP a
  , (<++) -- :: ReadP a -> ReadP a -> ReadP a
  , gather -- :: ReadP a -> ReadP (String, a)

    -- * Other operations
  , pfail -- :: ReadP a
  , eof -- :: ReadP ()
  , satisfy -- :: (Char -> Bool) -> ReadP Char
  , char -- :: Char -> ReadP Char
  , string -- :: String -> ReadP String
  , munch -- :: (Char -> Bool) -> ReadP String
  , munch1 -- :: (Char -> Bool) -> ReadP String
  , skipSpaces -- :: ReadP ()
  , skipSpaces1 -- :: ReadP ()
  , choice -- :: [ReadP a] -> ReadP a
  , count -- :: Int -> ReadP a -> ReadP [a]
  , between -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a
  , option -- :: a -> ReadP a -> ReadP a
  , optional -- :: ReadP a -> ReadP ()
  , many -- :: ReadP a -> ReadP [a]
  , many1 -- :: ReadP a -> ReadP [a]
  , skipMany -- :: ReadP a -> ReadP ()
  , skipMany1 -- :: ReadP a -> ReadP ()
  , sepBy -- :: ReadP a -> ReadP sep -> ReadP [a]
  , sepBy1 -- :: ReadP a -> ReadP sep -> ReadP [a]
  , endBy -- :: ReadP a -> ReadP sep -> ReadP [a]
  , endBy1 -- :: ReadP a -> ReadP sep -> ReadP [a]
  , chainr -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
  , chainl -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
  , chainl1 -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
  , chainr1 -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
  , manyTill -- :: ReadP a -> ReadP end -> ReadP [a]

    -- * Running a parser
  , ReadS -- :: *; = String -> [(a,String)]
  , readP_to_S -- :: ReadP a -> ReadS a
  , readS_to_P -- :: ReadS a -> ReadP a
  , readP_to_E

    -- ** Internal
  , Parser
  )
where

import Distribution.Client.Compat.Prelude hiding (get, many)
import Prelude ()

import Control.Monad (replicateM, (>=>))

import qualified Control.Monad.Fail as Fail

import Distribution.ReadE (ReadE (..))

infixr 5 +++, <++

-- ---------------------------------------------------------------------------
-- The P type
-- is representation type -- should be kept abstract

data P s a
  = Get (s -> P s a)
  | Look ([s] -> P s a)
  | Fail
  | Result a (P s a)
  | Final [(a, [s])] -- invariant: list is non-empty!

-- Monad, MonadPlus

instance Functor (P s) where
  fmap :: forall a b. (a -> b) -> P s a -> P s b
fmap = (a -> b) -> P s a -> P s b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (P s) where
  pure :: forall a. a -> P s a
pure a
x = a -> P s a -> P s a
forall s a. a -> P s a -> P s a
Result a
x P s a
forall s a. P s a
Fail
  <*> :: forall a b. P s (a -> b) -> P s a -> P s b
(<*>) = P s (a -> b) -> P s a -> P s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (P s) where
  return :: forall a. a -> P s a
return = a -> P s a
forall a. a -> P s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  (Get s -> P s a
f) >>= :: forall a b. P s a -> (a -> P s b) -> P s b
>>= a -> P s b
k = (s -> P s b) -> P s b
forall s a. (s -> P s a) -> P s a
Get (s -> P s a
f (s -> P s a) -> (a -> P s b) -> s -> P s b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> P s b
k)
  (Look [s] -> P s a
f) >>= a -> P s b
k = ([s] -> P s b) -> P s b
forall s a. ([s] -> P s a) -> P s a
Look ([s] -> P s a
f ([s] -> P s a) -> (a -> P s b) -> [s] -> P s b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> P s b
k)
  P s a
Fail >>= a -> P s b
_ = P s b
forall s a. P s a
Fail
  (Result a
x P s a
p) >>= a -> P s b
k = a -> P s b
k a
x P s b -> P s b -> P s b
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (P s a
p P s a -> (a -> P s b) -> P s b
forall a b. P s a -> (a -> P s b) -> P s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> P s b
k)
  (Final [(a, [s])]
r) >>= a -> P s b
k = [(b, [s])] -> P s b
forall a s. [(a, [s])] -> P s a
final [(b, [s])
ys' | (a
x, [s]
s) <- [(a, [s])]
r, (b, [s])
ys' <- P s b -> [s] -> [(b, [s])]
forall c a. P c a -> [c] -> [(a, [c])]
run (a -> P s b
k a
x) [s]
s]

instance Fail.MonadFail (P s) where
  fail :: forall a. String -> P s a
fail String
_ = P s a
forall s a. P s a
Fail

instance Alternative (P s) where
  empty :: forall a. P s a
empty = P s a
forall a. P s a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a. P s a -> P s a -> P s a
(<|>) = P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance MonadPlus (P s) where
  mzero :: forall a. P s a
mzero = P s a
forall s a. P s a
Fail

  -- most common case: two gets are combined
  Get s -> P s a
f1 mplus :: forall a. P s a -> P s a -> P s a
`mplus` Get s -> P s a
f2 = (s -> P s a) -> P s a
forall s a. (s -> P s a) -> P s a
Get (\s
c -> s -> P s a
f1 s
c P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` s -> P s a
f2 s
c)
  -- results are delivered as soon as possible
  Result a
x P s a
p `mplus` P s a
q = a -> P s a -> P s a
forall s a. a -> P s a -> P s a
Result a
x (P s a
p P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` P s a
q)
  P s a
p `mplus` Result a
x P s a
q = a -> P s a -> P s a
forall s a. a -> P s a -> P s a
Result a
x (P s a
p P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` P s a
q)
  -- fail disappears
  P s a
Fail `mplus` P s a
p = P s a
p
  P s a
p `mplus` P s a
Fail = P s a
p
  -- two finals are combined
  -- final + look becomes one look and one final (=optimization)
  -- final + sthg else becomes one look and one final
  Final [(a, [s])]
r `mplus` Final [(a, [s])]
t = [(a, [s])] -> P s a
forall s a. [(a, [s])] -> P s a
Final ([(a, [s])]
r [(a, [s])] -> [(a, [s])] -> [(a, [s])]
forall a. [a] -> [a] -> [a]
++ [(a, [s])]
t)
  Final [(a, [s])]
r `mplus` Look [s] -> P s a
f = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (\[s]
s -> [(a, [s])] -> P s a
forall s a. [(a, [s])] -> P s a
Final ([(a, [s])]
r [(a, [s])] -> [(a, [s])] -> [(a, [s])]
forall a. [a] -> [a] -> [a]
++ P s a -> [s] -> [(a, [s])]
forall c a. P c a -> [c] -> [(a, [c])]
run ([s] -> P s a
f [s]
s) [s]
s))
  Final [(a, [s])]
r `mplus` P s a
p = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (\[s]
s -> [(a, [s])] -> P s a
forall s a. [(a, [s])] -> P s a
Final ([(a, [s])]
r [(a, [s])] -> [(a, [s])] -> [(a, [s])]
forall a. [a] -> [a] -> [a]
++ P s a -> [s] -> [(a, [s])]
forall c a. P c a -> [c] -> [(a, [c])]
run P s a
p [s]
s))
  Look [s] -> P s a
f `mplus` Final [(a, [s])]
r = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (\[s]
s -> [(a, [s])] -> P s a
forall s a. [(a, [s])] -> P s a
Final (P s a -> [s] -> [(a, [s])]
forall c a. P c a -> [c] -> [(a, [c])]
run ([s] -> P s a
f [s]
s) [s]
s [(a, [s])] -> [(a, [s])] -> [(a, [s])]
forall a. [a] -> [a] -> [a]
++ [(a, [s])]
r))
  P s a
p `mplus` Final [(a, [s])]
r = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (\[s]
s -> [(a, [s])] -> P s a
forall s a. [(a, [s])] -> P s a
Final (P s a -> [s] -> [(a, [s])]
forall c a. P c a -> [c] -> [(a, [c])]
run P s a
p [s]
s [(a, [s])] -> [(a, [s])] -> [(a, [s])]
forall a. [a] -> [a] -> [a]
++ [(a, [s])]
r))
  -- two looks are combined (=optimization)
  -- look + sthg else floats upwards
  Look [s] -> P s a
f `mplus` Look [s] -> P s a
g = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (\[s]
s -> [s] -> P s a
f [s]
s P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [s] -> P s a
g [s]
s)
  Look [s] -> P s a
f `mplus` P s a
p = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (\[s]
s -> [s] -> P s a
f [s]
s P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` P s a
p)
  P s a
p `mplus` Look [s] -> P s a
f = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (\[s]
s -> P s a
p P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [s] -> P s a
f [s]
s)

-- ---------------------------------------------------------------------------
-- The ReadP type

newtype Parser r s a = R ((a -> P s r) -> P s r)
type ReadP r a = Parser r Char a

-- Functor, Monad, MonadPlus

instance Functor (Parser r s) where
  fmap :: forall a b. (a -> b) -> Parser r s a -> Parser r s b
fmap a -> b
h (R (a -> P s r) -> P s r
f) = ((b -> P s r) -> P s r) -> Parser r s b
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (\b -> P s r
k -> (a -> P s r) -> P s r
f (b -> P s r
k (b -> P s r) -> (a -> b) -> a -> P s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
h))

instance Applicative (Parser r s) where
  pure :: forall a. a -> Parser r s a
pure a
x = ((a -> P s r) -> P s r) -> Parser r s a
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (\a -> P s r
k -> a -> P s r
k a
x)
  <*> :: forall a b. Parser r s (a -> b) -> Parser r s a -> Parser r s b
(<*>) = Parser r s (a -> b) -> Parser r s a -> Parser r s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance s ~ Char => Alternative (Parser r s) where
  empty :: forall a. Parser r s a
empty = Parser r s a
ReadP r a
forall r a. ReadP r a
pfail
  <|> :: forall a. Parser r s a -> Parser r s a -> Parser r s a
(<|>) = Parser r s a -> Parser r s a -> Parser r s a
ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
(+++)

instance Monad (Parser r s) where
  return :: forall a. a -> Parser r s a
return = a -> Parser r s a
forall a. a -> Parser r s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  R (a -> P s r) -> P s r
m >>= :: forall a b. Parser r s a -> (a -> Parser r s b) -> Parser r s b
>>= a -> Parser r s b
f = ((b -> P s r) -> P s r) -> Parser r s b
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (\b -> P s r
k -> (a -> P s r) -> P s r
m (\a
a -> let R (b -> P s r) -> P s r
m' = a -> Parser r s b
f a
a in (b -> P s r) -> P s r
m' b -> P s r
k))

instance Fail.MonadFail (Parser r s) where
  fail :: forall a. String -> Parser r s a
fail String
_ = ((a -> P s r) -> P s r) -> Parser r s a
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (P s r -> (a -> P s r) -> P s r
forall a b. a -> b -> a
const P s r
forall s a. P s a
Fail)

instance s ~ Char => MonadPlus (Parser r s) where
  mzero :: forall a. Parser r s a
mzero = Parser r s a
ReadP r a
forall r a. ReadP r a
pfail
  mplus :: forall a. Parser r s a -> Parser r s a -> Parser r s a
mplus = Parser r s a -> Parser r s a -> Parser r s a
ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
(+++)

-- ---------------------------------------------------------------------------
-- Operations over P

final :: [(a, [s])] -> P s a
-- Maintains invariant for Final constructor
final :: forall a s. [(a, [s])] -> P s a
final [] = P s a
forall s a. P s a
Fail
final [(a, [s])]
r = [(a, [s])] -> P s a
forall s a. [(a, [s])] -> P s a
Final [(a, [s])]
r

run :: P c a -> ([c] -> [(a, [c])])
run :: forall c a. P c a -> [c] -> [(a, [c])]
run (Get c -> P c a
f) (c
c : [c]
s) = P c a -> [c] -> [(a, [c])]
forall c a. P c a -> [c] -> [(a, [c])]
run (c -> P c a
f c
c) [c]
s
run (Look [c] -> P c a
f) [c]
s = P c a -> [c] -> [(a, [c])]
forall c a. P c a -> [c] -> [(a, [c])]
run ([c] -> P c a
f [c]
s) [c]
s
run (Result a
x P c a
p) [c]
s = (a
x, [c]
s) (a, [c]) -> [(a, [c])] -> [(a, [c])]
forall a. a -> [a] -> [a]
: P c a -> [c] -> [(a, [c])]
forall c a. P c a -> [c] -> [(a, [c])]
run P c a
p [c]
s
run (Final [(a, [c])]
r) [c]
_ = [(a, [c])]
r
run P c a
_ [c]
_ = []

-- ---------------------------------------------------------------------------
-- Operations over ReadP

get :: ReadP r Char
-- ^ Consumes and returns the next character.
--   Fails if there is no input left.
get :: forall r. ReadP r Char
get = ((Char -> P Char r) -> P Char r) -> Parser r Char Char
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (Char -> P Char r) -> P Char r
forall s a. (s -> P s a) -> P s a
Get

look :: ReadP r String
-- ^ Look-ahead: returns the part of the input that is left, without
--   consuming it.
look :: forall r. ReadP r String
look = ((String -> P Char r) -> P Char r) -> Parser r Char String
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (String -> P Char r) -> P Char r
forall s a. ([s] -> P s a) -> P s a
Look

pfail :: ReadP r a
-- ^ Always fails.
pfail :: forall r a. ReadP r a
pfail = ((a -> P Char r) -> P Char r) -> Parser r Char a
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (P Char r -> (a -> P Char r) -> P Char r
forall a b. a -> b -> a
const P Char r
forall s a. P s a
Fail)

eof :: ReadP r ()
-- ^ Succeeds iff we are at the end of input
eof :: forall r. ReadP r ()
eof = do
  String
s <- ReadP r String
forall r. ReadP r String
look
  if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
    then () -> ReadP r ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else ReadP r ()
forall r a. ReadP r a
pfail

(+++) :: ReadP r a -> ReadP r a -> ReadP r a
-- ^ Symmetric choice.
R (a -> P Char r) -> P Char r
f1 +++ :: forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ R (a -> P Char r) -> P Char r
f2 = ((a -> P Char r) -> P Char r) -> Parser r Char a
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (\a -> P Char r
k -> (a -> P Char r) -> P Char r
f1 a -> P Char r
k P Char r -> P Char r -> P Char r
forall a. P Char a -> P Char a -> P Char a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (a -> P Char r) -> P Char r
f2 a -> P Char r
k)

(<++) :: ReadP a a -> ReadP r a -> ReadP r a
-- ^ Local, exclusive, left-biased choice: If left parser
--   locally produces any result at all, then right parser is
--   not used.
R (a -> P Char a) -> P Char a
f <++ :: forall a r. ReadP a a -> ReadP r a -> ReadP r a
<++ ReadP r a
q =
  do
    String
s <- ReadP r String
forall r. ReadP r String
look
    P Char a -> String -> Int -> ReadP r a
probe ((a -> P Char a) -> P Char a
f a -> P Char a
forall a. a -> P Char a
forall (m :: * -> *) a. Monad m => a -> m a
return) String
s Int
0
  where
    probe :: P Char a -> String -> Int -> ReadP r a
probe (Get Char -> P Char a
f') (Char
c : String
s) Int
n = P Char a -> String -> Int -> ReadP r a
probe (Char -> P Char a
f' Char
c) String
s (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 :: Int)
    probe (Look String -> P Char a
f') String
s Int
n = P Char a -> String -> Int -> ReadP r a
probe (String -> P Char a
f' String
s) String
s Int
n
    probe p :: P Char a
p@(Result a
_ P Char a
_) String
_ Int
n = Int -> Parser r Char ()
forall {r}. Int -> Parser r Char ()
discard Int
n Parser r Char () -> ReadP r a -> ReadP r a
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((a -> P Char r) -> P Char r) -> ReadP r a
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (P Char a
p P Char a -> (a -> P Char r) -> P Char r
forall a b. P Char a -> (a -> P Char b) -> P Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
    probe (Final [(a, String)]
r) String
_ Int
_ = ((a -> P Char r) -> P Char r) -> ReadP r a
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R ([(a, String)] -> P Char a
forall s a. [(a, [s])] -> P s a
Final [(a, String)]
r P Char a -> (a -> P Char r) -> P Char r
forall a b. P Char a -> (a -> P Char b) -> P Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
    probe P Char a
_ String
_ Int
_ = ReadP r a
q

    discard :: Int -> Parser r Char ()
discard Int
0 = () -> Parser r Char ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    discard Int
n = ReadP r Char
forall r. ReadP r Char
get ReadP r Char -> Parser r Char () -> Parser r Char ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser r Char ()
discard (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 :: Int)

gather :: ReadP (String -> P Char r) a -> ReadP r (String, a)
-- ^ Transforms a parser into one that does the same, but
--   in addition returns the exact characters read.
--   IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
--   is built using any occurrences of readS_to_P.
gather :: forall r a. ReadP (String -> P Char r) a -> ReadP r (String, a)
gather (R (a -> P Char (String -> P Char r)) -> P Char (String -> P Char r)
m) =
  (((String, a) -> P Char r) -> P Char r)
-> Parser r Char (String, a)
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (\(String, a) -> P Char r
k -> (String -> String) -> P Char (String -> P Char r) -> P Char r
forall {s} {t} {a}. ([s] -> t) -> P s (t -> P s a) -> P s a
gath String -> String
forall a. a -> a
id ((a -> P Char (String -> P Char r)) -> P Char (String -> P Char r)
m (\a
a -> (String -> P Char r) -> P Char (String -> P Char r)
forall a. a -> P Char a
forall (m :: * -> *) a. Monad m => a -> m a
return (\String
s -> (String, a) -> P Char r
k (String
s, a
a)))))
  where
    gath :: ([s] -> t) -> P s (t -> P s a) -> P s a
gath [s] -> t
l (Get s -> P s (t -> P s a)
f) = (s -> P s a) -> P s a
forall s a. (s -> P s a) -> P s a
Get (\s
c -> ([s] -> t) -> P s (t -> P s a) -> P s a
gath ([s] -> t
l ([s] -> t) -> ([s] -> [s]) -> [s] -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
c s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)) (s -> P s (t -> P s a)
f s
c))
    gath [s] -> t
_ P s (t -> P s a)
Fail = P s a
forall s a. P s a
Fail
    gath [s] -> t
l (Look [s] -> P s (t -> P s a)
f) = ([s] -> P s a) -> P s a
forall s a. ([s] -> P s a) -> P s a
Look (([s] -> t) -> P s (t -> P s a) -> P s a
gath [s] -> t
l (P s (t -> P s a) -> P s a)
-> ([s] -> P s (t -> P s a)) -> [s] -> P s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [s] -> P s (t -> P s a)
f)
    gath [s] -> t
l (Result t -> P s a
k P s (t -> P s a)
p) = t -> P s a
k ([s] -> t
l []) P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ([s] -> t) -> P s (t -> P s a) -> P s a
gath [s] -> t
l P s (t -> P s a)
p
    gath [s] -> t
_ (Final [(t -> P s a, [s])]
_) = String -> P s a
forall a. HasCallStack => String -> a
error String
"do not use readS_to_P in gather!"

-- ---------------------------------------------------------------------------
-- Derived operations

satisfy :: (Char -> Bool) -> ReadP r Char
-- ^ Consumes and returns the next character, if it satisfies the
--   specified predicate.
satisfy :: forall r. (Char -> Bool) -> ReadP r Char
satisfy Char -> Bool
p = do Char
c <- ReadP r Char
forall r. ReadP r Char
get; if Char -> Bool
p Char
c then Char -> ReadP r Char
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c else ReadP r Char
forall r a. ReadP r a
pfail

char :: Char -> ReadP r Char
-- ^ Parses and returns the specified character.
char :: forall r. Char -> ReadP r Char
char Char
c = (Char -> Bool) -> ReadP r Char
forall r. (Char -> Bool) -> ReadP r Char
satisfy (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)

string :: String -> ReadP r String
-- ^ Parses and returns the specified string.
string :: forall r. String -> ReadP r String
string String
this = do String
s <- ReadP r String
forall r. ReadP r String
look; String -> String -> ReadP r String
scan String
this String
s
  where
    scan :: String -> String -> ReadP r String
scan [] String
_ = String -> ReadP r String
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return String
this
    scan (Char
x : String
xs) (Char
y : String
ys) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y = ReadP r Char
forall r. ReadP r Char
get ReadP r Char -> ReadP r String -> ReadP r String
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> ReadP r String
scan String
xs String
ys
    scan String
_ String
_ = ReadP r String
forall r a. ReadP r a
pfail

munch :: (Char -> Bool) -> ReadP r String
-- ^ Parses the first zero or more characters satisfying the predicate.
munch :: forall r. (Char -> Bool) -> ReadP r String
munch Char -> Bool
p =
  do
    String
s <- ReadP r String
forall r. ReadP r String
look
    String -> ReadP r String
scan String
s
  where
    scan :: String -> ReadP r String
scan (Char
c : String
cs) | Char -> Bool
p Char
c = do Char
_ <- ReadP r Char
forall r. ReadP r Char
get; String
s <- String -> ReadP r String
scan String
cs; String -> ReadP r String
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
s)
    scan String
_ = do String -> ReadP r String
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""

munch1 :: (Char -> Bool) -> ReadP r String
-- ^ Parses the first one or more characters satisfying the predicate.
munch1 :: forall r. (Char -> Bool) -> ReadP r String
munch1 Char -> Bool
p =
  do
    Char
c <- ReadP r Char
forall r. ReadP r Char
get
    if Char -> Bool
p Char
c
      then do String
s <- (Char -> Bool) -> ReadP r String
forall r. (Char -> Bool) -> ReadP r String
munch Char -> Bool
p; String -> ReadP r String
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
s)
      else ReadP r String
forall r a. ReadP r a
pfail

choice :: [ReadP r a] -> ReadP r a
-- ^ Combines all parsers in the specified list.
choice :: forall r a. [ReadP r a] -> ReadP r a
choice [] = ReadP r a
forall r a. ReadP r a
pfail
choice [ReadP r a
p] = ReadP r a
p
choice (ReadP r a
p : [ReadP r a]
ps) = ReadP r a
p ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ [ReadP r a] -> ReadP r a
forall r a. [ReadP r a] -> ReadP r a
choice [ReadP r a]
ps

skipSpaces :: ReadP r ()
-- ^ Skips all whitespace.
skipSpaces :: forall r. ReadP r ()
skipSpaces =
  do
    String
s <- ReadP r String
forall r. ReadP r String
look
    String -> ReadP r ()
forall {r}. String -> Parser r Char ()
skip String
s
  where
    skip :: String -> Parser r Char ()
skip (Char
c : String
s) | Char -> Bool
isSpace Char
c = do Char
_ <- ReadP r Char
forall r. ReadP r Char
get; String -> Parser r Char ()
skip String
s
    skip String
_ = do () -> Parser r Char ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

skipSpaces1 :: ReadP r ()
-- ^ Like 'skipSpaces' but succeeds only if there is at least one
-- whitespace character to skip.
skipSpaces1 :: forall r. ReadP r ()
skipSpaces1 = (Char -> Bool) -> ReadP r Char
forall r. (Char -> Bool) -> ReadP r Char
satisfy Char -> Bool
isSpace ReadP r Char -> Parser r Char () -> Parser r Char ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser r Char ()
forall r. ReadP r ()
skipSpaces

count :: Int -> ReadP r a -> ReadP r [a]
-- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of
--   results is returned.
count :: forall r a. Int -> ReadP r a -> ReadP r [a]
count Int
n ReadP r a
p = Int -> ReadP r a -> Parser r Char [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n ReadP r a
p

between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a
-- ^ @ between open close p @ parses @open@, followed by @p@ and finally
--   @close@. Only the value of @p@ is returned.
between :: forall r open close a.
ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a
between ReadP r open
open ReadP r close
close ReadP r a
p = do
  open
_ <- ReadP r open
open
  a
x <- ReadP r a
p
  close
_ <- ReadP r close
close
  a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

option :: a -> ReadP r a -> ReadP r a
-- ^ @option x p@ will either parse @p@ or return @x@ without consuming
--   any input.
option :: forall a r. a -> ReadP r a -> ReadP r a
option a
x ReadP r a
p = ReadP r a
p ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

optional :: ReadP r a -> ReadP r ()
-- ^ @optional p@ optionally parses @p@ and always returns @()@.
optional :: forall r a. ReadP r a -> ReadP r ()
optional ReadP r a
p = (ReadP r a
p ReadP r a -> Parser r Char () -> Parser r Char ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser r Char ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Parser r Char () -> Parser r Char () -> Parser r Char ()
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ () -> Parser r Char ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

many :: ReadP r a -> ReadP r [a]
-- ^ Parses zero or more occurrences of the given parser.
many :: forall r a. ReadP r a -> ReadP r [a]
many ReadP r a
p = [a] -> Parser r Char [a]
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return [] Parser r Char [a] -> Parser r Char [a] -> Parser r Char [a]
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ ReadP r a -> Parser r Char [a]
forall r a. ReadP r a -> ReadP r [a]
many1 ReadP r a
p

many1 :: ReadP r a -> ReadP r [a]
-- ^ Parses one or more occurrences of the given parser.
many1 :: forall r a. ReadP r a -> ReadP r [a]
many1 ReadP r a
p = (a -> [a] -> [a])
-> ReadP r a -> Parser r Char [a] -> Parser r Char [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ReadP r a
p (ReadP r a -> Parser r Char [a]
forall r a. ReadP r a -> ReadP r [a]
many ReadP r a
p)

skipMany :: ReadP r a -> ReadP r ()
-- ^ Like 'many', but discards the result.
skipMany :: forall r a. ReadP r a -> ReadP r ()
skipMany ReadP r a
p = ReadP r a -> ReadP r [a]
forall r a. ReadP r a -> ReadP r [a]
many ReadP r a
p ReadP r [a] -> Parser r Char () -> Parser r Char ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser r Char ()
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

skipMany1 :: ReadP r a -> ReadP r ()
-- ^ Like 'many1', but discards the result.
skipMany1 :: forall r a. ReadP r a -> ReadP r ()
skipMany1 ReadP r a
p = ReadP r a
p ReadP r a -> Parser r Char () -> Parser r Char ()
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r a -> Parser r Char ()
forall r a. ReadP r a -> ReadP r ()
skipMany ReadP r a
p

sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
--   Returns a list of values returned by @p@.
sepBy :: forall r a sep. ReadP r a -> ReadP r sep -> ReadP r [a]
sepBy ReadP r a
p ReadP r sep
sep = ReadP r a -> ReadP r sep -> ReadP r [a]
forall r a sep. ReadP r a -> ReadP r sep -> ReadP r [a]
sepBy1 ReadP r a
p ReadP r sep
sep ReadP r [a] -> ReadP r [a] -> ReadP r [a]
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ [a] -> ReadP r [a]
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return []

sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
--   Returns a list of values returned by @p@.
sepBy1 :: forall r a sep. ReadP r a -> ReadP r sep -> ReadP r [a]
sepBy1 ReadP r a
p ReadP r sep
sep = (a -> [a] -> [a])
-> ReadP r a -> Parser r Char [a] -> Parser r Char [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ReadP r a
p (ReadP r a -> Parser r Char [a]
forall r a. ReadP r a -> ReadP r [a]
many (ReadP r sep
sep ReadP r sep -> ReadP r a -> ReadP r a
forall a b. Parser r Char a -> Parser r Char b -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r a
p))

endBy :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
--   by @sep@.
endBy :: forall r a sep. ReadP r a -> ReadP r sep -> ReadP r [a]
endBy ReadP r a
p ReadP r sep
sep = ReadP r a -> ReadP r [a]
forall r a. ReadP r a -> ReadP r [a]
many (do a
x <- ReadP r a
p; sep
_ <- ReadP r sep
sep; a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)

endBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
--   by @sep@.
endBy1 :: forall r a sep. ReadP r a -> ReadP r sep -> ReadP r [a]
endBy1 ReadP r a
p ReadP r sep
sep = ReadP r a -> ReadP r [a]
forall r a. ReadP r a -> ReadP r [a]
many1 (do a
x <- ReadP r a
p; sep
_ <- ReadP r sep
sep; a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)

chainr :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
--   Returns a value produced by a /right/ associative application of all
--   functions returned by @op@. If there are no occurrences of @p@, @x@ is
--   returned.
chainr :: forall r a. ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
chainr ReadP r a
p ReadP r (a -> a -> a)
op a
x = ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
forall r a. ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
chainr1 ReadP r a
p ReadP r (a -> a -> a)
op ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

chainl :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
-- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
--   Returns a value produced by a /left/ associative application of all
--   functions returned by @op@. If there are no occurrences of @p@, @x@ is
--   returned.
chainl :: forall r a. ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
chainl ReadP r a
p ReadP r (a -> a -> a)
op a
x = ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
forall r a. ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
chainl1 ReadP r a
p ReadP r (a -> a -> a)
op ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

chainr1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
-- ^ Like 'chainr', but parses one or more occurrences of @p@.
chainr1 :: forall r a. ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
chainr1 ReadP r a
p ReadP r (a -> a -> a)
op = ReadP r a
scan
  where
    scan :: ReadP r a
scan = ReadP r a
p ReadP r a -> (a -> ReadP r a) -> ReadP r a
forall a b.
Parser r Char a -> (a -> Parser r Char b) -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ReadP r a
rest
    rest :: a -> ReadP r a
rest a
x =
      do
        a -> a -> a
f <- ReadP r (a -> a -> a)
op
        a
y <- ReadP r a
scan
        a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
f a
x a
y)
        ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

chainl1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
-- ^ Like 'chainl', but parses one or more occurrences of @p@.
chainl1 :: forall r a. ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
chainl1 ReadP r a
p ReadP r (a -> a -> a)
op = ReadP r a
p ReadP r a -> (a -> ReadP r a) -> ReadP r a
forall a b.
Parser r Char a -> (a -> Parser r Char b) -> Parser r Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ReadP r a
rest
  where
    rest :: a -> ReadP r a
rest a
x =
      do
        a -> a -> a
f <- ReadP r (a -> a -> a)
op
        a
y <- ReadP r a
p
        a -> ReadP r a
rest (a -> a -> a
f a
x a
y)
        ReadP r a -> ReadP r a -> ReadP r a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ a -> ReadP r a
forall a. a -> Parser r Char a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

manyTill :: ReadP r a -> ReadP [a] end -> ReadP r [a]
-- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
--   succeeds. Returns a list of values returned by @p@.
manyTill :: forall r a end. ReadP r a -> ReadP [a] end -> ReadP r [a]
manyTill ReadP r a
p ReadP [a] end
end = ReadP r [a]
scan
  where
    scan :: ReadP r [a]
scan = (ReadP [a] end
end ReadP [a] end -> Parser [a] Char [a] -> Parser [a] Char [a]
forall a b.
Parser [a] Char a -> Parser [a] Char b -> Parser [a] Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Parser [a] Char [a]
forall a. a -> Parser [a] Char a
forall (m :: * -> *) a. Monad m => a -> m a
return []) Parser [a] Char [a] -> ReadP r [a] -> ReadP r [a]
forall a r. ReadP a a -> ReadP r a -> ReadP r a
<++ ((a -> [a] -> [a]) -> ReadP r a -> ReadP r [a] -> ReadP r [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ReadP r a
p ReadP r [a]
scan)

-- ---------------------------------------------------------------------------
-- Converting between ReadP and Read

readP_to_S :: ReadP a a -> ReadS a
-- ^ Converts a parser into a Haskell ReadS-style function.
--   This is the main way in which you can \"run\" a 'ReadP' parser:
--   the expanded type is
-- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
readP_to_S :: forall a. ReadP a a -> ReadS a
readP_to_S (R (a -> P Char a) -> P Char a
f) = P Char a -> String -> [(a, String)]
forall c a. P c a -> [c] -> [(a, [c])]
run ((a -> P Char a) -> P Char a
f a -> P Char a
forall a. a -> P Char a
forall (m :: * -> *) a. Monad m => a -> m a
return)

readS_to_P :: ReadS a -> ReadP r a
-- ^ Converts a Haskell ReadS-style function into a parser.
--   Warning: This introduces local backtracking in the resulting
--   parser, and therefore a possible inefficiency.
readS_to_P :: forall a r. ReadS a -> ReadP r a
readS_to_P ReadS a
r =
  ((a -> P Char r) -> P Char r) -> Parser r Char a
forall r s a. ((a -> P s r) -> P s r) -> Parser r s a
R (\a -> P Char r
k -> (String -> P Char r) -> P Char r
forall s a. ([s] -> P s a) -> P s a
Look (\String
s -> [(r, String)] -> P Char r
forall a s. [(a, [s])] -> P s a
final [(r, String)
bs'' | (a
a, String
s') <- ReadS a
r String
s, (r, String)
bs'' <- P Char r -> String -> [(r, String)]
forall c a. P c a -> [c] -> [(a, [c])]
run (a -> P Char r
k a
a) String
s']))

-------------------------------------------------------------------------------
-- ReadE
-------------------------------------------------------------------------------

readP_to_E :: (String -> String) -> ReadP a a -> ReadE a
readP_to_E :: forall a. (String -> String) -> ReadP a a -> ReadE a
readP_to_E String -> String
err ReadP a a
r =
  (String -> Either String a) -> ReadE a
forall a. (String -> Either String a) -> ReadE a
ReadE ((String -> Either String a) -> ReadE a)
-> (String -> Either String a) -> ReadE a
forall a b. (a -> b) -> a -> b
$ \String
txt -> case [ a
p | (a
p, String
s) <- ReadP a a -> ReadS a
forall a. ReadP a a -> ReadS a
readP_to_S ReadP a a
r String
txt, (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s
                       ] of
    [] -> String -> Either String a
forall a b. a -> Either a b
Left (String -> String
err String
txt)
    (a
p : [a]
_) -> a -> Either String a
forall a b. b -> Either a b
Right a
p