@@ -1,4 +1,5 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards, CPP #-}
1+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings,
2+ Rank2Types, RecordWildCards #-}
23-- |
34-- Module : Data.Attoparsec.Internal.Types
45-- Copyright : Bryan O'Sullivan 2007-2011
@@ -72,8 +73,8 @@ instance Functor (IResult t) where
7273 fmap = fmapR
7374 {-# INLINE fmap #-}
7475
75−newtype Input t = I {unI :: t}
76−newtype Added t = A {unA :: t}
76+newtype Input t = I {unI :: t} deriving (Monoid)
77+newtype Added t = A {unA :: t} deriving (Monoid)
7778
7879-- | The core parser type. This is parameterised over the type @t@ of
7980-- string being processed.
@@ -108,19 +109,20 @@ type Success t a r = Input t -> Added t -> More -> a -> IResult t r
108109data More = Complete | Incomplete
109110 deriving (Eq, Show)
110111
112+instance Monoid More where
113+ mappend c@Complete _ = c
114+ mappend _ m = m
115+ mempty = Incomplete
116+
111117addS :: (Monoid t) =>
112118 Input t -> Added t -> More
113119 -> Input t -> Added t -> More
114120 -> (Input t -> Added t -> More -> r) -> r
115121addS i0 a0 m0 _i1 a1 m1 f =
116− let !i = I (unI i0 <> unA a1)
117− a = A (unA a0 <> unA a1)
118− !m = m0 <?> m1
122+ let !i = i0 <> I (unA a1)
123+ a = a0 <> a1
124+ !m = m0 <> m1
119125 in f i a m
120− where
121− Complete <?> _ = Complete
122− _ <?> Complete = Complete
123− _ <?> _ = Incomplete
124126{-# INLINE addS #-}
125127
126128bindP :: Parser t a -> (a -> Parser t b) -> Parser t b
@@ -148,7 +150,7 @@ plus :: (Monoid t) => Parser t a -> Parser t a -> Parser t a
148150plus a b = Parser $ \i0 a0 m0 kf ks ->
149151 let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
150152 \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
151− ks' i1 a1 m1 = ks i1 (A (unA a0 <> unA a1)) m1
153+ ks' i1 a1 m1 = ks i1 (a0 <> a1) m1
152154 in noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks'
153155{-# INLINE plus #-}
154156