capped-list (empty) → 1.0

raw patch · 5 files changed

+322/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

Data/CappedList.hs +169/−0
Setup.hs +2/−0
Tests.hs +104/−0
capped-list.cabal +21/−0
license.txt +26/−0

+ Data/CappedList.hs view

@@ -0,0 +1,169 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.CappedList+-- Copyright   :  (c) 2010 John Millikin+-- License     :  BSD3+--+-- Maintainer  :  jmillikin@gmail.com+-- Portability :  portable+--+-- A list-like type for lazy sequences, with a user-defined termination value.+--+-- This module uses common names and so is designed to be imported qualified:+--+-- > import qualified Data.CappedList as CL+--+-----------------------------------------------------------------------------++module Data.CappedList+	( CappedList (..)+	, null+	, append+	, map+	, mapEither+	, concatMap+	, foldr+	, foldl+	, unfoldr+	, length+	) where+import Prelude hiding (null, map, concatMap, 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++-- | 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++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 Empty cap => MonadPlus (CappedList cap) where+	mzero = Cap empty+	mplus = append++instance Empty cap => A.Alternative (CappedList cap) where+	empty = Cap empty+	(<|>) = append++instance Empty cap => A.Applicative (CappedList cap) where+	pure = flip Next (Cap empty)+	(<*>) = ap++instance F.Foldable (CappedList cap) where+	foldMap = T.foldMapDefault++instance 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+	mfix f = case fix (f . head') of+		Cap x      -> Cap x+		(Next x _) -> append (return x) (mfix (tail' . f))++-- | Like the standard 'Prelude.null' function.+--+null :: CappedList cap a -> Bool+null (Next _ _) = False+null _          = True++-- | 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)++-- | Like the standard 'Prelude.map' function.+--+map :: (a -> b) -> CappedList cap a -> CappedList cap b+map f = foldr (Next . f) Cap++{-# INLINE [1] map #-}++{-# RULES+  "map/map" forall f g t.+   map f (map g t) = map (f . g) t+  #-}++-- | Like the standard 'Prelude.map' function, but the mapping function may+-- return a capping value.+--+mapEither :: (a -> Either cap b) -> CappedList cap a -> CappedList cap b+mapEither f = foldr (\a acc -> either Cap (flip Next acc) (f a)) Cap++{-# INLINE [1] mapEither #-}++{-# RULES+  "mapEither/mapEither" forall f g t.+   mapEither f (mapEither g t) = mapEither (either Left g . f) t+  #-}++-- | Like the standard 'Prelude.concatMap' function.+--+concatMap :: (a -> CappedList cap b) -> CappedList cap a -> CappedList cap b+concatMap f = foldr (append . f) Cap++-- | Like the standard 'Prelude.foldr' function, but accepting an extra+-- parameter to handle 'Cap' values.+--+foldr :: (a -> b -> b) -> (cap -> b) -> CappedList cap a -> b+foldr f z = foldr' where+	foldr' (Cap x)     = z x+	foldr' (Next x xs) = f x (foldr' xs)++-- | Like the standard 'Prelude.foldl' function, but accepting an extra+-- parameter to handle 'Cap' values.+--+foldl :: (b -> a -> b) -> (cap -> b) -> CappedList cap a -> b+foldl f = foldl' where+	foldl' z (Cap x)     = z x+	foldl' z (Next x xs) = foldl' (\cap -> f (z cap) x) xs++-- | Like the standard 'Data.List.unfoldr' function, but the step function+-- must return a cap to terminate the unfold.+--+unfoldr :: (b -> Either cap (a, b)) -> b -> CappedList cap a+unfoldr f = unfoldr' where+	unfoldr' x = case f x of+		Left cap -> Cap cap+		Right (a, b) -> Next a (unfoldr' b)++-- | Like the standard 'Prelude.length' function; 'Cap' is considered+-- 0-length.+--+length :: CappedList cap a -> Int+length = foldr (const (1 +)) (const 0)++-- Partial functions, used only to implement mfix; not exported+head' :: CappedList cap a -> a+head' (Cap _)    = error "mfix CappedList: Cap"+head' (Next x _) = x++tail' :: CappedList cap a -> CappedList cap a+tail' (Cap _)     = error "mfix CappedList: Cap"+tail' (Next _ xs) = xs

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ Tests.hs view

@@ -0,0 +1,104 @@+-- 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)

+ capped-list.cabal view

@@ -0,0 +1,21 @@+name: capped-list+version: 1.0+synopsis: A list-like type for lazy sequences, with a user-defined termination value.+license: BSD3+license-File: license.txt+author: John Millikin <jmillikin@gmail.com>+maintainer: John Millikin <jmillikin@gmail.com>+copyright: 2010 John Millikin <jmillikin@gmail.com>+build-type: Simple+cabal-version: >=1.2+category: Data+extra-source-files:+  Tests.hs++library+  build-depends: base >= 2 && < 5++  exposed-modules:+    Data.CappedList++  ghc-options: -Wall

+ license.txt view

@@ -0,0 +1,26 @@+Copyright (c) 2010 John Millikin+All rights reserved.++Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice, +  this list of conditions and the following disclaimer.+- Redistributions in binary form must reproduce the above copyright +  notice, this list of conditions and the following disclaimer in the +  documentation and/or other materials provided with the distribution.+- Neither the names of the copyright owners nor the names of the +  contributors may be used to endorse or promote products derived +  from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.