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 -----------------------------------------------------------------------------
  13
  14 module Text.ParserCombinators.ReadP
  15   (
  16   -- * The 'ReadP' type
  17   ReadP,      -- :: * -> *; instance Functor, Monad, MonadPlus
  18
  19   -- * Primitive operations
  20   get,        -- :: ReadP Char
  21   look,       -- :: ReadP String
  22   (+++),      -- :: ReadP a -> ReadP a -> ReadP a
  23
  24   -- * Other operations
  25   pfail,      -- :: ReadP a
  26   satisfy,    -- :: (Char -> Bool) -> ReadP Char
  27   char,       -- :: Char -> ReadP Char
  28   string,     -- :: String -> ReadP String
  29   munch,      -- :: (Char -> Bool) -> ReadP String
  30   munch1,     -- :: (Char -> Bool) -> ReadP String
  31   skipSpaces, -- :: ReadP ()
  32   choice,     -- :: [ReadP a] -> ReadP a
  33
  34   -- * Conversions
  35   readP_to_S, -- :: ReadP a -> ReadS a
  36   readS_to_P, -- :: ReadS a -> ReadP a
  37   )
  38  where
  39
  40 import Control.Monad( MonadPlus(..) )
  41 import GHC.Show( isSpace  )
  42 import GHC.Base
  43
  44 -- ---------------------------------------------------------------------------
  45 -- The ReadP type
  46
  47 newtype ReadP a = R (forall b . (a -> P b) -> P b)
  48
  49 data P a
  50   = Get (Char -> P a)
  51   | Look (String -> P a)
  52   | Fail
  53   | Result a (P a)
  54   | ReadS (ReadS a)
  55
  56 -- We define a local version of ReadS here,
  57 -- because its "real" definition site is in GHC.Read
  58 type ReadS a = String -> [(a,String)]
  59
  60 -- Functor, Monad, MonadPlus
  61
  62 instance Functor ReadP where
  63   fmap h (R f) = R (\k -> f (k . h))
  64
  65 instance Monad ReadP where
  66   return x  = R (\k -> k x)
  67   fail _    = R (\_ -> Fail)
  68   R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
  69
  70 instance MonadPlus ReadP where
  71   mzero = pfail
  72   mplus = (+++)
  73
  74 -- ---------------------------------------------------------------------------
  75 -- Operations over ReadP
  76
  77 get :: ReadP Char
  78 get = R (\k -> Get k)
  79
  80 look :: ReadP String
  81 look = R (\k -> Look k)
  82
  83 (+++) :: ReadP a -> ReadP a -> ReadP a
  84 R f1 +++ R f2 = R (\k -> f1 k >|< f2 k)
  85  where
  86   Get f1     >|< Get f2     = Get (\c -> f1 c >|< f2 c)
  87   Fail       >|< p          = p
  88   p          >|< Fail       = p
  89   Look f     >|< Look g     = Look (\s -> f s >|< g s)
  90   Result x p >|< q          = Result x (p >|< q)
  91   p          >|< Result x q = Result x (p >|< q)
  92   Look f     >|< p          = Look (\s -> f s >|< p)
  93   p          >|< Look f     = Look (\s -> p >|< f s)
  94   p          >|< q          = ReadS (\s -> run p s ++ run q s)
  95
  96 run :: P a -> ReadS a
  97 run (Get f)      []    = []
  98 run (Get f)      (c:s) = run (f c) s
  99 run (Look f)     s     = run (f s) s
 100 run (Result x p) s     = (x,s) : run p s
 101 run (ReadS r)    s     = r s
 102 run Fail         _     = []
 103
 104 -- ---------------------------------------------------------------------------
 105 -- Derived operations
 106
 107 pfail :: ReadP a
 108 pfail = fail ""
 109
 110 satisfy :: (Char -> Bool) -> ReadP Char
 111 satisfy p = do c <- get; if p c then return c else pfail
 112
 113 char :: Char -> ReadP Char
 114 char c = satisfy (c ==)
 115
 116 string :: String -> ReadP String
 117 string s = scan s
 118  where
 119   scan []     = do return s
 120   scan (c:cs) = do char c; scan cs
 121
 122 munch :: (Char -> Bool) -> ReadP String
 123 -- (munch p) parses the first zero or more characters satisfying p
 124 munch p =
 125   do s <- look
 126      scan s
 127  where
 128   scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
 129   scan _            = do return ""
 130
 131 munch1 :: (Char -> Bool) -> ReadP String
 132 -- (munch p) parses the first one or more characters satisfying p
 133 munch1 p =
 134   do c <- get
 135      if p c then do s <- munch p; return (c:s) else pfail
 136
 137 choice :: [ReadP a] -> ReadP a
 138 choice ps = foldr (+++) pfail ps
 139
 140 skipSpaces :: ReadP ()
 141 skipSpaces =
 142   do s <- look
 143      skip s
 144  where
 145   skip (c:s) | isSpace c = do get; skip s
 146   skip _                 = do return ()
 147
 148 -- ---------------------------------------------------------------------------
 149 -- Converting between ReadP and Read
 150
 151 readP_to_S :: ReadP a -> ReadS a
 152 readP_to_S (R f) = run (f (\x -> Result x Fail))
 153
 154 readS_to_P :: ReadS a -> ReadP a
 155 readS_to_P r = R (\k -> ReadS (\s -> [ bs''
 156                                      | (a,s') <- r s
 157                                      , bs''   <- run (k a) s'
 158                                      ]))