monoid-subclasses 0.1.2 → 0.2

raw patch · 6 files changed

+117/−26 lines, 6 filesdep ~basedep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, containers

API changes (from Hackage documentation)

Files

• Data/Monoid/Cancellative.hs +13/−9
• Data/Monoid/Factorial.hs +18/−13
• Data/Monoid/Null.hs +2/−0
• Data/Monoid/Textual.hs +80/−2
• Test/TestMonoidSubclasses.hs +3/−1
• monoid-subclasses.cabal +1/−1

@@ -51,6 +51,7 @@ import qualified Data.List as List import Data.Maybe (isJust) import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Unsafe as ByteString import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.Text as Text import qualified Data.Text.Lazy as LazyText@@ -451,13 +452,13 @@  instance LeftReductiveMonoid ByteString.ByteString where    stripPrefix p l = if ByteString.isPrefixOf p l-                     then Just (ByteString.drop (ByteString.length p) l)+                     then Just (ByteString.unsafeDrop (ByteString.length p) l)                      else Nothing    isPrefixOf = ByteString.isPrefixOf  instance RightReductiveMonoid ByteString.ByteString where    stripSuffix s l = if ByteString.isSuffixOf s l-                     then Just (ByteString.take (ByteString.length l - ByteString.length s) l)+                     then Just (ByteString.unsafeTake (ByteString.length l - ByteString.length s) l)                      else Nothing    isSuffixOf = ByteString.isSuffixOf @@ -466,18 +467,21 @@ instance RightCancellativeMonoid ByteString.ByteString  instance LeftGCDMonoid ByteString.ByteString where-   stripCommonPrefix x y = (xp, xs, ByteString.drop maxPrefixLength y)+   stripCommonPrefix x y = (xp, xs, ByteString.unsafeDrop maxPrefixLength y)       where maxPrefixLength = prefixLength 0 (ByteString.length x `min` ByteString.length y)-            prefixLength n len | n < len && ByteString.index x n == ByteString.index y n = prefixLength (succ n) len-            prefixLength n _ = n+            prefixLength n len | n < len, +                                 ByteString.unsafeIndex x n == ByteString.unsafeIndex y n = +                                    prefixLength (succ n) len+                               | otherwise = n             (xp, xs) = ByteString.splitAt maxPrefixLength x  instance RightGCDMonoid ByteString.ByteString where    stripCommonSuffix x y = findSuffix (ByteString.length x - 1) (ByteString.length y - 1)-      where findSuffix m n | m >= 0 && n >= 0 && ByteString.index x m == ByteString.index y n =-               findSuffix (pred m) (pred n)-            findSuffix m n = (ByteString.take (succ m) x, yp, ys)-               where (yp, ys) = ByteString.splitAt (succ n) y+      where findSuffix m n | m >= 0, n >= 0,+                             ByteString.unsafeIndex x m == ByteString.unsafeIndex y n =+                                findSuffix (pred m) (pred n)+                           | otherwise = let (yp, ys) = ByteString.splitAt (succ n) y+                                         in (ByteString.unsafeTake (succ m) x, yp, ys)  -- Lazy ByteString instances 

@@ -20,6 +20,7 @@ import Prelude hiding (break, drop, dropWhile, foldl, foldr, length, map, mapM, mapM_, null,                        reverse, span, splitAt, take, takeWhile)    +import Control.Arrow (first) import qualified Control.Monad as Monad import Data.Monoid (Monoid (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo)) import qualified Data.Foldable as Foldable@@ -89,9 +90,9 @@    foldr :: (m -> a -> a) -> a -> m -> a    -- | The 'length' of the list of 'primes'.    length :: m -> Int-   -- | Equivalent to 'List.map' from "Data.List", except the argument function works on prime factors rather than list-   -- elements.-   map :: (FactorialMonoid m, Monoid n) => (m -> n) -> m -> n+   -- | 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    -- | Like 'List.span' from "Data.List" on the list of 'primes'.    span :: (m -> Bool) -> m -> (m, m)    -- | Equivalent to 'List.break' from "Data.List".@@ -125,15 +126,17 @@    foldl' f f0 = List.foldl' f f0 . factors    foldr f f0 = List.foldr f f0 . factors    length = List.length . factors-   map f = foldr (mappend . f) mempty+   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 .)-   split p m = foldr f [mempty] m-      where f prime s@(x:xs) | p prime = mempty : s -                             | otherwise = mappend prime x : xs+   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)@@ -206,7 +209,7 @@    foldr _ f0 [] = f0    foldr f f0 (x:xs) = f [x] (foldr f f0 xs)    length = List.length-   map f = mconcat . List.map (f . (:[]))+   foldMap f = mconcat . List.map (f . (:[]))    break f = List.break (f . (:[]))    span f = List.span (f . (:[]))    dropWhile f = List.dropWhile (f . (:[]))@@ -275,8 +278,8 @@    factors = Text.chunksOf 1    primePrefix = Text.take 1    primeSuffix x = if Text.null x then Text.empty else Text.singleton (Text.last x)-   splitPrimePrefix = fmap (\(c, t)-> (Text.singleton c, t)) . Text.uncons-   splitPrimeSuffix x = if Text.null x then Nothing else Just (Text.splitAt (Text.length x - 1) 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))    foldl f = Text.foldl f'       where f' a char = f a (Text.singleton char)    foldl' f = Text.foldl' f'@@ -299,8 +302,10 @@    factors = LazyText.chunksOf 1    primePrefix = LazyText.take 1    primeSuffix x = if LazyText.null x then LazyText.empty else LazyText.singleton (LazyText.last x)-   splitPrimePrefix = fmap (\(c, t)-> (LazyText.singleton c, t)) . LazyText.uncons-   splitPrimeSuffix x = if LazyText.null x then Nothing else Just (LazyText.splitAt (LazyText.length x - 1) x)+   splitPrimePrefix = fmap (first LazyText.singleton) . LazyText.uncons+   splitPrimeSuffix x = if LazyText.null x+                        then Nothing+                        else Just (LazyText.init x, LazyText.singleton (LazyText.last x))    foldl f = LazyText.foldl f'       where f' a char = f a (LazyText.singleton char)    foldl' f = LazyText.foldl' f'@@ -448,7 +453,7 @@  -- | A 'Monad.mapM' equivalent. mapM :: (FactorialMonoid a, Monoid b, Monad m) => (a -> m b) -> a -> m b-mapM f = ($ return mempty) . appEndo . map (Endo . Monad.liftM2 mappend . f)+mapM f = ($ return mempty) . appEndo . foldMap (Endo . Monad.liftM2 mappend . f)  -- | A 'Monad.mapM_' equivalent. mapM_ :: (FactorialMonoid a, Monad m) => (a -> m b) -> a -> m ()

@@ -33,6 +33,8 @@ -- | Extension of 'Monoid' that allows testing a value for equality with 'mempty'. The following law must hold: --  -- prop> null x == (x == mempty)+-- +-- Furthermore, the performance of this method should be constant, /i.e./, independent of the length of its argument. class Monoid m => MonoidNull m where    null :: m -> Bool 

@@ -16,6 +16,8 @@  import Prelude hiding (foldl, foldl1, foldr, foldr1, scanl, scanr, scanl1, scanr1, map, concatMap, break, span) +import qualified Data.Foldable as Foldable+import qualified Data.Traversable as Traversable import Data.Maybe (fromJust) import Data.Either (rights) import qualified Data.List as List@@ -23,6 +25,8 @@ import qualified Data.Text.Lazy as LazyText import Data.Text (Text) import Data.Monoid (Monoid(mappend, mconcat, mempty))+import qualified Data.Sequence as Sequence+import qualified Data.Vector as Vector import Data.String (IsString(fromString))  import Data.Monoid.Null (MonoidNull (null))@@ -185,8 +189,12 @@    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))-   split f = Factorial.split (maybe False f . characterPrefix)-   find f = foldr (const id) (\c r-> if f c then Just c else r) Nothing+   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  foldlChars f (t, c1) c2 = (mappend t (singleton c'), c')    where c' = f c1 c2@@ -279,3 +287,73 @@    span _ = LazyText.span    split = LazyText.split    find = LazyText.find++instance IsString (Sequence.Seq Char) where+   fromString = Sequence.fromList++instance TextualMonoid (Sequence.Seq Char) where+   singleton = Sequence.singleton+   splitCharacterPrefix s = case Sequence.viewl s+                            of Sequence.EmptyL -> Nothing+                               c Sequence.:< rest -> Just (c, rest)+   characterPrefix s = case Sequence.viewl s+                       of Sequence.EmptyL -> Nothing+                          c Sequence.:< rest -> Just c+   map = Traversable.fmapDefault+   concatMap = Foldable.foldMap+   any = Foldable.any+   all = Foldable.all++   foldl   = const Foldable.foldl+   foldl'  = const Foldable.foldl'+   foldr   = const Foldable.foldr++   scanl = Sequence.scanl+   scanl1 f v | Sequence.null v = Sequence.empty+              | otherwise = Sequence.scanl1 f v+   scanr = Sequence.scanr+   scanr1 f v | Sequence.null v = Sequence.empty+              | otherwise = Sequence.scanr1 f v++   takeWhile _ = Sequence.takeWhileL+   dropWhile _ = Sequence.dropWhileL+   break _ = Sequence.breakl+   span _ = Sequence.spanl+   find = Foldable.find++instance IsString (Vector.Vector Char) where+   fromString = Vector.fromList++instance TextualMonoid (Vector.Vector Char) where+   singleton = Vector.singleton+   splitCharacterPrefix t = if Vector.null t then Nothing else Just (Vector.unsafeHead t, Vector.unsafeTail t)+   characterPrefix = (Vector.!? 0)+   map = Vector.map+   concatMap = Vector.concatMap+   any = Vector.any+   all = Vector.all++   foldl   = const Vector.foldl+   foldl'  = const Vector.foldl'+   foldr   = const Vector.foldr++   scanl = Vector.scanl+   scanl1 f v | Vector.null v = Vector.empty+              | otherwise = Vector.scanl1 f v+   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++   takeWhile _ = Vector.takeWhile+   dropWhile _ = Vector.dropWhile+   break _ = Vector.break+   span _ = Vector.span+   find = Vector.find

@@ -114,7 +114,9 @@                                                           .&&. checkType (mempty :: String)                                                           .&&. checkType (mempty :: ByteStringUTF8)                                                           .&&. checkType (mempty :: Text)-                                                          .&&. checkType (mempty :: Lazy.Text))+                                                          .&&. checkType (mempty :: Lazy.Text)+                                                          .&&. checkType (mempty :: Seq Char)+                                                          .&&. checkType (mempty :: Vector Char)) checkInstances name (LeftReductiveTest checkType) = label name (checkType (mempty :: String)                                                                 .&&. checkType (mempty :: ByteString)                                                                 .&&. checkType (mempty :: Lazy.ByteString)

@@ -1,5 +1,5 @@ Name:                monoid-subclasses-Version:             0.1.2+Version:             0.2 Cabal-Version:       >= 1.10 Build-Type:          Simple Synopsis:            Subclasses of Monoid