diff --git a/Data/Bimap.hs b/Data/Bimap.hs
new file mode 100644
--- /dev/null
+++ b/Data/Bimap.hs
@@ -0,0 +1,247 @@
+{-|
+An implementation of bidirectional maps between values of two
+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.
+-}
+module Data.Bimap (
+    -- * Bimap type
+    Bimap(),
+    -- * Query
+    null,
+    size,
+    member,
+    memberL,
+    memberR,
+    notMember,
+    notMemberL,
+    notMemberR,
+    pairMember,
+    pairNotMember,
+    lookup,
+    lookupL,
+    lookupR,
+    (!),
+    (!<),
+    (!>),
+    -- * Construction
+    empty,
+    singleton,
+    -- * Update
+    insert,
+    delete,
+    deleteL,
+    deleteR,
+    -- * Conversion\/traversal
+    fromList,
+    toList,
+    assocs,
+    fold,
+    -- * Miscellaneous
+    valid,
+    twist,
+) 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
+import Prelude hiding (lookup, null)
+
+
+infixr 9 .:
+(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
+(.:) = (.).(.)
+
+{-|
+A bidirectional map between values of types @a@ and @b@.
+-}
+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
+    show x = "fromList " ++ (show . toList $ x)
+
+{-| 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
+
+{-| Is the bimap empty? -}
+null :: Bimap a b -> Bool
+null (MkBimap left _) = M.null left
+
+{-| The number of elements in the bimap. -}
+size :: Bimap a b -> Int
+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
+{-| A version of 'member' specialized to the right key. -}
+memberR :: (Ord a, Ord b) => b -> Bimap a b -> Bool
+memberR = member . Right
+
+{-| Is the specified value not a member of the bimap? -}
+notMember :: (Ord a, Ord b)
+          => Either a b -> 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
+
+{-| Are the two values associated /with each other/ in the bimap? -}
+pairMember :: (Ord a, Ord b)
+           => (a, b) -> Bimap a b -> Bool
+pairMember (x, y) (MkBimap left _) =
+    maybe False (== y) (M.lookup x left)
+
+{-| Are the two values not in the bimap, or not associated with
+each other? (Complement of 'pairMember'.) -}
+pairNotMember :: (Ord a, Ord b)
+              => (a, b) -> Bimap a b -> Bool
+pairNotMember = not .: pairMember
+
+{-| Insert a pair of values into the bimap, associating them.
+If either of the values is already in the bimap, any overlapping
+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)
+
+{-| 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) =
+    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)
+       => Either a b -> Bimap a b -> Bimap a b
+delete e (MkBimap left right) =
+    MkBimap
+        (perhaps M.delete x $ left)
+        (perhaps M.delete y $ right)
+    where
+    perhaps = maybe id
+    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
+{-| A version of 'delete' specialized to the right key. -}
+deleteR :: (Ord a, Ord b) => b -> Bimap a b -> Bimap a b
+deleteR = delete . Right
+
+{-| Lookup the twin of a value in the bimap, returning both
+associated values as a pair.
+
+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 _) =
+    maybe (fail "Data.Bimap.lookup: Left key not found")
+          (\y -> return (x, y))
+          (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
+
+{-| Find the pair corresponding to a given value. Calls @'error'@
+when the value 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)
+
+{-| 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,
+and returns only the left key. -}
+(!>) :: (Ord a, Ord b) => Bimap a b -> b -> a
+(!>) bi y = fst $ bi ! Right y
+
+{-| 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
+
+{-| Convert to a list of associated pairs. -}
+toList :: Bimap a b -> [(a, b)]
+toList (MkBimap left _) = M.toList left
+
+{-| Return all associated pairs in the bimap, with the left-hand
+values in ascending order. -}
+assocs :: Bimap a b -> [(a, b)]
+assocs = toList
+
+{-| Test if the internal bimap structure is valid. -}
+valid :: (Ord a, Ord b)
+      => Bimap a b -> Bool
+valid (MkBimap left right) = and
+    [ M.valid left, M.valid right
+    , (==)
+        (sort .                M.toList $ left )
+        (sort . map flipPair . M.toList $ right)
+    ]
+    where
+    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 (MkBimap left right) = MkBimap right left
+
+{-| 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
+
+
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright Stuart Cook 2008
+
+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 Stuart Cook 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.
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,9 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> import System.Cmd
+> import System.Exit
+
+> main = defaultMainWithHooks (defaultUserHooks { runTests = suite })
+>     where
+>     suite _ _ _ _ = system "bash tests.sh" >> return ()
+
diff --git a/Test/RunTests.hs b/Test/RunTests.hs
new file mode 100644
--- /dev/null
+++ b/Test/RunTests.hs
@@ -0,0 +1,13 @@
+#!/usr/bin/env runhaskell
+{-# LANGUAGE TemplateHaskell #-}
+
+{-
+A stub file that uses Test.Util to extract and splice all the
+test names from Test.Tests.
+-}
+
+import Test.Tests
+import Test.Util
+
+main :: IO ()
+main = $( extractTests "Test/Tests.hs" )
diff --git a/Test/Tests.hs b/Test/Tests.hs
new file mode 100644
--- /dev/null
+++ b/Test/Tests.hs
@@ -0,0 +1,81 @@
+module Test.Tests where
+
+import Prelude hiding (null)
+import Test.QuickCheck
+
+import Data.Bimap
+
+
+instance (Ord a, Arbitrary a, Ord b, Arbitrary b)
+    => Arbitrary (Bimap a b) where
+    arbitrary = fromList `fmap` arbitrary
+    coarbitrary = coarbitrary . toList
+
+
+prop_size_empty = size empty == 0
+
+prop_null_empty = null empty
+
+-- (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 . filter (== x) . map fst $ xs) ||
+        ((>1) . length . filter (== y) . map snd $ xs)
+
+prop_fromList_size xs = (size $ fromList xs) <= length xs
+    where
+    _ = xs :: [(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) && (Right b' `notMember` 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)
+    ==>
+    (a, b) `pairNotMember` insert (a', b) bi
+    where
+    (a, b) = head . toList $ bi :: (Int, Integer)
+
+-- an arbitrary bimap is valid
+prop_valid bi = valid bi
+    where
+    _ = 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
+    ]
+    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
+    ]
+    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
+    ]
+    where
+    _ = bi :: Bimap Int Integer
diff --git a/Test/Util.hs b/Test/Util.hs
new file mode 100644
--- /dev/null
+++ b/Test/Util.hs
@@ -0,0 +1,48 @@
+{-# 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
diff --git a/bimap.cabal b/bimap.cabal
new file mode 100644
--- /dev/null
+++ b/bimap.cabal
@@ -0,0 +1,26 @@
+cabal-version:       >= 1.2.3.0
+name:                bimap
+version:             0.1
+synopsis:            Bidirectional mapping between two key types
+description:
+  A data structure representing a bidirectional mapping between two
+  key types. Each value in the bimap is associated with exactly one
+  value of the opposite type.
+category:            Data
+license:             BSD3
+license-file:        LICENSE
+author:              Stuart Cook
+maintainer:          scook0@gmail.com
+homepage:            http://code.haskell.org/bimap
+extra-source-files:
+    tests.sh
+    Test/Tests.hs
+    Test/Util.hs
+    Test/RunTests.hs
+
+Library
+  build-depends:       base, mtl
+  ghc-options:         -Wall -O2
+  exposed-modules:
+      Data.Bimap
+
diff --git a/tests.sh b/tests.sh
new file mode 100644
--- /dev/null
+++ b/tests.sh
@@ -0,0 +1,5 @@
+#!/bin/bash
+# ensure that an error in the test program doesn't accidentally
+# produce success
+set -o pipefail
+(runhaskell Test/RunTests.hs | tee .test.log) && if grep Falsifiable .test.log >/dev/null; then exit 1; fi