module Data.Binary.Generic.Extensions (
extGet
, extPut
, getExtDefault
, putExtDefault
, getExtInteger
, putExtInteger
, getExtChar
, putExtChar
, getExtWord
, putExtWord
, getExtInt
, putExtInt
, getExtFloat
, putExtFloat
, getExtText
, putExtText
, getExtByteString
, putExtByteString
) where
import Data.Binary
import Data.Binary.IEEE754 (putFloat32be, getFloat32be, putFloat64be, getFloat64be)
import Data.Data
import Data.Generics
import Data.Word ()
import Data.Int
import Data.List
import Data.Bits
import Data.ByteString.Lazy (ByteString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LTE
import Control.Monad
extGet :: (Monad m, Typeable a, Typeable b) => m b -> m a -> m a
extGet = flip extR
extPut :: (Typeable a, Typeable b) => (b -> q) -> (a -> q) -> a -> q
extPut = flip extQ
getExtDefault :: Typeable a => Get a -> Get a
getExtDefault = getExtInteger
. getExtChar
. getExtWord
. getExtInt
. getExtFloat
. getExtText
. getExtByteString
putExtDefault :: Typeable a => (a -> Put) -> a -> Put
putExtDefault = putExtInteger
. putExtChar
. putExtWord
. putExtInt
. putExtFloat
. putExtText
. putExtByteString
getExtInteger :: Typeable a => Get a -> Get a
getExtInteger = extGet (getInteger :: Get Integer)
putExtInteger :: Typeable a => (a -> Put) -> a -> Put
putExtInteger = extPut (putInteger :: Integer -> Put)
getExtChar :: Typeable a => Get a -> Get a
getExtChar = extGet (get :: Get Char)
putExtChar :: Typeable a => (a -> Put) -> a -> Put
putExtChar = extPut (put :: Char -> Put)
getExtWord :: Typeable a => Get a -> Get a
getExtWord = extGet (get :: Get Word )
. extGet (get :: Get Word8 )
. extGet (get :: Get Word16)
. extGet (get :: Get Word32)
. extGet (get :: Get Word64)
putExtWord :: Typeable a => (a -> Put) -> a -> Put
putExtWord = extPut (put :: Word -> Put)
. extPut (put :: Word8 -> Put)
. extPut (put :: Word16 -> Put)
. extPut (put :: Word32 -> Put)
. extPut (put :: Word64 -> Put)
getExtInt :: Typeable a => Get a -> Get a
getExtInt = extGet (get :: Get Int )
. extGet (get :: Get Int8 )
. extGet (get :: Get Int16)
. extGet (get :: Get Int32)
. extGet (get :: Get Int64)
putExtInt :: Typeable a => (a -> Put) -> a -> Put
putExtInt = extPut (put :: Int -> Put)
. extPut (put :: Int8 -> Put)
. extPut (put :: Int16 -> Put)
. extPut (put :: Int32 -> Put)
. extPut (put :: Int64 -> Put)
getExtFloat :: Typeable a => Get a -> Get a
getExtFloat = extGet (getFloat32be :: Get Float)
. extGet (getFloat64be :: Get Double)
putExtFloat :: Typeable a => (a -> Put) -> a -> Put
putExtFloat = extPut (putFloat32be :: Float -> Put)
. extPut (putFloat64be :: Double -> Put)
getExtText :: Typeable a => Get a -> Get a
getExtText = extGet (getText :: Get T.Text)
. extGet (getTextL :: Get LT.Text)
putExtText :: Typeable a => (a -> Put) -> a -> Put
putExtText = extPut (putText :: T.Text -> Put)
. extPut (putTextL :: LT.Text -> Put)
getExtByteString :: Typeable a => Get a -> Get a
getExtByteString = extGet (get :: Get ByteString)
putExtByteString :: Typeable a => (a -> Put) -> a -> Put
putExtByteString = extPut (put :: ByteString -> Put)
getText :: Get T.Text
getText = get >>= (return . TE.decodeUtf8)
getTextL :: Get LT.Text
getTextL = get >>= (return . LTE.decodeUtf8)
putText :: T.Text -> Put
putText = put . TE.encodeUtf8
putTextL :: LT.Text -> Put
putTextL = put . LTE.encodeUtf8
putInteger :: Integer -> Put
putInteger n | n >= lo && n <= hi = do
putWord8 0
put (fromIntegral n :: Int32)
where
lo = fromIntegral (minBound :: Int32) :: Integer
hi = fromIntegral (maxBound :: Int32) :: Integer
putInteger n = do
putWord8 1
put sign
put $ reverse (unroll (abs n))
where
sign = fromIntegral (signum n) :: Word8
getInteger :: Get Integer
getInteger = do
tag <- get :: Get Word8
case tag of
0 -> liftM fromIntegral (get :: Get Int32)
_ -> do sign <- get
bytes <- get
let v = roll (reverse bytes)
return $! if sign == (1 :: Word8) then v else v
unroll :: Integer -> [Word8]
unroll = unfoldr step
where
step 0 = Nothing
step i = Just (fromIntegral i, i `shiftR` 8)
roll :: [Word8] -> Integer
roll = foldr unstep 0
where
unstep b a = a `shiftL` 8 .|. fromIntegral b