Text/ParserCombinators/ReadP.lhs

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