packages feed

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 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 @@+[![Build Status](https://secure.travis-ci.org/JohnLato/listlike.png?branch=master)](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)+    ]