summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdwardKmett <>2013-03-30 06:17:29 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-03-30 06:17:29 (GMT)
commit3b07fe0cbbfe408170b72153818217dcdbbdc95b (patch)
tree848903028fb5507f259b4c42109b0a66e36c2e8d
parent5aeee1916f1fcf5a59285f9ee18c1bc4a4b247f1 (diff)
version 0.50.5
-rw-r--r--CHANGELOG.markdown4
-rw-r--r--bytes.cabal2
-rw-r--r--src/Data/Bytes/Get.hs18
-rw-r--r--src/Data/Bytes/Put.hs3
-rw-r--r--src/Data/Bytes/Serial.hs44
5 files changed, 68 insertions, 3 deletions
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index 9af9fae..1c10b10 100644
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,7 @@
+0.4
+---
+* Added a missing () instance
+
0.3
-----
* Added `Serial2` and various missing `Serial1` instances.
diff --git a/bytes.cabal b/bytes.cabal
index bb1b735..9776279 100644
--- a/bytes.cabal
+++ b/bytes.cabal
@@ -1,6 +1,6 @@
name: bytes
category: Data, Serialization
-version: 0.3
+version: 0.5
license: BSD3
cabal-version: >= 1.8
license-file: LICENSE
diff --git a/src/Data/Bytes/Get.hs b/src/Data/Bytes/Get.hs
index af4e245..5aaf36e 100644
--- a/src/Data/Bytes/Get.hs
+++ b/src/Data/Bytes/Get.hs
@@ -21,6 +21,7 @@ module Data.Bytes.Get
( MonadGet(..)
) where
+import Control.Applicative
import Control.Monad.Reader
import Control.Monad.RWS.Lazy as Lazy
import Control.Monad.RWS.Strict as Strict
@@ -35,7 +36,7 @@ import Data.Int
import qualified Data.Serialize.Get as S
import Data.Word
-class (Integral (Unchecked m), Monad m) => MonadGet m where
+class (Integral (Unchecked m), Monad m, Applicative m) => MonadGet m where
-- | An 'Integral' number type used for unchecked skips and counting.
type Unchecked m :: *
@@ -56,6 +57,14 @@ class (Integral (Unchecked m), Monad m) => MonadGet m where
uncheckedSkip = lift . uncheckedSkip
#endif
+ -- | If at least @n@ bytes are available return at least that much of the current input.
+ -- Otherwise fail.
+ ensure :: Int -> m Strict.ByteString
+#ifndef HLINT
+ default ensure :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m Strict.ByteString
+ ensure = lift . ensure
+#endif
+
-- | Run @ga@, but return without consuming its input.
-- Fails if @ga@ fails.
lookAhead :: m a -> m a
@@ -210,6 +219,11 @@ instance MonadGet B.Get where
{-# INLINE lookAheadE #-}
uncheckedLookAhead = B.uncheckedLookAhead
{-# INLINE uncheckedLookAhead #-}
+ ensure n = do
+ bs <- lookAhead $ getByteString n
+ unless (Strict.length bs >= n) $ fail "ensure: Required more bytes"
+ return bs
+ {-# INLINE ensure #-}
getBytes = B.getBytes
{-# INLINE getBytes #-}
remaining = B.remaining
@@ -260,6 +274,8 @@ instance MonadGet S.Get where
{-# INLINE uncheckedLookAhead #-}
getBytes = S.getBytes
{-# INLINE getBytes #-}
+ ensure = S.ensure
+ {-# INLINE ensure #-}
remaining = S.remaining
{-# INLINE remaining #-}
isEmpty = S.isEmpty
diff --git a/src/Data/Bytes/Put.hs b/src/Data/Bytes/Put.hs
index 18209e7..df7c1a1 100644
--- a/src/Data/Bytes/Put.hs
+++ b/src/Data/Bytes/Put.hs
@@ -24,6 +24,7 @@ module Data.Bytes.Put
( MonadPut(..)
) where
+import Control.Applicative
import Control.Monad.Reader
import Control.Monad.RWS.Lazy as Lazy
import Control.Monad.RWS.Strict as Strict
@@ -41,7 +42,7 @@ import Data.Word
-- MonadPut
------------------------------------------------------------------------------
-class Monad m => MonadPut m where
+class (Applicative m, Monad m) => MonadPut m where
-- | Efficiently write a byte into the output buffer
putWord8 :: Word8 -> m ()
#ifndef HLINT
diff --git a/src/Data/Bytes/Serial.hs b/src/Data/Bytes/Serial.hs
index 4c66b03..29af74d 100644
--- a/src/Data/Bytes/Serial.hs
+++ b/src/Data/Bytes/Serial.hs
@@ -4,7 +4,11 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE Trustworthy #-}
+#endif
--------------------------------------------------------------------
-- |
-- Copyright : (c) Edward Kmett 2013
@@ -26,14 +30,22 @@ module Data.Bytes.Serial
, Serial1(..), serialize1, deserialize1
, GSerial1(..)
, Serial2(..), serialize2, deserialize2
+ , store, restore
) where
import Control.Monad
import Data.Bytes.Get
import Data.Bytes.Put
+import Data.ByteString.Internal
+import Data.ByteString.Lazy as Lazy
+import Data.ByteString as Strict
import Data.Int
import Data.Word
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.Storable
import GHC.Generics
+import System.IO.Unsafe
------------------------------------------------------------------------------
-- Serialization
@@ -52,6 +64,19 @@ class Serial a where
deserialize = liftM to gdeserialize
#endif
+instance Serial Strict.ByteString where
+ serialize bs = putWord32host (fromIntegral (Strict.length bs)) >> putByteString bs
+ deserialize = do
+ n <- getWord32host
+ getByteString (fromIntegral n)
+
+instance Serial Lazy.ByteString where
+ serialize bs = putWord64host (fromIntegral (Lazy.length bs)) >> putLazyByteString bs
+ deserialize = do
+ n <- getWord64host
+ getLazyByteString (fromIntegral n)
+
+instance Serial ()
instance Serial a => Serial [a]
instance Serial a => Serial (Maybe a)
instance (Serial a, Serial b) => Serial (Either a b)
@@ -62,6 +87,25 @@ instance (Serial a, Serial b, Serial c, Serial d, Serial e) => Serial (a, b, c,
instance Serial Bool
+store :: (MonadPut m, Storable a) => a -> m ()
+store a = putByteString bs
+ where bs = unsafePerformIO $ create (sizeOf a) $ \ p -> poke (castPtr p) a
+
+restore :: forall m a. (MonadGet m, Storable a) => m a
+restore = do
+ let required = sizeOf (undefined :: a)
+ PS fp o n <- getByteString required
+ unless (n >= required) $ fail "restore: Required more bytes"
+ return $ unsafePerformIO $ withForeignPtr fp $ \p -> peekByteOff p o
+
+instance Serial Double where
+ serialize = store
+ deserialize = restore
+
+instance Serial Float where
+ serialize = store
+ deserialize = restore
+
instance Serial Char where
serialize = putWord32host . fromIntegral . fromEnum
deserialize = liftM (toEnum . fromIntegral) getWord32host