packages feed

monoid-subclasses 0.4.0.3 → 0.4.0.4

raw patch · 9 files changed

+154/−160 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.Monoid.Factorial: class MonoidNull m => FactorialMonoid m where factors = unfoldr splitPrimePrefix primePrefix = maybe mempty fst . splitPrimePrefix primeSuffix = maybe mempty snd . splitPrimeSuffix splitPrimePrefix x = case factors x of { [] -> Nothing prefix : rest -> Just (prefix, mconcat rest) } splitPrimeSuffix x = case factors x of { [] -> Nothing fs -> Just (mconcat (init fs), last fs) } inits = foldr (\ m l -> mempty : map (mappend m) l) [mempty] tails m = m : maybe [] (tails . snd) (splitPrimePrefix m) foldl f f0 = foldl f f0 . factors foldl' f f0 = foldl' f f0 . factors foldr f f0 = foldr f f0 . factors length = length . factors foldMap f = foldr (mappend . f) mempty span p m = spanAfter id m where spanAfter f m = case splitPrimePrefix m 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 of { Nothing -> [] Just (_, tail) -> split p tail } takeWhile p = fst . span p dropWhile p = snd . span p splitAt n m | n <= 0 = (mempty, m) | otherwise = split n id m where split 0 f m = (f mempty, m) split n f m = case splitPrimePrefix m of { Nothing -> (f mempty, m) Just (prime, rest) -> split (pred n) (f . mappend prime) rest } drop n p = snd (splitAt n p) take n p = fst (splitAt n p) reverse = mconcat . reverse . factors
+ Data.Monoid.Factorial: class MonoidNull m => FactorialMonoid m where factors = unfoldr splitPrimePrefix primePrefix = maybe mempty fst . splitPrimePrefix primeSuffix = maybe mempty snd . splitPrimeSuffix splitPrimePrefix x = case factors x of { [] -> Nothing prefix : rest -> Just (prefix, mconcat rest) } splitPrimeSuffix x = case factors x of { [] -> Nothing fs -> Just (mconcat (init fs), last fs) } inits = foldr (\ m l -> mempty : map (mappend m) l) [mempty] tails m = m : maybe [] (tails . snd) (splitPrimePrefix m) foldl f f0 = foldl f f0 . factors foldl' f f0 = foldl' f f0 . factors foldr f f0 = foldr f f0 . factors length = length . factors foldMap f = foldr (mappend . f) mempty span p m0 = spanAfter id m0 where spanAfter f m = case splitPrimePrefix m 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 of { Nothing -> [] Just (_, tl) -> split p tl } takeWhile p = fst . span p dropWhile p = snd . span p splitAt n0 m0 | n0 <= 0 = (mempty, m0) | otherwise = split' n0 id m0 where split' 0 f m = (f mempty, m) split' n f m = case splitPrimePrefix m of { Nothing -> (f mempty, m) Just (prime, rest) -> split' (pred n) (f . mappend prime) rest } drop n p = snd (splitAt n p) take n p = fst (splitAt n p) reverse = mconcat . reverse . factors
- Data.Monoid.Textual: class (IsString t, LeftReductiveMonoid t, LeftGCDMonoid t, FactorialMonoid t) => TextualMonoid t where fromText = fromString . unpack singleton = fromString . (: []) characterPrefix = fmap fst . splitCharacterPrefix map f = concatMap (singleton . f) concatMap f = foldr mappend (mappend . f) mempty all p = foldr (const id) ((&&) . p) True any p = foldr (const id) ((||) . p) False foldl ft fc = foldl (\ a prime -> maybe (ft a prime) (fc a) (characterPrefix prime)) foldr ft fc = foldr (\ prime -> maybe (ft prime) fc (characterPrefix prime)) foldl' ft fc = foldl' (\ a prime -> maybe (ft a prime) (fc a) (characterPrefix prime)) foldl_ = foldl const foldr_ = foldr (const id) foldl_' = foldl' const scanl f c = mappend (singleton c) . fst . foldl foldlOther (foldlChars f) (mempty, c) scanl1 f t = case (splitPrimePrefix t, splitCharacterPrefix t) of { (Nothing, _) -> t (Just (prefix, suffix), Nothing) -> mappend prefix (scanl1 f suffix) (Just _, Just (c, suffix)) -> scanl f c suffix } scanr f c = fst . foldr foldrOther (foldrChars f) (singleton c, c) scanr1 f = fst . foldr foldrOther fc (mempty, Nothing) where fc c (t, Nothing) = (mappend (singleton c) t, Just c) fc c1 (t, Just c2) = (mappend (singleton c') t, Just c') where c' = f c1 c2 mapAccumL f a0 = foldl ft fc (a0, mempty) where ft (a, t1) t2 = (a, mappend t1 t2) fc (a, t) c = (a', mappend t (singleton c')) where (a', c') = f a c mapAccumR f a0 = foldr ft fc (a0, mempty) where ft t1 (a, t2) = (a, mappend t1 t2) fc c (a, t) = (a', mappend (singleton c') t) where (a', c') = f a c takeWhile pt pc = fst . span pt pc dropWhile pt pc = snd . span pt pc span pt pc = span (\ prime -> maybe (pt prime) pc (characterPrefix prime)) break pt pc = break (\ prime -> maybe (pt prime) pc (characterPrefix prime)) spanMaybe s0 ft fc t0 = spanAfter id s0 t0 where spanAfter g s t = case 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 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) } takeWhile_ = takeWhile . const dropWhile_ = dropWhile . const break_ = break . const span_ = span . const spanMaybe_ s = spanMaybe s (const . Just) spanMaybe_' s = spanMaybe' s (const . Just) 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 elem c = any (== c)
+ Data.Monoid.Textual: class (IsString t, LeftReductiveMonoid t, LeftGCDMonoid t, FactorialMonoid t) => TextualMonoid t where fromText = fromString . unpack singleton = fromString . (: []) characterPrefix = fmap fst . splitCharacterPrefix map f = concatMap (singleton . f) concatMap f = foldr mappend (mappend . f) mempty all p = foldr (const id) ((&&) . p) True any p = foldr (const id) ((||) . p) False foldl ft fc = foldl (\ a prime -> maybe (ft a prime) (fc a) (characterPrefix prime)) foldr ft fc = foldr (\ prime -> maybe (ft prime) fc (characterPrefix prime)) foldl' ft fc = foldl' (\ a prime -> maybe (ft a prime) (fc a) (characterPrefix prime)) foldl_ = foldl const foldr_ = foldr (const id) foldl_' = foldl' const scanl f c = mappend (singleton c) . fst . foldl foldlOther (foldlChars f) (mempty, c) scanl1 f t = case (splitPrimePrefix t, splitCharacterPrefix t) of { (Nothing, _) -> t (Just (prefix, suffix), Nothing) -> mappend prefix (scanl1 f suffix) (Just _, Just (c, suffix)) -> scanl f c suffix } scanr f c = fst . foldr foldrOther (foldrChars f) (singleton c, c) scanr1 f = fst . foldr foldrOther fc (mempty, Nothing) where fc c (t, Nothing) = (mappend (singleton c) t, Just c) fc c1 (t, Just c2) = (mappend (singleton c') t, Just c') where c' = f c1 c2 mapAccumL f a0 = foldl ft fc (a0, mempty) where ft (a, t1) t2 = (a, mappend t1 t2) fc (a, t) c = (a', mappend t (singleton c')) where (a', c') = f a c mapAccumR f a0 = foldr ft fc (a0, mempty) where ft t1 (a, t2) = (a, mappend t1 t2) fc c (a, t) = (a', mappend (singleton c') t) where (a', c') = f a c takeWhile pt pc = fst . span pt pc dropWhile pt pc = snd . span pt pc span pt pc = span (\ prime -> maybe (pt prime) pc (characterPrefix prime)) break pt pc = break (\ prime -> maybe (pt prime) pc (characterPrefix prime)) spanMaybe s0 ft fc t0 = spanAfter id s0 t0 where spanAfter g s t = case 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 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) } takeWhile_ = takeWhile . const dropWhile_ = dropWhile . const break_ = break . const span_ = span . const spanMaybe_ s = spanMaybe s (const . Just) spanMaybe_' s = spanMaybe' s (const . Just) split p m = prefix : splitRest where (prefix, rest) = break (const False) p m splitRest = case splitCharacterPrefix rest of { Nothing -> [] Just (_, tl) -> split p tl } find p = foldr (const id) (\ c r -> if p c then Just c else r) Nothing elem c = any (== c)

Files

Data/Monoid/Cancellative.hs view
@@ -36,10 +36,10 @@  module Data.Monoid.Cancellative (    -- * Symmetric, commutative monoid classes-   CommutativeMonoid, ReductiveMonoid(..), CancellativeMonoid(..), GCDMonoid(..),+   CommutativeMonoid, ReductiveMonoid(..), CancellativeMonoid, GCDMonoid(..),    -- * Asymmetric monoid classes    LeftReductiveMonoid(..), RightReductiveMonoid(..),-   LeftCancellativeMonoid(..), RightCancellativeMonoid(..),+   LeftCancellativeMonoid, RightCancellativeMonoid,    LeftGCDMonoid(..), RightGCDMonoid(..)    ) where@@ -47,7 +47,7 @@ import Prelude hiding (gcd) import qualified Prelude -import Data.Monoid (Monoid (mappend), Dual(..), Sum(..), Product(..))+import Data.Monoid (Monoid, Dual(..), Sum(..), Product(..)) import qualified Data.List as List import Data.Maybe (isJust) import qualified Data.ByteString as ByteString@@ -99,7 +99,7 @@ class (ReductiveMonoid m, LeftGCDMonoid m, RightGCDMonoid m) => GCDMonoid m where    gcd :: m -> m -> m --- | Class of monoids with a left inverse of 'mappend', satisfying the following law:+-- | Class of monoids with a left inverse of 'Data.Monoid.mappend', satisfying the following law: --  -- > isPrefixOf a b == isJust (stripPrefix a b) -- > maybe b (a <>) (stripPrefix a b) == b@@ -113,7 +113,7 @@     isPrefixOf a b = isJust (stripPrefix a b) --- | Class of monoids with a right inverse of 'mappend', satisfying the following law:+-- | Class of monoids with a right inverse of 'Data.Monoid.mappend', satisfying the following law: --  -- > isSuffixOf a b == isJust (stripSuffix a b) -- > maybe b (<> a) (stripSuffix a b) == b@@ -273,7 +273,7 @@  instance Integral a => ReductiveMonoid (Product a) where    Product 0 </> Product 0 = Just (Product 0)-   Product a </> Product 0 = Nothing+   Product _ </> Product 0 = Nothing    Product a </> Product b = if remainder == 0 then Just (Product quotient) else Nothing       where (quotient, remainder) = quotRem a b @@ -414,7 +414,7 @@                    | otherwise = Nothing  instance (Ord k, Eq a) => LeftGCDMonoid (Map.Map k a) where-   commonPrefix = Map.mergeWithKey (\k a b -> if a == b then Just a else Nothing) (const Map.empty) (const Map.empty)+   commonPrefix = Map.mergeWithKey (\_ a b -> if a == b then Just a else Nothing) (const Map.empty) (const Map.empty)  -- IntMap instances @@ -424,7 +424,7 @@                    | otherwise = Nothing  instance Eq a => LeftGCDMonoid (IntMap.IntMap a) where-   commonPrefix = IntMap.mergeWithKey (\k a b -> if a == b then Just a else Nothing)+   commonPrefix = IntMap.mergeWithKey (\_ a b -> if a == b then Just a else Nothing)                                       (const IntMap.empty) (const IntMap.empty)  -- List instances@@ -439,7 +439,7 @@    commonPrefix (x:xs) (y:ys) | x == y = x : commonPrefix xs ys    commonPrefix _ _ = [] -   stripCommonPrefix x y = strip' id x y+   stripCommonPrefix x0 y0 = strip' id x0 y0       where strip' f (x:xs) (y:ys) | x == y = strip' (f . (x :)) xs ys             strip' f x y = (f [], x, y)
Data/Monoid/Factorial.hs view
@@ -17,8 +17,8 @@    ) where -import Prelude hiding (break, drop, dropWhile, foldl, foldl', foldMap, foldr, length, map, mapM, mapM_, null,-                       reverse, span, splitAt, take, takeWhile)+import Prelude hiding (break, drop, dropWhile, foldl, foldMap, foldr, last, length, map, mapM, mapM_, max, min,+                       null, reverse, span, splitAt, take, takeWhile)  import Control.Arrow (first) import qualified Control.Monad as Monad@@ -36,7 +36,6 @@ 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)@@ -146,7 +145,7 @@    foldr f f0 = List.foldr f f0 . factors    length = List.length . factors    foldMap f = foldr (mappend . f) mempty-   span p m = spanAfter id m+   span p m0 = spanAfter id m0       where spanAfter f m = case splitPrimePrefix m                             of Just (prime, rest) | p prime -> spanAfter (f . mappend prime) rest                                _ -> (f mempty, m)@@ -166,15 +165,15 @@       where (prefix, rest) = break p m             splitRest = case splitPrimePrefix rest                         of Nothing -> []-                           Just (_, tail) -> split p tail+                           Just (_, tl) -> split p tl    takeWhile p = fst . span p    dropWhile p = snd . span p-   splitAt n m | n <= 0 = (mempty, m)-                | otherwise = split n id m-      where split 0 f m = (f mempty, m)-            split n f m = case splitPrimePrefix m-                          of Nothing -> (f mempty, m)-                             Just (prime, rest) -> split (pred n) (f . mappend prime) rest+   splitAt n0 m0 | n0 <= 0 = (mempty, m0)+                 | otherwise = split' n0 id m0+      where split' 0 f m = (f mempty, m)+            split' n f m = case splitPrimePrefix m+                           of Nothing -> (f mempty, m)+                              Just (prime, rest) -> split' (pred n) (f . mappend prime) rest    drop n p = snd (splitAt n p)    take n p = fst (splitAt n p)    reverse = mconcat . List.reverse . factors@@ -233,7 +232,7 @@    reverse = fmap reverse  instance (FactorialMonoid a, FactorialMonoid b) => FactorialMonoid (a, b) where-   factors (a, b) = List.map (\a-> (a, mempty)) (factors a) ++ List.map ((,) mempty) (factors b)+   factors (a, b) = List.map (\a1-> (a1, mempty)) (factors a) ++ List.map ((,) mempty) (factors b)    primePrefix (a, b) | null a = (a, primePrefix b)                       | otherwise = (primePrefix a, mempty)    primeSuffix (a, b) | null b = (primeSuffix a, b)@@ -248,13 +247,13 @@                                 (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+   foldl f a0 (x, y) = foldl f2 (foldl f1 a0 x) y       where f1 a = f a . fromFst             f2 a = f a . fromSnd-   foldl' f a (x, y) = a' `seq` foldl' f2 a' y+   foldl' f a0 (x, y) = a' `seq` foldl' f2 a' y       where f1 a = f a . fromFst             f2 a = f a . fromSnd-            a' = foldl' f1 a x+            a' = foldl' f1 a0 x    foldr f a (x, y) = foldr (f . fromFst) (foldr (f . fromSnd) a y) x    foldMap f (x, y) = foldMap (f . fromFst) x `mappend` foldMap (f . fromSnd) y    length (a, b) = length a + length b@@ -270,11 +269,11 @@                           | 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-            combine x (y:ys, False) = (mappend x y : ys, True)-            combine x (xs, True) = (x:xs, True)+   split p (x0, y0) = fst $ List.foldr combine (ys, False) xs+      where xs = List.map fromFst $ split (p . fromFst) x0+            ys = List.map fromSnd $ split (p . fromSnd) y0+            combine x (~(y:rest), False) = (mappend x y : rest, True)+            combine x (rest, True) = (x:rest, True)    splitAt n (x, y) = ((xp, yp), (xs, ys))       where (xp, xs) = splitAt n x             (yp, ys) | null xs = splitAt (n - length x) y@@ -292,15 +291,15 @@ instance FactorialMonoid [x] where    factors xs = List.map (:[]) xs    primePrefix [] = []-   primePrefix (x:xs) = [x]+   primePrefix (x:_) = [x]    primeSuffix [] = []    primeSuffix xs = [List.last xs]    splitPrimePrefix [] = Nothing    splitPrimePrefix (x:xs) = Just ([x], xs)    splitPrimeSuffix [] = Nothing-   splitPrimeSuffix xs = Just (split id xs)-      where split f last@[x] = (f [], last)-            split f (x:xs) = split (f . (x:)) xs+   splitPrimeSuffix xs = Just (splitLast id xs)+      where splitLast f last@[_] = (f [], last)+            splitLast f ~(x:rest) = splitLast (f . (x:)) rest    inits = List.inits    tails = List.tails    foldl _ a [] = a@@ -316,13 +315,13 @@    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)+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = (prefix . (x:), id, s2, True)+                                           | otherwise = (prefix, suffix . (x:), s1, 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)+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = seq s2 $ (prefix . (x:), id, s2, True)+                                           | otherwise = (prefix, suffix . (x:), s1, False)    splitAt = List.splitAt    drop = List.drop    take = List.take@@ -330,9 +329,9 @@  instance FactorialMonoid ByteString.ByteString where    factors x = factorize (ByteString.length x) x-      where factorize 0 xs = []-            factorize n xs = x : factorize (pred n) xs'-              where (x, xs') = ByteString.splitAt 1 xs+      where factorize 0 _ = []+            factorize n xs = xs1 : factorize (pred n) xs'+              where (xs1, xs') = ByteString.splitAt 1 xs    primePrefix = ByteString.take 1    primeSuffix x = ByteString.drop (ByteString.length x - 1) x    splitPrimePrefix x = if ByteString.null x then Nothing else Just (ByteString.splitAt 1 x)@@ -366,9 +365,9 @@  instance FactorialMonoid LazyByteString.ByteString where    factors x = factorize (LazyByteString.length x) x-      where factorize 0 xs = []-            factorize n xs = x : factorize (pred n) xs'-              where (x, xs') = LazyByteString.splitAt 1 xs+      where factorize 0 _ = []+            factorize n xs = xs1 : factorize (pred n) xs'+               where (xs1, xs') = LazyByteString.splitAt 1 xs    primePrefix = LazyByteString.take 1    primeSuffix x = LazyByteString.drop (LazyByteString.length x - 1) x    splitPrimePrefix x = if LazyByteString.null x then Nothing@@ -534,13 +533,13 @@ instance FactorialMonoid (Sequence.Seq a) where    factors = List.map Sequence.singleton . Foldable.toList    primePrefix = Sequence.take 1-   primeSuffix seq = Sequence.drop (Sequence.length seq - 1) seq-   splitPrimePrefix seq = case Sequence.viewl seq-                          of Sequence.EmptyL -> Nothing-                             first Sequence.:< rest -> Just (Sequence.singleton first, rest)-   splitPrimeSuffix seq = case Sequence.viewr seq-                          of Sequence.EmptyR -> Nothing-                             rest Sequence.:> last -> Just (rest, Sequence.singleton last)+   primeSuffix q = Sequence.drop (Sequence.length q - 1) q+   splitPrimePrefix q = case Sequence.viewl q+                        of Sequence.EmptyL -> Nothing+                           hd Sequence.:< rest -> Just (Sequence.singleton hd, rest)+   splitPrimeSuffix q = case Sequence.viewr q+                        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'@@ -588,14 +587,14 @@  instance FactorialMonoid (Vector.Vector a) where    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 factorize 0 _ = []+            factorize n xs = xs1 : factorize (pred n) xs'+               where (xs1, 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 []+   inits x0 = initsWith x0 []       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)
Data/Monoid/Instances/ByteString/UTF8.hs view
@@ -47,8 +47,7 @@ import Data.Char (chr, ord, isDigit, isPrint) import qualified Data.Foldable as Foldable import qualified Data.List as List-import Data.Functor ((<$>))-import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)+import Data.Maybe (fromMaybe, isJust, isNothing) import Data.String (IsString(fromString)) import Data.Word (Word8) import Data.ByteString (ByteString)@@ -57,9 +56,9 @@ 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.Null (MonoidNull(..), PositiveMonoid) import Data.Monoid.Factorial (FactorialMonoid(..)) import Data.Monoid.Textual (TextualMonoid(..)) import qualified Data.Monoid.Factorial as Factorial (FactorialMonoid(..))@@ -106,7 +105,7 @@    {-# INLINE stripCommonPrefix #-}  instance Show ByteStringUTF8 where-   showsPrec _ bs s = '"' : Textual.foldr showsBytes showsChar ('"' : s) bs+   showsPrec _ bs s0 = '"' : Textual.foldr showsBytes showsChar ('"' : s0) bs       where showsBytes (ByteStringUTF8 b) s = '\\' : shows (ByteString.unpack b) s             showsChar c s               | isPrint c = c : s@@ -127,12 +126,12 @@                     of Just i -> Just (wrapPair $ ByteString.splitAt (succ i) bs)                        Nothing -> Just (utf8, ByteStringUTF8 $ ByteString.empty)    {-# INLINABLE splitPrimePrefix #-}-   splitPrimeSuffix utf8@(ByteStringUTF8 bs)+   splitPrimeSuffix (ByteStringUTF8 bs)       | ByteString.null bs = Nothing-      | ByteString.null prefix = Just (wrapPair split)-      | not (ByteString.null suffix) && ByteString.last prefix < 0x80 = Just (wrapPair split)+      | ByteString.null prefix = Just (wrapPair splitBS)+      | not (ByteString.null suffix) && ByteString.last prefix < 0x80 = Just (wrapPair splitBS)       | otherwise = Just (wrapPair $ ByteString.splitAt (pred $ ByteString.length prefix) bs)-      where split@(prefix, suffix) = ByteString.breakEnd byteStartsCharacter bs+      where splitBS@(prefix, suffix) = ByteString.breakEnd byteStartsCharacter bs    {-# INLINABLE splitPrimeSuffix #-}    primePrefix utf8@(ByteStringUTF8 bs)       | ByteString.null bs = utf8@@ -170,7 +169,7 @@    {-# INLINE take #-}    drop n (ByteStringUTF8 bs) = ByteStringUTF8 (ByteString.drop (charStartIndex n bs) bs)    {-# INLINE drop #-}-   dropWhile p (ByteStringUTF8 bs) = dropASCII bs+   dropWhile p (ByteStringUTF8 bs0) = dropASCII bs0       where dropASCII bs =                let suffix = ByteString.dropWhile (\w-> w < 0x80 && p (ByteStringUTF8 $ ByteString.singleton w)) bs                in if ByteString.null suffix || unsafeHead suffix < 0x80@@ -187,7 +186,7 @@    {-# 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+      where (ByteStringUTF8 s) = Factorial.dropWhile p utf8    {-# INLINE takeWhile #-}    span p utf8@(ByteStringUTF8 bs) =       (ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length s) bs, suffix)@@ -195,52 +194,52 @@    {-# 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+   spanMaybe s0 f (ByteStringUTF8 bs0) = (ByteStringUTF8 $ ByteString.take (ByteString.length bs0 - ByteString.length dropped) bs0,+                                          ByteStringUTF8 dropped,+                                          s')+      where (dropped, s') = dropASCII s0 bs0             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)+                   (index, s1) = ByteString.foldr f8 id bs (0, s)+                   f8 w cont (i, s2)+                     | w < 0x80, Just s3 <- f s2 (ByteStringUTF8 $ ByteString.singleton w) =+                         let i' = succ i :: Int in seq i' $ cont (i', s3)+                     | otherwise = (i, s2)                in if ByteString.null suffix || unsafeHead suffix < 0x80-                  then (suffix, s')-                  else dropMultiByte s' suffix+                  then (suffix, s1)+                  else dropMultiByte s1 suffix             dropMultiByte s bs =                case ByteString.findIndex byteStartsCharacter (unsafeTail bs)                of Nothing -> case f s (ByteStringUTF8 bs)-                             of Just s' -> (ByteString.empty, s')+                             of Just s1 -> (ByteString.empty, s1)                                 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+                               of Just s1 -> dropASCII s1 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+   spanMaybe' s0 f (ByteStringUTF8 bs0) = (ByteStringUTF8 $ ByteString.take (ByteString.length bs0 - ByteString.length dropped) bs0,+                                           ByteStringUTF8 dropped,+                                           s')+      where (dropped, s') = dropASCII s0 bs0             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')+                   (index, s1) = ByteString.foldr f8 id bs (0, s)+                   f8 w cont (i, s2)+                     | w < 0x80, Just s3 <- f s2 (ByteStringUTF8 $ ByteString.singleton w) =+                         let i' = succ i :: Int in seq i' $ seq s3 $ cont (i', s3)                      | otherwise = (i, s)                in if ByteString.null suffix || unsafeHead suffix < 0x80-                  then (suffix, s')-                  else dropMultiByte s' suffix+                  then (suffix, s1)+                  else dropMultiByte s1 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')+                             of Just s1 -> seq s1 (ByteString.empty, s1)                                 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)+                               of Just s1 -> seq s1 (dropASCII s1 tl)                                   Nothing -> (bs, s)    {-# INLINE spanMaybe' #-}    reverse (ByteStringUTF8 bs) =@@ -350,7 +349,7 @@           len = ByteString.length bs       in inner 0 s0    {-# INLINE spanMaybe' #-}-   find p (ByteStringUTF8 bs) = loop bs+   find p (ByteStringUTF8 bs0) = loop bs0       where loop bs = case ByteString.Char8.findIndex (\c-> c >= '\x80' || p c) bs                       of Nothing -> Nothing                          Just i -> let x = unsafeIndex bs i@@ -387,13 +386,13 @@   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+  if (0xF0 < b3 || 0xF0 == b3 && 0x90 <= 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])-reverseBytesToChar ft fc bytes = ft (ByteString.reverse $ ByteString.pack bytes)+reverseBytesToChar ft _fc bytes = ft (ByteString.reverse $ ByteString.pack bytes)  bytesToChar :: (ByteString -> a) -> (Char -> a) -> [Word8] -> a bytesToChar ft fc [w] = if w < 0x80 then fc (w2c w) else ft (ByteString.singleton w)@@ -404,23 +403,26 @@   else ft (ByteString.pack bytes) bytesToChar ft fc bytes@[b2, b1, b0] =   assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0) $-  if (0xE0 < b2 || 0xE0 == b2 && 0xA0 <= b1) && 0xC0 <= b2 && b2 < 0xF0+  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 bytes) bytesToChar ft fc bytes@[b3, b2, b1, b0] =   assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0 && 0x80 <= b2 && b2 < 0xC0) $-  if (0xF0 < b3 || 0xF0 == b3 && 0xA0 <= b2) && 0xC0 <= b3 && b3 < 0xF4+  if (0xF0 < b3 || 0xF0 == b3 && 0x90 <= 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 bytes)-bytesToChar ft fc bytes = ft (ByteString.pack bytes)+bytesToChar ft _fc bytes = ft (ByteString.pack bytes) +wrapPair :: (ByteString, ByteString) -> (ByteStringUTF8, ByteStringUTF8) wrapPair (bs1, bs2) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2) {-# INLINE wrapPair #-}++wrapTriple :: (ByteString, ByteString, ByteString) -> (ByteStringUTF8, ByteStringUTF8, ByteStringUTF8) wrapTriple (bs1, bs2, bs3) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2, ByteStringUTF8 bs3) {-# INLINE wrapTriple #-} @@ -435,6 +437,7 @@                                               0x80 + fromIntegral (shiftR n 12 .&. 0x3F),                                               0x80 + fromIntegral (shiftR n 6 .&. 0x3F),                                               0x80 + fromIntegral (n .&. 0x3F)]+           | otherwise  = error ("Data.Char.ord '" ++ (c : "' >=0x200000"))    where n = ord c  toChar :: Word8 -> ByteString -> Maybe (Char, ByteStringUTF8)@@ -471,6 +474,7 @@    where continued a b = (a < 0x80) == (b < 0x80) && b < 0xC0 {-# INLINE groupASCII #-} +headIndex :: ByteString -> Int headIndex bs = fromMaybe (ByteString.length bs) $ ByteString.findIndex byteStartsCharacter bs {-# INLINE headIndex #-}
Data/Monoid/Instances/Concat.hs view
@@ -17,11 +17,7 @@ import Prelude hiding (all, any, break, filter, foldl, foldl1, foldMap, foldr, foldr1, map, concatMap,                        length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt) import Control.Applicative (Applicative(..))-import Data.Foldable (Foldable)-import Data.Traversable (Traversable, traverse) import qualified Data.Foldable as Foldable-import qualified Data.Traversable as Traversable-import Data.Maybe (fromMaybe) import Data.String (IsString(..)) import Data.Monoid (Monoid(..), (<>), First(..), Sum(..)) import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..),@@ -69,7 +65,7 @@ instance PositiveMonoid (Concat a)  instance (LeftReductiveMonoid a, MonoidNull a, StableFactorialMonoid a) => LeftReductiveMonoid (Concat a) where-   stripPrefix (Concat x) (Concat y) = fmap Concat $ strip1 x y+   stripPrefix c1 c2 = fmap Concat $ strip1 (extract c1) (extract c2)       where strip1 x y = strip2 (Seq.viewl x) y             strip2 Seq.EmptyL y = Just y             strip2 (xp :< xs) y = strip3 xp xs (Seq.viewl y)@@ -81,7 +77,7 @@                   (Nothing, Just xps) -> strip3 xps xs (Seq.viewl ys)  instance (MonoidNull a, RightReductiveMonoid a, StableFactorialMonoid a) => RightReductiveMonoid (Concat a) where-   stripSuffix (Concat x) (Concat y) = fmap Concat $ strip1 x y+   stripSuffix c1 c2 = fmap Concat $ strip1 (extract c1) (extract c2)       where strip1 x y = strip2 (Seq.viewr x) y             strip2 Seq.EmptyR y = Just y             strip2 (xp :> xs) y = strip3 xp xs (Seq.viewr y)@@ -142,11 +138,11 @@               xp :> xs -> Just (Concat xp', Concat $ Seq.singleton xss)                  where Just (xsp, xss) = splitPrimeSuffix xs                        xp' = if null xsp then xp else xp |> xsp-   foldl f a (Concat x) = Foldable.foldl g a x+   foldl f a0 (Concat x) = Foldable.foldl g a0 x       where g = Factorial.foldl (\a-> f a . Concat . Seq.singleton)-   foldl' f a (Concat x) = Foldable.foldl' g a x+   foldl' f a0 (Concat x) = Foldable.foldl' g a0 x       where g = Factorial.foldl' (\a-> f a . Concat . Seq.singleton)-   foldr f a (Concat x) = Foldable.foldr g a x+   foldr f a0 (Concat x) = Foldable.foldr g a0 x       where g a b = Factorial.foldr (f . Concat . Seq.singleton) b a    length (Concat x) = getSum $ Foldable.foldMap (Sum . length) x    foldMap f (Concat x) = Foldable.foldMap (foldMap (f . Concat . Seq.singleton)) x@@ -159,7 +155,7 @@             where (xpp, xps) = Factorial.span (p . Concat . Seq.singleton) xp                   (Concat xsp, xss) = Factorial.span p (Concat xs)    split p (Concat x) = Foldable.foldr splitNext [mempty] x-      where splitNext a (xp:xs) =+      where splitNext a ~(xp:xs) =                let as = fmap (Concat . Seq.singleton) (Factorial.split (p . Concat . Seq.singleton) a)                in if null xp                   then as ++ xs@@ -198,11 +194,11 @@    any p (Concat x) = Foldable.any (any p) x    all p (Concat x) = Foldable.all (all p) x -   foldl ft fc a (Concat x) = Foldable.foldl g a x+   foldl ft fc a0 (Concat x) = Foldable.foldl g a0 x       where g = Textual.foldl (\a-> ft a . Concat . Seq.singleton) fc-   foldl' ft fc a (Concat x) = Foldable.foldl' g a x+   foldl' ft fc a0 (Concat x) = Foldable.foldl' g a0 x       where g = Textual.foldl' (\a-> ft a . Concat . Seq.singleton) fc-   foldr ft fc a (Concat x) = Foldable.foldr g a x+   foldr ft fc a0 (Concat x) = Foldable.foldr g a0 x       where g a b = Textual.foldr (ft . Concat . Seq.singleton) fc b a     span pt pc (Concat x) =@@ -216,7 +212,3 @@    break pt pc = Textual.span (not . pt) (not . pc)     find p (Concat x) = getFirst $ Foldable.foldMap (First . find p) x--injectSingleton :: (MonoidNull a, PositiveMonoid a) => a -> Concat a-injectSingleton a | null a = mempty-                  | otherwise = Concat (Seq.singleton a)
Data/Monoid/Instances/Measured.hs view
@@ -19,7 +19,7 @@ import Data.Functor ((<$>)) import qualified Data.List as List import Data.String (IsString(..))-import Data.Monoid (Monoid(..), (<>), First(..), Sum(..))+import Data.Monoid (Monoid(..)) import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..),                                  LeftGCDMonoid(..), RightGCDMonoid(..)) import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)@@ -32,7 +32,7 @@ -- constant-time operation. The parameter is restricted to the 'StableFactorialMonoid' class, which guarantees that -- @'length' (a <> b) == 'length' a + 'length' b@. -data Measured a = Measured{measuredLength :: Int, extract :: a} deriving (Eq, Show)+data Measured a = Measured{_measuredLength :: Int, extract :: a} deriving (Eq, Show)  -- | Create a new 'Measured' value. measure :: FactorialMonoid a => a -> Measured a@@ -46,7 +46,7 @@    mappend (Measured m a) (Measured n b) = Measured (m + n) (mappend a b)  instance StableFactorialMonoid a => MonoidNull (Measured a) where-   null (Measured n x) = n == 0+   null (Measured n _) = n == 0  instance StableFactorialMonoid a => PositiveMonoid (Measured a) @@ -72,11 +72,11 @@    splitPrimeSuffix (Measured n x) = case splitPrimeSuffix x                                      of Nothing -> Nothing                                         Just (p, s) -> Just (Measured (n - 1) p, Measured 1 s)-   foldl f a (Measured _ x) = Factorial.foldl g a x+   foldl f a0 (Measured _ x) = Factorial.foldl g a0 x       where g a = f a . Measured 1-   foldl' f a (Measured _ x) = Factorial.foldl' g a x+   foldl' f a0 (Measured _ x) = Factorial.foldl' g a0 x       where g a = f a . Measured 1-   foldr f a (Measured _ x) = Factorial.foldr g a x+   foldr f a0 (Measured _ x) = Factorial.foldr g a0 x       where g = f . Measured 1    length (Measured n _) = n    foldMap f (Measured _ x) = Factorial.foldMap (f . Measured 1) x@@ -105,9 +105,9 @@    any p (Measured _ x) = any p x    all p (Measured _ x) = all p x -   foldl ft fc a (Measured _ x) = Textual.foldl (\a-> ft a . Measured 1) fc a x-   foldl' ft fc a (Measured _ x) = Textual.foldl' (\a-> ft a . Measured 1) fc a x-   foldr ft fc a (Measured _ x) = Textual.foldr (ft . Measured 1) fc a x+   foldl ft fc a0 (Measured _ x) = Textual.foldl (\a-> ft a . Measured 1) fc a0 x+   foldl' ft fc a0 (Measured _ x) = Textual.foldl' (\a-> ft a . Measured 1) fc a0 x+   foldr ft fc a0 (Measured _ x) = Textual.foldr (ft . Measured 1) fc a0 x     span pt pc (Measured n x) = (xp', xs')       where (xp, xs) = Textual.span (pt . Measured 1) pc x
Data/Monoid/Instances/Stateful.hs view
@@ -19,15 +19,14 @@    ) where -import Prelude hiding (all, any, break, elem, drop, filter, foldl, foldl1, foldMap, foldr, foldr1, map, concatMap,+import Prelude hiding (all, any, break, elem, drop, filter, foldl, foldl1, foldMap, foldr, foldr1, gcd, map, concatMap,                        length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt, take) import Control.Applicative (Applicative(..)) import Data.Functor ((<$>)) import qualified Data.List as List import Data.String (IsString(..))-import Data.Monoid (Monoid(..), (<>), First(..), Sum(..))-import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..), ReductiveMonoid(..),-                                 LeftGCDMonoid(..), RightGCDMonoid(..), GCDMonoid(..))+import Data.Monoid (Monoid(..), (<>))+import Data.Monoid.Cancellative (LeftReductiveMonoid(..), LeftGCDMonoid(..), RightReductiveMonoid(..), RightGCDMonoid(..)) import Data.Monoid.Null (MonoidNull(null), PositiveMonoid) import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid) import Data.Monoid.Textual (TextualMonoid(..))@@ -100,10 +99,10 @@                                       return (Stateful xp, Stateful xs)    splitPrimeSuffix (Stateful x) = do (xp, xs) <- splitPrimeSuffix x                                       return (Stateful xp, Stateful xs)-   foldl f a (Stateful x) = Factorial.foldl f' a x-      where f' a x = f a (Stateful x)-   foldl' f a (Stateful x) = Factorial.foldl' f' a x-      where f' a x = f a (Stateful x)+   foldl f a0 (Stateful x) = Factorial.foldl f' a0 x+      where f' a x1 = f a (Stateful x1)+   foldl' f a0 (Stateful x) = Factorial.foldl' f' a0 x+      where f' a x1 = f a (Stateful x1)    foldr f a (Stateful x) = Factorial.foldr (f . Stateful) a x    foldMap f (Stateful x) = Factorial.foldMap (f . Stateful) x    span p (Stateful x) = (Stateful xp, Stateful xs)@@ -151,12 +150,12 @@    all p = all p . extract    any p = any p . extract -   foldl fx fc a (Stateful (t, x)) = Factorial.foldl f2 (Textual.foldl f1 fc a t) x+   foldl fx fc a0 (Stateful (t, x)) = Factorial.foldl f2 (Textual.foldl f1 fc a0 t) x       where f1 a = fx a . fromFst             f2 a = fx a . fromSnd    foldr fx fc a (Stateful (t, x)) = Textual.foldr (fx . fromFst) fc (Factorial.foldr (fx . fromSnd) a x) t-   foldl' fx fc a (Stateful (t, x)) = a' `seq` Factorial.foldl' f2 a' x-      where a' = Textual.foldl' f1 fc a t+   foldl' fx fc a0 (Stateful (t, x)) = a' `seq` Factorial.foldl' f2 a' x+      where a' = Textual.foldl' f1 fc a0 t             f1 a = fx a . fromFst             f2 a = fx a . fromSnd    foldl_' fc a (Stateful (t, _)) = foldl_' fc a t@@ -201,8 +200,8 @@                      | otherwise = (mempty, x)    split p (Stateful (t, x)) = restore id ts       where ts = Textual.split p t-            restore f [t] = f [Stateful (t, x)]-            restore f (hd:tl) = restore (f . (Stateful (hd, mempty):)) tl+            restore f [t1] = f [Stateful (t1, x)]+            restore f ~(hd:tl) = restore (f . (Stateful (hd, mempty):)) tl    find p = find p . extract    elem c = elem c . extract
Data/Monoid/Null.hs view
@@ -16,9 +16,8 @@  import Prelude hiding (null)    -import Data.Monoid (Monoid(mempty), First(..), Last(..), Dual(..), Sum(..), Product(..), All(getAll), Any(getAny))+import Data.Monoid (Monoid, First(..), Last(..), Dual(..), Sum(..), Product(..), All(getAll), Any(getAny)) import qualified Data.List as List-import Data.Ord (Ordering(EQ)) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.Text as Text@@ -38,8 +37,8 @@ class Monoid m => MonoidNull m where    null :: m -> Bool --- | Subclass of 'Monoid' for types whose values have no inverse, with the exception of 'mempty'. More formally, the--- class instances must satisfy the following law:+-- | Subclass of 'Monoid' for types whose values have no inverse, with the exception of 'Data.Monoid.mempty'. More+-- formally, the class instances must satisfy the following law: --  -- prop> null (x <> y) == (null x && null y) class MonoidNull m => PositiveMonoid m
Data/Monoid/Textual.hs view
@@ -19,19 +19,17 @@  import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable-import Data.Maybe (fromJust)-import Data.Either (rights)+import Data.Functor ((<$>)) import qualified Data.List as List import qualified Data.Text as Text import qualified Data.Text.Lazy as LazyText import Data.Text (Text)-import Data.Monoid (Monoid(mappend, mconcat, mempty))+import Data.Monoid (Monoid(mappend, mempty)) 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) import Data.Monoid.Factorial (FactorialMonoid) import qualified Data.Monoid.Factorial as Factorial@@ -246,7 +244,7 @@       where (prefix, rest) = break (const False) p m             splitRest = case splitCharacterPrefix rest                         of Nothing -> []-                           Just (_, tail) -> split p tail+                           Just (_, tl) -> split p tl    find p = foldr (const id) (\c r-> if p c then Just c else r) Nothing    elem c = any (== c) @@ -276,6 +274,10 @@    {-# INLINE takeWhile_ #-}    {-# INLINE dropWhile_ #-} +foldlChars :: TextualMonoid t => (Char -> Char -> Char) -> (t, Char) -> Char -> (t, Char)+foldlOther :: Monoid t => (t, Char) -> t -> (t, Char)+foldrChars :: TextualMonoid t => (Char -> Char -> Char) -> Char -> (t, Char) -> (t, Char)+foldrOther :: Monoid t => t -> (t, a) -> (t, a) foldlChars f (t, c1) c2 = (mappend t (singleton c'), c')    where c' = f c1 c2 foldlOther (t1, c) t2 = (mappend t1 t2, c)@@ -311,12 +313,12 @@    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)+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s, live) c | live, Just s1 <- fc s c = (prefix . (c:), id, s1, 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)+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l+            g (prefix, suffix, s, live) c | live, Just s1 <- fc s c = seq s1 (prefix . (c:), id, s1, True)                                           | otherwise = (prefix, suffix . (c:), s, False)    find = List.find    elem = List.elem@@ -481,7 +483,7 @@                                c Sequence.:< rest -> Just (c, rest)    characterPrefix s = case Sequence.viewl s                        of Sequence.EmptyL -> Nothing-                          c Sequence.:< rest -> Just c+                          c Sequence.:< _ -> Just c    map = Traversable.fmapDefault    concatMap = Foldable.foldMap    any = Foldable.any@@ -562,14 +564,12 @@    scanr = Vector.scanr    scanr1 f v | Vector.null v = Vector.empty               | otherwise = Vector.scanr1 f v-   mapAccumL f a0 t = (a, Vector.reverse $ Vector.fromList l)-      where (a, l) = Vector.foldl fc (a0, []) t-            fc (a, l) c = (a', c':l)-               where (a', c') = f a c-   mapAccumR f a0 t = (a, Vector.fromList l)-      where (a, l) = Vector.foldr fc (a0, []) t-            fc c (a, l) = (a',  c':l)-               where (a', c') = f a c+   mapAccumL f a0 t = (a', Vector.reverse $ Vector.fromList l')+      where (a', l') = Vector.foldl fc (a0, []) t+            fc (a, l) c = (:l) <$> f a c+   mapAccumR f a0 t = (a', Vector.fromList l')+      where (a', l') = Vector.foldr fc (a0, []) t+            fc c (a, l) = (:l) <$> f a c     takeWhile _ = Vector.takeWhile    dropWhile _ = Vector.dropWhile
monoid-subclasses.cabal view
@@ -1,5 +1,5 @@ Name:                monoid-subclasses-Version:             0.4.0.3+Version:             0.4.0.4 Cabal-Version:       >= 1.10 Build-Type:          Simple Synopsis:            Subclasses of Monoid@@ -26,6 +26,7 @@                      Data.Monoid.Instances.Measured, Data.Monoid.Instances.Positioned, Data.Monoid.Instances.Stateful   Build-Depends:     base >= 4 && < 5, bytestring >= 0.9 && < 1.0, containers >= 0.5.2.0 && < 0.6, text >= 0.11 && < 1.3,                      primes == 0.2.*, vector >= 0.9 && < 0.11+  GHC-options:       -Wall   GHC-prof-options:  -auto-all   default-language:  Haskell2010