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