{-
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)
-}
module SoleArbitrary (
	encode,
	decode,
	blockSize
) where

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     = 128 :: Int
bMask = (1 .<< b) - 1 :: Integer

bigB :: B
bigB = 2 ^ b

eof :: B
eof = bigB

-- ! Exported value
blockSize = b

-- !
-- 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 :: [Integer] -> [Integer]
pass1 = pass1c 0
  where pass1c i []  = tf (bigB - 3*i) eof eof
        pass1c i [x] = tf (bigB - 3*i) x eof
        pass1c i (x1:x2:xs) = (tf (bigB - 3*i) x1 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] -> [Integer]
pass2 (z:xs) = 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 x = [x >>. b, x .&. bMask]

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

example_input = [5, 7, (1 `shiftL` b) - 1]

-- !
-- Output: [12,127,386,0,32]    when b = 32
encode_example = split enc --encode [5, 7, (1 `shiftL` b) - 1]
  where enc = encode example_input

split [] = []
split (x:xs) = x `shiftR` 64 : x .&. ((1 .<< 64)-1) : split xs

de_pass2 :: [Integer] -> [Integer]
de_pass2 (w:ws) = w : de_pass2c 1 ws
  where 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 v w base = [y, z]
          where w'     = v .<< b .|. w
                (y, z) = (w' `mod` base, w' `div` base)


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


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

-- !
-- Testing

-- prop_encode_decode_id list = not (anyNeg list) ==> list == (decode . encode $ list)
--   where anyNeg = any (\i -> i < 0)

-- first_7_blocks =
--  [ (7956010481807946867 .<< 64) .|. 2338615488418245744
--  , (7874860801617168957 .<< 64) .|. 4412750324381798228
--  , (2308765963911831668 .<< 64) .|. 6998711947288649773
--  , (2340029477534396015 .<< 64) .|. 7598807797348048999
--  , (2338623232362770208 .<< 64) .|. 2968197749036490859
--  , (7161130725581808997 .<< 64) .|. 7719297800551079968
--  , (2338615488502986083 .<< 64) .|. 2317439730694299764
--  ]

-- input_64_bits =
--  [ 7956010481807946867,  2338615488418245744,  7874860801617168957,  4412750324381798228] ++
--  [ 2308765963911831668,  6998711947288649773,  2340029477534396015,  7598807797348048999] ++
--  [ 2338623232362770208,  2968197749036490859,  7161130725581808997,  7719297800551079968] ++
--  [ 2338615488502986083,  2317439730694299764,  7954890152741117993,  3614174066888165702] ++
--  [ 2308783538983497760,  8386658438904705056,  8103418724639928919,  2318544612252396866] ++
--  [ 8747512699207249768,  2334383527001289760,  8388349453327409268,  6998711947286552621] ++
--  [ 2340027244252129644,  2333824980480193327,  7163376947542189088,  7311142548479893792] ++
--  [ 7164740061713624169,  7022349199690256449,  2317700185732312937,  8386103181254160227] ++
--  [ 2334391151653578082,  2338621054691338094,  7594317344347005028,  7953674045519127663] ++
--  [ 8390322045806929252,  2314885437491800422,  2336916790227005025,  2334390048165752692] ++
--  [ 7882742402838983785,  2336358255488737396,  7575181512696622962,  8079568156741366383] ++
--  [ 8388361499482683764,  7596553798410663011,  7959380205302202656,  3035437187693376624] ++
--  [ 7381153929786389619,  7955925892426262133,  7070761801878692713,  7236837239260717157] ++
--  [ 8583987786327269408,  2308708828011851881,  8242558622326875500,  7594793480127278880] ++
--  [ 2338042707301724016,  2333181740536850286,  7598543858634356591,  7812726245332645231] ++
--  [ 7023439623332301322,  3346020730649471346,  8583983434319422822,  7382915055351787380] ++
--  [ 7881706611452047392,  7453010377922670624,  7308332045224797543,  7022085026001743981] ++
--  [ 8583981155066802034,  8079569256392174948,  7953758733700636780,  7809643570066956334] ++
--  [ 8367814982840447776,  7236828442999417190,  2333181404303225700,  7018141077842651496] ++
--  [ 7165072115075411567,  2334101988924681829,  3262097408680555630,  7310589519812650344] ++
--  [ 2336912335020498954,  8243124888016217458,  2334391211988711525,  2336876863126005099] ++
--  [ 8386658473162842226,  7306086968195293253,  5498705068648068128,  7310315402303989876] ++
--  [ 8367808372735636595,  2333274043595122542,  7596850619288723557,  7526676535925832044] ++
--  [ 5917776227460591225,  7810966223636930670,  8007528132324106250,  7306086968195293295] ++
--  [ 3347146965563764335,  7142829274090861683,  6874019632179602802,  8463498955818562405] ++
--  [ 7382915055658541163,  7165064700875861615,  2340020702962284908,  8389754698058777376] ++
--  [ 8439879208341956979,  2334111931572777760,  7307218076735375972,  7953674032483820902] ++
--  [ 7088701442087281764,  6998719600735646574,  8017287145291211116,  8083238303993980275] ++
--  [ 7018141438804190572,  8030797882880323444,  2332920043939192864,  7236828442911665004] ++
--  [ 7307218077898531171,  7594316269448295456,  8243112831976546405,  8319591502357536877] ++
--  [  754753633590980210,  7306640099798705512,  8367800735120913267,  7308898458350789152] ++
--  [ 2321101147493919852,  8459484630119117413,  7378714103803897972,  2336916756001464352] ++
--  [ 7305805557823202658,  2338340649032773231,  7142835952826739820,  7599578258613758306] ++
--  [ 8583987794835106914,  2338623232362770208,  2314861419091271780,  7953673791948026739] ++
--  [ 2333181761949952373,  8171062582634440788,  2318912240166922610,  8583972361893342313] ++
--  [ 7453001534312310131,  7307182892363287050,  2843018646617616245,  8153521356360802659] ++
--  [ 8386093285481475184,  7883959205594429295,  7812726245517651041,  2336361506924426085] ++
--  [ 3245518023745102709,  8247343400851039594,  8030569089604805992,  8367809505449111401] ++
--  [ 8022047167468889701,  7737550435390589450,  3255307777713450285,  3255307777713450285] ++
--  [ 7236287822631733513,  3414698781263601674,  7308332183824589133,  2336353865880579440] ++
--  [ 7598805623977110901,  7165020337769243503,  7214816218685076847,  7599369650658697760] ++
--  [ 8223622535216063852,  7594793497306358117,  5190732158044826723,  7955925594909863535] ++
--  [ 2338603393740665456,  3252270137497231476,  8245933023747401064,  6055423351158960229] ++
--  [ 8079507347135358316,  7594869333475270766,  8606133093174681715,  7306093603886885160] ++
--  [ 7022359100883561584,  7883868307162751854,  8026294585227503215,  8030569085294044015] ++
--  [ 3255307777713450250,  7453010313196425738,   751094420714250568,  2336920844664531316] ++
--  [ 5489733341695717223,  8245860516096992814,  8608480257281519732,  8387989684162136586] ++
--  [ 5716289825064974706,  7021782973413158241,  8243680179687214932,  6291326564591562345] ++
--  [ 7454142578312765815,  7305808869231636271,  4211833721993044013,  2314861669277526062] ++
--  [ 3342637894046805871,  7093015985622313839,  8026100031903838059,  8029744891459625263] ++
--  [ 7146772183035045236,  7023210986255638883,  3400000498352547872,  3251634160102372456] ++
--  [ 7594301959987801376,  2308770340545639473,  8097868380196074863,  7088999392340356961] ++
--  [ 7940444467082511136,  7236828442424012393,  2340016313276196719,  8390339637451646830] ++
--  [ 8242000070408566127,  8299904566358471796,  7496815964599627374,  8028075806767259748] ++
--  [ 7741528753040553313,  3416947266474177653,  7002934071938674548,  8458093696526528101] ++
--  [ 7310012310605754997,  8030813651172011823,  4211833721993038444,  7887043395878614111] ++
--  [ 6875711780294718581,  7002934071938674548,  8458093713656078959,  8391720336901697326] ++
--  [ 8247620833090434935,  3400000511170344040,   735836278138164003,  7813028919358404402] ++
--  [ 8391720336968609634,  8031173095776284527,  7093015985622312818,  8011452329074582883] ++
--  [ 7142835918572844143,  8391684992051656003,  4995375360283797550,  3978190760887411311] ++
--  [ 7070762926840029229,  2308707431035514157,  3255307777713450285,  3255269596665705065] ++
--  [ 7308620310548475680,  2839353978740761383,  2337214749187534695,  2338324135100378729] ++
--  [ 7955941241716697446,  7957688057361350944,  3251610417405127791,  7359007570993114912] ++
--  [ 3255307777713441381,  7163384703710426216,  7451612924364145418,   746829315853015840] ++
--  [ 2334381286437645856,  8388068008567337071,  7142819390760299821,  3255307777713450285] ++
--  [ 3400000511170344040,  2322280043722181159,  7161055895742670697,  7380959310955704180] ++
--  [ 7435288453835615075,  7307199442084523630,  7022907816275309167,  3347703287460099959] ++
--  [ 4122533301949197935,  7165073579660242017,  8461807871450312303,  7165073579660244334] ++
--  [  753057040346410830,  2552535435543737189,  7163384703711405412,  8029460104945625135] ++
--  [ 2570 ]

-- transform_64bit_numbers :: [Integer] -> [Integer]
-- transform_64bit_numbers (x3:x2:x1:x0:xs) = (x0 .|. (x1 .<< b)) : (x2 .|. (x3 .<< b)) : (transform_64bit_numbers xs)
-- transform_64bit_numbers [x2,x1,x0]       = (x0 .|. (x1 .<< b)) : [x2]
-- transform_64bit_numbers [x1,x0]          = [x0 .|. (x1 .<< b)]
-- transform_64bit_numbers [x0]             = [x0]
-- transform_64bit_numbers []               = []


-- encodeTODO = split . encode $ input
--   where input = transform_64bit_numbers input_64_bits