Text/ParserCombinators/ReadP.hs

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Text.ParserCombinators.ReadP
   5 -- Copyright   :  (c) The University of Glasgow 2002
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- "ReadP" is a library of parser combinators, originally written by Koen Claessen.
  13 -- It parses all alternatives in parallel, so it never keeps hold of
  14 -- the beginning of the input string, a common source of space leaks with
  15 -- other parsers.  The '(+++)' choice combinator is genuinely commutative;
  16 -- it makes no difference which branch is "shorter".
  17
  18 -----------------------------------------------------------------------------
  19
  20 module Text.ParserCombinators.ReadP
  21   (
  22   -- * The 'ReadP' type
  23   ReadP,      -- :: * -> *; instance Functor, Monad, MonadPlus
  24
  25   -- * Primitive operations
  26   get,        -- :: ReadP Char
  27   look,       -- :: ReadP String
  28   (+++),      -- :: ReadP a -> ReadP a -> ReadP a
  29   gather,     -- :: ReadP a -> ReadP (String, a)
  30
  31   -- * Other operations
  32   pfail,      -- :: ReadP a
  33   satisfy,    -- :: (Char -> Bool) -> ReadP Char
  34   char,       -- :: Char -> ReadP Char
  35   string,     -- :: String -> ReadP String
  36   munch,      -- :: (Char -> Bool) -> ReadP String
  37   munch1,     -- :: (Char -> Bool) -> ReadP String
  38   skipSpaces, -- :: ReadP ()
  39   choice,     -- :: [ReadP a] -> ReadP a
  40
  41   -- * Conversions
  42   readP_to_S, -- :: ReadP a -> ReadS a
  43   readS_to_P, -- :: ReadS a -> ReadP a
  44   )
  45  where
  46
  47 import Control.Monad( MonadPlus(..) )
  48 import GHC.Show( isSpace  )
  49 import GHC.Base
  50
  51 -- ---------------------------------------------------------------------------
  52 -- The ReadP type
  53
  54 newtype ReadP a = R (forall b . (a -> P b) -> P b)
  55
  56 data P a
  57   = Get (Char -> P a)
  58   | Look (String -> P a)
  59   | Fail
  60   | Result a (P a)
  61   | ReadS (ReadS a)
  62
  63 -- We define a local version of ReadS here,
  64 -- because its "real" definition site is in GHC.Read
  65 type ReadS a = String -> [(a,String)]
  66
  67 -- Functor, Monad, MonadPlus
  68
  69 instance Functor ReadP where
  70   fmap h (R f) = R (\k -> f (k . h))
  71
  72 instance Monad ReadP where
  73   return x  = R (\k -> k x)
  74   fail _    = R (\_ -> Fail)
  75   R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
  76
  77 instance MonadPlus ReadP where
  78   mzero = pfail
  79   mplus = (+++)
  80
  81 -- ---------------------------------------------------------------------------
  82 -- Operations over ReadP
  83
  84 get :: ReadP Char
  85 get = R (\k -> Get k)
  86
  87 look :: ReadP String
  88 look = R (\k -> Look k)
  89
  90 (+++) :: ReadP a -> ReadP a -> ReadP a
  91 R f1 +++ R f2 = R (\k -> f1 k >|< f2 k)
  92
  93 gather :: ReadP a -> ReadP (String, a)
  94 -- ^ Transforms a parser into one that does the same, but
  95 --   in addition returns the exact characters read.
  96 --   IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
  97 --   is built using any occurrences of readS_to_P.
  98 gather (R m)
  99   = R (\k -> gath id (m (\a -> Result (\s -> k (s,a)) Fail)))
 100   where
 101     gath l (Get f)      = Get (\c -> gath (l.(c:)) (f c))
 102     gath l Fail         = Fail
 103     gath l (Look f)     = Look (\s -> gath l (f s))
 104     gath l (Result k p) = k (l []) >|< gath l p
 105     gath l (ReadS r)    = error "do not use ReadS in gather!"
 106
 107 (>|<) :: P a -> P a -> P a
 108 -- Not exported!  Works over the representation type
 109 Get f1     >|< Get f2     = Get (\c -> f1 c >|< f2 c)
 110 Fail       >|< p          = p
 111 p          >|< Fail       = p
 112 Look f     >|< Look g     = Look (\s -> f s >|< g s)
 113 Result x p >|< q          = Result x (p >|< q)
 114 p          >|< Result x q = Result x (p >|< q)
 115 Look f     >|< p          = Look (\s -> f s >|< p)
 116 p          >|< Look f     = Look (\s -> p >|< f s)
 117 p          >|< q          = ReadS (\s -> run p s ++ run q s)
 118
 119 run :: P a -> ReadS a
 120 run (Get f)      []    = []
 121 run (Get f)      (c:s) = run (f c) s
 122 run (Look f)     s     = run (f s) s
 123 run (Result x p) s     = (x,s) : run p s
 124 run (ReadS r)    s     = r s
 125 run Fail         _     = []
 126
 127 -- ---------------------------------------------------------------------------
 128 -- Derived operations
 129
 130 pfail :: ReadP a
 131 pfail = fail ""
 132
 133 satisfy :: (Char -> Bool) -> ReadP Char
 134 satisfy p = do c <- get; if p c then return c else pfail
 135
 136 char :: Char -> ReadP Char
 137 char c = satisfy (c ==)
 138
 139 string :: String -> ReadP String
 140 string s = scan s
 141  where
 142   scan []     = do return s
 143   scan (c:cs) = do char c; scan cs
 144
 145 munch :: (Char -> Bool) -> ReadP String
 146 -- (munch p) parses the first zero or more characters satisfying p
 147 munch p =
 148   do s <- look
 149      scan s
 150  where
 151   scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
 152   scan _            = do return ""
 153
 154 munch1 :: (Char -> Bool) -> ReadP String
 155 -- (munch p) parses the first one or more characters satisfying p
 156 munch1 p =
 157   do c <- get
 158      if p c then do s <- munch p; return (c:s) else pfail
 159
 160 choice :: [ReadP a] -> ReadP a
 161 choice ps = foldr (+++) pfail ps
 162
 163 skipSpaces :: ReadP ()
 164 skipSpaces =
 165   do s <- look
 166      skip s
 167  where
 168   skip (c:s) | isSpace c = do get; skip s
 169   skip _                 = do return ()
 170
 171 -- ---------------------------------------------------------------------------
 172 -- Converting between ReadP and Read
 173
 174 readP_to_S :: ReadP a -> ReadS a
 175 readP_to_S (R f) = run (f (\x -> Result x Fail))
 176
 177 readS_to_P :: ReadS a -> ReadP a
 178 readS_to_P r = R (\k -> ReadS (\s -> [ bs''
 179                                      | (a,s') <- r s
 180                                      , bs''   <- run (k a) s'
 181                                      ]))