{-# LANGUAGE CPP #-}
{-# 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 Prelude ()
import Distribution.Client.Compat.Prelude hiding (many, get)

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 :: (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 :: 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
  <*> :: 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 :: a -> P s a
return = a -> P s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  (Get s -> P s a
f)      >>= :: 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 (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 (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]

#if !(MIN_VERSION_base(4,9,0))
  fail _ = Fail
#elif !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail
#endif

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

instance Alternative (P s) where
      empty :: P s a
empty = P s a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      <|> :: P s a -> P s a -> P s 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 :: 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 :: 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 (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 (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 (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 (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 (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 (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 :: (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 :: 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)
  <*> :: 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 :: Parser r s a
empty = Parser r s a
forall r a. ReadP r a
pfail
  <|> :: Parser r s a -> Parser r s a -> Parser r s a
(<|>) = Parser r s a -> Parser r s a -> Parser r s a
forall r a. ReadP r a -> ReadP r a -> ReadP r a
(+++)

instance Monad (Parser r s) where
  return :: a -> Parser r s a
return = a -> Parser r s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  R (a -> P s r) -> P s r
m >>= :: 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))

#if !(MIN_VERSION_base(4,9,0))
  fail _ = R (const Fail)
#elif !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail
#endif

instance Fail.MonadFail (Parser r s) where
  fail :: 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 :: Parser r s a
mzero = Parser r s a
forall r a. ReadP r a
pfail
  mplus :: 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
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 :: [(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 :: 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 :: ReadP r Char
get = ((Char -> P Char r) -> P Char r) -> ReadP r 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 :: ReadP r String
look = ((String -> P Char r) -> P Char r) -> ReadP r 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 :: ReadP r a
pfail = ((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 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 :: ReadP r ()
eof = do { String
s <- ReadP r String
forall r. ReadP r String
look
         ; if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then () -> ReadP r ()
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 +++ :: 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) -> ReadP r 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 (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 <++ :: 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 (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
nInt -> 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 (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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser r Char ()
discard (Int
nInt -> 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 :: 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) -> ReadP r (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 (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
cs -> [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 (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 :: (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 (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 :: 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 :: 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 (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 (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 :: (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 (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
s)
  scan String
_            = do String -> ReadP r String
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 :: (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 (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> 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 :: [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 :: 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 (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 :: ReadP r ()
skipSpaces1 = (Char -> Bool) -> ReadP r Char
forall r. (Char -> Bool) -> ReadP r Char
satisfy Char -> Bool
isSpace ReadP r Char -> ReadP r () -> ReadP r ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r ()
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 :: Int -> ReadP r a -> ReadP r [a]
count Int
n ReadP r a
p = Int -> ReadP r a -> ReadP r [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 :: 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 (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 :: 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 (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 :: ReadP r a -> ReadP r ()
optional ReadP r a
p = (ReadP r a
p ReadP r a -> ReadP r () -> ReadP r ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ReadP r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ReadP r () -> ReadP r () -> ReadP r ()
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ () -> ReadP r ()
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 :: ReadP r a -> ReadP r [a]
many ReadP r a
p = [a] -> ReadP r [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [] 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]
many1 ReadP r a
p

many1 :: ReadP r a -> ReadP r [a]
-- ^ Parses one or more occurrences of the given parser.
many1 :: ReadP r a -> ReadP r [a]
many1 ReadP r a
p = (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 -> ReadP r [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 :: 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] -> ReadP r () -> ReadP r ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ReadP r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

skipMany1 :: ReadP r a -> ReadP r ()
-- ^ Like 'many1', but discards the result.
skipMany1 :: ReadP r a -> ReadP r ()
skipMany1 ReadP r a
p = ReadP r a
p ReadP r a -> ReadP r () -> ReadP r ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r a -> ReadP r ()
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 :: 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 (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 :: ReadP r a -> ReadP r sep -> ReadP r [a]
sepBy1 ReadP r a
p ReadP r sep
sep = (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 -> ReadP r [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 (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 :: 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 (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 :: 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 (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 :: 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 (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 :: 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 (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 :: 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 (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 (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 (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 :: 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 (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 (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 :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [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 :: ReadP a a -> ReadS a
readP_to_S (R (a -> P Char a) -> P Char a
f) = P Char a -> ReadS a
forall c a. P c a -> [c] -> [(a, [c])]
run ((a -> P Char a) -> P Char a
f 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 :: ReadS a -> ReadP r a
readS_to_P ReadS a
r =
  ((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 -> 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 :: (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