module Data.Binary.Generic (
getGeneric
, putGeneric
) where
import Data.Binary
import Data.Binary.IEEE754 (putFloat32be, getFloat32be, putFloat64be, getFloat64be)
import Data.ByteString.Lazy (ByteString)
import Data.Data
import Data.Generics
import Data.Word ()
import Data.Int
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)
getGeneric :: (Data a) => Get a
getGeneric = generalCase
`extR` (get :: Get Char)
`extR` (get :: Get Int)
`extR` (get :: Get Word)
`extR` (get :: Get Integer)
`extR` (get :: Get Int8)
`extR` (get :: Get Int16)
`extR` (get :: Get Int32)
`extR` (get :: Get Int64)
`extR` (get :: Get Word8)
`extR` (get :: Get Word16)
`extR` (get :: Get Word32)
`extR` (get :: Get Word64)
`extR` (get :: Get ByteString)
`extR` (getText :: Get Text)
`extR` (getFloat32be :: Get Float)
`extR` (getFloat64be :: Get Double)
where
getText = get >>= (return . decodeUtf8)
fromIntegralM = return . fromIntegral
myDataType = dataTypeOf ((undefined :: Get b -> b) generalCase)
generalCase = let imax = maxConstrIndex myDataType
index | imax == 1 = return 1 :: Get Int
| imax <= 255 = (get :: Get Word8) >>= fromIntegralM
| otherwise = (get :: Get Word16) >>= fromIntegralM
in index >>= \i-> fromConstrM getGeneric (indexConstr myDataType i)
putGeneric :: (Data a) => a -> Put
putGeneric = generalCase
`extQ` (put :: Char -> Put)
`extQ` (put :: Int -> Put)
`extQ` (put :: Word -> Put)
`extQ` (put :: Integer -> Put)
`extQ` (put :: Int8 -> Put)
`extQ` (put :: Int16 -> Put)
`extQ` (put :: Int32 -> Put)
`extQ` (put :: Int64 -> Put)
`extQ` (put :: Word8 -> Put)
`extQ` (put :: Word16 -> Put)
`extQ` (put :: Word32 -> Put)
`extQ` (put :: Word64 -> Put)
`extQ` (put :: ByteString -> Put)
`extQ` (put . encodeUtf8 :: Text -> Put)
`extQ` (putFloat32be :: Float -> Put)
`extQ` (putFloat64be :: Double -> Put)
where
generalCase t = let i = fromIntegral $ constrIndex (toConstr t)
imax = maxConstrIndex (dataTypeOf t)
putIndex | imax == 1 = return ()
| imax <= 255 = put (i :: Word8) >> return ()
| otherwise = put (i :: Word16) >> return ()
in foldl (>>) putIndex (gmapQ putGeneric t)