--
-- Morton number generator
-- Can be used for n-dimensional hash

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

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

-- |Return an element having all bits set to 0, excepting the bit at n
takeBitAt :: (Bits a) => a -> Int -> a
takeBitAt x n = x .&. (shiftL 1 n)

-- |Return a list have shifted elements by (n + index)
shiftElements :: (Bits a) => [a] -> Int -> [a]
shiftElements [] n = []
shiftElements (x:xs) n = [(shiftL x n)] ++ (shiftElements xs (n+1))

-- |Return a list have been shifted elements by n + index
concatBits :: (Bits a) => [a] -> Int -> Int -> a
concatBits list n npos = foldl (\acc x -> acc .|. x) 0 shiftedMap
	where 	
		shiftedMap = shiftElements mapList npos
		mapList = map (\x -> (takeBitAt x n)) list

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

-- | recursevely compute the morton number.	
class (Bits a) => (MortonNumber a) where	
	dimensionalHash :: (Bits a) => [a] -> a
	dimensionalHash list = hash list 0 0 (bitSize (head list))

-- Integer haven't a fixed bitsize
instance MortonNumber Integer where
	dimensionalHash list = hash list 0 0 32

-- 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