{-
Proof of concept implementation of the SOLE encoding scheme.

This implementation only serves to show the conceptual method behind the SOLE
encoding, it does not consider efficient implementation whatsoever.

 * Using arbitrary precision Integer as intermediate representation
 * Only works for blocks of size up to 32
 * Uses `div` and `mod`. More efficient methods exist
 * Uses multiplication of large numbers that are almost powers of two

TODO
 * Allow modification of a single block (to demonstrate only four output blocks
   need to be decoded in order to do this)
-}

import Data.Word
import Data.Bits ((.&.), (.|.), shiftR, shiftL)
import Test.QuickCheck (quickCheck)

type B = Integer

-- !
-- Shift operations
(.<<) :: Integer -> Int -> Integer
(.<<) = shiftL

(>>.) :: Integer -> Int -> Integer
(>>.) = shiftR

-- !
-- Blocks consists of b bits
b     = 32 :: Int
bMask = (1 .<< b) - 1 :: Integer

bigB :: B
bigB = 2 ^ b

eof :: B
eof = bigB

-- !
-- Pass 1: Group (2i,2i+1) into a number in [(B+1)^2] and decompose into two
-- numbers in respectively [B-3i] and [B+3i+3]
pass1 :: [Word32] -> [Integer]
pass1 = pass1c 0
  where pass1c i []  = tf (bigB - 3*i) eof eof
        pass1c i [x] = tf (bigB - 3*i) (fromIntegral x) eof
        pass1c i (x1:x2:xs) = (tf (bigB - 3*i) (fromIntegral x1) (fromIntegral x2)) ++ pass1c (i+1) xs

        tf :: B -> Integer -> Integer -> [Integer]
        tf cb x1 x2 = [z, y]
          where (z, y) = (v `mod` cb, v `div` cb)
                v      = x1 * (bigB + 1) + x2

-- !
-- Pass2: Regroup output from pass 1 into a new number in [B^2] and decompose
-- into two numbers in [B]
pass2 :: [Integer] -> [Word32]
pass2 (z:xs) = fromIntegral z : pass2c 1 xs
  where pass2c _ [y]      = decomp y
        pass2c i (y:z:xs) = (decomp $ z * (bigB + 3*i) + y) ++ pass2c (i+1) xs

        decomp :: Integer -> [Word32]
        decomp x = [fromIntegral (x >>. b), fromIntegral (x .&. bMask)]

-- !
-- Entire encoding procedure
encode :: [Word32] -> [Word32]
encode = pass2 . pass1

-- !
-- Output: [12,127,386,0,32]    when b = 32
encode_example = encode [5, 7, 31]

de_pass2 :: [Word32] -> [Integer]
de_pass2 (w:ws) = fromIntegral w : de_pass2c 1 ws
  where de_pass2c :: Integer -> [Word32] -> [Integer]
        de_pass2c i [v, w]   = decomp v w (bigB + 3*i)
        de_pass2c i (v:w:ws) = (decomp v w $ bigB + 3*i) ++ (de_pass2c (i+1) ws)

        decomp :: Word32 -> Word32 -> Integer -> [Integer]
        decomp v w base = [y, z]
          where w'     = (fromIntegral v) .<< b .|. fromIntegral w
                (y, z) = (w' `mod` base, w' `div` base)


de_pass1 :: [Integer] -> [Word32]
de_pass1 = de_pass1c 0
  where de_pass1c i (z:y:xs)
          | x2 == eof && x1 == eof = []
          | x2 == eof              = [fromIntegral x1]
          | otherwise              = fromIntegral x1 : fromIntegral x2 : de_pass1c (i+1) xs
          where x'       = y * (bigB - 3*i) + z
                (x1, x2) = (x' `div` (bigB+1), x' `mod` (bigB+1))

decode :: [Word32] -> [Word32]
decode = de_pass1 . de_pass2

-- !
-- Testing

prop_encode_decode_id list = list == (decode . encode $ list)