-- | An efficient membership-testing module, for types that can be mapped into
-- @Int@s.
--
-- The implementation is quite simple: we rely on the @Bits Integer@ instance
-- from @Data.Bits@ for the three main operations.  An advantage of this
-- library is the phantom parameter used in the BitSet type.  Since there is
-- no exported way to construct a value of type `BitSet' directly, the
-- interface we expose ensures client code will not typecheck if it confuses
-- two bit sets intended to keep track of different types.
--
-- It is important that the values you intend to keep track of start from 0
-- and go up.  Each @Int@ mapped to be hash corresponds to that bit location in
-- an @Integer@, and thus requires that @Integer@ to have at least that many
-- bits.  Don't shoot yourself in the foot.
module Data.BitSet
    ( Hash(..)
    , BitSet
    , empty
    , insert
    , delete
    , member
    ) where

import Data.Bits

import Test.QuickCheck

-- | Map a value to an non-negative @Int@.
--
-- For the implementation to give reliable results, it must be that if @hash x
-- == hash y@, @x@ and @y@ are equivalent under the relevant relation used in
-- the client code.  (We don't depend on equality, but the client code will
-- certainly want to use the above sort of inference.)
--
-- In fact, if your equivalence relation is @==@, the following quickcheck
-- test should pass, for arbitrary @x@ and @y@:
--
-- @prop_hash x y =
--     if hash x == hash y then x == y
--     else x /= y
--     && if x == y then hash x == hash y
--        else hash x /= hash y@
class Hash a where
    hash :: a -> Int

-- | The @Show@ instance kind of sucks.  It just shows the @Integer@
-- representation.  A good show would probably show all the present hashes.
newtype BitSet a = BS { unBS :: Integer }
    deriving (Eq)

instance Show (BitSet a) where
    show s = "BitSet " ++ show (unBS s)

-- | The empty bit set.
empty :: BitSet a

-- | /O(setBit on Integer)/ Insert an item into the bit set.
insert :: Hash a => a -> BitSet a -> BitSet a

-- | /O(clearBit on Integer)/ Delete an item from the bit set.
delete :: Hash a => a -> BitSet a -> BitSet a

-- | /O(testBit on Integer)/ Ask whether the item is in the bit set.
member :: Hash a => a -> BitSet a -> Bool


-- * Implementation

empty = BS 0

{-# INLINE insert #-}
insert x s = BS $ setBit (unBS s) (hash x)

{-# INLINE delete #-}
delete x s = BS $ clearBit (unBS s) (hash x)

{-# INLINE member #-}
member x s = testBit (unBS s) (hash x)

-- * Default instances

instance Hash Int where
    hash = id

instance Hash Integer where
    hash = fromIntegral

-- Needs UndecidableInstances?
-- instance Integral a => Hash a where
--     hash = fromIntegral

-- * Quickcheck properties

instance Arbitrary (BitSet a) where
    arbitrary = sized $ \n -> return $ BS $ fromIntegral n

prop_insert x s = xa `member` insert xa s
    where xa = abs x :: Int

prop_delete x s = not $ xa `member` delete xa s
    where xa = abs x :: Int

prop_insDelIdempotent x = empty == (delete xa . insert xa $ empty)
    where xa = abs x :: Int

prop_delDelIdempotent x s = delete xa s == (delete xa . delete xa $ s)
    where xa = abs x :: Int

prop_insInsIdempotent x s = insert xa s == (insert xa . insert xa $ s)
    where xa = abs x :: Int

prop_extensional xs = and $ map (`member` s) xsa
    where s = foldr insert empty xsa
          xsa = map abs xs :: [Int]

prop_empty x = not $ xa `member` empty
    where xa = abs x :: Int