{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

module Database.CDB.Packable (
  Packable,
  Unpackable,
  pack,
  unpack
) where

import Data.Array.Unboxed
import Data.Bits
import qualified Data.ByteString as ByteString
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as ByteString.Char8
import Data.Word

-- |An instance of 'Packable' can be losslessly transformed into a 'ByteString'.
class Packable k where
  pack :: k -> ByteString

-- |An instance of 'Unpackable' can be losslessly transformed from a 'ByteString'.
class Unpackable v where
  unpack :: ByteString -> v

instance Packable ByteString where
  pack :: ByteString -> ByteString
pack = forall a. a -> a
id

instance Unpackable ByteString where
  unpack :: ByteString -> ByteString
unpack = forall a. a -> a
id

instance Packable [Char] where
  pack :: [Char] -> ByteString
pack = [Char] -> ByteString
ByteString.Char8.pack

instance Unpackable [Char] where
  unpack :: ByteString -> [Char]
unpack = ByteString -> [Char]
ByteString.Char8.unpack

instance Packable [Word8] where
  pack :: [Word8] -> ByteString
pack = [Word8] -> ByteString
ByteString.pack

instance Unpackable [Word8] where
  unpack :: ByteString -> [Word8]
unpack = ByteString -> [Word8]
ByteString.unpack

instance Packable Word32 where
  pack :: Word32 -> ByteString
pack Word32
n = [Word8] -> ByteString
ByteString.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral 
    [Word32
n forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
    (Word32
n forall a. Bits a => a -> Int -> a
`shiftR` Int
8) forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
    (Word32
n forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
    (Word32
n forall a. Bits a => a -> Int -> a
`shiftR` Int
24) forall a. Bits a => a -> a -> a
.&. Word32
0xFF]

instance Packable (UArray Word32 Word32) where
  pack :: UArray Word32 Word32 -> ByteString
pack UArray Word32 Word32
t = forall k. Packable k => k -> ByteString
pack forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
ByteString.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall k. Packable k => k -> ByteString
pack forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Word32 Word32
t