-- | Haskell98 polymorphic Hash interface
module Data.Generics.Fixplate.Util.Hash.Class where

--------------------------------------------------------------------------------

import Data.Char
import Data.Word
import Data.Bits
import Data.List
-- import Data.Int

--------------------------------------------------------------------------------

-- | A type class for hashes.
-- Minimal complete definition: 'emptyHash', 'hashWord8', 'hashHash' and 'showHex'.
class (Eq hash, Ord hash, Hashable hash) => HashValue hash where

  hashWord8  :: Word8  -> hash -> hash
  hashWord16 :: Word16 -> hash -> hash
  hashWord32 :: Word32 -> hash -> hash
  hashWord64 :: Word64 -> hash -> hash

  emptyHash  :: hash
  hashHash   :: hash -> hash -> hash
  showHex    :: hash -> String

  hashWord32 w = hashWord8 a . hashWord8 b . hashWord8 c . hashWord8 d where
    a = fromIntegral (255 .&. (       w   ))
    b = fromIntegral (255 .&. (shiftR w  8))
    c = fromIntegral (255 .&. (shiftR w 16))
    d = fromIntegral (255 .&. (shiftR w 24))
 
  hashWord16 w = hashWord8 a . hashWord8 b where
    a = fromIntegral (255 .&. (       w   ))
    b = fromIntegral (255 .&. (shiftR w  8))

  hashWord64 w = hashWord32 a . hashWord32 b where
    a = fromIntegral (0xffffffff .&. (       w   ))
    b = fromIntegral (0xffffffff .&. (shiftR w 32))

--------------------------------------------------------------------------------

-- | A type class of hashable objects. An instance has to compute the hash for
-- /any/ hash function, using the \"base\" types (eg. Word32).
--
-- Minimal complete definition: 'hashDigest'. The default for 'computeHash' is
--
-- > computeHash x = hashDigest x emptyHash
-- 
class Hashable a where
  hashDigest  :: HashValue hash => a -> hash -> hash
  computeHash :: HashValue hash => a -> hash

  computeHash x = hashDigest x emptyHash

--------------------------------------------------------------------------------

instance Hashable Word8  where hashDigest = hashWord8
instance Hashable Word16 where hashDigest = hashWord16
instance Hashable Word32 where hashDigest = hashWord32
instance Hashable Word64 where hashDigest = hashWord64

instance Hashable Int  where hashDigest = hashInt
instance Hashable Word where hashDigest = hashWord
instance Hashable Bool where hashDigest = hashBool
instance Hashable Char where hashDigest = hashChar

--------------------------------------------------------------------------------

instance Hashable a => Hashable [a] where
  hashDigest xs h = foldl' (flip hashDigest) h xs

instance (Hashable a, Hashable b) => Hashable (a,b) where
  hashDigest (x,y) = hashDigest y . hashDigest x

instance (Hashable a, Hashable b, Hashable c) => Hashable (a,b,c) where
  hashDigest (x,y,z) = hashDigest z . hashDigest y . hashDigest x

instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a,b,c,d) where
  hashDigest (x,y,z,w) = hashDigest w . hashDigest z . hashDigest y . hashDigest x

instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable (a,b,c,d,e) where
  hashDigest (x,y,z,w,u) = hashDigest u . hashDigest w . hashDigest z . hashDigest y . hashDigest x

--------------------------------------------------------------------------------

hashInt  :: HashValue hash => Int  -> hash -> hash
hashWord :: HashValue hash => Word -> hash -> hash
hashBool :: HashValue hash => Bool -> hash -> hash
hashChar :: HashValue hash => Char -> hash -> hash

hashInt  k = hashWord64 (fromIntegral k)
hashWord k = hashWord64 (fromIntegral k)
hashBool b = hashWord8  (if b then 255 else 0)
hashChar c = hashWord16 (fromIntegral (ord c)) 

--------------------------------------------------------------------------------