Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Remove Map instance (it was broken and needs some re-think)

  • Loading branch information...
commit 118c1ef2bc2876db9f36bd20064aa057d1b89de5 1 parent 1e4dd5b
@JohnLato JohnLato authored
View
112 src/Data/ListLike/Instances.hs
@@ -50,7 +50,6 @@ import Data.Array.IArray((!), (//), Ix(..))
import qualified Data.ByteString.Lazy as BSL
import qualified System.IO as IO
import Data.Word
-import qualified Data.Map as Map
--------------------------------------------------
-- []
@@ -302,112 +301,13 @@ instance StringLike BSL.ByteString where
--------------------------------------------------
-- Map
+-- N.B. the Map instance is broken because it treats the key as part of the
+-- element. Consider:
+-- let m = fromList [(False,0)] :: Map Bool Int
+-- let m' = cons (False, 1) m
+-- m' == fromList [(False,1)] =/= [(False,1), (False,0)]
+-- Map isn't a suitable candidate for ListLike...
-instance (Ord key) => FoldableLL (Map.Map key val) (key, val) where
- foldr f start m = Map.foldrWithKey func start m
- where func k v accum = f (k, v) accum
- foldl f start m = L.foldl f start (Map.toList m)
-
-l2m :: (Ord k, Ord k2) => ([(k, v)], [(k2, v2)]) -> (Map.Map k v, Map.Map k2 v2)
-l2m (l1, l2) = (Map.fromList l1, Map.fromList l2)
-instance (Ord key, Eq val) => ListLike (Map.Map key val) (key, val) where
- empty = Map.empty
- singleton (k, v) = Map.singleton k v
- cons (k, v) m = Map.insert k v m
- snoc = flip cons
- append = Map.union
- head = Map.elemAt 0
- last m = Map.elemAt (Map.size m - 1) m
- -- was deleteAt 0, but that is broken in GHC 6.6
- tail = drop 1
- -- broken in GHC 6.6: init m = Map.deleteAt (Map.size m - 1) m
- init = Map.fromAscList . L.init . Map.toAscList
- null = Map.null
- length = Map.size
- map f = fromList . map f . Map.toList
- rigidMap f = Map.fromList . L.map f . Map.toList
- reverse = id
- intersperse i f
- | Map.size f <= 1 = f
- | otherwise = cons i f
- -- concat
- -- concatMap
- -- rigidConcatMap
- -- any
- -- all
- -- maximum
- -- minimum
- replicate = genericReplicate
- take n = Map.fromAscList . L.take n . Map.toAscList
- drop n = Map.fromAscList . L.drop n . Map.toAscList
- splitAt n = l2m . L.splitAt n . Map.toList
- takeWhile f = Map.fromAscList . L.takeWhile f . Map.toAscList
- dropWhile f = Map.fromAscList . L.dropWhile f . Map.toAscList
- span f = l2m . L.span f . Map.toList
- break f = span (not . f)
- group m
- | null m = empty
- | otherwise = cons (singleton (head m)) (group (tail m))
- -- group
- -- inits
- -- tails
- isPrefixOf f1 f2 = L.isPrefixOf (Map.toList f1) (Map.toList f2)
- isSuffixOf f1 f2 = L.isSuffixOf (Map.toList f1) (Map.toList f2)
- isInfixOf = Map.isSubmapOf
- --elem = Map.member
- --notElem = Map.notMember
- -- find
- filter f m = Map.filterWithKey func m
- where func k v = f (k, v)
- index = flip Map.elemAt
- elemIndex (k, v) m =
- case Map.lookupIndex k m of
- Nothing -> fail "elemIndex: no matching key"
- Just i -> if snd (Map.elemAt i m) == v
- then Just i
- else fail "elemIndex on Map: matched key but not value"
- elemIndices i m =
- case elemIndex i m of
- Nothing -> empty
- Just x -> singleton x
- -- findIndex
- -- findIndices
- -- sequence
- -- mapM
- -- rigidMapM
- -- mapM_
- nub = id
- delete (k, v) m =
- case Map.lookup k m of
- Nothing -> m
- Just x -> if x == v
- then Map.delete k m
- else m
- union = Map.union
- -- intersect
- sort = id
- insert = cons
- toList = Map.toList
- fromList = Map.fromList
- nubBy func = Map.fromAscList . L.nubBy func . Map.toAscList
- --deleteBy
- deleteFirstsBy func m1 m2 = Map.fromAscList $
- L.deleteFirstsBy func (Map.toAscList m1)
- (Map.toAscList m2)
- --deleteFirstsBy
- unionBy func m1 m2 = Map.fromList $
- L.unionBy func (Map.toList m1) (Map.toList m2)
- --intersectBy
- --groupBy
- sortBy _ = id
- insertBy _ = insert
- genericLength = fromIntegral . Map.size
- genericTake n = Map.fromAscList . L.genericTake n . Map.toAscList
- genericDrop n = Map.fromAscList . L.genericDrop n . Map.toAscList
- genericSplitAt n = l2m . L.genericSplitAt n . Map.toList
- genericReplicate count item
- | count <= 0 = empty
- | otherwise = singleton item
--------------------------------------------------
-- Arrays
View
22 testsrc/TestInfrastructure.hs
@@ -24,7 +24,6 @@ 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.Map as Map
import qualified Data.Array as A
import qualified Data.Foldable as F
import System.Random
@@ -76,19 +75,10 @@ instance Arbitrary i => Arbitrary (A.Array Int i) where
instance (CoArbitrary i) => CoArbitrary (A.Array Int i) where
coarbitrary l = coarbitrary (LL.toList l)
-instance (Ord k, Eq i, Arbitrary i, Arbitrary k) => Arbitrary (Map.Map k 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 (Ord k, Eq i, CoArbitrary k, CoArbitrary i) => CoArbitrary (Map.Map k 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] -> Bool
- llcmp f l = l == (LL.toList f)
+ 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
@@ -102,8 +92,6 @@ instance TestLL BSL.ByteString Word8 where
instance (Arbitrary a, Show a, Eq a) => TestLL (A.Array Int a) a where
-instance (Show k, Show v, Arbitrary k, Arbitrary v, Ord v, Ord k) => TestLL (Map.Map k v) (k, v) where
-
mapRemoveDups :: (Eq k1) => [(k1, v1)] -> [(k1, v1)]
mapRemoveDups = nubBy (\(k1, _) (k2, _) -> k1 == k2)
@@ -191,10 +179,6 @@ apf msg x = HU.TestLabel msg $ HU.TestList $
w "String" (x::LLTest String Char),
w "[Bool]" (x::LLTest [Bool] Bool),
w "MyList Bool" (x::LLTest (MyList Bool) Bool),
- w "Map Int Int" (x::LLTest (Map.Map Int Int) (Int, Int)),
- w "Map Bool Int" (x::LLTest (Map.Map Bool Int) (Bool, Int)),
- w "Map Int Bool" (x::LLTest (Map.Map Int Bool) (Int, Bool)),
- w "Map Bool Bool" (x::LLTest (Map.Map Bool Bool) (Bool, Bool)),
w "ByteString" (x::LLTest BS.ByteString Word8),
w "ByteString.Lazy" (x::LLTest BSL.ByteString Word8),
w "Array Int Int" (x::LLTest (A.Array Int Int) Int),
View
8 testsrc/runtests.hs
@@ -15,13 +15,13 @@ All rights reserved.
For license and copyright information, see the file COPYRIGHT
-}
+module Main where
import Test.QuickCheck
import qualified Data.ByteString as BS
import qualified Data.Array as A
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ListLike as LL
-import qualified Data.Map as Map
import qualified Data.Array as A
import qualified Data.Foldable as F
import System.Random
@@ -60,7 +60,7 @@ 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) -> Bool
+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)
@@ -71,7 +71,7 @@ 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]) -> Bool
+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))
@@ -139,7 +139,7 @@ prop_mapM :: forall full item. (TestLL full item, TestLL [item] item) => full ->
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) -> Bool
+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

0 comments on commit 118c1ef

Please sign in to comment.
Something went wrong with that request. Please try again.