@@ -30,6 +30,7 @@ module Data.Attoparsec.Combinator
3030
3131import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,
3232 (<|>), (*>), (<$>))
33+import Control.Monad (MonadPlus(..))
3334#if !MIN_VERSION_base(4,2,0)
3435import Control.Applicative (many)
3536#endif
@@ -65,18 +66,24 @@ option x p = p <|> pure x
6566{-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-}
6667#endif
6768
69+-- | A version of 'liftM2' that is strict in the result of its first
70+-- action.
71+liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
72+liftM2' f a b = do
73+ !x <- a
74+ y <- b
75+ return (f x y)
76+{-# INLINE liftM2' #-}
77+
6878-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a
6979-- list of the returned values of @p@. The value returned by @p@ is
7080-- forced to WHNF.
7181--
7282-- > word = many' letter
73−many' :: (Alternative f, Monad f) => f a -> f [a]
83+many' :: (MonadPlus m) => m a -> m [a]
7484many' p = many_p
75− where many_p = some_p <|> pure []
76− some_p = do
77− !a <- p
78− as <- many_p
79− return (a : as)
85+ where many_p = some_p `mplus` return []
86+ some_p = liftM2' (:) p many_p
8087{-# INLINE many' #-}
8188
8289-- | @many1 p@ applies the action @p@ /one/ or more times. Returns a
@@ -92,11 +99,8 @@ many1 p = liftA2 (:) p (many p)
9299-- forced to WHNF.
93100--
94101-- > word = many1' letter
95−many1' :: (Alternative f, Monad f) => f a -> f [a]
96−many1' p = do
97− !a <- p
98− as <- many' p
99− return (a : as)
102+many1' :: (MonadPlus m) => m a -> m [a]
103+many1' p = liftM2' (:) p (many' p)
100104{-# INLINE many1' #-}
101105
102106-- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated
@@ -117,13 +121,9 @@ sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure []
117121-- returned by @p@ is forced to WHNF.
118122--
119123-- > commaSep p = p `sepBy'` (symbol ",")
120−sepBy' :: (Alternative f, Monad f) => f a -> f s -> f [a]
121−sepBy' p s = scan <|> pure []
122− where
123− scan = do
124− !a <- p
125− as <- (s *> sepBy1' p s) <|> pure []
126− return (a : as)
124+sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
125+sepBy' p s = scan `mplus` return []
126+ where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return [])
127127#if __GLASGOW_HASKELL__ >= 700
128128{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s
129129 -> Parser ByteString [a] #-}
@@ -150,11 +150,9 @@ sepBy1 p s = scan
150150-- returned by @p@ is forced to WHNF.
151151--
152152-- > commaSep p = p `sepBy1'` (symbol ",")
153−sepBy1' :: (Alternative f, Monad f) => f a -> f s -> f [a]
153+sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
154154sepBy1' p s = scan
155− where scan = do !a <- p
156− as <- (s *> scan) <|> pure []
157− return (a : as)
155+ where scan = liftM2' (:) p ((s >> scan) `mplus` return [])
158156#if __GLASGOW_HASKELL__ >= 700
159157{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s
160158 -> Parser ByteString [a] #-}
@@ -189,13 +187,9 @@ manyTill p end = scan
189187-- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and
190188-- therefore the use of the 'try' combinator. The value returned by @p@
191189-- is forced to WHNF.
192−manyTill' :: (Alternative f, Monad f) => f a -> f b -> f [a]
190+manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
193191manyTill' p end = scan
194− where scan = (end *> pure []) <|> scan'
195− scan' = do
196− !a <- p
197− as <- scan
198− return (a : as)
192+ where scan = (end >> return []) `mplus` liftM2' (:) p scan
199193#if __GLASGOW_HASKELL__ >= 700
200194{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b
201195 -> Parser ByteString [a] #-}