packages feed

listlike-instances (empty) → 0.1

raw patch · 12 files changed

+1089/−0 lines, 12 filesdep +ListLikedep +basedep +bytestringsetup-changed

Dependencies added: ListLike, base, bytestring, text, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, ++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of  nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell+import Distribution.Simple++main = defaultMain+
+ listlike-instances.cabal view
@@ -0,0 +1,31 @@+Name:                listlike-instances+Version:             0.1+Synopsis:            Extra instances of the ListLike class+Description:         Provides ListLike instances for Vector and Text types+Homepage:            http://tanimoto.us/~jwlato/haskell/listlike-instances+License:             BSD3+License-file:        LICENSE+Author:              John W. Lato+Maintainer:          jwlato@gmail.com+Category:            Generics, Data Structures+Build-type:          Simple+Cabal-version:       >=1.6++extra-source-files:+  testsrc/*.hs++Library+  Hs-Source-Dirs:    src+  Exposed-modules:   Data.ListLike.Text+                     Data.ListLike.Text.Text+                     Data.ListLike.Text.TextLazy+                     Data.ListLike.Vector+                     Data.ListLike.Vector.Storable+                     Data.ListLike.Vector.Unboxed+                     Data.ListLike.Vector.Vector+  Ghc-Options:       -fspec-constr-count=32+  Build-depends:     base             >= 3    && < 5+                    ,bytestring       >= 0.8  && < 0.10+                    ,ListLike         >= 2.0  && < 4.0+                    ,text             >= 0.11 && < 0.12+                    ,vector           >= 0.5  && < 0.8
+ 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,95 @@+{-# LANGUAGE MultiParamTypeClasses+            ,FlexibleInstances #-}++module Data.ListLike.Text.Text++where++import qualified Data.Text as T+import qualified Data.Text.IO as TI+import           Data.Text.Encoding (decodeASCII)+import           Data.ListLike+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 = Data.ListLike.replicate (fromIntegral i)++instance ListLikeIO T.Text Char where+    hGetLine = TI.hGetLine+    hGetContents = TI.hGetContents+    hGet h c = BS.hGet h c >>= return . decodeASCII+    hGetNonBlocking h i = BS.hGetNonBlocking h i >>= return . decodeASCII+    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,93 @@+{-# LANGUAGE MultiParamTypeClasses+            ,FlexibleInstances #-}++module Data.ListLike.Text.TextLazy++where++import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as TI+import           Data.Text.Encoding (decodeASCII)+import           Data.ListLike+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 = Data.ListLike.replicate (fromIntegral i)++instance ListLikeIO T.Text Char where+    hGetLine = TI.hGetLine+    hGetContents = TI.hGetContents+    hGet h = fmap (T.fromStrict . decodeASCII) . BS.hGet h+    hGetNonBlocking h = fmap (T.fromStrict . decodeASCII) . 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,11 @@+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/Storable.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE MultiParamTypeClasses+            ,FlexibleInstances #-}++module Data.ListLike.Vector.Storable ()++where++import qualified Data.Vector.Storable as V+import           Data.Vector.Storable ((!))+import           Data.ListLike+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)++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,95 @@+{-# LANGUAGE MultiParamTypeClasses+            ,FlexibleInstances #-}++module Data.ListLike.Vector.Unboxed ()++where++import qualified Data.Vector.Unboxed as V+import           Data.Vector.Unboxed (Unbox, (!))+import           Data.ListLike+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)++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,93 @@+{-# LANGUAGE MultiParamTypeClasses+            ,FlexibleInstances #-}++module Data.ListLike.Vector.Vector ()++where++import qualified Data.Vector as V+import           Data.Vector ((!))+import           Data.ListLike+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)++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,182 @@+{-# 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++-}++module TestInfrastructure where++import Test.QuickCheck+import Test.QuickCheck.Test+import qualified Data.ListLike as LL+import Data.ListLike.Text+import Data.ListLike.Vector+import qualified Data.Foldable as F+import qualified Data.Vector as V+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+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 (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 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)++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 (LL.ListLike f i, Arbitrary f, Arbitrary i, Show f, Show i, Eq i, Eq f) => LLTest f i =+    forall t. Testable t => LLTest (f -> t)++data (LL.ListLike f i, Arbitrary f, Arbitrary i, Show f, Show i, Eq i, Eq f, LL.ListLike f' f, TestLL f' f, Show f', Eq f', Arbitrary f') =>+     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 (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, VS.Storable i, VU.Unbox 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 "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, VU.Unbox 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 "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)+    ]
+ testsrc/runtests.hs view
@@ -0,0 +1,349 @@+{-# 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++-}+module Main where++import Test.QuickCheck+import qualified Data.ListLike as LL+import Data.ListLike.Text+import Data.ListLike.Vector+import System.Random+import qualified Test.HUnit as HU+import System.IO+import Text.Printf+import Data.Word+import Data.List+import Data.Monoid+import TestInfrastructure+import Data.Foldable(foldr', fold, foldMap)+import System.Info+++-- prop_singleton :: (Eq i,LL.ListLike f i) => f -> i -> Bool+--prop_singleton :: (Eq i, LL.ListLike f i, Arbitrary f, Show f, Show i, Arbitrary i) => f -> i -> Bool+prop_singleton f x = (LL.toList $ asTypeOf (LL.singleton x) f) == [x]++prop_empty f = (LL.toList l == []) && (LL.null l) && (LL.length l == 0)+    where l = asTypeOf LL.empty f++prop_tofromlist f =+    LL.toList f == l &&+    LL.length f == length l &&+    f == (LL.fromList . LL.toList $ f)+    where l = LL.toList f++prop_length f = LL.length f == length (LL.toList f)+prop_cons f i = llcmp (LL.cons i f) (i : (LL.toList f))+prop_append f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2)+prop_head f = not (LL.null f) ==> LL.head f == head (LL.toList f)+prop_last f = not (LL.null f) ==> LL.last f == last (LL.toList f)+prop_tail f = not (LL.null f) ==> llcmp (LL.tail f) (tail (LL.toList f))+prop_init f = not (LL.null f) ==> llcmp (LL.init f) (init (LL.toList f))+prop_null f = LL.null f == null (LL.toList f)+prop_length2 f = checkLengths f (LL.toList f)+prop_length3 f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2)++prop_map :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> item) -> Property+prop_map f func = llcmp llmap (map func (LL.toList f))+    where llmap = asTypeOf (LL.map func f) (LL.toList f)++prop_rigidMap f func = llcmp (LL.rigidMap func f) (map func (LL.toList f))+prop_reverse f = llcmp (LL.reverse f) (reverse (LL.toList f))+prop_intersperse f i = llcmp (LL.intersperse i f) (intersperse i (LL.toList f))++prop_concat f =+    llcmp (LL.concat f) (concat $ map LL.toList (LL.toList f))++prop_concatmap :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> [item]) -> Property+prop_concatmap f func =+    llcmp (LL.concatMap func f)+          (concatMap func (LL.toList f))++prop_rigidConcatMap f func =+    llcmp (LL.rigidConcatMap func f)+          (concatMap (LL.toList . func) (LL.toList f))++prop_any f func = (LL.any func f) == (any func (LL.toList f))+prop_all f func = (LL.all func f) == (all func (LL.toList f))+prop_maximum f = not (LL.null f) ==> LL.maximum f == maximum (LL.toList f)+prop_minimum f = not (LL.null f) ==> LL.minimum f == minimum (LL.toList f)+prop_replicate f count i = count <= 1000 ==> llcmp res (replicate count i)+    where res = asTypeOf (LL.replicate count i) f+prop_take f count = llcmp (LL.take count f) (take count (LL.toList f))+prop_drop f count = count >= 0 ==> llcmp (LL.drop count f) (drop count (LL.toList f))+prop_splitAt f count = count >= 0 ==>+    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.splitAt count $ f]+          [LL.splitAt count (LL.toList f)]+prop_takeWhile f func = llcmp (LL.takeWhile func f)+                              (takeWhile func (LL.toList f))+prop_dropWhile f func = llcmp (LL.dropWhile func f)+                              (dropWhile func (LL.toList f))+prop_span f func =+    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.span func $ f]+          [span func (LL.toList f)]+prop_break f func =+    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.break func $ f]+          [break func (LL.toList f)]+prop_group f =+    -- llcmp (map LL.toList (LL.group f)) (group (LL.toList f))+    (map LL.toList (LL.group f)) == (group (LL.toList f))+prop_inits f = (map LL.toList (LL.inits f)) == (inits (LL.toList f))+prop_tails f = (map LL.toList (LL.tails f)) == (tails (LL.toList f))+prop_isPrefixOf f1 f2 = LL.isPrefixOf f1 f2 ==+    (isPrefixOf (LL.toList f1) (LL.toList f2))+prop_isSuffixOf f1 f2 = LL.isSuffixOf f1 f2 ==+    (isSuffixOf (LL.toList f1) (LL.toList f2))+prop_isInfixOf f1 f2 = LL.isInfixOf f1 f2 ==+    (isInfixOf (LL.toList f1) (LL.toList f2))+prop_elem f i = LL.elem i f == elem i (LL.toList f)+prop_notElem f i = LL.notElem i f == notElem i (LL.toList f)+prop_find f func = LL.find func f == find func (LL.toList f)+prop_filter f func = llcmp (LL.filter func f) (filter func (LL.toList f))+prop_partition f func =+    (LL.toList f1, LL.toList f2) == partition func (LL.toList f)+    where (f1, f2) = LL.partition func f+prop_index f i = (i >= 0 && i < LL.length f) ==>+    (LL.index f i == ((LL.toList f) !! i))+prop_elemIndex f i = LL.elemIndex i f == elemIndex i (LL.toList f)+prop_elemIndices f i = LL.elemIndices i f == elemIndices i (LL.toList f)+prop_findIndex f func = LL.findIndex func f == findIndex func (LL.toList f)+prop_findIndices f func =+    LL.findIndices func f == findIndices func (LL.toList f)++prop_sequence f =+    case (llres, sequence testit) of+         (Just ll, Just l) -> llcmp ll l+         _ -> error "Error!"+    where testit = map Just (LL.toList f)+          llres = asTypeOf (LL.sequence testit) (Just f)++prop_mapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Bool+prop_mapM f func = llmapM == (mapM func (LL.toList f))+    where llmapM = asTypeOf (LL.mapM func f) (Just (LL.toList f))++prop_rigidMapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Property+prop_rigidMapM f func =+    case (LL.rigidMapM func f, mapM func (LL.toList f)) of+         (Just ll, Just l)  -> llcmp ll l+         (Nothing, Nothing) -> property True+         e -> error $ "error in prop_rigidMapM: " ++ show e++-- FIXME: can we test mapM_?++prop_nub f = llcmp (LL.nub f) (nub (LL.toList f))+prop_delete f i = llcmp (LL.delete i f) (delete i (LL.toList f))+prop_deleteFirsts f1 f2 = llcmp (LL.deleteFirsts f1 f2)+    ((LL.toList f1) \\ (LL.toList f2))+prop_union f1 f2 = llcmp (LL.union f1 f2)+    (union (LL.toList f1) (LL.toList f2))+prop_intersect f1 f2 = llcmp (LL.intersect f1 f2)+    (intersect (LL.toList f1) (LL.toList f2))+prop_sort f1 = llcmp (LL.sort f1) (sort (LL.toList f1))+prop_insert f i = llcmp (LL.insert i f) (insert i (LL.toList f))+prop_nubBy f func = llcmp (LL.nubBy func f) (nubBy func (LL.toList f))+prop_deleteBy f func i = llcmp (LL.deleteBy func i f)+                         (deleteBy func i (LL.toList f))+prop_deleteFirstsBy f1 f2 func = llcmp (LL.deleteFirstsBy func f1 f2)+    (deleteFirstsBy func (LL.toList f1) (LL.toList f2))+prop_unionBy f1 f2 func = llcmp (LL.unionBy func f1 f2)+    (unionBy func (LL.toList f1) (LL.toList f2))+prop_intersectBy f1 f2 func = llcmp (LL.intersectBy func f1 f2)+    (intersectBy func (LL.toList f1) (LL.toList f2))+prop_groupBy f func =+    (map LL.toList (LL.groupBy func f)) == (groupBy func (LL.toList f))+prop_sortBy1 f = llcmp (LL.sortBy compare f) (sortBy compare (LL.toList f))+prop_sortBy2 f = llcmp (LL.sortBy func f) (sortBy func (LL.toList f))+    where func x y = compare y x+prop_sortBy f func = llcmp (LL.sortBy func f) (sortBy func (LL.toList f))+prop_insertBy1 f i = llcmp (LL.insertBy compare i f)+    (insertBy compare i (LL.toList f))+prop_insertBy2 f i = llcmp (LL.insertBy func i f)+    (insertBy func i (LL.toList f))+    where func x y = compare y x+prop_genericLength f =+    LL.genericLength f == genericLength (LL.toList f)+prop_genericTake f (i::Integer) = (i >= 0) ==>+    llcmp (LL.genericTake i f) (genericTake i (LL.toList f))+prop_genericDrop f (i::Integer) = (i >= 0) ==>+    llcmp (LL.genericDrop i f) (genericDrop i (LL.toList f))+prop_genericSplitAt f (i::Integer) = i >= 0 ==>+    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.genericSplitAt i $ f]+          [LL.genericSplitAt i (LL.toList f)]+prop_genericReplicate f (count::Integer) i = count >= 0 ==>+    llcmp res (genericReplicate count i)+    where res = asTypeOf (LL.genericReplicate count i) f++--prop_zip :: (LL.ListLike full item, LL.ListLike result (item, Int)) =>+--    full -> Result+prop_zip f = LL.zip f f2 == zip (LL.toList f) f2+    where f2 = [(-5::Int)..]+prop_zipWith f =+    LL.toList res == (zipWith func (LL.toList f) f2)+    where f2 = [(100::Int)..(-100)]+          func x y = (y + 5, x)+          res = asTypeOf (LL.zipWith func f f2) [(5::Int, LL.head f)]+--FIXME: prop_unzip+--FIXME: prop_and+--FIXME: prop_or+--FIXME: prop_sum+--FIXME: prop_product+prop_foldl f func (i::Int) = LL.foldl func i f == foldl func i (LL.toList f)+prop_foldl' f func (i::Integer) =+    LL.foldl' func i f == foldl' func i (LL.toList f)+prop_foldl1 f func = not (LL.null f) ==>+    (LL.foldl1 func f) == (foldl1 func (LL.toList f))+prop_foldr f func (i::Int) = LL.foldr func i f == foldr func i (LL.toList f)+prop_foldr' f func (i::Integer) =+    LL.foldr' func i f == foldr' func i (LL.toList f)+prop_foldr1 f func = not (LL.null f) ==>+    LL.foldl1 func f == foldl1 func (LL.toList f)+prop_fold f = llcmp res resl+    where res = LL.fold f+          resl = fold (map LL.toList (LL.toList f))+prop_foldMap :: (LL.ListLike full item, Eq full) => full -> (item -> [Int]) -> Bool+prop_foldMap f func = res == resl+    where res = LL.foldMap func f+          resl = foldMap func  (LL.toList f) -- asTypeOf (foldMap (LL.toList f)) (head f)++prop_toString f =+    ((LL.fromString . LL.toString $ f) == f)+    where l = LL.toList f+prop_fromString f x =+    LL.toString (asTypeOf (LL.fromString x) f) == x+prop_lines f = map LL.toString res == lines (LL.toString f)+    where res = asTypeOf (LL.lines f) [f]+prop_words f = map LL.toString res == words (LL.toString f)+    where res = asTypeOf (LL.words f) [f]++allt = [apf "empty" (t prop_empty),+        apf "length" (t prop_length),+        apf "to/fromList" (t prop_tofromlist),+        apf "singleton" (t prop_singleton),+        apf "cons" (t prop_cons),+        apf "append" (t prop_append),+        apf "head" (t prop_head),+        apf "last" (t prop_last),+        apf "tail" (t prop_tail),+        apf "init" (t prop_init),+        apf "null" (t prop_null),+        apf "length2" (t prop_length2),+        apf "length3" (t prop_length3),+        apf "map" (t prop_map),+        apf "rigidMap" (t prop_rigidMap),+        apf "reverse" (t prop_reverse),+        apf "intersperse" (t prop_intersperse),+        apw "concat" (LLWrap prop_concat),+        apf "concatMap" (t prop_concatmap),+        apf "rigidConcatMap" (t prop_rigidConcatMap),+        apf "any" (t prop_any),+        apf "all" (t prop_all),+        apf "maximum" (t prop_maximum),+        apf "minimum" (t prop_minimum),+        apf "replicate" (t prop_replicate),+        apf "take" (t prop_take),+        apf "drop" (t prop_drop),+        apf "splitAt" (t prop_splitAt),+        apf "takeWhile" (t prop_takeWhile),+        apf "dropWhile" (t prop_dropWhile),+        apf "span" (t prop_span),+        apf "break" (t prop_break),+        apf "group" (t prop_group),+        apf "inits" (t prop_inits),+        apf "tails" (t prop_tails),+        apf "isPrefixOf" (t prop_isPrefixOf),+        apf "isSuffixOf" (t prop_isSuffixOf),+        apf "isInfixOf" (t prop_isInfixOf),+        apf "elem" (t prop_elem),+        apf "notElem" (t prop_notElem),+        apf "find" (t prop_find),+        apf "filter" (t prop_filter),+        apf "partition" (t prop_partition),+        apf "index" (t prop_index),+        apf "elemIndex" (t prop_elemIndex),+        apf "elemIndices" (t prop_elemIndices),+        apf "findIndex" (t prop_findIndex),+        apf "findIndices" (t prop_findIndices),+        apf "sequence" (t prop_sequence),+        apf "mapM" (t prop_mapM),+        apf "rigidMapM" (t prop_rigidMapM),+        -- FIXME: mapM_ ?+        apf "nub" (t prop_nub),+        apf "delete" (t prop_delete),+        apf "deleteFirsts" (t prop_deleteFirsts),+        apf "union" (t prop_union),+        apf "intersect" (t prop_intersect),+        apf "sort" (t prop_sort),+        apf "insert" (t prop_insert),+        -- toList+        -- fromList+        -- fromListLike+        apf "nubBy" (t prop_nubBy),+        apf "deleteBy" (t prop_deleteBy),+        apf "deleteFirstsBy" (t prop_deleteFirstsBy),+        apf "unionBy" (t prop_unionBy),+        apf "intersectBy" (t prop_intersectBy),+        apf "groupBy" (t prop_groupBy),+        apf "sortBy1" (t prop_sortBy1),+        apf "sortBy2" (t prop_sortBy2),+        apf "insertBy1" (t prop_insertBy1),+        apf "insertBy2" (t prop_insertBy2),+        apf "genericLength" (t prop_genericLength),+        apf "genericTake" (t prop_genericTake),+        apf "genericDrop" (t prop_genericDrop),+        apf "genericSplitAt" (t prop_genericSplitAt),+        apf "genericReplicate" (t prop_genericReplicate),+        apf "zip" (t prop_zip),+        apf "zipWith" (t prop_zipWith)+        -- apf "unzip" (t prop_unzip),+        -- apf "and" (t prop_and),+        -- apf "or" (t prop_or),+        -- apf "sum" (t prop_sum),+        -- apf "propduct" (t prop_product),+        -- sequence_+        ]++allf = (if compilerName == "hugs" then [] else [ apf "foldl" (t prop_foldl),+                                                 apf "foldr1" (t prop_foldr1),+                                                 apf "foldl1" (t prop_foldl1)])+       +++       [+        apf "foldl'" (t prop_foldl'),+        apf "foldr" (t prop_foldr),+        apf "foldr'" (t prop_foldr'),+        apw "fold" (LLWrap prop_fold),+        apf "foldMap" (t prop_foldMap)+       ]++alls = [+        aps "toString" (t prop_toString),+        aps "fromString" (t prop_fromString),+        aps "lines" (t prop_lines),+        aps "words" (t prop_words)+        -- FIXME: aps (t prop_unlines),+        -- FIXME: aps (t prop_unwords)+       ]+allTests = HU.TestList $ reverse $+                       [HU.TestLabel "ListLike" (HU.TestList allt),+                        HU.TestLabel "FoldableLL" (HU.TestList allf),+                        HU.TestLabel "StringLike" (HU.TestList alls)]++testh = HU.runTestTT $ allTests+testv = runVerbTestText (HU.putTextToHandle stderr True) $ allTests++main =+    do testv+       return ()