ref: 2e57a841206dffa9015c16471490e036e9a53551
parent: 30bbf972cec6f7ed080b42d6ccead04e110f8b98
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Fri Feb 2 17:23:52 EST 2024
Start of Read.
--- /dev/null
+++ b/lib/Text/ParserCombinators/ReadP.hs
@@ -1,0 +1,428 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Text.ParserCombinators.ReadP
+-- Copyright : (c) The University of Glasgow 2002
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : provisional
+-- Portability : non-portable (local universal quantification)
+--
+-- 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\".
+
+-----------------------------------------------------------------------------
+
+module Text.ParserCombinators.ReadP
+ (
+ -- * The 'ReadP' type
+ ReadP,
+
+ -- * Primitive operations
+ get,
+ look,
+ (+++),
+ (<++),
+ gather,
+
+ -- * Other operations
+ pfail,
+ eof,
+ satisfy,
+ char,
+ string,
+ munch,
+ munch1,
+ skipSpaces,
+ choice,
+ count,
+ between,
+ option,
+ optional,
+ many,
+ many1,
+ skipMany,
+ skipMany1,
+ sepBy,
+ sepBy1,
+ endBy,
+ endBy1,
+ chainr,
+ chainl,
+ chainl1,
+ chainr1,
+ manyTill,
+
+ -- * Running a parser
+ ReadS,
+ readP_to_S,
+ readS_to_P,
+
+ -- * Properties
+ -- $properties
+ )
+ where
+
+import Control.Applicative
+import Control.Alternative
+import Control.Error
+import Control.Monad
+import Data.Bool
+import Data.Char
+import Data.Eq
+import Data.Function
+import Data.Int
+import Data.List
+import Data.Num
+import Data.Tuple
+
+infixr 5 +++, <++
+
+------------------------------------------------------------------------
+-- ReadS
+
+-- | A parser for a type @a@, represented as a function that takes a
+-- 'String' and returns a list of possible parses as @(a,'String')@ pairs.
+--
+-- Note that this kind of backtracking parser is very inefficient;
+-- reading a large structure may be quite slow (cf 'ReadP').
+type ReadS a = String -> [(a,String)]
+
+-- ---------------------------------------------------------------------------
+-- The P type
+-- is representation type -- should be kept abstract
+
+data P a
+ = Get (Char -> P a)
+ | Look (String -> P a)
+ | Fail
+ | Result a (P a)
+ | Final [(a,String)]
+-- deriving Functor -- ^ @since 4.8.0.0
+instance Functor P where
+ fmap f (Get p) = Get (\ c -> fmap f (p c))
+
+-- Monad, MonadPlus
+
+-- | @since 4.5.0.0
+instance Applicative P where
+ pure x = Result x Fail
+ (<*>) = ap
+
+-- | @since 2.01
+instance MonadPlus P
+
+-- | @since 2.01
+instance Monad P where
+ (Get f) >>= k = Get (\c -> f c >>= k)
+ (Look f) >>= k = Look (\s -> f s >>= k)
+ Fail >>= _ = Fail
+ (Result x p) >>= k = k x <|> (p >>= k)
+ (Final (r:rs)) >>= k = final [ys' | (x,s) <- (r:rs), ys' <- run (k x) s]
+
+-- | @since 4.9.0.0
+instance MonadFail P where
+ fail _ = Fail
+
+-- | @since 4.5.0.0
+instance Alternative P where
+ empty = Fail
+
+ -- most common case: two gets are combined
+ Get f1 <|> Get f2 = Get (\c -> f1 c <|> f2 c)
+
+ -- results are delivered as soon as possible
+ Result x p <|> q = Result x (p <|> q)
+ p <|> Result x q = Result x (p <|> q)
+
+ -- fail disappears
+ Fail <|> p = p
+ p <|> 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 <|> Final t = Final (r ++ t)
+ Final (r:rs) <|> Look f = Look (\s -> Final (r:(rs ++ run (f s) s)))
+ Final (r:rs) <|> p = Look (\s -> Final (r:(rs ++ run p s)))
+ Look f <|> Final r = Look (\s -> Final (run (f s) s ++ r))
+ p <|> Final r = Look (\s -> Final (run p s ++ r))
+
+ -- two looks are combined (=optimization)
+ -- look + sthg else floats upwards
+ Look f <|> Look g = Look (\s -> f s <|> g s)
+ Look f <|> p = Look (\s -> f s <|> p)
+ p <|> Look f = Look (\s -> p <|> f s)
+
+-- ---------------------------------------------------------------------------
+-- The ReadP type
+
+newtype ReadP a = R (forall b . (a -> P b) -> P b)
+
+-- | @since 2.01
+instance Functor ReadP where
+ fmap h (R f) = R (\k -> f (k . h))
+
+-- | @since 4.6.0.0
+instance Applicative ReadP where
+ pure x = R (\k -> k x)
+ (<*>) = ap
+ -- liftA2 = liftM2
+
+-- | @since 2.01
+instance Monad ReadP where
+ R m >>= f = R (\k -> m (\a -> let { R m' = f a } in m' k))+
+-- | @since 4.9.0.0
+instance MonadFail ReadP where
+ fail _ = R (\_ -> Fail)
+
+-- | @since 4.6.0.0
+instance Alternative ReadP where
+ empty = pfail
+ (<|>) = (+++)
+
+-- | @since 2.01
+instance MonadPlus ReadP
+
+-- ---------------------------------------------------------------------------
+-- Operations over P
+
+final :: forall a . [(a,String)] -> P a
+final [] = Fail
+final rs = Final rs
+
+run :: forall a . P a -> ReadS a
+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 rs) _ = rs
+run _ _ = []
+
+-- ---------------------------------------------------------------------------
+-- Operations over ReadP
+
+get :: ReadP Char
+-- ^ Consumes and returns the next character.
+-- Fails if there is no input left.
+get = R Get
+
+look :: ReadP String
+-- ^ Look-ahead: returns the part of the input that is left, without
+-- consuming it.
+look = R Look
+
+pfail :: forall a . ReadP a
+-- ^ Always fails.
+pfail = R (\_ -> Fail)
+
+(+++) :: forall a . ReadP a -> ReadP a -> ReadP a
+-- ^ Symmetric choice.
+R f1 +++ R f2 = R (\k -> f1 k <|> f2 k)
+
+(<++) :: forall a . ReadP a -> ReadP a -> ReadP a
+-- ^ Local, exclusive, left-biased choice: If left parser
+-- locally produces any result at all, then right parser is
+-- not used.
+R f0 <++ q =
+ do s <- look
+ probe (f0 return) s (0::Int)
+ 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 n = if n == 0::Int then return () else get >> discard (n - (1::Int))
+
+gather :: forall a . ReadP a -> ReadP (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 :: forall b . (String -> String) -> P (String -> P b) -> P b
+ gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
+ gath _ Fail = Fail
+ gath l (Look f) = Look (\s -> gath l (f s))
+ gath l (Result k p) = k (l []) <|> gath l p
+ gath _ (Final _) = error "do not use readS_to_P in gather!"
+
+-- ---------------------------------------------------------------------------
+-- Derived operations
+
+satisfy :: (Char -> Bool) -> ReadP 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 Char
+-- ^ Parses and returns the specified character.
+char c = satisfy (c ==)
+
+eof :: ReadP ()
+-- ^ Succeeds iff we are at the end of input
+eof = do { s <- look+ ; if null s then return ()
+ else pfail }
+
+string :: String -> ReadP 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 = do _ <- get; scan xs ys
+ scan _ _ = pfail
+
+munch :: (Char -> Bool) -> ReadP String
+-- ^ Parses the first zero or more characters satisfying the predicate.
+-- Always succeeds, exactly once having consumed all the characters
+-- Hence NOT the same as (many (satisfy p))
+munch p =
+ do s <- look
+ scan s
+ where
+ scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
+ scan _ = return ""
+
+munch1 :: (Char -> Bool) -> ReadP String
+-- ^ Parses the first one or more characters satisfying the predicate.
+-- Fails if none, else succeeds exactly once having consumed all the characters
+-- Hence NOT the same as (many1 (satisfy p))
+munch1 p =
+ do c <- get
+ if p c then do s <- munch p; return (c:s)
+ else pfail
+
+choice :: forall a . [ReadP a] -> ReadP a
+-- ^ Combines all parsers in the specified list.
+choice [] = pfail
+choice [p] = p
+choice (p:ps) = p +++ choice ps
+
+skipSpaces :: ReadP ()
+-- ^ Skips all whitespace.
+skipSpaces =
+ do s <- look
+ skip s
+ where
+ skip (c:s) | isSpace c = do _ <- get; skip s
+ skip _ = return ()
+
+count :: forall a . Int -> ReadP a -> ReadP [a]
+-- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
+-- results is returned.
+count n p = sequence (replicate n p)
+
+between :: forall a open close . ReadP open -> ReadP close -> ReadP a -> ReadP 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 :: forall a . a -> ReadP a -> ReadP a
+-- ^ @option x p@ will either parse @p@ or return @x@ without consuming
+-- any input.
+option x p = p +++ return x
+
+optional :: forall a . ReadP a -> ReadP ()
+-- ^ @optional p@ optionally parses @p@ and always returns @()@.
+optional p = (p >> return ()) +++ return ()
+
+many :: forall a . ReadP a -> ReadP [a]
+-- ^ Parses zero or more occurrences of the given parser.
+many p = return [] +++ many1 p
+
+many1 :: forall a . ReadP a -> ReadP [a]
+-- ^ Parses one or more occurrences of the given parser.
+many1 p = liftM2 (:) p (many p)
+
+skipMany :: forall a . ReadP a -> ReadP ()
+-- ^ Like 'many', but discards the result.
+skipMany p = many p >> return ()
+
+skipMany1 :: forall a . ReadP a -> ReadP ()
+-- ^ Like 'many1', but discards the result.
+skipMany1 p = p >> skipMany p
+
+sepBy :: forall a sep . ReadP a -> ReadP sep -> ReadP [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 :: forall a sep . ReadP a -> ReadP sep -> ReadP [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 :: forall a sep . ReadP a -> ReadP sep -> ReadP [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 :: forall a sep . ReadP a -> ReadP sep -> ReadP [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 :: forall a . ReadP a -> ReadP (a -> a -> a) -> a -> ReadP 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 :: forall a . ReadP a -> ReadP (a -> a -> a) -> a -> ReadP 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 :: forall a . ReadP a -> ReadP (a -> a -> a) -> ReadP 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 :: forall a . ReadP a -> ReadP (a -> a -> a) -> ReadP 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 :: forall a end . ReadP a -> ReadP end -> ReadP [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 :: forall a . ReadP 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 :: forall a . ReadS a -> ReadP 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']))
--- /dev/null
+++ b/lib/Text/ParserCombinators/ReadPrec.hs
@@ -1,0 +1,177 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Text.ParserCombinators.ReadPrec
+-- Copyright : (c) The University of Glasgow 2002
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : provisional
+-- Portability : non-portable (uses Text.ParserCombinators.ReadP)
+--
+-- This library defines parser combinators for precedence parsing.
+
+-----------------------------------------------------------------------------
+
+module Text.ParserCombinators.ReadPrec
+ (
+ ReadPrec,
+
+ -- * Precedences
+ Prec,
+ minPrec,
+
+ -- * Precedence operations
+ lift,
+ prec,
+ step,
+ reset,
+
+ -- * Other operations
+ -- | All are based directly on their similarly-named 'ReadP' counterparts.
+ get,
+ look,
+ (+++),
+ (<++),
+ pfail,
+ choice,
+
+ -- * Converters
+ readPrec_to_P,
+ readP_to_Prec,
+ readPrec_to_S,
+ readS_to_Prec,
+ )
+ where
+
+
+import Text.ParserCombinators.ReadP
+ ( ReadP
+ , ReadS
+ , readP_to_S
+ , readS_to_P
+ )
+
+import qualified Text.ParserCombinators.ReadP as ReadP
+ ( get
+ , look
+ , (+++), (<++)
+ , pfail
+ )
+
+import Control.Applicative
+import Control.Alternative
+import Control.Monad
+import Data.Char
+import Data.Int
+import Data.List
+import Data.Num
+import Data.Ord
+
+-- ---------------------------------------------------------------------------
+-- The readPrec type
+
+newtype ReadPrec a = P (Prec -> ReadP a)
+
+-- Functor, Monad, MonadPlus
+
+-- | @since 2.01
+instance Functor ReadPrec where
+ fmap h (P f) = P (\n -> fmap h (f n))
+
+-- | @since 4.6.0.0
+instance Applicative ReadPrec where
+ pure x = P (\_ -> pure x)
+ (<*>) = ap
+ liftA2 = liftM2
+
+-- | @since 2.01
+instance Monad ReadPrec where
+ P f >>= k = P (\n -> do {a <- f n; let {P f' = k a}; f' n})+
+-- | @since 4.9.0.0
+instance MonadFail ReadPrec where
+ fail s = P (\_ -> fail s)
+
+-- | @since 2.01
+instance MonadPlus ReadPrec
+
+-- | @since 4.6.0.0
+instance Alternative ReadPrec where
+ empty = pfail
+ (<|>) = (+++)
+
+-- precedences
+type Prec = Int
+
+minPrec :: Prec
+minPrec = 0
+
+-- ---------------------------------------------------------------------------
+-- Operations over ReadPrec
+
+lift :: forall a . ReadP a -> ReadPrec a
+-- ^ Lift a precedence-insensitive 'ReadP' to a 'ReadPrec'.
+lift m = P (\_ -> m)
+
+step :: forall a . ReadPrec a -> ReadPrec a
+-- ^ Increases the precedence context by one.
+step (P f) = P (\n -> f (n+1))
+
+reset :: forall a . ReadPrec a -> ReadPrec a
+-- ^ Resets the precedence context to zero.
+reset (P f) = P (\_ -> f minPrec)
+
+prec :: forall a . Prec -> ReadPrec a -> ReadPrec a
+-- ^ @(prec n p)@ checks whether the precedence context is
+-- less than or equal to @n@, and
+--
+-- * if not, fails
+--
+-- * if so, parses @p@ in context @n@.
+prec n (P f) = P (\c -> if c <= n then f n else ReadP.pfail)
+
+-- ---------------------------------------------------------------------------
+-- Derived operations
+
+get :: ReadPrec Char
+-- ^ Consumes and returns the next character.
+-- Fails if there is no input left.
+get = lift ReadP.get
+
+look :: ReadPrec String
+-- ^ Look-ahead: returns the part of the input that is left, without
+-- consuming it.
+look = lift ReadP.look
+
+(+++) :: forall a . ReadPrec a -> ReadPrec a -> ReadPrec a
+-- ^ Symmetric choice.
+P f1 +++ P f2 = P (\n -> f1 n ReadP.+++ f2 n)
+
+(<++) :: forall a . ReadPrec a -> ReadPrec a -> ReadPrec a
+-- ^ Local, exclusive, left-biased choice: If left parser
+-- locally produces any result at all, then right parser is
+-- not used.
+P f1 <++ P f2 = P (\n -> f1 n ReadP.<++ f2 n)
+
+pfail :: forall a . ReadPrec a
+-- ^ Always fails.
+pfail = lift ReadP.pfail
+
+choice :: forall a . [ReadPrec a] -> ReadPrec a
+-- ^ Combines all parsers in the specified list.
+choice ps = foldr (+++) pfail ps
+
+-- ---------------------------------------------------------------------------
+-- Converting between ReadPrec and Read
+
+readPrec_to_P :: forall a . ReadPrec a -> (Int -> ReadP a)
+readPrec_to_P (P f) = f
+
+readP_to_Prec :: forall a . (Int -> ReadP a) -> ReadPrec a
+readP_to_Prec f = P f
+
+readPrec_to_S :: forall a . ReadPrec a -> (Int -> ReadS a)
+readPrec_to_S (P f) n = readP_to_S (f n)
+
+readS_to_Prec :: forall a . (Int -> ReadS a) -> ReadPrec a
+readS_to_Prec f = P (\n -> readS_to_P (f n))
--- /dev/null
+++ b/lib/Text/Read.hs
@@ -1,0 +1,6 @@
+module Text.Read(
+ Read(..)
+ read,
+ readMaybe,
+ ReadS,
+ ) where
--
⑨