diff --git a/ListLike.cabal b/ListLike.cabal --- a/ListLike.cabal +++ b/ListLike.cabal @@ -1,13 +1,13 @@ Name: ListLike -Version: 3.1.7.1 +Version: 4.0.0 License: BSD3 Maintainer: John Lato 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 diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -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 diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/src/Data/ListLike/Instances.hs b/src/Data/ListLike/Instances.hs --- a/src/Data/ListLike/Instances.hs +++ b/src/Data/ListLike/Instances.hs @@ -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 diff --git a/src/Data/ListLike/Text.hs b/src/Data/ListLike/Text.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Text.hs @@ -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 diff --git a/src/Data/ListLike/Text/Text.hs b/src/Data/ListLike/Text/Text.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Text/Text.hs @@ -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 diff --git a/src/Data/ListLike/Text/TextLazy.hs b/src/Data/ListLike/Text/TextLazy.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Text/TextLazy.hs @@ -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 diff --git a/src/Data/ListLike/Vector.hs b/src/Data/ListLike/Vector.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Vector.hs @@ -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 diff --git a/src/Data/ListLike/Vector/Generic.hs b/src/Data/ListLike/Vector/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Vector/Generic.hs @@ -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 diff --git a/src/Data/ListLike/Vector/Storable.hs b/src/Data/ListLike/Vector/Storable.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Vector/Storable.hs @@ -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 + diff --git a/src/Data/ListLike/Vector/Unboxed.hs b/src/Data/ListLike/Vector/Unboxed.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Vector/Unboxed.hs @@ -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 + diff --git a/src/Data/ListLike/Vector/Vector.hs b/src/Data/ListLike/Vector/Vector.hs new file mode 100644 --- /dev/null +++ b/src/Data/ListLike/Vector/Vector.hs @@ -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 diff --git a/testsrc/TestInfrastructure.hs b/testsrc/TestInfrastructure.hs new file mode 100644 --- /dev/null +++ b/testsrc/TestInfrastructure.hs @@ -0,0 +1,292 @@ +{-# LANGUAGE ScopedTypeVariables + ,RankNTypes + ,ExistentialQuantification + ,MultiParamTypeClasses + ,FunctionalDependencies + ,FlexibleInstances + ,UndecidableInstances + ,FlexibleContexts #-} + +{- +Copyright (C) 2007 John Goerzen + +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) + ]