packages feed

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 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