content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  Distribution.Compat.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.Compat.ReadP, by
  -- Mark Lentczner <mailto:mark@glyphic.com>
  -----------------------------------------------------------------------------
  
  module Distribution.Compat.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
    )
   where
  
  import Prelude ()
  import Distribution.Compat.Prelude hiding (many, get)
  
  import qualified Distribution.Compat.MonadFail as Fail
  
  import Control.Monad( replicateM, (>=>) )
  
  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 = liftM
  
  instance Applicative (P s) where
    pure x = Result x Fail
    (<*>) = ap
  
  instance Monad (P s) where
    return = pure
  
    (Get f)      >>= k = Get (f >=> k)
    (Look f)     >>= k = Look (f >=> k)
    Fail         >>= _ = Fail
    (Result x p) >>= k = k x `mplus` (p >>= k)
    (Final r)    >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
  
    fail = Fail.fail
  
  instance Fail.MonadFail (P s) where
    fail _ = Fail
  
  instance Alternative (P s) where
        empty = mzero
        (<|>) = mplus
  
  instance MonadPlus (P s) where
    mzero = Fail
  
    -- most common case: two gets are combined
    Get f1     `mplus` Get f2     = Get (\c -> f1 c `mplus` f2 c)
  
    -- results are delivered as soon as possible
    Result x p `mplus` q          = Result x (p `mplus` q)
    p          `mplus` Result x q = Result x (p `mplus` q)
  
    -- fail disappears
    Fail       `mplus` p          = p
    p          `mplus` Fail       = p
  
    -- two finals are combined
    -- final + look becomes one look and one final (=optimization)
    -- final + sthg else becomes one look and one final
    Final r    `mplus` Final t    = Final (r ++ t)
    Final r    `mplus` Look f     = Look (\s -> Final (r ++ run (f s) s))
    Final r    `mplus` p          = Look (\s -> Final (r ++ run p s))
    Look f     `mplus` Final r    = Look (\s -> Final (run (f s) s ++ r))
    p          `mplus` Final r    = Look (\s -> Final (run p s ++ r))
  
    -- two looks are combined (=optimization)
    -- look + sthg else floats upwards
    Look f     `mplus` Look g     = Look (\s -> f s `mplus` g s)
    Look f     `mplus` p          = Look (\s -> f s `mplus` p)
    p          `mplus` Look f     = Look (\s -> p `mplus` f 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 h (R f) = R (\k -> f (k . h))
  
  instance Applicative (Parser r s) where
    pure x  = R (\k -> k x)
    (<*>) = ap
  
  instance Monad (Parser r s) where
    return = pure
    fail = Fail.fail
    R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
  
  instance Fail.MonadFail (Parser r s) where
    fail _    = R (const Fail)
  
  --instance MonadPlus (Parser r s) where
  --  mzero = pfail
  --  mplus = (+++)
  
  -- ---------------------------------------------------------------------------
  -- Operations over P
  
  final :: [(a,[s])] -> P s a
  -- Maintains invariant for Final constructor
  final [] = Fail
  final r  = Final r
  
  run :: P c a -> ([c] -> [(a, [c])])
  run (Get f)      (c:s) = run (f c) s
  run (Look f)     s     = run (f s) s
  run (Result x p) s     = (x,s) : run p s
  run (Final r)    _     = r
  run _            _     = []
  
  -- ---------------------------------------------------------------------------
  -- Operations over ReadP
  
  get :: ReadP r Char
  -- ^ Consumes and returns the next character.
  --   Fails if there is no input left.
  get = R Get
  
  look :: ReadP r String
  -- ^ Look-ahead: returns the part of the input that is left, without
  --   consuming it.
  look = R Look
  
  pfail :: ReadP r a
  -- ^ Always fails.
  pfail = R (const Fail)
  
  eof :: ReadP r ()
  -- ^ Succeeds iff we are at the end of input
  eof = do { s <- look
           ; if null s then return ()
                       else pfail }
  
  (+++) :: ReadP r a -> ReadP r a -> ReadP r a
  -- ^ Symmetric choice.
  R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 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 f <++ q =
    do s <- look
       probe (f return) s 0
   where
    probe (Get f')       (c:s) n = probe (f' c) s (n+1 :: Int)
    probe (Look f')      s     n = probe (f' s) s n
    probe p@(Result _ _) _     n = discard n >> R (p >>=)
    probe (Final r)      _     _ = R (Final r >>=)
    probe _              _     _ = q
  
    discard 0 = return ()
    discard n  = get >> discard (n-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 (R m) =
    R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
   where
    gath l (Get f)      = Get (\c -> gath (l.(c:)) (f c))
    gath _ Fail         = Fail
    gath l (Look f)     = Look (gath l . f)
    gath l (Result k p) = k (l []) `mplus` gath l p
    gath _ (Final _)    = error "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 p = do c <- get; if p c then return c else pfail
  
  char :: Char -> ReadP r Char
  -- ^ Parses and returns the specified character.
  char c = satisfy (c ==)
  
  string :: String -> ReadP r String
  -- ^ Parses and returns the specified string.
  string this = do s <- look; scan this s
   where
    scan []     _               = return this
    scan (x:xs) (y:ys) | x == y = get >> scan xs ys
    scan _      _               = pfail
  
  munch :: (Char -> Bool) -> ReadP r String
  -- ^ Parses the first zero or more characters satisfying the predicate.
  munch p =
    do s <- look
       scan s
   where
    scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
    scan _            = do return ""
  
  munch1 :: (Char -> Bool) -> ReadP r String
  -- ^ Parses the first one or more characters satisfying the predicate.
  munch1 p =
    do c <- get
       if p c then do s <- munch p; return (c:s)
              else pfail
  
  choice :: [ReadP r a] -> ReadP r a
  -- ^ Combines all parsers in the specified list.
  choice []     = pfail
  choice [p]    = p
  choice (p:ps) = p +++ choice ps
  
  skipSpaces :: ReadP r ()
  -- ^ Skips all whitespace.
  skipSpaces =
    do s <- look
       skip s
   where
    skip (c:s) | isSpace c = do _ <- get; skip s
    skip _                 = do return ()
  
  skipSpaces1 :: ReadP r ()
  -- ^ Like 'skipSpaces' but succeeds only if there is at least one
  -- whitespace character to skip.
  skipSpaces1 = satisfy isSpace >> 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 n p = replicateM n 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 open close p = do _ <- open
                            x <- p
                            _ <- close
                            return x
  
  option :: a -> ReadP r a -> ReadP r a
  -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
  --   any input.
  option x p = p +++ return x
  
  optional :: ReadP r a -> ReadP r ()
  -- ^ @optional p@ optionally parses @p@ and always returns @()@.
  optional p = (p >> return ()) +++ return ()
  
  many :: ReadP r a -> ReadP r [a]
  -- ^ Parses zero or more occurrences of the given parser.
  many p = return [] +++ many1 p
  
  many1 :: ReadP r a -> ReadP r [a]
  -- ^ Parses one or more occurrences of the given parser.
  many1 p = liftM2 (:) p (many p)
  
  skipMany :: ReadP r a -> ReadP r ()
  -- ^ Like 'many', but discards the result.
  skipMany p = many p >> return ()
  
  skipMany1 :: ReadP r a -> ReadP r ()
  -- ^ Like 'many1', but discards the result.
  skipMany1 p = p >> skipMany 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 p sep = sepBy1 p sep +++ 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 p sep = liftM2 (:) p (many (sep >> 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 p sep = many (do x <- p ; _ <- sep ; return 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 p sep = many1 (do x <- p ; _ <- sep ; return 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 p op x = chainr1 p op +++ return 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 p op x = chainl1 p op +++ return x
  
  chainr1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
  -- ^ Like 'chainr', but parses one or more occurrences of @p@.
  chainr1 p op = scan
    where scan   = p >>= rest
          rest x = do f <- op
                      y <- scan
                      return (f x y)
                   +++ return x
  
  chainl1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
  -- ^ Like 'chainl', but parses one or more occurrences of @p@.
  chainl1 p op = p >>= rest
    where rest x = do f <- op
                      y <- p
                      rest (f x y)
                   +++ return 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 p end = scan
    where scan = (end >> return []) <++ (liftM2 (:) p 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 (R f) = run (f 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 r =
    R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
  