ListLike 3.1.7.1 → 4.0.0
raw patch · 13 files changed
+974/−19 lines, 13 filesdep +HUnitdep +ListLikedep +QuickCheckdep ~arraydep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, ListLike, QuickCheck, random, text, vector
Dependency ranges changed: array, base, bytestring, containers
API changes (from Hackage documentation)
+ Data.ListLike.Text.Text: instance FoldableLL Text Char
+ Data.ListLike.Text.Text: instance ListLike Text Char
+ Data.ListLike.Text.Text: instance ListLikeIO Text Char
+ Data.ListLike.Text.Text: instance StringLike Text
+ Data.ListLike.Text.TextLazy: instance FoldableLL Text Char
+ Data.ListLike.Text.TextLazy: instance ListLike Text Char
+ Data.ListLike.Text.TextLazy: instance ListLikeIO Text Char
+ Data.ListLike.Text.TextLazy: instance StringLike Text
+ Data.ListLike.Vector.Generic: instance [overlap ok] (Eq (v Char), Vector v Char) => StringLike (v Char)
+ Data.ListLike.Vector.Generic: instance [overlap ok] (Monoid (v a), Eq (v a), Vector v a) => ListLike (v a) a
+ Data.ListLike.Vector.Generic: instance [overlap ok] Vector v a => FoldableLL (v a) a
+ Data.ListLike.Vector.Storable: instance Storable a => FoldableLL (Vector a) a
+ Data.ListLike.Vector.Storable: instance Storable a => ListLike (Vector a) a
+ Data.ListLike.Vector.Storable: instance StringLike (Vector Char)
+ Data.ListLike.Vector.Unboxed: instance StringLike (Vector Char)
+ Data.ListLike.Vector.Unboxed: instance Unbox a => FoldableLL (Vector a) a
+ Data.ListLike.Vector.Unboxed: instance Unbox a => ListLike (Vector a) a
+ Data.ListLike.Vector.Vector: instance FoldableLL (Vector a) a
+ Data.ListLike.Vector.Vector: instance ListLike (Vector a) a
+ Data.ListLike.Vector.Vector: instance StringLike (Vector Char)
Files
- ListLike.cabal +29/−9
- README +0/−10
- README.md +18/−0
- src/Data/ListLike/Instances.hs +2/−0
- src/Data/ListLike/Text.hs +9/−0
- src/Data/ListLike/Text/Text.hs +102/−0
- src/Data/ListLike/Text/TextLazy.hs +100/−0
- src/Data/ListLike/Vector.hs +15/−0
- src/Data/ListLike/Vector/Generic.hs +105/−0
- src/Data/ListLike/Vector/Storable.hs +102/−0
- src/Data/ListLike/Vector/Unboxed.hs +101/−0
- src/Data/ListLike/Vector/Vector.hs +99/−0
- testsrc/TestInfrastructure.hs +292/−0
ListLike.cabal view
@@ -1,13 +1,13 @@ Name: ListLike-Version: 3.1.7.1+Version: 4.0.0 License: BSD3 Maintainer: John Lato <jwlato@gmail.com> Author: John Goerzen Copyright: Copyright (c) 2007-2008 John Goerzen license-file: COPYRIGHT-extra-source-files: COPYRIGHT, README+extra-source-files: COPYRIGHT, README.md Category: Generics-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 Build-Type: Simple homepage: http://software.complete.org/listlike synopsis: Generic support for list-like structures@@ -32,19 +32,39 @@ Data.ListLike.IO, Data.ListLike.Instances, Data.ListLike.String,+ Data.ListLike.Text+ Data.ListLike.Text.Text+ Data.ListLike.Text.TextLazy Data.ListLike.Utils+ Data.ListLike.Vector+ Data.ListLike.Vector.Generic+ Data.ListLike.Vector.Storable+ Data.ListLike.Vector.Unboxed+ Data.ListLike.Vector.Vector -- Other-Modules: Data.ConfigFile.Lexer Build-Depends: base >= 3 && < 5 ,containers >= 0.3 && < 0.6 ,bytestring >= 0.9.1 && < 0.11 ,array >= 0.3 && < 0.5+ ,text >= 0.11 && < 0.12+ ,vector >= 0.5 && < 0.11 -Executable runtests- Buildable: False- Main-Is: runtests.hs- HS-Source-Dirs: testsrc, .- Extensions: ExistentialQuantification- UndecidableInstances, CPP+Test-suite listlike-tests+ Hs-source-dirs: src testsrc+ Main-is: runtests.hs+ Type: exitcode-stdio-1.0++ Other-modules: TestInfrastructure+ Build-depends: base+ ,ListLike+ ,HUnit >= 1.2 && < 2+ ,QuickCheck >= 2.4 && < 3+ ,random >= 1 && < 2+ ,array+ ,bytestring+ ,containers+ ,text+ ,vector source-repository head type: git
− README
@@ -1,10 +0,0 @@-The ListLike package provides typeclasses and instances to allow-polymorphism over many common datatypes.--The package can be built/installed with Cabal. If you have cabal-install,-simply run "cabal install ListLike" to install the package. Without-cabal-install, execute the following commands:--$ runghc Setup.hs configure-$ runghc Setup.hs build-$ runghc Setup.hs install
+ README.md view
@@ -0,0 +1,18 @@+[](http://travis-ci.org/JohnLato/listlike)++ListLike+========++The ListLike package provides typeclasses and instances to allow+polymorphism over many common datatypes.++Installation+------------++The package can be built/installed with Cabal. If you have cabal-install,+simply run "cabal install ListLike" to install the package. Without+cabal-install, execute the following commands:++$ runghc Setup.hs configure+$ runghc Setup.hs build+$ runghc Setup.hs install
src/Data/ListLike/Instances.hs view
@@ -46,6 +46,8 @@ import Data.ListLike.String import Data.ListLike.IO import Data.ListLike.FoldableLL+import Data.ListLike.Text ()+import Data.ListLike.Vector () import Data.Int import Data.Monoid import qualified Data.ByteString as BS
+ src/Data/ListLike/Text.hs view
@@ -0,0 +1,9 @@+module Data.ListLike.Text (+ module Data.ListLike.Text.Text+ ,module Data.ListLike.Text.TextLazy+)++where++import Data.ListLike.Text.Text+import Data.ListLike.Text.TextLazy
+ src/Data/ListLike/Text/Text.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances #-}++module Data.ListLike.Text.Text++where++import Prelude as P+import Control.Monad+import qualified Data.Text as T+import qualified Data.Text.IO as TI+import Data.Text.Encoding (decodeUtf8)+import Data.ListLike.Base as LL+import Data.ListLike.FoldableLL+import Data.ListLike.IO+import Data.ListLike.String++import qualified Data.ByteString as BS++instance FoldableLL T.Text Char where+ foldl = T.foldl+ foldl' = T.foldl'+ foldl1 = T.foldl1+ foldr = T.foldr+ --foldr' = T.foldr'+ foldr1 = T.foldr1++instance ListLike T.Text Char where+ empty = T.empty+ singleton = T.singleton+ cons = T.cons+ snoc = T.snoc+ append = T.append+ head = T.head+ last = T.last+ tail = T.tail+ init = T.init+ null = T.null+ length = T.length+ rigidMap = T.map+ reverse = T.reverse+ intersperse = T.intersperse+ concat = T.concat . toList+ rigidConcatMap = T.concatMap+ any = T.any+ all = T.all+ maximum = T.maximum+ minimum = T.minimum+ replicate n = T.replicate n . T.singleton+ take = T.take+ drop = T.drop+ splitAt = T.splitAt+ takeWhile = T.takeWhile+ dropWhile = T.dropWhile+ span = T.span+ break = T.break+ group = fromList . T.group+ inits = fromList . T.inits+ tails = fromList . T.tails+ isPrefixOf = T.isPrefixOf+ isSuffixOf = T.isSuffixOf+ elem = T.isInfixOf . T.singleton+ find = T.find+ filter = T.filter+ index = T.index+ findIndex = T.findIndex+ toList = T.unpack+ fromList = T.pack+ fromListLike = fromList . toList+ groupBy f = fromList . T.groupBy f+ genericLength = fromInteger . fromIntegral . T.length+ genericTake i = T.take (fromIntegral i)+ genericDrop i = T.drop (fromIntegral i)+ genericSplitAt i = T.splitAt (fromIntegral i)+ genericReplicate i = LL.replicate (fromIntegral i)++ sequence = liftM fromList . P.sequence . toList+ mapM func = liftM fromList . P.mapM func . toList++instance ListLikeIO T.Text Char where+ hGetLine = TI.hGetLine+ hGetContents = TI.hGetContents+ hGet h c = BS.hGet h c >>= return . decodeUtf8+ hGetNonBlocking h i = BS.hGetNonBlocking h i >>= return . decodeUtf8+ hPutStr = TI.hPutStr+ hPutStrLn = TI.hPutStrLn+ getLine = TI.getLine+ getContents = TI.getContents+ putStr = TI.putStr+ putStrLn = TI.putStrLn+ interact = TI.interact+ readFile = TI.readFile+ writeFile = TI.writeFile+ appendFile = TI.appendFile++instance StringLike T.Text where+ toString = T.unpack+ fromString = T.pack+ words = fromList . T.words+ lines = fromList . T.lines+ unwords = T.unwords . toList+ unlines = T.unlines . toList
+ src/Data/ListLike/Text/TextLazy.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances #-}++module Data.ListLike.Text.TextLazy++where++import Prelude as P+import Control.Monad+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as TI+import Data.Text.Encoding (decodeUtf8)+import Data.ListLike.Base as LL+import Data.ListLike.FoldableLL+import Data.ListLike.IO+import Data.ListLike.String++import qualified Data.ByteString as BS++instance FoldableLL T.Text Char where+ foldl = T.foldl+ foldl' = T.foldl'+ foldl1 = T.foldl1+ foldr = T.foldr+ foldr1 = T.foldr1++instance ListLike T.Text Char where+ empty = T.empty+ singleton = T.singleton+ cons = T.cons+ snoc = T.snoc+ append = T.append+ head = T.head+ last = T.last+ tail = T.tail+ init = T.init+ null = T.null+ length = fromIntegral . T.length+ rigidMap = T.map+ reverse = T.reverse+ intersperse = T.intersperse+ concat = T.concat . toList+ rigidConcatMap = T.concatMap+ any = T.any+ all = T.all+ maximum = T.maximum+ minimum = T.minimum+ replicate n = T.replicate (fromIntegral n) . T.singleton+ take = T.take . fromIntegral+ drop = T.drop . fromIntegral+ splitAt = T.splitAt . fromIntegral+ takeWhile = T.takeWhile+ dropWhile = T.dropWhile+ span = T.span+ break = T.break+ group = fromList . T.group+ inits = fromList . T.inits+ tails = fromList . T.tails+ isPrefixOf = T.isPrefixOf+ isSuffixOf = T.isSuffixOf+ elem = T.isInfixOf . T.singleton+ find = T.find+ filter = T.filter+ index t = T.index t . fromIntegral+ toList = T.unpack+ fromList = T.pack+ fromListLike = fromList . toList+ groupBy f = fromList . T.groupBy f+ genericLength = fromInteger . fromIntegral . T.length+ genericTake i = T.take (fromIntegral i)+ genericDrop i = T.drop (fromIntegral i)+ genericSplitAt i = T.splitAt (fromIntegral i)+ genericReplicate i = LL.replicate (fromIntegral i)++ sequence = liftM fromList . P.sequence . toList+ mapM func = liftM fromList . P.mapM func . toList++instance ListLikeIO T.Text Char where+ hGetLine = TI.hGetLine+ hGetContents = TI.hGetContents+ hGet h = fmap (T.fromStrict . decodeUtf8) . BS.hGet h+ hGetNonBlocking h = fmap (T.fromStrict . decodeUtf8) . BS.hGetNonBlocking h+ hPutStr = TI.hPutStr+ hPutStrLn = TI.hPutStrLn+ getLine = TI.getLine+ getContents = TI.getContents+ putStr = TI.putStr+ putStrLn = TI.putStrLn+ interact = TI.interact+ readFile = TI.readFile+ writeFile = TI.writeFile+ appendFile = TI.appendFile++instance StringLike T.Text where+ toString = T.unpack+ fromString = T.pack+ words = fromList . T.words+ lines = fromList . T.lines+ unwords = T.unwords . toList+ unlines = T.unlines . toList
+ src/Data/ListLike/Vector.hs view
@@ -0,0 +1,15 @@+-- | ListLike instances for several @Data.Vector@ types.+-- The `Data.ListLike.Vector.Generic` instances are not exported from this+-- module in order to prevent collisions.+--+module Data.ListLike.Vector (+ module Data.ListLike.Vector.Storable+ ,module Data.ListLike.Vector.Unboxed+ ,module Data.ListLike.Vector.Vector+)++where++import Data.ListLike.Vector.Storable+import Data.ListLike.Vector.Unboxed+import Data.ListLike.Vector.Vector
+ src/Data/ListLike/Vector/Generic.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleContexts+ ,FlexibleInstances+ ,OverlappingInstances+ ,UndecidableInstances #-}++-- | ListLike instance for any type supporting the @Data.Vector.Generic@+-- interface. To avoid collisions with other Vector instances, this module+-- must be imported directly.+module Data.ListLike.Vector.Generic ()++where++import Prelude as P+import Control.Monad+import qualified Data.Vector.Generic as V+import Data.Vector.Generic ((!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String++import Data.Monoid++instance V.Vector v a => FoldableLL (v a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++instance (Monoid (v a), Eq (v a), V.Vector v a) => ListLike (v a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ toList = V.toList+ fromList = V.fromList+ fromListLike = fromList . toList+ --groupBy f = + genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i = + genericReplicate i = V.replicate (fromIntegral i)++ sequence = liftM fromList . P.sequence . toList+ mapM func = liftM fromList . P.mapM func . toList++instance (Eq (v Char), V.Vector v Char) => StringLike (v Char) where+ toString = V.toList+ fromString = V.fromList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False
+ src/Data/ListLike/Vector/Storable.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances #-}++module Data.ListLike.Vector.Storable ()++where++import Prelude as P+import Control.Monad+import qualified Data.Vector.Storable as V+import Data.Vector.Storable ((!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String++import Data.Monoid+import Foreign.Storable (Storable)+++instance Storable a => FoldableLL (V.Vector a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++instance Storable a => ListLike (V.Vector a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ toList = V.toList+ fromList = V.fromList+ fromListLike = fromList . toList+ --groupBy f = + genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i = + genericReplicate i = V.replicate (fromIntegral i)++ sequence = liftM fromList . P.sequence . toList+ mapM func = liftM fromList . P.mapM func . toList++instance StringLike (V.Vector Char) where+ toString = toList+ fromString = fromList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+
+ src/Data/ListLike/Vector/Unboxed.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances #-}++module Data.ListLike.Vector.Unboxed ()++where++import Prelude as P+import Control.Monad+import qualified Data.Vector.Unboxed as V+import Data.Vector.Unboxed (Unbox, (!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String++import Data.Monoid+++instance Unbox a => FoldableLL (V.Vector a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++instance Unbox a => ListLike (V.Vector a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ toList = V.toList+ fromList = V.fromList+ fromListLike = fromList . toList+ --groupBy f = + genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i = + genericReplicate i = V.replicate (fromIntegral i)++ sequence = liftM fromList . P.sequence . toList+ mapM func = liftM fromList . P.mapM func . toList++instance StringLike (V.Vector Char) where+ toString = toList+ fromString = fromList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+
+ src/Data/ListLike/Vector/Vector.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances #-}++module Data.ListLike.Vector.Vector ()++where++import Prelude as P+import Control.Monad+import qualified Data.Vector as V+import Data.Vector ((!))+import Data.ListLike.Base+import Data.ListLike.FoldableLL+import Data.ListLike.String++import Data.Monoid++instance FoldableLL (V.Vector a) a where+ foldl = V.foldl+ foldl' = V.foldl'+ foldl1 = V.foldl1+ foldr = V.foldr+ foldr' = V.foldr'+ foldr1 = V.foldr1++instance ListLike (V.Vector a) a where+ empty = V.empty+ singleton = V.singleton+ cons = V.cons+ snoc = V.snoc+ append = mappend+ head = V.head+ last = V.last+ tail = V.tail+ init = V.init+ null = V.null+ length = V.length+ rigidMap = V.map+ reverse = V.reverse+ --intersperse =+ concat = V.concat . toList+ rigidConcatMap = V.concatMap+ any = V.any+ all = V.all+ maximum = V.maximum+ minimum = V.minimum+ replicate = V.replicate+ take = V.take+ drop = V.drop+ --splitAt =+ takeWhile = V.takeWhile+ dropWhile = V.dropWhile+ span = V.span+ break = V.break+ --group =+ --inits =+ --tails =+ isPrefixOf = isPrefixOf'+ isSuffixOf = isSuffixOf'+ elem = V.elem+ find = V.find+ filter = V.filter+ index = (!)+ findIndex = V.findIndex+ toList = V.toList+ fromList = V.fromList+ fromListLike = fromList . toList+ --groupBy f = + genericLength = fromInteger . fromIntegral . V.length+ genericTake i = V.take (fromIntegral i)+ genericDrop i = V.drop (fromIntegral i)+ --genericSplitAt i = + genericReplicate i = V.replicate (fromIntegral i)++ sequence = liftM fromList . P.sequence . toList+ mapM func = liftM fromList . P.mapM func . toList++instance StringLike (V.Vector Char) where+ toString = toList+ fromString = fromList+ --words =+ --lines =+ unwords = let sp = V.singleton ' ' in V.concat . intersperse sp . toList+ unlines = let eol = V.singleton '\n' in V.concat . intersperse eol . toList++isPrefixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice 0 (V.length needle) haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False+isSuffixOf' needle haystack+ | V.null needle = True+ | V.length needle < V.length haystack =+ needle == V.slice (V.length haystack - V.length needle)+ (V.length needle)+ haystack+ | V.length needle == V.length haystack = needle == haystack+ | otherwise = False
+ testsrc/TestInfrastructure.hs view
@@ -0,0 +1,292 @@+{-# LANGUAGE ScopedTypeVariables+ ,RankNTypes+ ,ExistentialQuantification+ ,MultiParamTypeClasses+ ,FunctionalDependencies+ ,FlexibleInstances+ ,UndecidableInstances+ ,FlexibleContexts #-}++{-+Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>++All rights reserved.++For license and copyright information, see the file COPYRIGHT++-}++-- FIXME -- better code is in offlineimap v7 branch+module TestInfrastructure where++import Test.QuickCheck+import Test.QuickCheck.Test+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ListLike as LL+import qualified Data.Array as A+import qualified Data.Sequence as S+import qualified Data.Foldable as F+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Vector as V+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import System.Random+import System.IO+import qualified Test.HUnit as HU+import Text.Printf+import Data.Word+import Data.List+import Data.Monoid+++instance (Arbitrary i) => Arbitrary (MyList i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink (MyList l) = map MyList $ shrink l++instance (CoArbitrary i) => CoArbitrary (MyList i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance (Arbitrary i) => Arbitrary (S.Seq i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i) => CoArbitrary (S.Seq i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (BSL.ByteString) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (BSL.ByteString) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (BS.ByteString) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (BS.ByteString) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary i => Arbitrary (A.Array Int i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i) => CoArbitrary (A.Array Int i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (T.Text) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (T.Text) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary (TL.Text) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance CoArbitrary (TL.Text) where+ coarbitrary l = coarbitrary (LL.toList l)++instance Arbitrary i => Arbitrary (V.Vector i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i) => CoArbitrary (V.Vector i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance (Arbitrary i, VS.Storable i) => Arbitrary (VS.Vector i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i, VS.Storable i) => CoArbitrary (VS.Vector i) where+ coarbitrary l = coarbitrary (LL.toList l)++instance (Arbitrary i, VU.Unbox i) => Arbitrary (VU.Vector i) where+ arbitrary = sized (\n -> choose (0, n) >>= myVector)+ where myVector n =+ do arblist <- vector n+ return (LL.fromList arblist)+ shrink = map LL.fromList . shrink . LL.toList++instance (CoArbitrary i, VU.Unbox i) => CoArbitrary (VU.Vector i) where+ coarbitrary l = coarbitrary (LL.toList l)++class (Show b, Arbitrary a, Show a, Eq a, Eq b, LL.ListLike a b) => TestLL a b where+ llcmp :: a -> [b] -> Property+ llcmp f l = (putStrLn ("Expected: " ++ show l ++ "\nGot: " ++ show f))+ `whenFail` (l == (LL.toList f))+ checkLengths :: a -> [b] -> Bool+ checkLengths f l = (LL.length f) == length l++instance (Arbitrary a, Show a, Eq a) => TestLL [a] a where++instance (Arbitrary a, Show a, Eq a) => TestLL (MyList a) a where++instance TestLL BS.ByteString Word8 where++instance TestLL BSL.ByteString Word8 where++instance (Arbitrary a, Show a, Eq a) => TestLL (S.Seq a) a where++instance (Arbitrary a, Show a, Eq a) => TestLL (A.Array Int a) a where++instance TestLL T.Text Char where++instance TestLL TL.Text Char where++instance (Arbitrary a, Show a, Eq a) => TestLL (V.Vector a) a where++instance (Arbitrary a, Show a, Eq a, VS.Storable a) => TestLL (VS.Vector a) a where++instance (Arbitrary a, Show a, Eq a, VU.Unbox a) => TestLL (VU.Vector a) a where++mapRemoveDups :: (Eq k1) => [(k1, v1)] -> [(k1, v1)]+mapRemoveDups = nubBy (\(k1, _) (k2, _) -> k1 == k2)++data MyList a = MyList [a]+ deriving (Ord, Eq, Show)++instance LL.FoldableLL (MyList a) a where+ foldr f i (MyList x) = foldr f i x+ foldl f i (MyList x) = foldl f i x+ foldr1 f (MyList x) = foldr1 f x+ foldl1 f (MyList x) = foldl1 f x++instance Monoid (MyList a) where+ mempty = MyList []+ mappend (MyList x) (MyList y) = MyList (x ++ y)++instance LL.ListLike (MyList a) a where+ singleton x = MyList [x]+ head (MyList x) = head x+ tail (MyList x) = MyList (tail x)+ null (MyList x) = null x++instance LL.StringLike (MyList Char) where+ toString (MyList x) = x+ fromString x = MyList x++mkTest msg test = HU.TestLabel msg $ HU.TestCase (quickCheck test)++-- Modified from HUnit+runVerbTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)+runVerbTestText (HU.PutText put us) t = do+ (counts, us') <- HU.performTest reportStart reportError reportFailure us t+ us'' <- put (HU.showCounts counts) True us'+ return (counts, us'')+ where+ reportStart ss us = do hPrintf stderr "\rTesting %-68s\n" (HU.showPath (HU.path ss))+ put (HU.showCounts (HU.counts ss)) False us+ reportError = reportProblem "Error:" "Error in: "+ reportFailure = reportProblem "Failure:" "Failure in: "+ reportProblem p0 p1 msg ss us = put line True us+ where line = "### " ++ kind ++ path' ++ '\n' : msg+ kind = if null path' then p0 else p1+ path' = HU.showPath (HU.path ss)+++-- | So we can test map and friends+instance Show (a -> b) where+ show _ = "(a -> b)"++data LLTest f i =+ forall t. Testable t => LLTest (f -> t)++data LLWrap f' f i =+ forall t. Testable t => LLWrap (f' -> t)++w :: TestLL f i => String -> LLTest f i -> HU.Test+w msg f = case f of+ LLTest theTest -> mkTest msg theTest++ws :: (LL.StringLike f, TestLL f i) => String -> LLTest f i -> HU.Test+ws = w++wwrap :: (TestLL f i, TestLL f' f) => String -> LLWrap f' f i -> HU.Test+wwrap msg f = case f of+ LLWrap theTest -> mkTest msg theTest++t :: forall f t i. (TestLL f i, Arbitrary f, Arbitrary i, Show f, Eq f, Testable t) => (f -> t) -> LLTest f i+t = LLTest++-- | all props, wrapped list+apw :: String -> (forall f' f i. (TestLL f i, Show i, Eq i, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i, LL.ListLike f' f, Show f', TestLL f' f, Arbitrary f', Eq f') => LLWrap f' f i) -> HU.Test+apw msg x = HU.TestLabel msg $ HU.TestList $+ [wwrap "wrap [[Int]]" (x::LLWrap [[Int]] [Int] Int),+ wwrap "wrap MyList (MyList Int)" (x::LLWrap (MyList (MyList Int)) (MyList Int) Int),+ wwrap "wrap S.Seq (S.Seq Int)" (x::LLWrap (S.Seq (S.Seq Int)) (S.Seq Int) Int),+ wwrap "wrap Array (Array Int)" (x::LLWrap (A.Array Int (A.Array Int Int)) (A.Array Int Int) Int),+ wwrap "wrap Array [Int]" (x::LLWrap (A.Array Int [Int]) [Int] Int),+ wwrap "wrap (Vector (Vector Int))" (x::LLWrap (V.Vector (V.Vector Int)) (V.Vector Int) Int)+ ]++-- | all props, 1 args: full+apf :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i, CoArbitrary f, CoArbitrary i) => LLTest f i) -> HU.Test +apf msg x = HU.TestLabel msg $ HU.TestList $+ [w "[Int]" (x::LLTest [Int] Int),+ w "MyList Int" (x::LLTest (MyList Int) Int),+ w "String" (x::LLTest String Char),+ w "[Bool]" (x::LLTest [Bool] Bool),+ w "MyList Bool" (x::LLTest (MyList Bool) Bool),+ w "ByteString" (x::LLTest BS.ByteString Word8),+ w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8),+ w "Sequence Int" (x::LLTest (S.Seq Int) Int),+ w "Sequence Bool" (x::LLTest (S.Seq Bool) Bool),+ w "Sequence Char" (x::LLTest (S.Seq Char) Char),+ w "Array Int Int" (x::LLTest (A.Array Int Int) Int),+ w "Array Int Bool" (x::LLTest (A.Array Int Bool) Bool),+ w "Array (Just Int)" (x::LLTest (A.Array Int (Maybe Int)) (Maybe Int)),+ w "Vector Int" (x::LLTest (V.Vector Int) Int),+ w "StorableVector Int" (x::LLTest (VS.Vector Int) Int),+ w "UnboxVector Int" (x::LLTest (VU.Vector Int) Int),+ w "Vector Bool" (x::LLTest (V.Vector Bool) Bool),+ w "StorableVector Bool" (x::LLTest (VS.Vector Bool) Bool),+ w "UnboxVector Bool" (x::LLTest (VU.Vector Bool) Bool),+ w "Text" (x::LLTest T.Text Char),+ w "Text.Lazy" (x::LLTest TL.Text Char)+ ]++-- | all props, 1 args: full+aps :: String -> (forall f i. (Ord i, TestLL f i, Show i, Eq i, LL.StringLike f, LL.ListLike f i, Eq f, Show f, Arbitrary f, Arbitrary i) => LLTest f i) -> HU.Test +aps msg x = HU.TestLabel msg $ HU.TestList $+ [w "String" (x::LLTest String Char),+ w "MyList Char" (x::LLTest (MyList Char) Char),+ w "Sequence Char" (x::LLTest (S.Seq Char) Char),+ w "ByteString" (x::LLTest BS.ByteString Word8),+ w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8),+ w "Array Int Char" (x::LLTest (A.Array Int Char) Char),+ w "Text" (x::LLTest T.Text Char),+ w "Text.Lazy" (x::LLTest TL.Text Char),+ w "Vector Char" (x::LLTest (V.Vector Char) Char),+ w "Vector.Unbox Char" (x::LLTest (VU.Vector Char) Char)+ ]