capped-list 1.1 → 1.2

raw patch · 3 files changed

+94/−143 lines, 3 filesdep −emptyPVP ok

version bump matches the API change (PVP)

Dependencies removed: empty

API changes (from Hackage documentation)

Files

• Data/CappedList.hs +92/−35
• Tests.hs +0/−104
• capped-list.cabal +2/−4

@@ -15,77 +15,98 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE DeriveDataTypeable #-} module Data.CappedList 	( CappedList (..)+	, toList+	, toList_+	, fromList 	, null-	, append+	, appendR+	, appendL+	, appendR_+	, appendL_+	, appendWith 	, map 	, mapEither-	, concatMap+	, concatMapM 	, foldr 	, foldl 	, unfoldr 	, length 	) where-import Prelude hiding (null, map, concatMap, foldl, foldr, length)+import Prelude hiding (null, map, foldl, foldr, length) import qualified Prelude as Prelude import Data.Monoid (Monoid, mempty, mappend) import Control.Monad (MonadPlus, mzero, mplus, ap) import Control.Monad.Fix (MonadFix, fix, mfix) import qualified Control.Applicative as A import Control.Applicative ((<$>), (<*>))-import Data.Empty (Empty (empty)) import qualified Data.Foldable as F import qualified Data.Traversable as T+import Data.Data (Data)+import Data.Typeable (Typeable)  -- | A list-like type for lazy sequences, with a user-defined termination value. -- data CappedList cap a 	= Next a (CappedList cap a) 	| Cap cap-	deriving (Eq, Show)---- TODO: deriving Data?--instance Empty cap => Empty (CappedList cap a) where-	empty = Cap empty+	deriving (Eq, Show, Data, Typeable)  instance Functor (CappedList cap) where 	fmap = map -instance Empty cap => Monoid (CappedList cap a) where-	mempty = Cap empty-	mappend = append--instance Empty cap => Monad (CappedList cap) where-	Cap x       >>= _ = Cap x-	(Next x xs) >>= k = append (k x) (xs >>= k)-	return = flip Next (Cap empty)+instance Monoid cap => Monoid (CappedList cap a) where+	mempty = Cap mempty+	mappend = appendWith mappend -instance Empty cap => MonadPlus (CappedList cap) where-	mzero = Cap empty-	mplus = append+instance Monoid cap => Monad (CappedList cap) where+	(>>=) = flip concatMapM+	return = flip Next (Cap mempty) -instance Empty cap => A.Alternative (CappedList cap) where-	empty = Cap empty-	(<|>) = append+instance Monoid cap => MonadPlus (CappedList cap) where+	mzero = mempty+	mplus = mappend -instance Empty cap => A.Applicative (CappedList cap) where-	pure = flip Next (Cap empty)+instance Monoid cap => A.Applicative (CappedList cap) where+	pure = return 	(<*>) = ap -instance F.Foldable (CappedList cap) where+instance Monoid cap => A.Alternative (CappedList cap) where+	empty = mempty+	(<|>) = mappend++instance Monoid cap => F.Foldable (CappedList cap) where 	foldMap = T.foldMapDefault -instance T.Traversable (CappedList cap) where+instance Monoid cap => T.Traversable (CappedList cap) where 	sequenceA (Cap x)     = A.pure $ Cap x 	sequenceA (Next f fs) = Next <$> f <*> T.sequenceA fs -instance Empty cap => MonadFix (CappedList cap) where+instance Monoid cap => MonadFix (CappedList cap) where 	mfix f = case fix (f . head') of 		Cap x      -> Cap x-		(Next x _) -> append (return x) (mfix (tail' . f))+		(Next x _) -> mappend (return x) (mfix (tail' . f)) +-- | Convert a capped list to a standard list.+--+-- The cap is returned in the first value of the result tuple.+--+toList :: CappedList cap a -> (cap, [a])+toList = foldl (\(cap, xs) x -> (cap, x:xs)) (\cap -> (cap, []))++-- | Convert a capped list to a standard list, discarding the cap.+--+toList_ :: CappedList cap a -> [a]+toList_ = foldr (:) (const [])++-- | Convert a standard list and cap to a capped list.+--+fromList :: [a] -> cap -> CappedList cap a+fromList []     = Cap+fromList (x:xs) = Next x . fromList xs+ -- | Like the standard 'Prelude.null' function. -- null :: CappedList cap a -> Bool@@ -94,10 +115,45 @@  -- | Like the standard '++' function. ---append :: CappedList cap a -> CappedList cap a -> CappedList cap a-append x@(Cap _)   _ = x-append (Next x xs) y = Next x (append xs y)+appendL :: CappedList cap1 a -> CappedList cap2 a -> (cap2, CappedList cap1 a)+appendL xs          (Cap y)     = (y, xs)+appendL x@(Cap _)   (Next y ys) = let (cap, z) = appendL x ys in (cap, Next y z)+appendL (Next x xs) ys          = let (cap, z) = appendL xs ys in (cap, Next x z) +-- | Like the standard '++' function.+--+appendR :: CappedList cap1 a -> CappedList cap2 a -> (cap1, CappedList cap2 a)+appendR (Next x xs) ys = let (cap, z) = appendR xs ys in (cap, Next x z)+appendR (Cap x)     ys = (x, ys)++-- | Like the standard '++' function.+--+-- The second list's \"cap\" will be discarded; to preserve the cap, use+-- 'appendL'.+--+appendL_ :: CappedList cap1 a -> CappedList cap2 a -> CappedList cap1 a+appendL_ xs          (Cap _)     = xs+appendL_ (Next x xs) ys          = Next x (appendL_ xs ys)+appendL_ xs          (Next y ys) = Next y (appendL_ xs ys)++-- | Like the standard '++' function.+--+-- The first list's \"cap\" will be discarded; to preserve the cap, use+-- 'appendR'.+--+appendR_ :: CappedList cap1 a -> CappedList cap2 a -> CappedList cap2 a+appendR_ (Next x xs) = Next x . appendR_ xs+appendR_ _           = id++-- | Append two capped lists, merging the caps together using a user-provided+-- function.+--+appendWith :: (c -> d -> e) -> CappedList c a -> CappedList d a+           -> CappedList e a+appendWith f (Cap x)     (Cap y)     = Cap (f x y)+appendWith f (Next x xs) ys          = Next x (appendWith f xs ys)+appendWith f xs          (Next y ys) = Next y (appendWith f xs ys)+ -- | Like the standard 'Prelude.map' function. -- map :: (a -> b) -> CappedList cap a -> CappedList cap b@@ -125,8 +181,9 @@  -- | Like the standard 'Prelude.concatMap' function. ---concatMap :: (a -> CappedList cap b) -> CappedList cap a -> CappedList cap b-concatMap f = foldr (append . f) Cap+concatMapM :: Monoid cap => (a -> CappedList cap b) -> CappedList cap a+           -> CappedList cap b+concatMapM f = foldr (mappend . f) Cap  -- | Like the standard 'Prelude.foldr' function, but accepting an extra -- parameter to handle 'Cap' values.

@@ -1,104 +0,0 @@--- Tests for Data.CappedList--module Main (tests) where-import Test.QuickCheck (Arbitrary, arbitrary)-import Test.Framework (Test, testGroup, defaultMain)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Data.CappedList (CappedList (..))-import qualified Data.CappedList as CL--main :: IO ()-main = defaultMain tests--tests :: [Test]-tests =-	[ testProperty "append" $ prop_Append-	, testProperty "map" $ prop_Map (1 +)-	, testProperty "mapEither Left" $ prop_MapEither (Left  . Just . (1 +))-	, testProperty "mapEither Right" $ prop_MapEither (Right . (1 +))-	, testProperty "concatMap" $ prop_ConcatMap (return . (1 +))-	, testProperty "foldr" $ prop_FoldR (+) $ \x -> case x of-		Nothing -> 0-		Just x -> x + 2-	, testProperty "foldl" $ prop_FoldL (+) $ \x -> case x of-		Nothing -> 0-		Just x -> x + 2-	, testProperty "unfoldr Left" $ prop_UnfoldR (Left . Just)-	, let-		step x = if x > 0-			then Right (x, x `div` 10)-			else Left (Just x)-		in testProperty "unfoldr Right" $ prop_UnfoldR step-	, testProperty "length" prop_Length-	]--instance (Arbitrary cap, Arbitrary a) => Arbitrary (CappedList cap a) where-	arbitrary = do-		cap <- arbitrary-		foldr Next (Cap cap) `fmap` arbitrary---- Pseudo type variables, for polymorphic properties-type A = Int-type B = Int-type CAP = Maybe Int--prop_Length :: CappedList CAP A -> Bool-prop_Length fl = CL.length fl == modelLength fl--prop_Append :: CappedList CAP A -> CappedList CAP A -> Bool-prop_Append x y = CL.append x y == modelAppend x y--prop_Map :: (A -> B) -> CappedList CAP A -> Bool-prop_Map f fl = CL.map f fl == modelMap f fl--prop_MapEither :: (A -> Either CAP B) -> CappedList CAP A -> Bool-prop_MapEither f fl = CL.mapEither f fl == modelMapEither f fl--prop_FoldR :: (A -> B -> B) -> (CAP -> B) -> CappedList CAP A -> Bool-prop_FoldR f z fl = CL.foldr f z fl == modelFoldR f z fl--prop_FoldL :: (B -> A -> B) -> (CAP -> B) -> CappedList CAP A -> Bool-prop_FoldL f z fl = CL.foldl f z fl == modelFoldL f z fl--prop_UnfoldR :: (B -> Either CAP (A, B)) -> B -> Bool-prop_UnfoldR f nil = CL.unfoldr f nil == modelUnfoldR f nil--prop_ConcatMap :: (A -> CappedList CAP B) -> CappedList CAP A -> Bool-prop_ConcatMap f fl = CL.concatMap f fl == modelConcatMap f fl---- Versions of the basic operations, inefficient but known to be correct.-modelLength :: CappedList cap a -> Int-modelLength (Cap _)     = 0-modelLength (Next x xs) = 1 + modelLength xs--modelAppend :: CappedList cap a -> CappedList cap a -> CappedList cap a-modelAppend (Cap x)     _ = Cap x-modelAppend (Next x xs) y = Next x (modelAppend xs y)--modelMap :: (a -> b) -> CappedList cap a -> CappedList cap b-modelMap _ (Cap x)     = Cap x-modelMap f (Next x xs) = Next (f x) (modelMap f xs)--modelMapEither :: (a -> Either cap b) -> CappedList cap a -> CappedList cap b-modelMapEither _ (Cap x) = Cap x-modelMapEither f (Next x xs) = case f x of-	Left cap -> Cap cap-	Right x' -> Next x' (modelMapEither f xs)--modelConcatMap :: (a -> CappedList cap b) -> CappedList cap a -> CappedList cap b-modelConcatMap _ (Cap x)     = Cap x-modelConcatMap f (Next x xs) = modelAppend (f x) (modelConcatMap f xs)--modelFoldR :: (a -> b -> b) -> (cap -> b) -> CappedList cap a -> b-modelFoldR _ z (Cap x)     = z x-modelFoldR f z (Next x xs) = f x (modelFoldR f z xs)--modelFoldL :: (b -> a -> b) -> (cap -> b) -> CappedList cap a -> b-modelFoldL _ z (Cap x)     = z x-modelFoldL f z (Next x xs) = modelFoldL f (\cap -> f (z cap) x) xs--modelUnfoldR :: (b -> Either cap (a, b)) -> b -> CappedList cap a-modelUnfoldR f = unfoldr' where-	unfoldr' x = case f x of-		Left cap -> Cap cap-		Right (a, b) -> Next a (unfoldr' b)

@@ -1,5 +1,5 @@ name: capped-list-version: 1.1+version: 1.2 synopsis: A list-like type for lazy sequences, with a user-defined termination value. license: BSD3 license-File: license.txt@@ -9,11 +9,9 @@ build-type: Simple cabal-version: >=1.2 category: Data-extra-source-files:-  Tests.hs  library-  build-depends: base >= 2 && < 5, empty+  build-depends: base >= 2 && < 5    exposed-modules:     Data.CappedList