git.iko.soy/typeable/attoparsec
on master help sign in
Use MonadPlus and liftM2' for strict combinators
1b39dd7Bryan O'Sullivan
Data/Attoparsec/Combinator.hs+22−28
compare with master
unifiedsplit
@@ -30,6 +30,7 @@ module Data.Attoparsec.Combinator
30
30
31import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,
31import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,
32 (<|>), (*>), (<$>))
32 (<|>), (*>), (<$>))
33+import Control.Monad (MonadPlus(..))
33#if !MIN_VERSION_base(4,2,0)
34#if !MIN_VERSION_base(4,2,0)
34import Control.Applicative (many)
35import Control.Applicative (many)
35#endif
36#endif
@@ -65,18 +66,24 @@ option x p = p <|> pure x
65{-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-}
66{-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-}
66#endif
67#endif
67
68
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+
68-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a
78-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a
69-- list of the returned values of @p@. The value returned by @p@ is
79-- list of the returned values of @p@. The value returned by @p@ is
70-- forced to WHNF.
80-- forced to WHNF.
71--
81--
72-- > word = many' letter
82-- > word = many' letter
73−many' :: (Alternative f, Monad f) => f a -> f [a]
83+many' :: (MonadPlus m) => m a -> m [a]
74many' p = many_p
84many' p = many_p
75− where many_p = some_p <|> pure []
85+ where many_p = some_p `mplus` return []
76− some_p = do
86+ some_p = liftM2' (:) p many_p
77− !a <- p
78− as <- many_p
79− return (a : as)
80{-# INLINE many' #-}
87{-# INLINE many' #-}
81
88
82-- | @many1 p@ applies the action @p@ /one/ or more times. Returns a
89-- | @many1 p@ applies the action @p@ /one/ or more times. Returns a
@@ -92,11 +99,8 @@ many1 p = liftA2 (:) p (many p)
92-- forced to WHNF.
99-- forced to WHNF.
93--
100--
94-- > word = many1' letter
101-- > word = many1' letter
95−many1' :: (Alternative f, Monad f) => f a -> f [a]
102+many1' :: (MonadPlus m) => m a -> m [a]
96−many1' p = do
103+many1' p = liftM2' (:) p (many' p)
97− !a <- p
98− as <- many' p
99− return (a : as)
100{-# INLINE many1' #-}
104{-# INLINE many1' #-}
101
105
102-- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated
106-- | @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 []
117-- returned by @p@ is forced to WHNF.
121-- returned by @p@ is forced to WHNF.
118--
122--
119-- > commaSep p = p `sepBy'` (symbol ",")
123-- > commaSep p = p `sepBy'` (symbol ",")
120−sepBy' :: (Alternative f, Monad f) => f a -> f s -> f [a]
124+sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
121−sepBy' p s = scan <|> pure []
125+sepBy' p s = scan `mplus` return []
122− where
126+ where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return [])
123− scan = do
124− !a <- p
125− as <- (s *> sepBy1' p s) <|> pure []
126− return (a : as)
127#if __GLASGOW_HASKELL__ >= 700
127#if __GLASGOW_HASKELL__ >= 700
128{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s
128{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s
129 -> Parser ByteString [a] #-}
129 -> Parser ByteString [a] #-}
@@ -150,11 +150,9 @@ sepBy1 p s = scan
150-- returned by @p@ is forced to WHNF.
150-- returned by @p@ is forced to WHNF.
151--
151--
152-- > commaSep p = p `sepBy1'` (symbol ",")
152-- > 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]
154sepBy1' p s = scan
154sepBy1' p s = scan
155− where scan = do !a <- p
155+ where scan = liftM2' (:) p ((s >> scan) `mplus` return [])
156− as <- (s *> scan) <|> pure []
157− return (a : as)
158#if __GLASGOW_HASKELL__ >= 700
156#if __GLASGOW_HASKELL__ >= 700
159{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s
157{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s
160 -> Parser ByteString [a] #-}
158 -> Parser ByteString [a] #-}
@@ -189,13 +187,9 @@ manyTill p end = scan
189-- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and
187-- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and
190-- therefore the use of the 'try' combinator. The value returned by @p@
188-- therefore the use of the 'try' combinator. The value returned by @p@
191-- is forced to WHNF.
189-- 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]
193manyTill' p end = scan
191manyTill' p end = scan
194− where scan = (end *> pure []) <|> scan'
192+ where scan = (end >> return []) `mplus` liftM2' (:) p scan
195− scan' = do
196− !a <- p
197− as <- scan
198− return (a : as)
199#if __GLASGOW_HASKELL__ >= 700
193#if __GLASGOW_HASKELL__ >= 700
200{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b
194{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b
201 -> Parser ByteString [a] #-}
195 -> Parser ByteString [a] #-}