bimap 0.3.0 → 0.3.1
raw patch · 9 files changed
+133/−578 lines, 9 filesdep +QuickCheckdep +exceptionsdep +template-haskelldep ~basesetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: QuickCheck, exceptions, template-haskell
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.Bimap: instance (Eq a, Eq b) => Eq (Bimap a b)
- Data.Bimap: instance (Show a, Show b) => Show (Bimap a b)
+ Data.Bimap: adjust :: (Ord a, Ord b) => (b -> b) -> a -> Bimap a b -> Bimap a b
+ Data.Bimap: adjustR :: (Ord a, Ord b) => (a -> a) -> b -> Bimap a b -> Bimap a b
+ Data.Bimap: adjustWithKey :: (Ord a, Ord b) => (a -> b -> b) -> a -> Bimap a b -> Bimap a b
+ Data.Bimap: adjustWithKeyR :: (Ord a, Ord b) => (b -> a -> a) -> b -> Bimap a b -> Bimap a b
+ Data.Bimap: instance (GHC.Classes.Eq a, GHC.Classes.Eq b) => GHC.Classes.Eq (Data.Bimap.Bimap a b)
+ Data.Bimap: instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (Data.Bimap.Bimap a b)
+ Data.Bimap: instance GHC.Classes.Eq Data.Bimap.BimapException
+ Data.Bimap: instance GHC.Exception.Exception Data.Bimap.BimapException
+ Data.Bimap: instance GHC.Show.Show Data.Bimap.BimapException
+ Data.Bimap: update :: (Ord a, Ord b) => (b -> Maybe b) -> a -> Bimap a b -> Bimap a b
+ Data.Bimap: updateR :: (Ord a, Ord b) => (a -> Maybe a) -> b -> Bimap a b -> Bimap a b
+ Data.Bimap: updateWithKey :: (Ord a, Ord b) => (a -> b -> Maybe b) -> a -> Bimap a b -> Bimap a b
+ Data.Bimap: updateWithKeyR :: (Ord a, Ord b) => (b -> a -> Maybe a) -> b -> Bimap a b -> Bimap a b
- Data.Bimap: deleteFindMax :: Ord b => Bimap a b -> ((a, b), Bimap a b)
+ Data.Bimap: deleteFindMax :: (Ord b) => Bimap a b -> ((a, b), Bimap a b)
- Data.Bimap: deleteFindMaxR :: Ord a => Bimap a b -> ((b, a), Bimap a b)
+ Data.Bimap: deleteFindMaxR :: (Ord a) => Bimap a b -> ((b, a), Bimap a b)
- Data.Bimap: deleteFindMin :: Ord b => Bimap a b -> ((a, b), Bimap a b)
+ Data.Bimap: deleteFindMin :: (Ord b) => Bimap a b -> ((a, b), Bimap a b)
- Data.Bimap: deleteFindMinR :: Ord a => Bimap a b -> ((b, a), Bimap a b)
+ Data.Bimap: deleteFindMinR :: (Ord a) => Bimap a b -> ((b, a), Bimap a b)
- Data.Bimap: deleteMax :: Ord b => Bimap a b -> Bimap a b
+ Data.Bimap: deleteMax :: (Ord b) => Bimap a b -> Bimap a b
- Data.Bimap: deleteMaxR :: Ord a => Bimap a b -> Bimap a b
+ Data.Bimap: deleteMaxR :: (Ord a) => Bimap a b -> Bimap a b
- Data.Bimap: deleteMin :: Ord b => Bimap a b -> Bimap a b
+ Data.Bimap: deleteMin :: (Ord b) => Bimap a b -> Bimap a b
- Data.Bimap: deleteMinR :: Ord a => Bimap a b -> Bimap a b
+ Data.Bimap: deleteMinR :: (Ord a) => Bimap a b -> Bimap a b
- Data.Bimap: lookup :: (Ord a, Ord b, Monad m) => a -> Bimap a b -> m b
+ Data.Bimap: lookup :: (Ord a, Ord b, MonadThrow m) => a -> Bimap a b -> m b
- Data.Bimap: lookupR :: (Ord a, Ord b, Monad m) => b -> Bimap a b -> m a
+ Data.Bimap: lookupR :: (Ord a, Ord b, MonadThrow m) => b -> Bimap a b -> m a
Files
- Data/Bimap.hs +104/−10
- HISTORY +8/−0
- Setup.hs +2/−0
- Setup.lhs +0/−9
- Test/RunTests.hs +6/−1
- Test/Tests.hs +0/−492
- Test/Util.hs +0/−48
- bimap.cabal +13/−10
- tests.sh +0/−8
Data/Bimap.hs view
@@ -36,6 +36,14 @@ -- * Update insert, tryInsert,+ adjust,+ adjustR,+ adjustWithKey,+ adjustWithKeyR,+ update,+ updateR,+ updateWithKey,+ updateWithKeyR, delete, deleteR, -- * Min\/Max@@ -79,13 +87,17 @@ twisted, ) where -import Data.List (foldl', sort)-import qualified Data.Map as M-import Prelude hiding (lookup, null, filter, pred)-import qualified Prelude as P-import Data.Maybe(fromMaybe)+import Control.Monad.Catch +import Data.List (foldl', sort)+import qualified Data.Map as M+import Data.Maybe (fromMaybe)+import Data.Typeable +import Prelude hiding (filter, lookup, null, pred)+import qualified Prelude as P++ infixr 9 .: (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (.:) = (.).(.)@@ -101,6 +113,14 @@ instance (Eq a, Eq b) => Eq (Bimap a b) where (==) bx by = toAscList bx == toAscList by +{-|+A 'Bimap' action failed.+-}+data BimapException = KeyNotFound String+ deriving(Eq, Show, Typeable)++instance Exception BimapException+ {-| /O(1)/. The empty bimap. /Version: 0.2/-} empty :: Bimap a b@@ -222,16 +242,90 @@ deleteR = deleteE . Right {-| /O(log n)/.+Update a value at a specific left key with the result of the provided function.++When the left key is not a member of the bimap, the original bimap is returned.-}+adjust :: (Ord a, Ord b) => (b -> b) -> a -> Bimap a b -> Bimap a b+adjust f = adjustWithKey (const f)++{-| /O(log n)/.+Update a value at a specific right key with the result of the provided function.++When the right key is not a member of the bimap, the original bimap is returned.-}+adjustR :: (Ord a, Ord b) => (a -> a) -> b -> Bimap a b -> Bimap a b+adjustR f b = reverseBimap . adjust f b . reverseBimap+ where reverseBimap (MkBimap left right) = MkBimap right left++{-| /O(log n)/.+Adjust a value at a specific left key.++When the left key is not a member of the bimap, the original bimap is returned.-}+adjustWithKey :: (Ord a, Ord b) => (a -> b -> b) -> a -> Bimap a b -> Bimap a b+adjustWithKey f = updateWithKey (\a -> Just . f a)++{-| /O(log n)/.+Adjust a value at a specific right key.++When the right key is not a member of the bimap, the original bimap is returned.-}+adjustWithKeyR :: (Ord a, Ord b) => (b -> a -> a) -> b -> Bimap a b -> Bimap a b+adjustWithKeyR f b = reverseBimap . adjustWithKey f b . reverseBimap+ where reverseBimap (MkBimap left right) = MkBimap right left++{-| /O(log n)/.+The expression (@'update' f a bimap@) updates the right value @b@ at @a@ (if it is in the bimap).++If (@f b@) is 'Nothing', the element is deleted.++If it is (@'Just' y@), the left key @a@ is bound to the new value @y@.-}+update :: (Ord a, Ord b) => (b -> Maybe b) -> a -> Bimap a b -> Bimap a b+update f = updateWithKey (const f)++{-| /O(log n)/.+The expression (@'updateR' f b bimap@) updates the left value @a@ at @b@ (if it is in the bimap).++If (@f a@) is 'Nothing', the element is deleted.++If it is (@'Just' x@), the right key @b@ is bound to the new value @x@.-}+updateR :: (Ord a, Ord b) => (a -> Maybe a) -> b -> Bimap a b -> Bimap a b+updateR f b = reverseBimap . update f b . reverseBimap+ where reverseBimap (MkBimap left right) = MkBimap right left++{-| /O(log n)/.+The expression (@'updateWithKey' f a bimap@) updates the right value @b@ at @a@ (if it is in the bimap).++If (@f a b@) is 'Nothing', the element is deleted.++If it is (@'Just' y@), the left key @a@ is bound to the new value @y@.-}+updateWithKey :: (Ord a, Ord b) => (a -> b -> Maybe b) -> a -> Bimap a b -> Bimap a b+updateWithKey f a (MkBimap left right) = MkBimap left' right' where+ oldB = M.lookup a left+ newB = f a =<< oldB+ oldA = newB >>= (`M.lookup` right) >>= \x -> if x == a then Nothing else Just x+ left' = maybe id M.delete oldA $ M.updateWithKey f a left+ right' = maybe id (`M.insert` a) newB $ maybe id M.delete oldB right++{-| /O(log n)/.+The expression (@'updateWithKeyR' f b bimap@) updates the left value @a@ at @b@ (if it is in the bimap).++If (@f b a@) is 'Nothing', the element is deleted.++If it is (@'Just' x@), the right key @b@ is bound to the new value @x@.-}+updateWithKeyR :: (Ord a, Ord b) => (b -> a -> Maybe a) -> b -> Bimap a b -> Bimap a b+updateWithKeyR f b = reverseBimap . updateWithKey f b . reverseBimap+ where reverseBimap (MkBimap left right) = MkBimap right left+++{-| /O(log n)/. Lookup a left key in the bimap, returning the associated right key. This function will @return@ the result in the monad, or @fail@ if the value isn't in the bimap. /Version: 0.2/-}-lookup :: (Ord a, Ord b, Monad m)- => a -> Bimap a b -> m b+lookup :: (Ord a, Ord b, MonadThrow m)+ => a -> Bimap a b -> m b lookup x (MkBimap left _) =- maybe (fail "Data.Bimap.lookup: Left key not found")+ maybe (throwM $ KeyNotFound "Data.Bimap.lookup") return (M.lookup x left) @@ -239,10 +333,10 @@ A version of 'lookup' that is specialized to the right key, and returns the corresponding left key. /Version: 0.2/-}-lookupR :: (Ord a, Ord b, Monad m)+lookupR :: (Ord a, Ord b, MonadThrow m) => b -> Bimap a b -> m a lookupR y (MkBimap _ right) =- maybe (fail "Data.Bimap.lookupR: Right key not found")+ maybe (throwM $ KeyNotFound "Data.Bimap.lookupR") return (M.lookup y right)
HISTORY view
@@ -1,3 +1,11 @@+Version 0.3.1 (17 October 2015)++ * Added update and adjust functions (thanks to koral)++Version 0.3.0 (12 Mar 2015)++ * Added map functions+ Version 0.2.4 (25 Aug 2008) * added filter and partition
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,9 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> import System.Cmd-> import System.Exit--> main = defaultMainWithHooks (simpleUserHooks { runTests = suite })-> where-> suite _ _ _ _ = system "bash tests.sh" >> return ()-
Test/RunTests.hs view
@@ -8,6 +8,11 @@ import Test.Tests import Test.Util+import System.Exit main :: IO ()-main = $( extractTests "Test/Tests.hs" )+main = do+ allPassed <- $( extractTests "Test/Tests.hs" )+ if allPassed+ then exitSuccess+ else exitFailure
− Test/Tests.hs
@@ -1,492 +0,0 @@-module Test.Tests where--import Data.List (sort)-import qualified Data.Set as S-import Prelude hiding (null, lookup, filter,map)-import qualified Prelude as P-import Test.QuickCheck-import Control.Applicative((<$>))--import Data.Bimap---(.:) = (.).(.)--instance (Ord a, Arbitrary a, Ord b, Arbitrary b)- => Arbitrary (Bimap a b) where- arbitrary = fromList `fmap` arbitrary--instance (Ord a, CoArbitrary a, Ord b, CoArbitrary b)- => CoArbitrary (Bimap a b) where- coarbitrary = coarbitrary . toList---- generator for filter/partition classification functions-data FilterFunc a b = FilterFunc String (a -> b -> Bool)-instance Show (FilterFunc a b) where- show (FilterFunc desc _) = desc-instance (Integral a, Arbitrary a, Integral b, Arbitrary b)- => Arbitrary (FilterFunc a b) where- arbitrary = do- pivot <- (arbitrary :: Gen Integer)- return $ FilterFunc- ("(\\x y -> x - y < " ++ show pivot ++ ")")- (\x y -> fromIntegral x - fromIntegral y < pivot)-instance (Integral a, CoArbitrary a, Integral b, CoArbitrary b)- => CoArbitrary (FilterFunc a b) where- coarbitrary _ gen = do- x <- arbitrary- coarbitrary (x :: Int) gen----- empty bimap has zero size-prop_size_empty = size empty == 0---- empty bimap is null-prop_null_empty = null empty---- when converting from a list and back, each pair in the latter--- list was originally in the former list--- (heh, this is probably made redundant by polymorphism)-prop_fromList_toList xs =- let xs' = toList . fromList $ xs- in all (flip elem xs) xs'- where- _ = xs :: [(Int, Integer)]---- when converting a list to a bimap, each list element either--- ends up in the bimap, or could conceivably have been clobbered-prop_fromList_account xs = all (\x -> isMember x || notUnique x) xs- where- _ = xs :: [(Int, Integer)]- bi = fromList xs- isMember x = x `pairMember` bi- notUnique (x, y) = - ((>1) . length . P.filter (== x) . P.map fst $ xs) ||- ((>1) . length . P.filter (== y) . P.map snd $ xs)---- a bimap created from a list is no larger than the list-prop_fromList_size xs = (size $ fromList xs) <= length xs- where- _ = xs :: [(Int, Integer)]---- a monotone bimap can be reconstituted via fromAscPairList-prop_fromAscPairList_reconstitute xs = and- [ valid bi'- , (bi == bi')- ]- where- xs' = zip (sort $ P.map fst xs) (sort $ P.map snd xs)- bi :: Bimap Int Integer- bi = fromList xs'- bi' = fromAscPairList . toAscList $ bi---- fromAscPairList will never produce an invalid bimap-prop_fromAscPairList_check xs = valid bi- where- bi :: Bimap Int Integer- bi = fromAscPairList xs---- if a pair is a member of the bimap, then both elements are present--- and associated with each other-prop_pairMember bi k v =- ((k, v) `pairMember` bi) == and- [ k `member` bi- , v `memberR` bi- , lookup k bi == Just v- , lookupR v bi == Just k- ]- where- _ = bi :: Bimap Int Integer---- an inserted pair ends up in the bimap-prop_insert_member bi k v = (k, v) `pairMember` (insert k v bi)- where- _ = bi :: Bimap Int Integer---- if we insert a pair with an existing value, the old value's twin--- is no longer in the bimap-prop_clobberL bi b' =- (not . null $ bi) && (b' `notMemberR` bi)- ==>- (a, b) `pairNotMember` insert a b' bi- where- (a, b) = head . toList $ bi :: (Int, Integer)--prop_clobberR bi a' =- (not . null $ bi) && (a' `notMember` bi)- ==>- (a, b) `pairNotMember` insert a' b bi- where- (a, b) = head . toList $ bi :: (Int, Integer)---- if we politely insert two members, neither of which is present,--- then the two are successfully associated-prop_tryInsert_member bi k v = (k, v) `neitherMember` bi ==>- pairMember (k, v) (tryInsert k v bi)- where- _ = bi :: Bimap Int Integer- neitherMember (k, v) bi = k `notMember` bi && v `notMemberR` bi---- polite insertion will never remove existing associations-prop_tryInsert_not_clobber bi k v =- all (flip pairMember $ tryInsert k v bi) (toList bi)- where- _ = bi :: Bimap Int Integer---- an arbitrary bimap is valid-prop_valid bi = valid bi- where- _ = bi :: Bimap Int Integer---- if x maps to y, then y maps to x-prop_member_twin bi = flip all (toList bi) $ \(x, y) -> and- [ (bi ! x) `memberR` bi- , (bi !> y) `member` bi- ]- where- _ = bi :: Bimap Int Integer---- deleting an element removes it from the map-prop_delete bi = flip all (toList bi) $ \(x, y) -> and- [ x `notMember` delete x bi- , y `notMemberR` deleteR y bi- ]- where- _ = bi :: Bimap Int Integer---- deleting an element removes its twin from the map-prop_delete_twin bi = flip all (toList bi) $ \(x, y) -> and- [ (bi ! x) `notMemberR` delete x bi- , (bi !> y) `notMember` deleteR y bi- ]- where- _ = bi :: Bimap Int Integer---- a singleton bimap is valid, has one association, and the two--- given values map to each other-prop_singleton x y = let bi = singleton x y in and- [ valid bi- , (x, y) `pairMember` bi- , (bi ! x) == y- , (bi !> y) == x- , size bi == 1- ]- where- _ = (x, y) :: (Int, Integer)---- an always-true filter makes no changes-prop_filter_true bi =- bi == filter (curry $ const True) bi- where- _ = bi :: Bimap Int Integer---- an always-false filter gives an empty result-prop_filter_false bi =- null $ filter (curry $ const False) bi- where- _ = bi :: Bimap Int Integer---- all elements of the projection satisfy the predicate, and all--- elements of the rejection do not-prop_partition_agree bi (FilterFunc _ ff) = and- [ all ( uncurry ff) (toList projection)- , all (not . uncurry ff) (toList rejection)- ]- where- _ = bi :: Bimap Int Integer- (projection, rejection) = partition ff bi---- the two halves of a partition are disjoint-prop_partition_disjoint bi (FilterFunc _ ff) =- S.null $ S.intersection (asSet projection) (asSet rejection)- where- _ = bi :: Bimap Int Integer- (projection, rejection) = partition ff bi- asSet = S.fromList . toList---- the two halves of a partition contain the elements of the original--- bimap-prop_partition_union bi (FilterFunc _ ff) =- (==) (asSet bi) $- S.union (asSet projection) (asSet rejection)- where- _ = bi :: Bimap Int Integer- (projection, rejection) = partition ff bi- asSet = S.fromList . toList---- the two halves of a partition agree with individual filters-prop_partition_filter bi (FilterFunc _ ff) = and- [ projection == filter ( ff) bi- , rejection == filter (not .: ff) bi- ]- where- _ = bi :: Bimap Int Integer- (projection, rejection) = partition ff bi---- partition and filter produce valid results-prop_partition_filter_valid bi (FilterFunc _ ff) = all valid- [ projection- , rejection- , filter ( ff) bi- , filter (not .: ff) bi- ]- where- _ = bi :: Bimap Int Integer- (projection, rejection) = partition ff bi---- twist is its own inverse-prop_twist_twist bi =- bi == (twist . twist $ bi)- where- _ = bi :: Bimap Int Integer---- the property (fromList == fromAList . reverse) only holds--- if either the left or right values are all distinct-prop_fromList_fromAList xs = and- [ fromList ys == fromAList rys- , fromList rys == fromAList ys- ]- where- ys = xs `zip` [1..] :: [(Int, Integer)]- rys = reverse ys--swap (x, y) = (y, x)---- deleteFindMin and deleteMin agree-prop_deleteMin_is_delete bi = not (null bi) ==>- snd (deleteFindMin bi) == deleteMin bi- where- _ = bi :: Bimap Int Integer---- deleteFindMin and findMin agree-prop_deleteMin_is_find bi = not (null bi) ==>- fst (deleteFindMin bi) == findMin bi- where- _ = bi :: Bimap Int Integer---- elements removed by deleteFindMin are no longer in the bimap-prop_deleteMin_deletes bi = not (null bi) ==>- fst (deleteFindMin bi) `pairNotMember` snd (deleteFindMin bi)- where- _ = bi :: Bimap Int Integer---- findMin finds a member of the map-prop_findMin_member bi = not (null bi) ==>- findMin bi `pairMember` bi- where- _ = bi :: Bimap Int Integer---- the minimum of a singleton bimap is its contents-prop_singleton_is_findMin x y = findMin bi == (x, y)- where- bi :: Bimap Int Integer- bi = singleton x y---- deleting the minimum of a singleton leaves it empty-prop_singleton_deleteMin_empty x y = null (deleteMin bi)- where- bi :: Bimap Int Integer- bi = singleton x y---- the minimum of a bimap is <= all other elements-prop_findMin_is_minimal bi = all (\ (a, _) -> a >= x) lst- where- lst = toList bi- _ = bi :: Bimap Int Integer- x = fst . findMin $ bi--prop_deleteMinR_is_delete bi = not (null bi) ==>- snd (deleteFindMinR bi) == deleteMinR bi - where- _ = bi :: Bimap Int Integer--prop_deleteMinR_is_find bi = not (null bi) ==>- fst (deleteFindMinR bi) == findMinR bi - where- _ = bi :: Bimap Int Integer--prop_deleteMinR_deletes bi = not (null bi) ==>- (swap . fst) (deleteFindMinR bi) `pairNotMember` snd (deleteFindMinR bi)- where- _ = bi :: Bimap Int Integer--prop_findMinR_member bi = not (null bi) ==>- swap (findMinR bi) `pairMember` bi- where- _ = bi :: Bimap Int Integer- -prop_singleton_is_findMinR x y = findMinR bi == (y, x)- where- bi :: Bimap Int Integer- bi = singleton x y--prop_singleton_deleteMinR_empty x y = null (deleteMinR bi)- where- bi :: Bimap Int Integer- bi = singleton x y--prop_findMinR_is_minimal bi = all (\ (_, b) -> b >= y) lst- where- lst = toList bi- _ = bi :: Bimap Int Integer- y = fst . findMinR $ bi--prop_deleteMax_is_delete bi = not (null bi) ==>- snd (deleteFindMax bi) == deleteMax bi- where- _ = bi :: Bimap Int Integer--prop_deleteMax_is_find bi = not (null bi) ==>- fst (deleteFindMax bi) == findMax bi- where- _ = bi :: Bimap Int Integer--prop_deleteMax_deletes bi = not (null bi) ==>- fst (deleteFindMax bi) `pairNotMember` snd (deleteFindMax bi)- where- _ = bi :: Bimap Int Integer--prop_findMax_member bi = not (null bi) ==>- findMax bi `pairMember` bi- where- _ = bi :: Bimap Int Integer- -prop_singleton_is_findMax x y = findMax bi == (x, y)- where- bi :: Bimap Int Integer- bi = singleton x y--prop_singleton_deleteMax_empty x y = null (deleteMax bi)- where- bi :: Bimap Int Integer- bi = singleton x y--prop_findMax_is_maximal bi = all (\ (a, _) -> a <= x) lst- where- lst = toList bi- _ = bi :: Bimap Int Integer- x = fst . findMax $ bi--prop_deleteMaxR_is_delete bi = not (null bi) ==>- snd (deleteFindMaxR bi) == deleteMaxR bi - where- _ = bi :: Bimap Int Integer--prop_deleteMaxR_is_find bi = not (null bi) ==>- fst (deleteFindMaxR bi) == findMaxR bi- where- _ = bi :: Bimap Int Integer--prop_deleteMaxR_deletes bi = not (null bi) ==>- (swap . fst) (deleteFindMaxR bi) `pairNotMember` snd (deleteFindMaxR bi)- where- _ = bi :: Bimap Int Integer--prop_findMaxR_member bi = not (null bi) ==>- swap (findMaxR bi) `pairMember` bi- where- _ = bi :: Bimap Int Integer- -prop_singleton_is_findMaxR x y = findMaxR bi == (y, x)- where- bi :: Bimap Int Integer- bi = singleton x y--prop_singleton_deleteMaxR_empty x y = null (deleteMaxR bi)- where- bi :: Bimap Int Integer- bi = singleton x y--prop_findMaxR_is_maximal bi = all (\ (_, b) -> b <= y) lst- where- lst = toList bi- _ = bi :: Bimap Int Integer- y = fst . findMaxR $ bi--prop_deleteMin_is_valid bi = not (null bi) ==>- valid (deleteMin bi)- where- _ = bi :: Bimap Int Integer--prop_deleteFindMin_is_valid bi = not (null bi) ==>- valid (snd $ deleteFindMin bi)- where- _ = bi :: Bimap Int Integer--prop_deleteMinR_is_valid bi = not (null bi) ==>- valid (deleteMinR bi)- where- _ = bi :: Bimap Int Integer--prop_deleteFindMinR_is_valid bi = not (null bi) ==>- valid (snd $ deleteFindMinR bi)- where- _ = bi :: Bimap Int Integer--prop_deleteMax_is_valid bi = not (null bi) ==>- valid (deleteMax bi)- where- _ = bi :: Bimap Int Integer--prop_deleteFindMax_is_valid bi = not (null bi) ==>- valid (snd $ deleteFindMax bi)- where- _ = bi :: Bimap Int Integer--prop_deleteMaxR_is_valid bi = not (null bi) ==>- valid (deleteMaxR bi)- where- _ = bi :: Bimap Int Integer--prop_deleteFindMaxR_is_valid bi = not (null bi) ==>- valid (snd $ deleteFindMaxR bi)- where- _ = bi :: Bimap Int Integer--prop_map_preserve_keys bi =- (Data.List.sort $ P.map f $ keys bi) == (keys $ map f bi)- where- f = (4/) -- This is an arbitrary function- _ = bi :: Bimap Double Integer--prop_map_preserve_lookup bi v =- (lookup (f v) $ map f bi) == (lookup v bi :: Maybe Integer)- where- f = (1-)- _ = bi :: Bimap Int Integer--prop_map_preserve_right_keys bi =- (Data.List.sort $ P.map f $ keysR bi) == (keysR $ mapR f bi)- where- f = (4/) -- This is an arbitrary function- _ = bi :: Bimap Int Double--prop_map_preserve_lookupR bi v =- (lookup v $ mapR f bi) == (f <$> lookup v bi :: Maybe Integer)- where- f = (1-)- _ = bi :: Bimap Int Integer--prop_mapMonotonic_preserve_keys bi =- (P.map f $ keys bi) == (keys $ mapMonotonic f bi)- where- f = (3+) -- This is an arbitrary monotonic function- _ = bi :: Bimap Double Integer--prop_mapMonotonic_preserve_lookup bi v =- (lookup (f v) $ mapMonotonic f bi) == (lookup v bi :: Maybe Integer)- where- f = (2*)- _ = bi :: Bimap Int Integer--prop_mapMontonic_preserve_right_keys bi =- (P.map f $ keysR bi) == (keysR $ mapMonotonicR f bi)- where- f = (^2) -- This is an arbitrary monotonic function- _ = bi :: Bimap Int Double--prop_mapMonotonic_preserve_lookupR bi v =- (lookup v $ mapMonotonicR f bi) == (f <$> lookup v bi :: Maybe Integer)- where- f = (1-)- _ = bi :: Bimap Int Integer
− Test/Util.hs
@@ -1,48 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module Test.Util (- extractTests,-) where--import Control.Arrow-import Data.List-import Language.Haskell.TH-import Language.Haskell.TH.Syntax-import Test.QuickCheck-import Text.Printf---{--Use 'propertyNames' to extract all QuickCheck test names from-a file.--}-fileProperties :: FilePath -> IO [String]-fileProperties = fmap propertyNames . readFile--{--Find all the tokens in a file that- 1) are the first token on a line, and- 2) begin with "prop_".--}-propertyNames :: String -> [String]-propertyNames = - lines >>> map firstToken >>> filter isProperty >>> nub- where- firstToken = fst . head . lex- isProperty = isPrefixOf "prop_"--{- Inspired by & borrowed from: -}--- http://blog.codersbase.com/2006/09/01/simple-unit-testing-in-haskell/-mkCheck name =- [| printf "%-25s : " name >> quickCheck $(varE (mkName name)) |]--mkChecks [] = undefined -- if we don't have any tests, then the test suite is undefined right?-mkChecks [name] = mkCheck name-mkChecks (name:ns) = [| $(mkCheck name) >> $(mkChecks ns) |]--{--Extract the names of QuickCheck tests from a file, and splice in-a sequence of calls to them. The module doing the splicing must-also import the file being processed.--}-extractTests :: FilePath -> Q Exp-extractTests = (mkChecks =<<) . runIO . fileProperties
bimap.cabal view
@@ -1,6 +1,6 @@-cabal-version: >= 1.6+cabal-version: >= 1.8 name: bimap-version: 0.3.0+version: 0.3.1 synopsis: Bidirectional mapping between two key types description: A data structure representing a bidirectional mapping between two@@ -13,22 +13,25 @@ author: Stuart Cook and contributors 2008, Joel Williamson 2015 maintainer: Joel Williamson <joel@joelwilliamson.ca> homepage: https://github.com/joelwilliamson/bimap--- This build-type is a lie, but we're only using hooks to specify--- a test command, so there shouldn't be any problems. build-type: Simple-tested-with: GHC ==7.8.4+tested-with: GHC ==7.10.2 extra-source-files: HISTORY- tests.sh- Test/Tests.hs- Test/Util.hs- Test/RunTests.hs Library- build-depends: base >= 4 && <5, containers+ build-depends: base >= 4 && <5, containers, exceptions ghc-options: -Wall exposed-modules: Data.Bimap++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Test/RunTests.hs+ build-depends: base >= 4 && < 5,+ containers,+ exceptions,+ QuickCheck >= 2 && < 3,+ template-haskell >= 2 && < 3 source-repository head type: git
− tests.sh
@@ -1,8 +0,0 @@-#!/bin/bash--rm .test.log 2>/dev/null-runhaskell Test/RunTests.hs > .test.log || exit 1-cat .test.log || exit 2-grep Falsifiable .test.log >/dev/null && exit 3-echo "~~ all tests passed ~~"-exit 0