{-# LANGUAGE ScopedTypeVariables #-}
module Data.Serialize (
  module Control.Parser,
  Serializable(..)
  ) where

import Control.Parser
import Data.ByteString.Lazy.Builder
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe
import Data.Word
import Foreign.Ptr
import Foreign.Storable
import qualified Data.Monoid as M
import System.Endian

class Serializable t where
  encode :: t -> Builder
  serializable :: Parser String ByteString t 

instance Semigroup Builder where (+) = M.mappend
instance Monoid Builder where zero = M.mempty

withByteString :: ByteString -> (Ptr a -> IO b) -> b
withByteString b f = unsafeUseAsCString b (f . castPtr)^._thunk

storable :: forall a. Storable a => Parser String ByteString a
storable = p^.parser
  where p s | BS.length s >= sz = (zero,pure (unsafeDrop sz s,res))
            | otherwise = ("Input too short",zero)
          where res = withByteString s peek :: a
                sz = sizeOf res
  
instance Serializable Word8 where
  encode = word8
  serializable = storable
instance Serializable Word32 where
  encode = word32BE
  serializable = fromBE32<$>storable
instance Serializable Word64 where
  encode = word64BE
  serializable = fromBE64<$>storable
instance (Serializable a,Serializable b) => Serializable (a:*:b) where
  encode (a,b) = encode a+encode b
  serializable = (,)<$>serializable<*>serializable
instance (Serializable a,Serializable b) => Serializable (a:+:b) where
  encode (Left a) = word8 0+encode a
  encode (Right b) = word8 1+encode b
  serializable = storable >>= \x -> case x :: Word8 of
    0 -> Left<$>serializable
    1 -> Right<$>serializable
    _ -> tell "Invalid encoding" >> zero