@@ -2,7 +2,7 @@
22#if __GLASGOW_HASKELL__ >= 702
33{-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe
44#endif
5−{-# LANGUAGE BangPatterns #-}
5+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
66
77-- |
88-- Module : Data.Attoparsec.Zepto
@@ -27,139 +27,101 @@
2727module Data.Attoparsec.Zepto
2828 (
2929 Parser
30− , ZeptoT
3130 , parse
32− , parseT
3331 , atEnd
3432 , string
3533 , take
3634 , takeWhile
3735 ) where
3836
39−import Control.Applicative
40−import Control.Monad (MonadPlus(..), ap)
41−import qualified Control.Monad.Fail as Fail
42−import Control.Monad.IO.Class (MonadIO(..))
43−import Data.ByteString (ByteString)
44−import Data.Functor.Identity (Identity(runIdentity))
45−import Data.Monoid as Mon (Monoid(..))
46−import Data.Semigroup (Semigroup(..))
4737import Data.Word (Word8)
48−import Prelude hiding (take, takeWhile)
38+import Control.Applicative
39+import Control.Monad
40+import Data.Monoid
4941import qualified Data.ByteString as B
5042import qualified Data.ByteString.Unsafe as B
43+import Data.ByteString (ByteString)
44+import Prelude hiding (take, takeWhile)
5145
5246newtype S = S {
5347 input :: ByteString
5448 }
5549
5650data Result a = Fail String
57− | OK !a S
51+ | OK !a
5852
5953-- | A simple parser.
6054--
6155-- This monad is strict in its state, and the monadic bind operator
6256-- ('>>=') evaluates each result to weak head normal form before
6357-- passing it along.
64−newtype ZeptoT m a = Parser {
65− runParser :: S -> m (Result a)
58+newtype Parser a = Parser {
59+ runParser :: S -> (# Result a, S #)
6660 }
6761
68−type Parser a = ZeptoT Identity a
69−
70−instance Monad m => Functor (ZeptoT m) where
71− fmap f m = Parser $ \s -> do
72− result <- runParser m s
73− case result of
74− OK a s' -> return (OK (f a) s')
75− Fail err -> return (Fail err)
62+instance Functor Parser where
63+ fmap f m = Parser $ \s -> case runParser m s of
64+ (# OK a, s' #) -> (# OK (f a), s' #)
65+ (# Fail err, s' #) -> (# Fail err, s' #)
7666 {-# INLINE fmap #-}
7767
78−instance MonadIO m => MonadIO (ZeptoT m) where
79− liftIO act = Parser $ \s -> do
80− result <- liftIO act
81− return (OK result s)
82− {-# INLINE liftIO #-}
83−
84−instance Monad m => Monad (ZeptoT m) where
85− return = pure
68+instance Monad Parser where
69+ return a = Parser $ \s -> (# OK a, s #)
8670 {-# INLINE return #-}
8771
88− m >>= k = Parser $ \s -> do
89− result <- runParser m s
90− case result of
91− OK a s' -> runParser (k a) s'
92− Fail err -> return (Fail err)
72+ m >>= k = Parser $ \s -> case runParser m s of
73+ (# OK a, s' #) -> runParser (k a) s'
74+ (# Fail err, s' #) -> (# Fail err, s' #)
9375 {-# INLINE (>>=) #-}
9476
95−#if !(MIN_VERSION_base(4,13,0))
96− fail = Fail.fail
97− {-# INLINE fail #-}
98−#endif
77+ fail msg = Parser $ \s -> (# Fail msg, s #)
9978
100−instance Monad m => Fail.MonadFail (ZeptoT m) where
101− fail msg = Parser $ \_ -> return (Fail msg)
102− {-# INLINE fail #-}
103−
104−instance Monad m => MonadPlus (ZeptoT m) where
79+instance MonadPlus Parser where
10580 mzero = fail "mzero"
10681 {-# INLINE mzero #-}
10782
108− mplus a b = Parser $ \s -> do
109− result <- runParser a s
110− case result of
111− ok@(OK _ _) -> return ok
112− _ -> runParser b s
83+ mplus a b = Parser $ \s ->
84+ case runParser a s of
85+ (# ok@(OK _), s' #) -> (# ok, s' #)
86+ (# _, _ #) -> case runParser b s of
87+ (# ok@(OK _), s'' #) -> (# ok, s'' #)
88+ (# err, s'' #) -> (# err, s'' #)
11389 {-# INLINE mplus #-}
11490
115−instance (Monad m) => Applicative (ZeptoT m) where
116− pure a = Parser $ \s -> return (OK a s)
91+instance Applicative Parser where
92+ pure = return
11793 {-# INLINE pure #-}
11894 (<*>) = ap
11995 {-# INLINE (<*>) #-}
12096
121−gets :: Monad m => (S -> a) -> ZeptoT m a
122−gets f = Parser $ \s -> return (OK (f s) s)
97+gets :: (S -> a) -> Parser a
98+gets f = Parser $ \s -> (# OK (f s), s #)
12399{-# INLINE gets #-}
124100
125−put :: Monad m => S -> ZeptoT m ()
126−put s = Parser $ \_ -> return (OK () s)
101+put :: S -> Parser ()
102+put s = Parser $ \_ -> (# OK (), s #)
127103{-# INLINE put #-}
128104
129105-- | Run a parser.
130106parse :: Parser a -> ByteString -> Either String a
131−parse p bs = case runIdentity (runParser p (S bs)) of
132− (OK a _) -> Right a
133− (Fail err) -> Left err
134−{-# INLINE parse #-}
135−
136−-- | Run a parser on top of the given base monad.
137−parseT :: Monad m => ZeptoT m a -> ByteString -> m (Either String a)
138−parseT p bs = do
139− result <- runParser p (S bs)
140− case result of
141− OK a _ -> return (Right a)
142− Fail err -> return (Left err)
143−{-# INLINE parseT #-}
144−
145−instance Monad m => Semigroup (ZeptoT m a) where
146− (<>) = mplus
147− {-# INLINE (<>) #-}
148−
149−instance Monad m => Mon.Monoid (ZeptoT m a) where
107+parse p bs = case runParser p (S bs) of
108+ (# OK a, _ #) -> Right a
109+ (# Fail err, _ #) -> Left err
110+
111+instance Monoid (Parser a) where
150112 mempty = fail "mempty"
151113 {-# INLINE mempty #-}
152− mappend = (<>)
114+ mappend = mplus
153115 {-# INLINE mappend #-}
154116
155−instance Monad m => Alternative (ZeptoT m) where
117+instance Alternative Parser where
156118 empty = fail "empty"
157119 {-# INLINE empty #-}
158120 (<|>) = mplus
159121 {-# INLINE (<|>) #-}
160122
161123-- | Consume input while the predicate returns 'True'.
162−takeWhile :: Monad m => (Word8 -> Bool) -> ZeptoT m ByteString
124+takeWhile :: (Word8 -> Bool) -> Parser ByteString
163125takeWhile p = do
164126 (h,t) <- gets (B.span p . input)
165127 put (S t)
@@ -167,7 +129,7 @@ takeWhile p = do
167129{-# INLINE takeWhile #-}
168130
169131-- | Consume @n@ bytes of input.
170−take :: Monad m => Int -> ZeptoT m ByteString
132+take :: Int -> Parser ByteString
171133take !n = do
172134 s <- gets input
173135 if B.length s >= n
@@ -176,7 +138,7 @@ take !n = do
176138{-# INLINE take #-}
177139
178140-- | Match a string exactly.
179−string :: Monad m => ByteString -> ZeptoT m ()
141+string :: ByteString -> Parser ()
180142string s = do
181143 i <- gets input
182144 if s `B.isPrefixOf` i
@@ -185,7 +147,7 @@ string s = do
185147{-# INLINE string #-}
186148
187149-- | Indicate whether the end of the input has been reached.
188−atEnd :: Monad m => ZeptoT m Bool
150+atEnd :: Parser Bool
189151atEnd = do
190152 i <- gets input
191153 return $! B.null i