monoid-subclasses 0.3.6.1 → 0.3.6.2

raw patch · 6 files changed

+565/−38 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Monoid/Factorial.hs +130/−9
• Data/Monoid/Instances/ByteString/UTF8.hs +203/−23
• Data/Monoid/Null.hs +4/−0
• Data/Monoid/Textual.hs +203/−1
• Test/TestMonoidSubclasses.hs +23/−3
• monoid-subclasses.cabal +2/−2

@@ -1,5 +1,5 @@ {- -    Copyright 2011-2013 Mario Blazevic+    Copyright 2011-2014 Mario Blazevic      License: BSD3 (see BSD3-LICENSE.txt file) -}@@ -35,6 +35,8 @@ import qualified Data.Sequence as Sequence import qualified Data.Set as Set import qualified Data.Vector as Vector+import Data.Int (Int64)+import Data.Word (Word8) import Data.Numbers.Primes (primeFactors)  import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)@@ -57,6 +59,8 @@ -- > reverse == mconcat . List.reverse . factors -- > primePrefix == maybe mempty fst . splitPrimePrefix -- > primeSuffix == maybe mempty snd . splitPrimeSuffix+-- > inits == List.map mconcat . List.tails . factors+-- > tails == List.map mconcat . List.tails . factors -- > foldl f a == List.foldl f a . factors -- > foldl' f a == List.foldl' f a . factors -- > foldr f a == List.foldr f a . factors@@ -64,6 +68,15 @@ -- > List.all (List.all (not . pred) . factors) . split pred -- > mconcat . intersperse prime . split (== prime) == id -- > splitAt i m == (mconcat l, mconcat r) where (l, r) = List.splitAt i (factors m)+-- > spanMaybe () (const $ bool Nothing (Maybe ()) . p) m == (takeWhile p m, dropWhile p m, ())+-- > spanMaybe s0 (\s m-> Just $ f s m) m0 == (m0, mempty, foldl f s0 m0)+-- > let (prefix, suffix, s') = spanMaybe s f m+-- >     foldMaybe = foldl g (Just s)+-- >     g s m = s >>= flip f m+-- > in all ((Nothing ==) . foldMaybe) (inits prefix)+-- >    && prefix == last (filter (isJust . foldMaybe) $ inits m)+-- >    && Just s' == foldMaybe prefix+-- >    && m == prefix <> suffix -- -- A minimal instance definition must implement 'factors' or 'splitPrimePrefix'. Other methods are provided and should -- be implemented only for performance reasons.@@ -78,6 +91,10 @@    splitPrimePrefix :: m -> Maybe (m, m)    -- | Splits the argument into its prime suffix and the remaining prefix. Returns 'Nothing' for 'mempty'.    splitPrimeSuffix :: m -> Maybe (m, m)+   -- | Returns the list of all prefixes of the argument, 'mempty' first.+   inits :: m -> [m]+   -- | Returns the list of all suffixes of the argument, 'mempty' last.+   tails :: m -> [m]    -- | Like 'List.foldl' from "Data.List" on the list of 'primes'.    foldl :: (a -> m -> a) -> a -> m -> a    -- | Like 'List.foldl'' from "Data.List" on the list of 'primes'.@@ -88,26 +105,30 @@    length :: m -> Int    -- | Generalizes 'foldMap' from "Data.Foldable", except the function arguments are prime factors rather than the    -- structure elements.-   foldMap :: (FactorialMonoid m, Monoid n) => (m -> n) -> m -> n+   foldMap :: Monoid n => (m -> n) -> m -> n    -- | Like 'List.span' from "Data.List" on the list of 'primes'.    span :: (m -> Bool) -> m -> (m, m)    -- | Equivalent to 'List.break' from "Data.List".-   break :: FactorialMonoid m => (m -> Bool) -> m -> (m, m)+   break :: (m -> Bool) -> m -> (m, m)    -- | Splits the monoid into components delimited by prime separators satisfying the given predicate. The primes    -- satisfying the predicate are not a part of the result.    split :: (m -> Bool) -> m -> [m]    -- | Equivalent to 'List.takeWhile' from "Data.List".-   takeWhile :: FactorialMonoid m => (m -> Bool) -> m -> m+   takeWhile :: (m -> Bool) -> m -> m    -- | Equivalent to 'List.dropWhile' from "Data.List".-   dropWhile :: FactorialMonoid m => (m -> Bool) -> m -> m+   dropWhile :: (m -> Bool) -> m -> m+   -- | A stateful variant of 'span', threading the result of the test function as long as it returns 'Just'.+   spanMaybe :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)+   -- | Strict version of 'spanMaybe'.+   spanMaybe' :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)    -- | Like 'List.splitAt' from "Data.List" on the list of 'primes'.    splitAt :: Int -> m -> (m, m)    -- | Equivalent to 'List.drop' from "Data.List".-   drop :: FactorialMonoid m => Int -> m -> m+   drop :: Int -> m -> m    -- | Equivalent to 'List.take' from "Data.List".-   take :: FactorialMonoid m => Int -> m -> m+   take :: Int -> m -> m    -- | Equivalent to 'List.reverse' from "Data.List".-   reverse :: FactorialMonoid m => m -> m+   reverse :: m -> m     factors = List.unfoldr splitPrimePrefix    primePrefix = maybe mempty fst . splitPrimePrefix@@ -118,6 +139,8 @@    splitPrimeSuffix x = case factors x                         of [] -> Nothing                            fs -> Just (mconcat (List.init fs), List.last fs)+   inits = foldr (\m l-> mempty : List.map (mappend m) l) [mempty]+   tails m = m : maybe [] (tails . snd) (splitPrimePrefix m)    foldl f f0 = List.foldl f f0 . factors    foldl' f f0 = List.foldl' f f0 . factors    foldr f f0 = List.foldr f f0 . factors@@ -128,6 +151,17 @@                             of Just (prime, rest) | p prime -> spanAfter (f . mappend prime) rest                                _ -> (f mempty, m)    break = span . (not .)+   spanMaybe s0 f m0 = spanAfter id s0 m0+      where spanAfter g s m = case splitPrimePrefix m+                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest+                                                    | otherwise -> (g mempty, m, s)+                                 Nothing -> (m0, m, s)+   spanMaybe' s0 f m0 = spanAfter id s0 m0+      where spanAfter g s m = seq s $+                              case splitPrimePrefix m+                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest+                                                    | otherwise -> (g mempty, m, s)+                                 Nothing -> (m0, m, s)    split p m = prefix : splitRest       where (prefix, rest) = break p m             splitRest = case splitPrimePrefix rest@@ -171,6 +205,8 @@    splitPrimeSuffix (Dual a) = case splitPrimePrefix a                                of Nothing -> Nothing                                   Just (p, s) -> Just (Dual s, Dual p)+   inits (Dual a) = fmap Dual (reverse $ tails a)+   tails (Dual a) = fmap Dual (reverse $ inits a)    reverse (Dual a) = Dual (reverse a)  instance (Integral a, Eq a) => FactorialMonoid (Sum a) where@@ -210,6 +246,8 @@                              of (_, Just (bp, bs)) -> Just ((a, bp), (mempty, bs))                                 (Just (ap, as), Nothing) -> Just ((ap, b), (as, b))                                 (Nothing, Nothing) -> Nothing+   inits (a, b) = List.map (flip (,) mempty) (inits a) ++ List.map ((,) a) (List.tail $ inits b)+   tails (a, b) = List.map (flip (,) b) (tails a) ++ List.map ((,) mempty) (List.tail $ tails b)    foldl f a (x, y) = foldl f2 (foldl f1 a x) y       where f1 a = f a . fromFst             f2 a = f a . fromSnd@@ -224,6 +262,14 @@       where (xp, xs) = span (p . fromFst) x             (yp, ys) | null xs = span (p . fromSnd) y                      | otherwise = (mempty, y)+   spanMaybe s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)+                         | otherwise = ((xp, mempty), (xs, y), s1)+     where (xp, xs, s1) = spanMaybe s0 (\s-> f s . fromFst) x+           (yp, ys, s2) = spanMaybe s1 (\s-> f s . fromSnd) y+   spanMaybe' s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)+                          | otherwise = ((xp, mempty), (xs, y), s1)+     where (xp, xs, s1) = spanMaybe' s0 (\s-> f s . fromFst) x+           (yp, ys, s2) = spanMaybe' s1 (\s-> f s . fromSnd) y    split p (x, y) = fst $ List.foldr combine (ys, False) xs       where xs = List.map fromFst $ split (p . fromFst) x             ys = List.map fromSnd $ split (p . fromSnd) y@@ -255,6 +301,8 @@    splitPrimeSuffix xs = Just (split id xs)       where split f last@[x] = (f [], last)             split f (x:xs) = split (f . (x:)) xs+   inits = List.inits+   tails = List.tails    foldl _ a [] = a    foldl f a (x:xs) = foldl f (f a [x]) xs    foldl' _ a [] = a@@ -267,6 +315,14 @@    span f = List.span (f . (:[]))    dropWhile f = List.dropWhile (f . (:[]))    takeWhile f = List.takeWhile (f . (:[]))+   spanMaybe s0 f l = (prefix' [], suffix' [], s')+      where (prefix', suffix', s', live') = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s, live) x | live, Just s' <- f s [x] = (prefix . (x:), id, s', True)+                                          | otherwise = (prefix, suffix . (x:), s, False)+   spanMaybe' s0 f l = (prefix' [], suffix' [], s')+      where (prefix', suffix', s', live') = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s, live) x | live, Just s' <- f s [x] = seq s' $ (prefix . (x:), id, s', True)+                                          | otherwise = (prefix, suffix . (x:), s, False)    splitAt = List.splitAt    drop = List.drop    take = List.take@@ -281,6 +337,8 @@    primeSuffix x = ByteString.drop (ByteString.length x - 1) x    splitPrimePrefix x = if ByteString.null x then Nothing else Just (ByteString.splitAt 1 x)    splitPrimeSuffix x = if ByteString.null x then Nothing else Just (ByteString.splitAt (ByteString.length x - 1) x)+   inits = ByteString.inits+   tails = ByteString.tails    foldl f = ByteString.foldl f'       where f' a byte = f a (ByteString.singleton byte)    foldl' f = ByteString.foldl' f'@@ -288,6 +346,14 @@    foldr f = ByteString.foldr (f . ByteString.singleton)    break f = ByteString.break (f . ByteString.singleton)    span f = ByteString.span (f . ByteString.singleton)+   spanMaybe s0 f b = case ByteString.foldr g id b (0, s0)+                      of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')+      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 f b = case ByteString.foldr g id b (0, s0)+                       of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')+      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')+                            | otherwise = (i, s)    dropWhile f = ByteString.dropWhile (f . ByteString.singleton)    takeWhile f = ByteString.takeWhile (f . ByteString.singleton)    length = ByteString.length@@ -309,6 +375,8 @@                         else Just (LazyByteString.splitAt 1 x)    splitPrimeSuffix x = if LazyByteString.null x then Nothing                          else Just (LazyByteString.splitAt (LazyByteString.length x - 1) x)+   inits = LazyByteString.inits+   tails = LazyByteString.tails    foldl f = LazyByteString.foldl f'       where f' a byte = f a (LazyByteString.singleton byte)    foldl' f = LazyByteString.foldl' f'@@ -318,6 +386,15 @@    length = fromIntegral . LazyByteString.length    break f = LazyByteString.break (f . LazyByteString.singleton)    span f = LazyByteString.span (f . LazyByteString.singleton)+   spanMaybe s0 f b = case LazyByteString.foldr g id b (0, s0)+                      of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')+      where g w cont (i, s) | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 f b = case LazyByteString.foldr g id b (0, s0)+                       of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')+      where g w cont (i, s)+              | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')+              | otherwise = (i, s)    dropWhile f = LazyByteString.dropWhile (f . LazyByteString.singleton)    takeWhile f = LazyByteString.takeWhile (f . LazyByteString.singleton)    split f = LazyByteString.splitWith f'@@ -333,6 +410,8 @@    primeSuffix x = if Text.null x then Text.empty else Text.singleton (Text.last x)    splitPrimePrefix = fmap (first Text.singleton) . Text.uncons    splitPrimeSuffix x = if Text.null x then Nothing else Just (Text.init x, Text.singleton (Text.last x))+   inits = Text.inits+   tails = Text.tails    foldl f = Text.foldl f'       where f' a char = f a (Text.singleton char)    foldl' f = Text.foldl' f'@@ -344,6 +423,14 @@    break f = Text.break (f . Text.singleton)    dropWhile f = Text.dropWhile (f . Text.singleton)    takeWhile f = Text.takeWhile (f . Text.singleton)+   spanMaybe s0 f t = case Text.foldr g id t (0, s0)+                      of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 f t = case Text.foldr g id t (0, s0)+                       of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')+                            | otherwise = (i, s)    split f = Text.split f'       where f' = f . Text.singleton    splitAt = Text.splitAt@@ -359,6 +446,8 @@    splitPrimeSuffix x = if LazyText.null x                         then Nothing                         else Just (LazyText.init x, LazyText.singleton (LazyText.last x))+   inits = LazyText.inits+   tails = LazyText.tails    foldl f = LazyText.foldl f'       where f' a char = f a (LazyText.singleton char)    foldl' f = LazyText.foldl' f'@@ -370,6 +459,14 @@    break f = LazyText.break (f . LazyText.singleton)    dropWhile f = LazyText.dropWhile (f . LazyText.singleton)    takeWhile f = LazyText.takeWhile (f . LazyText.singleton)+   spanMaybe s0 f t = case LazyText.foldr g id t (0, s0)+                      of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 f t = case LazyText.foldr g id t (0, s0)+                       of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')+                            | otherwise = (i, s)    split f = LazyText.split f'       where f' = f . LazyText.singleton    splitAt = LazyText.splitAt . fromIntegral@@ -444,6 +541,8 @@    splitPrimeSuffix seq = case Sequence.viewr seq                           of Sequence.EmptyR -> Nothing                              rest Sequence.:> last -> Just (rest, Sequence.singleton last)+   inits = Foldable.toList . Sequence.inits+   tails = Foldable.toList . Sequence.tails    foldl f = Foldable.foldl f'       where f' a b = f a (Sequence.singleton b)    foldl' f = Foldable.foldl' f'@@ -454,6 +553,14 @@    break f = Sequence.breakl (f . Sequence.singleton)    dropWhile f = Sequence.dropWhileL (f . Sequence.singleton)    takeWhile f = Sequence.takeWhileL (f . Sequence.singleton)+   spanMaybe s0 f b = case Foldable.foldr g id b (0, s0)+                      of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')+      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 f b = case Foldable.foldr g id b (0, s0)+                       of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')+      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')+                            | otherwise = (i, s)    splitAt = Sequence.splitAt    drop = Sequence.drop    take = Sequence.take@@ -483,11 +590,15 @@    factors x = factorize (Vector.length x) x       where factorize 0 xs = []             factorize n xs = x : factorize (pred n) xs'-              where (x, xs') = Vector.splitAt 1 xs+               where (x, xs') = Vector.splitAt 1 xs    primePrefix = Vector.take 1    primeSuffix x = Vector.drop (Vector.length x - 1) x    splitPrimePrefix x = if Vector.null x then Nothing else Just (Vector.splitAt 1 x)    splitPrimeSuffix x = if Vector.null x then Nothing else Just (Vector.splitAt (Vector.length x - 1) x)+   inits x = initsWith x []+      where initsWith x rest | Vector.null x = x:rest+                             | otherwise = initsWith (Vector.unsafeInit x) (x:rest)+   tails x = x : if Vector.null x then [] else tails (Vector.unsafeTail x)    foldl f = Vector.foldl f'       where f' a byte = f a (Vector.singleton byte)    foldl' f = Vector.foldl' f'@@ -498,6 +609,16 @@    span f = Vector.span (f . Vector.singleton)    dropWhile f = Vector.dropWhile (f . Vector.singleton)    takeWhile f = Vector.takeWhile (f . Vector.singleton)+   spanMaybe s0 f v = case Vector.ifoldr g Left v s0+                      of Left s' -> (v, Vector.empty, s')+                         Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')+      where g i x cont s | Just s' <- f s (Vector.singleton x) = cont s'+                         | otherwise = Right (i, s)+   spanMaybe' s0 f v = case Vector.ifoldr' g Left v s0+                       of Left s' -> (v, Vector.empty, s')+                          Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')+      where g i x cont s | Just s' <- f s (Vector.singleton x) = seq s' (cont s')+                         | otherwise = Right (i, s)    splitAt = Vector.splitAt    drop = Vector.drop    take = Vector.take

@@ -8,6 +8,8 @@ -- instance. --  +{-# LANGUAGE Haskell2010 #-}+ module Data.Monoid.Instances.ByteString.UTF8 (    ByteStringUTF8(..), decode    )@@ -16,19 +18,22 @@ import Prelude hiding (drop, dropWhile, foldl, foldl1, foldr, foldr1, scanl, scanr, scanl1, scanr1,                        map, concatMap, break, span) +import Control.Exception (assert) import Data.Bits ((.&.), (.|.), shiftL, shiftR) import Data.Char (chr, ord) import qualified Data.Foldable as Foldable import qualified Data.List as List-import Data.Maybe (fromMaybe)+import Data.Functor ((<$>))+import Data.Maybe (fromJust, fromMaybe) import Data.String (IsString(fromString)) import Data.Word (Word8) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as ByteString.Char8-import Data.ByteString.Unsafe (unsafeDrop, unsafeHead, unsafeTail, unsafeIndex)+import Data.ByteString.Internal (w2c)+import Data.ByteString.Unsafe (unsafeDrop, unsafeHead, unsafeTail, unsafeTake, unsafeIndex) -import Data.Monoid (Monoid(mempty, mappend))+import Data.Monoid (Monoid(mempty, mappend), (<>)) import Data.Monoid.Cancellative (LeftReductiveMonoid(..), LeftCancellativeMonoid, LeftGCDMonoid(..)) import Data.Monoid.Null (MonoidNull(null), PositiveMonoid) import Data.Monoid.Factorial (FactorialMonoid(..))@@ -54,20 +59,27 @@  instance Monoid ByteStringUTF8 where    mempty = ByteStringUTF8 ByteString.empty+   {-# INLINE mempty #-}    ByteStringUTF8 a `mappend` ByteStringUTF8 b = ByteStringUTF8 (a `mappend` b)+   {-# INLINE mappend #-}  instance MonoidNull ByteStringUTF8 where    null (ByteStringUTF8 b) = ByteString.null b+   {-# INLINE null #-}  instance LeftReductiveMonoid ByteStringUTF8 where    stripPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = fmap ByteStringUTF8 (stripPrefix a b)+   {-# INLINE stripPrefix #-}    ByteStringUTF8 a `isPrefixOf` ByteStringUTF8 b = a `isPrefixOf` b+   {-# INLINE isPrefixOf #-}  instance LeftCancellativeMonoid ByteStringUTF8  instance LeftGCDMonoid ByteStringUTF8 where    commonPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = ByteStringUTF8 (commonPrefix a b)+   {-# INLINE commonPrefix #-}    stripCommonPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = wrapTriple (stripCommonPrefix a b)+   {-# INLINE stripCommonPrefix #-}  instance Show ByteStringUTF8 where    showsPrec _ bs s = '"' : Textual.foldr showsBytes (:) ('"' : s) bs@@ -75,6 +87,7 @@  instance IsString ByteStringUTF8 where    fromString = ByteStringUTF8 . Foldable.foldMap fromChar+   {-# INLINE fromString #-}  instance PositiveMonoid ByteStringUTF8 @@ -85,39 +98,50 @@       | otherwise = case ByteString.findIndex byteStartsCharacter (unsafeTail bs)                     of Just i -> Just (wrapPair $ ByteString.splitAt (succ i) bs)                        Nothing -> Just (utf8, ByteStringUTF8 $ ByteString.empty)+   {-# INLINABLE splitPrimePrefix #-}    splitPrimeSuffix utf8@(ByteStringUTF8 bs)       | ByteString.null bs = Nothing       | ByteString.null prefix = Just (wrapPair split)       | not (ByteString.null suffix) && ByteString.last prefix < 0x80 = Just (wrapPair split)       | otherwise = Just (wrapPair $ ByteString.splitAt (pred $ ByteString.length prefix) bs)       where split@(prefix, suffix) = ByteString.breakEnd byteStartsCharacter bs+   {-# INLINABLE splitPrimeSuffix #-}    primePrefix utf8@(ByteStringUTF8 bs)       | ByteString.null bs = utf8       | unsafeHead bs < 0x80 = ByteStringUTF8 (ByteString.take 1 bs)       | otherwise = case ByteString.findIndex byteStartsCharacter (unsafeTail bs)                     of Just i -> ByteStringUTF8 (ByteString.take (succ i) bs)                        Nothing -> utf8+   {-# INLINABLE primePrefix #-}    factors (ByteStringUTF8 bs) = List.map ByteStringUTF8 $ ByteString.groupBy continued bs       where continued a b = a >= 0x80 && b >= 0x80 && b < 0xC0+   {-# INLINABLE factors #-}    length (ByteStringUTF8 bs) = fst (ByteString.foldl' count (0, False) bs)       where count (n, high) byte | byte < 0x80 = (succ n, False)                                  | byte < 0xC0 = (if high then n else succ n, True)                                  | otherwise = (succ n, True)+   {-# INLINABLE length #-}    foldl f a0 (ByteStringUTF8 bs) = List.foldl f' a0 (groupASCII bs)       where f' a b | unsafeHead b < 0x80 = ByteString.foldl f'' a b                    | otherwise = f a (ByteStringUTF8 b)             f'' a w = f a (ByteStringUTF8 $ ByteString.singleton w)+   {-# INLINABLE foldl #-}    foldl' f a0 (ByteStringUTF8 bs) = List.foldl' f' a0 (groupASCII bs)       where f' a b | unsafeHead b < 0x80 = ByteString.foldl' f'' a b                    | otherwise = f a (ByteStringUTF8 b)             f'' a w = f a (ByteStringUTF8 $ ByteString.singleton w)+   {-# INLINABLE foldl' #-}    foldr f a0 (ByteStringUTF8 bs) = List.foldr f' a0 (groupASCII bs)       where f' b a | unsafeHead b < 0x80 = ByteString.foldr f'' a b                    | otherwise = f (ByteStringUTF8 b) a             f'' w a = f (ByteStringUTF8 $ ByteString.singleton w) a+   {-# INLINABLE foldr #-}    splitAt n (ByteStringUTF8 bs) = wrapPair (ByteString.splitAt (charStartIndex n bs) bs)+   {-# INLINE splitAt #-}    take n (ByteStringUTF8 bs) = ByteStringUTF8 (ByteString.take (charStartIndex n bs) bs)+   {-# INLINE take #-}    drop n (ByteStringUTF8 bs) = ByteStringUTF8 (ByteString.drop (charStartIndex n bs) bs)+   {-# INLINE drop #-}    dropWhile p (ByteStringUTF8 bs) = dropASCII bs       where dropASCII bs =                let suffix = ByteString.dropWhile (\w-> w < 0x80 && p (ByteStringUTF8 $ ByteString.singleton w)) bs@@ -132,36 +156,107 @@                                in if p (ByteStringUTF8 hd)                                   then dropASCII tl                                   else utf8+   {-# INLINE dropWhile #-}    takeWhile p utf8@(ByteStringUTF8 bs) =       ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length s) bs       where suffix@(ByteStringUTF8 s) = Factorial.dropWhile p utf8+   {-# INLINE takeWhile #-}    span p utf8@(ByteStringUTF8 bs) =       (ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length s) bs, suffix)       where suffix@(ByteStringUTF8 s) = Factorial.dropWhile p utf8+   {-# INLINE span #-}    break p = Factorial.span (not . p)+   {-# INLINE break #-}+   spanMaybe s0 f (ByteStringUTF8 bs) = (ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length dropped) bs,+                                         ByteStringUTF8 dropped,+                                         s')+      where (dropped, s') = dropASCII s0 bs+            dropASCII s bs =+               let suffix = ByteString.drop index bs+                   (index, s') = ByteString.foldr f8 id bs (0, s)+                   f8 w cont (i, s)+                     | w < 0x80, Just s' <- f s (ByteStringUTF8 $ ByteString.singleton w) =+                         let i' = succ i :: Int in seq i' $ cont (i', s')+                     | otherwise = (i, s)+               in if ByteString.null suffix || unsafeHead suffix < 0x80+                  then (suffix, s')+                  else dropMultiByte s' suffix+            dropMultiByte s bs =+               case ByteString.findIndex byteStartsCharacter (unsafeTail bs)+               of Nothing -> case f s (ByteStringUTF8 bs)+                             of Just s' -> (ByteString.empty, s')+                                Nothing -> (bs, s)+                  Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs+                            in case f s (ByteStringUTF8 hd)+                               of Just s' -> dropASCII s' tl+                                  Nothing -> (bs, s)+   {-# INLINE spanMaybe #-}+   spanMaybe' s0 f (ByteStringUTF8 bs) = (ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length dropped) bs,+                                          ByteStringUTF8 dropped,+                                          s')+      where (dropped, s') = dropASCII s0 bs+            dropASCII s bs =+               let suffix = ByteString.drop index bs+                   (index, s') = ByteString.foldr f8 id bs (0, s)+                   f8 w cont (i, s)+                     | w < 0x80, Just s' <- f s (ByteStringUTF8 $ ByteString.singleton w) =+                         let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')+                     | otherwise = (i, s)+               in if ByteString.null suffix || unsafeHead suffix < 0x80+                  then (suffix, s')+                  else dropMultiByte s' suffix+            dropMultiByte s bs =+               case ByteString.findIndex byteStartsCharacter (unsafeTail bs)+               of Nothing -> case f s (ByteStringUTF8 bs)+                             of Just s' -> seq s' (ByteString.empty, s')+                                Nothing -> (bs, s)+                  Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs+                            in case f s (ByteStringUTF8 hd)+                               of Just s' -> seq s' (dropASCII s' tl)+                                  Nothing -> (bs, s)+   {-# INLINE spanMaybe' #-}    reverse (ByteStringUTF8 bs) =       ByteStringUTF8 (ByteString.concat $ List.reverse $ List.map reverseASCII $ groupASCII bs)       where reverseASCII b | unsafeHead b < 0x80 = ByteString.reverse b                            | otherwise = b+   {-# INLINABLE reverse #-}  instance TextualMonoid ByteStringUTF8 where    singleton = ByteStringUTF8 . fromChar+   {-# INLINE singleton #-}    splitCharacterPrefix (ByteStringUTF8 bs) = ByteString.uncons bs >>= uncurry toChar-   foldl ft fc a0 (ByteStringUTF8 bs) = List.foldl f a0 (groupASCII bs)-      where f a b = let hd = unsafeHead b-                    in if hd < 0x80-                       then ByteString.Char8.foldl fc a b-                       else maybe (ft a $ ByteStringUTF8 b) (fc a . fst) (toChar hd $ unsafeTail b)-   foldl' ft fc a0 (ByteStringUTF8 bs) = List.foldl' f a0 (groupASCII bs)-      where f a b = let hd = unsafeHead b-                    in if hd < 0x80-                       then ByteString.Char8.foldl' fc a b-                       else maybe (ft a $ ByteStringUTF8 b) (fc a . fst) (toChar hd $ unsafeTail b)-   foldr ft fc a0 (ByteStringUTF8 bs) = List.foldr f a0 (groupASCII bs)-      where f b a = let hd = unsafeHead b-                    in if hd < 0x80-                       then ByteString.Char8.foldr fc a b-                       else maybe (ft (ByteStringUTF8 b) a) (flip fc a . fst) (toChar hd $ unsafeTail b)+   {-# INLINE splitCharacterPrefix #-}+   foldl ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldl f (a0, []) bs+                                        of (a, []) -> a+                                           (a, acc) -> multiByte a acc+      where f (a, []) c | c < '\x80' = (fc a c, [])+                        | otherwise = (a, [fromIntegral $ ord c])+            f (a, acc) c | c < '\x80' = (fc (multiByte a acc) c, [])+                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)+                         | otherwise = (multiByte a acc, [fromIntegral $ ord c])+            multiByte a acc = reverseBytesToChar (ft a . ByteStringUTF8) (fc a) acc+   {-# INLINE foldl #-}+   foldl' ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldl' f (a0, []) bs+                                         of (a, []) -> a+                                            (a, acc) -> multiByte a acc+      where f (a, []) c | c < '\x80' = (fc a c, [])+                        | otherwise = seq a (a, [fromIntegral $ ord c])+            f (a, acc) c | seq a c < '\x80' = let a' = multiByte a acc in seq a' (fc a' c, [])+                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)+                         | otherwise = let a' = multiByte a acc in seq a' (a', [fromIntegral $ ord c])+            multiByte a acc = reverseBytesToChar (ft a . ByteStringUTF8) (fc a) acc+                                                                  +   {-# INLINE foldl' #-}+   foldr ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldr f (a0, []) bs+                                        of (a, []) -> a+                                           (a, acc) -> multiByte a acc+      where f c (a, []) | c < '\x80' = (fc c a, [])+                        | otherwise = (a, [fromIntegral $ ord c])+            f c (a, acc) | c < '\x80' = (fc c (multiByte a acc), [])+                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)+                         | otherwise = (multiByte a acc, [fromIntegral $ ord c])+            multiByte a acc = reverseBytesToChar ((`ft` a) . ByteStringUTF8) (`fc` a) acc+   {-# INLINE foldr #-}    dropWhile pb pc (ByteStringUTF8 bs) = ByteStringUTF8 $ dropASCII bs       where dropASCII rest = case ByteString.Char8.findIndex (\c-> c > '\x7f' || not (pc c)) rest                              of Nothing -> ByteString.empty@@ -176,16 +271,97 @@                                                   then dropASCII (unsafeDrop j rest)                                                   else rest                                     _ -> rest+   {-# INLINE dropWhile #-}    takeWhile pb pc utf8@(ByteStringUTF8 bs) =-      ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length suffix) bs-      where ByteStringUTF8 suffix = Textual.dropWhile pb pc utf8-   span pb pc utf8@(ByteStringUTF8 bs) =-      wrapPair $ ByteString.splitAt (ByteString.length bs - ByteString.length suffix) bs+      ByteStringUTF8 $ unsafeTake (ByteString.length bs - ByteString.length suffix) bs       where ByteStringUTF8 suffix = Textual.dropWhile pb pc utf8+   {-# INLINE takeWhile #-}+   span pb pc utf8@(ByteStringUTF8 bs) = (ByteStringUTF8 $ unsafeTake (ByteString.length bs - ByteString.length suffix') bs, suffix)+      where suffix@(ByteStringUTF8 suffix') = Textual.dropWhile pb pc utf8+   {-# INLINE span #-}    break pb pc = Textual.span (not . pb) (not . pc)+   {-# INLINE break #-}+   spanMaybe s0 ft fc (ByteStringUTF8 bs)  =+      let inner i s+            | i < len =+                let w = unsafeIndex bs i+                in if w < 0x80+                   then case fc s (w2c w)+                        of Just s' -> inner (i + 1) s'+                           Nothing -> done i s+                   else case splitCharacterPrefix (ByteStringUTF8 $ unsafeDrop i bs)+                        of Just (c, ByteStringUTF8 rest) | Just s' <- fc s c -> inner (len - ByteString.length rest) s'+                           Nothing -> let j = succ (headIndex $ drop (i + 1) bs)+                                      in case ft s (ByteStringUTF8 $ ByteString.take j $ unsafeDrop i bs)+                                         of Just s' -> inner (i + j) s'+                                            Nothing -> done i s+                           _ -> done i s+            | otherwise = done i s+          done i s = i `seq` s `seq` (ByteStringUTF8 $ unsafeTake i bs, ByteStringUTF8 $ unsafeDrop i bs, s)+          len = ByteString.length bs+      in inner 0 s0+   {-# INLINE spanMaybe #-}+   spanMaybe' s0 ft fc (ByteStringUTF8 bs)  =+      let inner i s+            | i < len =+                s `seq`+                let w = unsafeIndex bs i+                in if w < 0x80+                   then case fc s (w2c w)+                        of Just s' -> inner (i + 1) s'+                           Nothing -> done i s+                   else case splitCharacterPrefix (ByteStringUTF8 $ unsafeDrop i bs)+                        of Just (c, ByteStringUTF8 rest) | Just s' <- fc s c -> inner (len - ByteString.length rest) s'+                           Nothing -> let j = succ (headIndex $ drop (i + 1) bs)+                                      in case ft s (ByteStringUTF8 $ ByteString.take j $ unsafeDrop i bs)+                                         of Just s' -> inner (i + j) s'+                                            Nothing -> done i s+                           _ -> done i s+            | otherwise = done i s+          done i s = i `seq` s `seq` (ByteStringUTF8 $ unsafeTake i bs, ByteStringUTF8 $ unsafeDrop i bs, s)+          len = ByteString.length bs+      in inner 0 s0+   {-# INLINE spanMaybe' #-}+   find p (ByteStringUTF8 bs) = loop bs+      where loop bs = case ByteString.Char8.findIndex (\c-> c >= '\x80' || p c) bs+                      of Nothing -> Nothing+                         Just i -> let x = unsafeIndex bs i+                                       bs' = unsafeDrop (i + 1) bs+                                   in if x < 0x80+                                      then Just (w2c x)+                                      else case toChar x bs'+                                           of Just (c, ByteStringUTF8 rest) | p c -> Just c+                                                                            | otherwise -> loop rest+                                              Nothing -> loop (ByteString.dropWhile (not . byteStartsCharacter) bs')+   {-# INLINE find #-} +reverseBytesToChar :: (ByteString -> a) -> (Char -> a) -> [Word8] -> a+reverseBytesToChar ft fc [w] = if w < 0x80 then fc (w2c w) else ft (ByteString.singleton w)+reverseBytesToChar ft fc [b0, b1] =+  assert (0x80 <= b0 && b0 < 0xC0 && 0xC0 <= b1) $+  if b1 < 0xE0+  then fc (chr (shiftL (fromIntegral b1 .&. 0x1F) 6 .|. fromIntegral b0 .&. 0x3F))+  else ft (ByteString.pack [b1, b0])+reverseBytesToChar ft fc [b0, b1, b2] =+  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0 && 0xC0 <= b2) $+  if (0xE0 < b2 || 0xE0 == b2 && 0xA0 <= b1) && b2 < 0xF0+  then fc (chr (shiftL (fromIntegral b2 .&. 0xF) 12+                .|. shiftL (fromIntegral b1 .&. 0x3F) 6+                .|. fromIntegral b0 .&. 0x3F))+  else ft (ByteString.pack [b2, b1, b0])+reverseBytesToChar ft fc [b0, b1, b2, b3] =+  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0 && 0x80 <= b2 && b2 < 0xC0 && 0xC0 <= b3) $+  if (0xF0 < b3 || 0xF0 == b3 && 0xA0 <= b2) && b3 < 0xF4+  then fc (chr (shiftL (fromIntegral b3 .&. 0x7) 18+                .|. shiftL (fromIntegral b2 .&. 0x3F) 12+                .|. shiftL (fromIntegral b1 .&. 0x3F) 6+                .|. fromIntegral b0 .&. 0x3F))+  else ft (ByteString.pack [b3, b2, b1, b0])+ wrapPair (bs1, bs2) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2)+{-# INLINE wrapPair #-} wrapTriple (bs1, bs2, bs3) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2, ByteStringUTF8 bs3)+{-# INLINE wrapTriple #-}  fromChar :: Char -> ByteString fromChar c | c < '\x80'    = ByteString.Char8.singleton c@@ -201,7 +377,7 @@    where n = ord c  toChar :: Word8 -> ByteString -> Maybe (Char, ByteStringUTF8)-toChar hd tl | hd < 0x80 = Just (chr $ fromIntegral hd, ByteStringUTF8 tl)+toChar hd tl | hd < 0x80 = Just (w2c hd, ByteStringUTF8 tl)              | hd < 0xC2 = Nothing              | hd < 0xE0 = do (b0, t0) <- ByteString.uncons tl                               if headIndex tl == 1@@ -232,11 +408,14 @@ groupASCII :: ByteString -> [ByteString] groupASCII = ByteString.groupBy continued    where continued a b = (a < 0x80) == (b < 0x80) && b < 0xC0+{-# INLINE groupASCII #-}  headIndex bs = fromMaybe (ByteString.length bs) $ ByteString.findIndex byteStartsCharacter bs+{-# INLINE headIndex #-}  byteStartsCharacter :: Word8 -> Bool byteStartsCharacter b = b < 0x80 || b >= 0xC0+{-# INLINE byteStartsCharacter #-}  charStartIndex :: Int -> ByteString -> Int charStartIndex n _ | n <= 0 = 0@@ -244,3 +423,4 @@    case List.drop (pred n) (ByteString.findIndices byteStartsCharacter $ ByteString.drop 1 bs)    of [] -> ByteString.length bs       k:_ -> succ k+{-# INLINE charStartIndex #-}

@@ -85,15 +85,19 @@  instance MonoidNull ByteString.ByteString where    null = ByteString.null+   {-# INLINE null #-}  instance MonoidNull LazyByteString.ByteString where    null = LazyByteString.null+   {-# INLINE null #-}  instance MonoidNull Text.Text where    null = Text.null+   {-# INLINE null #-}  instance MonoidNull LazyText.Text where    null = LazyText.null+   {-# INLINE null #-}  instance Ord k => MonoidNull (Map.Map k v) where    null = Map.null

@@ -28,6 +28,7 @@ import qualified Data.Sequence as Sequence import qualified Data.Vector as Vector import Data.String (IsString(fromString))+import Data.Int (Int64)  import Data.Monoid.Null (MonoidNull (null)) import Data.Monoid.Cancellative (LeftReductiveMonoid, LeftGCDMonoid)@@ -112,7 +113,7 @@    -- | Strict version of 'foldl'.    foldl'  :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a    -- | The first argument folds over the non-character prime factors, the second over characters. Otherwise equivalent-   -- to 'List.foldr' from "Data.List".+   -- to 'List.foldl\'' from "Data.List".    foldr   :: (t -> a -> a) -> (Char -> a -> a) -> a -> t -> a     -- | Equivalent to 'List.scanl' from "Data.List" when applied to a 'String', but preserves all non-character data.@@ -144,6 +145,10 @@    break :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)    -- | 'span pt pc t' is equivalent to |(takeWhile pt pc t, dropWhile pt pc t)|.    span :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)+   -- | A stateful variant of 'span', threading the result of the test function as long as it returns 'Just'.+   spanMaybe :: s -> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)+   -- | Strict version of 'spanMaybe'.+   spanMaybe' :: s -> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)    -- | Splits the monoid into components delimited by character separators satisfying the given predicate. The    -- characters satisfying the predicate are not a part of the result.    --@@ -189,12 +194,42 @@    dropWhile pt pc = snd . span pt pc    span pt pc = Factorial.span (\prime-> maybe (pt prime) pc (characterPrefix prime))    break pt pc = Factorial.break (\prime-> maybe (pt prime) pc (characterPrefix prime))+   spanMaybe s0 ft fc t0 = spanAfter id s0 t0+      where spanAfter g s t = case Factorial.splitPrimePrefix t+                              of Just (prime, rest) | Just s' <- maybe (ft s prime) (fc s) (characterPrefix prime) ->+                                                        spanAfter (g . mappend prime) s' rest+                                                    | otherwise -> (g mempty, t, s)+                                 Nothing -> (t0, t, s)+   spanMaybe' s0 ft fc t0 = spanAfter id s0 t0+      where spanAfter g s t = seq s $+                              case Factorial.splitPrimePrefix t+                              of Just (prime, rest) | Just s' <- maybe (ft s prime) (fc s) (characterPrefix prime) ->+                                                        spanAfter (g . mappend prime) s' rest+                                                    | otherwise -> (g mempty, t, s)+                                 Nothing -> (t0, t, s)    split p m = prefix : splitRest       where (prefix, rest) = break (const False) p m             splitRest = case splitCharacterPrefix rest                         of Nothing -> []                            Just (_, tail) -> split p tail    find p = foldr (const id) (\c r-> if p c then Just c else r) Nothing+   {-# INLINE characterPrefix #-}+   {-# INLINE concatMap #-}+   {-# INLINE dropWhile #-}+   {-# INLINE find #-}+   {-# INLINE fromText #-}+   {-# INLINE map #-}+   {-# INLINE mapAccumL #-}+   {-# INLINE mapAccumR #-}+   {-# INLINE scanl #-}+   {-# INLINE scanl1 #-}+   {-# INLINE scanr #-}+   {-# INLINE scanr1 #-}+   {-# INLINE singleton #-}+   {-# INLINE spanMaybe #-}+   {-# INLINE spanMaybe' #-}+   {-# INLINE split #-}+   {-# INLINE takeWhile #-}  foldlChars f (t, c1) c2 = (mappend t (singleton c'), c')    where c' = f c1 c2@@ -230,7 +265,40 @@    dropWhile _ = List.dropWhile    break _ = List.break    span _ = List.span+   spanMaybe s0 ft fc l = (prefix' [], suffix' [], s')+      where (prefix', suffix', s', live') = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s, live) c | live, Just s' <- fc s c = (prefix . (c:), id, s', True)+                                          | otherwise = (prefix, suffix . (c:), s, False)+   spanMaybe' s0 ft fc l = (prefix' [], suffix' [], s')+      where (prefix', suffix', s', live') = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s, live) c | live, Just s' <- fc s c = seq s' (prefix . (c:), id, s', True)+                                          | otherwise = (prefix, suffix . (c:), s, False)    find = List.find+   {-# INLINE all #-}+   {-# INLINE any #-}+   {-# INLINE break #-}+   {-# INLINE characterPrefix #-}+   {-# INLINE concatMap #-}+   {-# INLINE dropWhile #-}+   {-# INLINE find #-}+   {-# INLINE foldl   #-}+   {-# INLINE foldl'  #-}+   {-# INLINE foldr   #-}+   {-# INLINE fromText #-}+   {-# INLINE map #-}+   {-# INLINE mapAccumL #-}+   {-# INLINE mapAccumR #-}+   {-# INLINE scanl #-}+   {-# INLINE scanl1 #-}+   {-# INLINE scanr #-}+   {-# INLINE scanr1 #-}+   {-# INLINE singleton #-}+   {-# INLINE span #-}+   {-# INLINE spanMaybe #-}+   {-# INLINE spanMaybe' #-}+   {-# INLINE split #-}+   {-# INLINE splitCharacterPrefix #-}+   {-# INLINE takeWhile #-}  instance TextualMonoid Text where    fromText = id@@ -257,8 +325,41 @@    dropWhile _ = Text.dropWhile    break _ = Text.break    span _ = Text.span+   spanMaybe s0 ft fc t = case Text.foldr g id t (0, s0)+                          of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 ft fc t = case Text.foldr g id t (0, s0)+                           of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')+                            | otherwise = (i, s)    split = Text.split    find = Text.find+   {-# INLINE all #-}+   {-# INLINE any #-}+   {-# INLINE break #-}+   {-# INLINE characterPrefix #-}+   {-# INLINE concatMap #-}+   {-# INLINE dropWhile #-}+   {-# INLINE find #-}+   {-# INLINE foldl   #-}+   {-# INLINE foldl'  #-}+   {-# INLINE foldr   #-}+   {-# INLINE fromText #-}+   {-# INLINE map #-}+   {-# INLINE mapAccumL #-}+   {-# INLINE mapAccumR #-}+   {-# INLINE scanl #-}+   {-# INLINE scanl1 #-}+   {-# INLINE scanr #-}+   {-# INLINE scanr1 #-}+   {-# INLINE singleton #-}+   {-# INLINE span #-}+   {-# INLINE spanMaybe #-}+   {-# INLINE spanMaybe' #-}+   {-# INLINE split #-}+   {-# INLINE splitCharacterPrefix #-}+   {-# INLINE takeWhile #-}  instance TextualMonoid LazyText.Text where    fromText = LazyText.fromStrict@@ -285,8 +386,41 @@    dropWhile _ = LazyText.dropWhile    break _ = LazyText.break    span _ = LazyText.span+   spanMaybe s0 ft fc t = case LazyText.foldr g id t (0, s0)+                          of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int64 in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 ft fc t = case LazyText.foldr g id t (0, s0)+                           of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')+                            | otherwise = (i, s)    split = LazyText.split    find = LazyText.find+   {-# INLINE all #-}+   {-# INLINE any #-}+   {-# INLINE break #-}+   {-# INLINE characterPrefix #-}+   {-# INLINE concatMap #-}+   {-# INLINE dropWhile #-}+   {-# INLINE find #-}+   {-# INLINE foldl   #-}+   {-# INLINE foldl'  #-}+   {-# INLINE foldr   #-}+   {-# INLINE fromText #-}+   {-# INLINE map #-}+   {-# INLINE mapAccumL #-}+   {-# INLINE mapAccumR #-}+   {-# INLINE scanl #-}+   {-# INLINE scanl1 #-}+   {-# INLINE scanr #-}+   {-# INLINE scanr1 #-}+   {-# INLINE singleton #-}+   {-# INLINE span #-}+   {-# INLINE spanMaybe #-}+   {-# INLINE spanMaybe' #-}+   {-# INLINE split #-}+   {-# INLINE splitCharacterPrefix #-}+   {-# INLINE takeWhile #-}  instance IsString (Sequence.Seq Char) where    fromString = Sequence.fromList@@ -319,7 +453,40 @@    dropWhile _ = Sequence.dropWhileL    break _ = Sequence.breakl    span _ = Sequence.spanl+   spanMaybe s0 ft fc b = case Foldable.foldr g id b (0, s0)+                          of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ cont (i', s')+                            | otherwise = (i, s)+   spanMaybe' s0 ft fc b = case Foldable.foldr g id b (0, s0)+                           of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')+                            | otherwise = (i, s)    find = Foldable.find+   {-# INLINE all #-}+   {-# INLINE any #-}+   {-# INLINE break #-}+   {-# INLINE characterPrefix #-}+   {-# INLINE concatMap #-}+   {-# INLINE dropWhile #-}+   {-# INLINE find #-}+   {-# INLINE foldl   #-}+   {-# INLINE foldl'  #-}+   {-# INLINE foldr   #-}+   {-# INLINE fromText #-}+   {-# INLINE map #-}+   {-# INLINE mapAccumL #-}+   {-# INLINE mapAccumR #-}+   {-# INLINE scanl #-}+   {-# INLINE scanl1 #-}+   {-# INLINE scanr #-}+   {-# INLINE scanr1 #-}+   {-# INLINE singleton #-}+   {-# INLINE span #-}+   {-# INLINE spanMaybe #-}+   {-# INLINE spanMaybe' #-}+   {-# INLINE split #-}+   {-# INLINE splitCharacterPrefix #-}+   {-# INLINE takeWhile #-}  instance IsString (Vector.Vector Char) where    fromString = Vector.fromList@@ -356,4 +523,39 @@    dropWhile _ = Vector.dropWhile    break _ = Vector.break    span _ = Vector.span+   spanMaybe s0 ft fc v = case Vector.ifoldr g Left v s0+                          of Left s' -> (v, Vector.empty, s')+                             Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')+      where g i c cont s | Just s' <- fc s c = cont s'+                         | otherwise = Right (i, s)+   spanMaybe' s0 ft fc v = case Vector.ifoldr' g Left v s0+                           of Left s' -> (v, Vector.empty, s')+                              Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')+      where g i c cont s | Just s' <- fc s c = seq s' (cont s')+                         | otherwise = Right (i, s)    find = Vector.find+   {-# INLINE all #-}+   {-# INLINE any #-}+   {-# INLINE break #-}+   {-# INLINE characterPrefix #-}+   {-# INLINE concatMap #-}+   {-# INLINE dropWhile #-}+   {-# INLINE find #-}+   {-# INLINE foldl   #-}+   {-# INLINE foldl'  #-}+   {-# INLINE foldr   #-}+   {-# INLINE fromText #-}+   {-# INLINE map #-}+   {-# INLINE mapAccumL #-}+   {-# INLINE mapAccumR #-}+   {-# INLINE scanl #-}+   {-# INLINE scanl1 #-}+   {-# INLINE scanr #-}+   {-# INLINE scanr1 #-}+   {-# INLINE singleton #-}+   {-# INLINE span #-}+   {-# INLINE spanMaybe #-}+   {-# INLINE spanMaybe' #-}+   {-# INLINE split #-}+   {-# INLINE splitCharacterPrefix #-}+   {-# INLINE takeWhile #-}

@@ -12,7 +12,7 @@ import Prelude hiding (foldl, foldr, gcd, length, null, reverse, span, splitAt, takeWhile)  import Test.QuickCheck (Arbitrary, CoArbitrary, Property, Gen,-                        quickCheck, arbitrary, coarbitrary, property, label, forAll, variant, whenFail, (.&&.))+                        quickCheck, arbitrary, coarbitrary, property, label, forAll, mapSize, variant, whenFail, (.&&.)) import Test.QuickCheck.Instances ()  import Control.Applicative (Applicative(..), liftA2)@@ -58,8 +58,8 @@                     First(First), Last(Last), Sum(Sum), Product(Product)) import Data.Monoid.Null (MonoidNull, PositiveMonoid, null) import Data.Monoid.Factorial (FactorialMonoid, StableFactorialMonoid, -                              factors, splitPrimePrefix, splitPrimeSuffix, primePrefix, primeSuffix,-                              foldl, foldl', foldr, length, reverse, span, split, splitAt)+                              factors, splitPrimePrefix, splitPrimeSuffix, primePrefix, primeSuffix, inits, tails,+                              foldl, foldl', foldr, length, reverse, span, spanMaybe, split, splitAt) import Data.Monoid.Cancellative (CommutativeMonoid, ReductiveMonoid, LeftReductiveMonoid, RightReductiveMonoid,                                  CancellativeMonoid, LeftCancellativeMonoid, RightCancellativeMonoid,                                  GCDMonoid, LeftGCDMonoid, RightGCDMonoid,@@ -344,11 +344,14 @@          ("splitPrimeSuffix", FactorialTest checkSplitPrimeSuffix),          ("primePrefix", FactorialTest checkPrimePrefix),          ("primeSuffix", FactorialTest checkPrimeSuffix),+         ("inits", FactorialTest checkInits),+         ("tails", FactorialTest checkTails),          ("foldl", FactorialTest checkLeftFold),          ("foldl'", FactorialTest checkLeftFold'),          ("foldr", FactorialTest checkRightFold),          ("length", FactorialTest checkLength),          ("span", FactorialTest checkSpan),+         ("spanMaybe", FactorialTest checkSpanMaybe),          ("split", FactorialTest checkSplit),          ("splitAt", FactorialTest checkSplitAt),          ("reverse", FactorialTest checkReverse),@@ -420,6 +423,12 @@ checkPrimeSuffix (FactorialMonoidInstance (_ :: a)) =     forAll (arbitrary :: Gen a) (\a-> primeSuffix a == maybe mempty snd (splitPrimeSuffix a)) +checkInits (FactorialMonoidInstance (_ :: a)) =+   mapSize (`div` 5) $ forAll (arbitrary :: Gen a) (\a-> inits a == List.map mconcat (List.inits $ factors a))++checkTails (FactorialMonoidInstance (_ :: a)) =+   mapSize (`div` 5) $ forAll (arbitrary :: Gen a) (\a-> tails a == List.map mconcat (List.tails $ factors a))+ checkLeftFold (FactorialMonoidInstance (_ :: a)) =     forAll (arbitrary :: Gen a) (\a-> foldl (flip (:)) [] a == List.foldl (flip (:)) [] (factors a)) @@ -436,6 +445,14 @@    where check p a = span p a == (mconcat l, mconcat r)             where (l, r) = List.span p (factors a) +checkSpanMaybe (FactorialMonoidInstance (_ :: a)) = property $ \(f, s)-> forAll (arbitrary :: Gen a) (check f (s :: Bool))+   where check f s0 a = a == prefix <> suffix+                        && foldMaybe prefix == Just s'+                        && (null suffix || f s' (primePrefix suffix) == Nothing)+            where (prefix, suffix, s') = spanMaybe s0 f a+                  foldMaybe = foldl g (Just s0)+                  g s m = s >>= flip f m+ checkSplit (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check    where check a = property (\pred-> all (all (not . pred) . factors) (split pred a))                    .&&. property (\prime-> mconcat (intersperse prime $ split (== prime) a) == a)@@ -750,6 +767,9 @@  instance Show a => Show (a -> Bool) where    show _ = "predicate"++instance Show a => Show (Bool -> a -> Maybe Bool) where+   show _ = "stateful predicate"  instance (PositiveMonoid a, MonoidNull b) => PositiveMonoid (a, b) 

@@ -1,5 +1,5 @@ Name:                monoid-subclasses-Version:             0.3.6.1+Version:             0.3.6.2 Cabal-Version:       >= 1.10 Build-Type:          Simple Synopsis:            Subclasses of Monoid@@ -11,7 +11,7 @@    License:             BSD3 License-file:        BSD3-LICENSE.txt-Copyright:           (c) 2013 Mario Blazevic+Copyright:           (c) 2013-2014 Mario Blazevic Author:              Mario Blazevic Maintainer:          Mario Blazevic <blamario@yahoo.com> Homepage:            https://github.com/blamario/monoid-subclasses/