Data/BinaryState.hs

   1 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
   2 module Data.BinaryState where
   3
   4 import Control.Monad
   5 import qualified Control.Monad.State as State
   6 import qualified Data.Binary as Binary
   7 import qualified Data.Binary.Put as Put
   8 import qualified Data.Binary.Get as Get
   9 import qualified Data.ByteString.Lazy as B
  10 import Foreign.Storable
  11 import Data.Word
  12 import Data.Int
  13
  14 type PutState s a = State.StateT s Put.PutM a
  15 type GetState s a = State.StateT s Binary.Get a
  16
  17 class BinaryState s a where
  18   put :: a -> PutState s ()
  19   get :: GetState s a
  20
  21 instance (Binary.Binary a) => BinaryState () a where
  22   put x = putZ x
  23   get = getZ
  24
  25 putZ :: (Binary.Binary a) => a -> PutState s ()
  26 putZ x = State.lift (Binary.put x)
  27
  28 getZ :: (Binary.Binary a) => GetState s a
  29 getZ = State.lift Binary.get
  30
  31 ------------------------------------------------
  32
  33 encodeS :: (BinaryState s a) => s -> a -> B.ByteString
  34 encodeS s a = Put.runPut $ State.evalStateT (put a) s
  35
  36 decodeS :: (BinaryState s a) => s -> B.ByteString -> a
  37 decodeS s str = Get.runGet (State.evalStateT get s) str
  38
  39 decodeWith :: GetState s a -> s -> B.ByteString -> a
  40 decodeWith getter s str =
  41   let (x,_,_) = Get.runGetState (State.evalStateT getter s) str 0
  42   in  x
  43
  44 encodeFile :: BinaryState s a => FilePath -> s -> a -> IO ()
  45 encodeFile f s v = B.writeFile f (encodeS s v)
  46
  47 decodeFile :: BinaryState s a => FilePath -> s -> IO a
  48 decodeFile f s = liftM (decodeS s) (B.readFile f)
  49
  50 ------------------------------------------------
  51
  52 getByte :: GetState s Word8
  53 getByte = State.lift Binary.getWord8
  54
  55 liftOffset :: (Binary.Binary a) => Integer -> (a -> Binary.Put) -> a -> PutState Integer ()
  56 liftOffset d fn x = State.modify (+d) >> State.lift (fn x)
  57
  58 putByte :: Word8 -> PutState Integer ()
  59 putByte x = liftOffset 1 Put.putWord8 x
  60
  61 isEmpty :: GetState s Bool
  62 isEmpty = State.lift Get.isEmpty
  63
  64 skip :: Int -> GetState s ()
  65 skip n = State.lift (Get.skip n)
  66
  67 getOffset :: PutState Integer Integer
  68 getOffset = State.get
  69
  70 bytesRead :: GetState s Int64
  71 bytesRead = State.lift Get.bytesRead
  72
  73 --------------------------------------------------
  74
  75 instance BinaryState Integer Word8 where
  76   put x = putByte x
  77   get = getZ
  78
  79 instance BinaryState Integer Word16 where
  80   put x = liftOffset 2 Binary.put x
  81   get = getZ
  82
  83 instance BinaryState Integer Word32 where
  84   put x = liftOffset 4 Binary.put x
  85   get = getZ
  86
  87 instance (BinaryState s a, BinaryState s b) => BinaryState s (a,b) where
  88   put (x,y) = put x >> put y
  89   get = do
  90     x <- get
  91     y <- get
  92     return (x,y)
  93
  94 --------------------------------------------------
  95
  96 -- instance (Binary.Binary a, Storable a) => BinaryState Integer a where
  97 --   put x = liftOffset (fromIntegral $ sizeOf x) Binary.put x
  98 --   get = getZ