packages feed

bimap 0.1 → 0.2

raw patch · 4 files changed

+134/−91 lines, 4 filesdep +containersdep ~basesetup-changed

Dependencies added: containers

Dependency ranges changed: base

Files

Data/Bimap.hs view
@@ -3,9 +3,10 @@ key types. A 'Bimap' is essentially a bijection between subsets of its two argument types. -For functions with an @L@ or @R@ suffix, the letter indicates whether-the /parameter/ type is specialized to the left or right type of-the bimap.+Most functions implicitly consider the left-hand type to be the+key, and the right-hand type to be the value.+Functions with an @R@ suffix reverse this convention, treating the+left-hand type as the key. -} module Data.Bimap (     -- * Bimap type@@ -14,18 +15,14 @@     null,     size,     member,-    memberL,     memberR,     notMember,-    notMemberL,     notMemberR,     pairMember,     pairNotMember,     lookup,-    lookupL,     lookupR,     (!),-    (!<),     (!>),     -- * Construction     empty,@@ -33,20 +30,24 @@     -- * Update     insert,     delete,-    deleteL,     deleteR,     -- * Conversion\/traversal     fromList,     toList,+    toAscList,+    toAscListR,+    keys,+    keysR,+    elems,     assocs,     fold,     -- * Miscellaneous     valid,     twist,+    twisted, ) where  import Control.Arrow ((>>>))-import Control.Monad (liftM) import Control.Monad.Error () -- Monad instance for Either e import Data.List (foldl', sort) import qualified Data.Map as M@@ -62,17 +63,19 @@ -} data Bimap a b = MkBimap !(M.Map a b) !(M.Map b a) -instance (Show a, Ord a, Show b, Ord b) => Show (Bimap a b) where+instance (Show a, Show b) => Show (Bimap a b) where     show x = "fromList " ++ (show . toList $ x) +instance (Eq a, Eq b) => Eq (Bimap a b) where+    (==) bx by = toAscList bx == toAscList by+ {-| The empty bimap. -} empty :: Bimap a b empty = MkBimap M.empty M.empty  {-| A bimap with a single element. -}-singleton :: (Ord a, Ord b)-          => (a, b) -> Bimap a b-singleton xy = unsafeInsert xy empty+singleton :: a -> b -> Bimap a b+singleton x y = MkBimap (M.singleton x y) (M.singleton y x)  {-| Is the bimap empty? -} null :: Bimap a b -> Bool@@ -83,31 +86,24 @@ size (MkBimap left _) = M.size left  {-| Is the specified value a member of the bimap? -}-member :: (Ord a, Ord b)-       => Either a b -> Bimap a b -> Bool-member (Left  x) (MkBimap left  _) = M.member x left-member (Right y) (MkBimap _ right) = M.member y right--{-| A version of 'member' specialized to the left key. -}-memberL :: (Ord a, Ord b) => a -> Bimap a b -> Bool-memberL = member . Left+member :: (Ord a, Ord b) => a -> Bimap a b -> Bool+member x (MkBimap left _) = M.member x left {-| A version of 'member' specialized to the right key. -} memberR :: (Ord a, Ord b) => b -> Bimap a b -> Bool-memberR = member . Right+memberR y (MkBimap _ right) = M.member y right  {-| Is the specified value not a member of the bimap? -}-notMember :: (Ord a, Ord b)-          => Either a b -> Bimap a b -> Bool+notMember :: (Ord a, Ord b) => a -> Bimap a b -> Bool notMember = not .: member--{-| A version of 'notMember' specialized to the left key. -}-notMemberL :: (Ord a, Ord b) => a -> Bimap a b -> Bool-notMemberL = notMember . Left {-| A version of 'notMember' specialized to the right key. -} notMemberR :: (Ord a, Ord b) => b -> Bimap a b -> Bool-notMemberR = notMember . Right+notMemberR = not .: memberR -{-| Are the two values associated /with each other/ in the bimap? -}+{-| Are the two values associated /with each other/ in the bimap?++This function is uncurried in its first two arguments, so that it+can be used infix.+-} pairMember :: (Ord a, Ord b)            => (a, b) -> Bimap a b -> Bool pairMember (x, y) (MkBimap left _) =@@ -124,27 +120,24 @@ bindings are deleted. -} insert :: (Ord a, Ord b)-        => (a, b) -> Bimap a b -> Bimap a b-insert (x, y) = delete (Left x)-            >>> delete (Right y)-            >>> unsafeInsert (x, y)+        => a -> b -> Bimap a b -> Bimap a b+insert x y = delete  x+         >>> deleteR y+         >>> unsafeInsert x y  {-| Insert a pair of values into the bimap, without checking for overlapping bindings. If either value is already in the bimap, and is not bound to the other value, the bimap will become inconsistent. -} unsafeInsert :: (Ord a, Ord b)-             => (a, b) -> Bimap a b -> Bimap a b-unsafeInsert (x, y) (MkBimap left right) =+             => a -> b -> Bimap a b -> Bimap a b+unsafeInsert x y (MkBimap left right) =     MkBimap (M.insert x y left) (M.insert y x right) -{-| Delete a value and its twin from a bimap.-When the value is not a member of the bimap, the original bimap is-returned.--}-delete :: (Ord a, Ord b)+{-| Common implementation for 'delete' and 'deleteR'. -}+deleteE :: (Ord a, Ord b)        => Either a b -> Bimap a b -> Bimap a b-delete e (MkBimap left right) =+deleteE e (MkBimap left right) =     MkBimap         (perhaps M.delete x $ left)         (perhaps M.delete y $ right)@@ -153,73 +146,94 @@     x = either Just (flip M.lookup right) e     y = either (flip M.lookup left) Just  e -{-| A version of 'delete' specialized to the left key. -}-deleteL :: (Ord a, Ord b) => a -> Bimap a b -> Bimap a b-deleteL = delete . Left+{-| Delete a value and its twin from a bimap.+When the value is not a member of the bimap, the original bimap is+returned.+-}+delete :: (Ord a, Ord b) => a -> Bimap a b -> Bimap a b+delete = deleteE . Left+ {-| A version of 'delete' specialized to the right key. -} deleteR :: (Ord a, Ord b) => b -> Bimap a b -> Bimap a b-deleteR = delete . Right+deleteR = deleteE . Right -{-| Lookup the twin of a value in the bimap, returning both-associated values as a pair.+{-| 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. -} lookup :: (Ord a, Ord b, Monad m)-       => Either a b -> Bimap a b -> m (a, b)-lookup (Left x)  (MkBimap left _) =+        => a -> Bimap a b -> m b+lookup x (MkBimap left _) =     maybe (fail "Data.Bimap.lookup: Left key not found")-          (\y -> return (x, y))+          (return)           (M.lookup x left)-lookup (Right y) (MkBimap _ right) =-    maybe (fail "Data.Bimap.lookup: Right key not found")-          (\x -> return (x, y))-          (M.lookup y right) -{-| A version of 'lookup' that is specialized to the left key,-and returns only the right key. -}-lookupL :: (Ord a, Ord b, Monad m)-        => a -> Bimap a b -> m b-lookupL = (liftM snd) .: lookup . Left {-| A version of 'lookup' that is specialized to the right key, and returns only the left key. -} lookupR :: (Ord a, Ord b, Monad m)         => b -> Bimap a b -> m a-lookupR = (liftM fst) .: lookup . Right+lookupR y (MkBimap _ right) =+    maybe (fail "Data.Bimap.lookupR: Right key not found")+          (return)+          (M.lookup y right) -{-| Find the pair corresponding to a given value. Calls @'error'@-when the value is not in the bimap.+{-| Find the right key corresponding to a given left key.+Calls @'error'@ when the key is not in the bimap. -}-(!) :: (Ord a, Ord b)-    => Bimap a b -> Either a b -> (a, b)-(!) bi e = either error id (lookup e bi)+(!) :: (Ord a, Ord b) => Bimap a b -> a -> b+(!) bi x = either error id (lookup x bi) -{-| A version of '(!)' that is specialized to the left key,-and returns only the right key. -}-(!<) :: (Ord a, Ord b) => Bimap a b -> a -> b-(!<) bi x = snd $ bi ! Left  x-{-| A version of '(!)' that is specialized to the right key,+{-| A version of @(!)@ that is specialized to the right key, and returns only the left key. -} (!>) :: (Ord a, Ord b) => Bimap a b -> b -> a-(!>) bi y = fst $ bi ! Right y+(!>) bi y = either error id (lookupR y bi)  {-| Build a map from a list of pairs. If there are any overlapping pairs in the list, the later ones will override the earlier ones. -} fromList :: (Ord a, Ord b)          => [(a, b)] -> Bimap a b-fromList xs = foldl' (flip insert) empty xs+fromList xs = foldl' (flip . uncurry $ insert) empty xs  {-| Convert to a list of associated pairs. -} toList :: Bimap a b -> [(a, b)]-toList (MkBimap left _) = M.toList left+toList = toAscList +{-| Convert to a list of associated pairs, with the left-hand+values in ascending order.+Since pair ordering is lexical, the pairs will also be in+ascending order.+-}+toAscList :: Bimap a b -> [(a, b)]+toAscList (MkBimap left _) = M.toList left++{-| Convert to a list of associated pairs, with the right-hand+values first in the pair and in ascending order.+Since pair ordering is lexical, the pairs will also be in+ascending order.+-}+toAscListR :: Bimap a b -> [(b, a)]+toAscListR = toAscList . twist+ {-| Return all associated pairs in the bimap, with the left-hand values in ascending order. -} assocs :: Bimap a b -> [(a, b)] assocs = toList +{-| Return all left-hand keys in the bimap in ascending order. -}+keys :: Bimap a b -> [a]+keys (MkBimap left _) = M.keys left++{-| Return all right-hand keys in the bimap in ascending order. -}+keysR :: Bimap a b -> [b]+keysR (MkBimap _ right) = M.keys right++{-| An alias for 'keysR'. -}+elems :: Bimap a b -> [b]+elems = keysR+ {-| Test if the internal bimap structure is valid. -} valid :: (Ord a, Ord b)       => Bimap a b -> Bool@@ -233,15 +247,19 @@     flipPair (x, y) = (y, x)  {-| Reverse the positions of the two element types in the bimap. -}-twist :: (Ord a, Ord b)-      => Bimap a b -> Bimap b a+twist ::  Bimap a b -> Bimap b a twist (MkBimap left right) = MkBimap right left +{-| Reverse the positions of the two element types in a bimap+transformation. -}+twisted :: (Bimap a b -> Bimap a b) -> (Bimap b a -> Bimap b a)+twisted f = twist . f . twist+ {-| Fold the association pairs in the map, such that @'fold' f z == 'foldr' f z . 'assocs'@. -}-fold :: ((a, b) -> c -> c) -> c -> Bimap a b -> c-fold f z = foldr f z . assocs+fold :: (a -> b -> c -> c) -> c -> Bimap a b -> c+fold f z = foldr (uncurry f) z . assocs
Setup.lhs view
@@ -3,7 +3,7 @@ > import System.Cmd > import System.Exit -> main = defaultMainWithHooks (defaultUserHooks { runTests = suite })+> main = defaultMainWithHooks (simpleUserHooks { runTests = suite }) >     where >     suite _ _ _ _ = system "bash tests.sh" >> return ()
Test/Tests.hs view
@@ -41,16 +41,16 @@ -- 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) && (Right b' `notMember` bi)+    (not . null $ bi) && (b' `notMemberR` bi)     ==>-    (a, b) `pairNotMember` insert (a, b') bi+    (a, b) `pairNotMember` insert a b' bi     where     (a, b) = head . toList $ bi :: (Int, Integer)  prop_clobberR bi a' =-    (not . null $ bi) && (Left a' `notMember` bi)+    (not . null $ bi) && (a' `notMember` bi)     ==>-    (a, b) `pairNotMember` insert (a', b) bi+    (a, b) `pairNotMember` insert a' b bi     where     (a, b) = head . toList $ bi :: (Int, Integer) @@ -60,22 +60,37 @@     _ = bi :: Bimap Int Integer  prop_member_twin bi = flip all (toList bi) $ \(x, y) -> and-    [ (Right . snd $ bi ! Left  x) `member` bi-    , (Left  . fst $ bi ! Right y) `member` bi+    [ (bi !  x) `memberR` bi+    , (bi !> y) `member`  bi     ]     where     _ = bi :: Bimap Int Integer  prop_delete bi = flip all (toList bi) $ \(x, y) -> and-    [ (Left  x) `notMember` delete (Left  x) bi-    , (Right y) `notMember` delete (Right y) bi+    [ x `notMember`  delete  x bi+    , y `notMemberR` deleteR y bi     ]     where     _ = bi :: Bimap Int Integer  prop_delete_twin bi = flip all (toList bi) $ \(x, y) -> and-    [ (Right . snd $ bi ! Left  x) `notMember` delete (Left  x) bi-    , (Left  . fst $ bi ! Right y) `notMember` delete (Right y) bi+    [ (bi !  x) `notMemberR` delete  x bi+    , (bi !> y) `notMember`  deleteR y bi     ]+    where+    _ = bi :: Bimap Int Integer++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)++prop_twist_twist bi =+    bi == (twist . twist $ bi)     where     _ = bi :: Bimap Int Integer
bimap.cabal view
@@ -1,6 +1,6 @@ cabal-version:       >= 1.2.3.0 name:                bimap-version:             0.1+version:             0.2 synopsis:            Bidirectional mapping between two key types description:   A data structure representing a bidirectional mapping between two@@ -9,17 +9,27 @@ category:            Data license:             BSD3 license-file:        LICENSE+copyright:           Stuart Cook 2008 author:              Stuart Cook maintainer:          scook0@gmail.com homepage:            http://code.haskell.org/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 ==6.6, GHC ==6.8.1 extra-source-files:     tests.sh     Test/Tests.hs     Test/Util.hs     Test/RunTests.hs +flag small-base+ Library-  build-depends:       base, mtl+  if flag(small-base)+    build-depends:       base >= 3, mtl, containers+  else+    build-depends:       base < 3, mtl   ghc-options:         -Wall -O2   exposed-modules:       Data.Bimap