-----------------------------------------------------------------------------
-- |
-- Module      : Data.DimensionalHash
-- Copyright   : Hamrouni Ghassen
-- License     : BSD3
-- 
-- Maintainer  : Hamrouni Ghassen <ghamrouni@iptechinside.com>
-- Stability   : Experimental
-- Portability :
--
-----------------------------------------------------------------------------

module Data.DimensionalHash  
(
  MortonNumber(..)
) where

import Data.Bits
import Data.Int
import Data.Word

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

class (Bits a, Integral a) => (MortonNumber a) where
	-- | Recursively compute the hash.	
	dimensionalHash :: (Bits a) => [a] -> a
	dimensionalHash [] 		= 0
	dimensionalHash list
		| hashable == True = hash list 0 (bitSize (head list))
		| otherwise = error "The list is not hashable."
		where
			hashable = isHashable list
 	
	-- | Compute max size (in bit) for an element of the list.
	maxBitSize :: (Bits a) => [a] -> Int
	maxBitSize list = div (bitSize (head list)) (length list)
	
	-- | Compute maximum size for an element of the list.
	maxSize :: (Bits a) => [a] -> Int
	maxSize list = 2 ^ (maxBitSize list)
	
	-- | Returns true if the list is hashable
	-- A list is hashable IIF for every element x :
	-- x > (maxSize list)
	isHashable :: (Bits a) => [a] -> Bool
	isHashable [x] = True
	isHashable list = (length filteredList) == 0
		where
			filteredList = filter (\x -> (fromIntegral x) > (maxSize list)) list

------------------------------------------------------------------------
-- | 
			
-- Integer haven't a fixed bitsize
instance MortonNumber Integer where
	dimensionalHash list
		| hachable == True = hash list 0 32
		| otherwise = error "The list is not hashable."
		where
			hachable = isHashable list
	
	maxBitSize list = div 32 (length list)

-- Types that have a fixed bitsize are instance of MortonNumber
instance MortonNumber Int8
instance MortonNumber Int32
instance MortonNumber Int64

instance MortonNumber Word
instance MortonNumber Word8
instance MortonNumber Word16
instance MortonNumber Word32
instance MortonNumber Word64

------------------------------------------------------------------------
-- | Recursively compute the hash.

hash :: (Bits a) => [a] -> Int -> Int -> a
hash list n precision
	| length list == 1 	= head list
	| n < precision 	= (concatBits list n) .|. (hash list (n + 1) precision)
	| otherwise 		= 0

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

concatBits :: (Bits a) => [a] -> Int -> a
concatBits list n = foldl (\acc x -> acc .|. x) 0 shiftedMap
	where 	
		shiftedMap 	= shiftElements mapList (n * ((length list) - 1))
		mapList 	= map (\x -> (takeBitAt x n)) list
		
------------------------------------------------------------------------
-- | Shift the elements by n + index

shiftElements :: (Bits a) => [a] -> Int -> [a]
shiftElements [] n 		= []
shiftElements (x:xs) n 	= [(shiftL x n)] ++ (shiftElements xs (n+1))

------------------------------------------------------------------------
-- | Set all bits to 0, except the bit at index n

takeBitAt :: (Bits a) => a -> Int -> a
takeBitAt x n = x .&. (shiftL 1 n)