cereal 0.3.3.0 → 0.3.4.0

raw patch · 4 files changed

+93/−2 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• cereal.cabal +3/−2
• src/Data/Serialize.hs +2/−0
• src/Data/Serialize/IEEE754.hs +83/−0
• tests/Tests.hs +5/−0

@@ -1,5 +1,5 @@ name:                   cereal-version:                0.3.3.0+version:                0.3.4.0 license:                BSD3 license-file:           LICENSE author:                 Lennart Kolmodin <kolmodin@dtek.chalmers.se>,@@ -39,7 +39,8 @@         exposed-modules:        Data.Serialize,                                 Data.Serialize.Put,                                 Data.Serialize.Get,-                                Data.Serialize.Builder+                                Data.Serialize.Builder,+                                Data.Serialize.IEEE754          extensions:             CPP,                                 FlexibleContexts,

@@ -26,11 +26,13 @@      , module Data.Serialize.Get     , module Data.Serialize.Put+    , module Data.Serialize.IEEE754      ) where  import Data.Serialize.Put import Data.Serialize.Get+import Data.Serialize.IEEE754  import Control.Monad import Data.Array.Unboxed

@@ -0,0 +1,83 @@+{-# LANGUAGE FlexibleContexts #-}++-- | IEEE-754 parsing, as described in this stack-overflow article:+--+-- http://stackoverflow.com/questions/6976684/converting-ieee-754-floating-point-in-haskell-word32-64-to-and-from-haskell-float/7002812#7002812++module Data.Serialize.IEEE754 (++    -- * IEEE-754 reads+      getFloat32le+    , getFloat32be+    , getFloat64le+    , getFloat64be++    -- * IEEE-754 writes+    , putFloat32le+    , putFloat32be+    , putFloat64le+    , putFloat64be++) where++import Control.Applicative ( (<$>) )+import Control.Monad.ST ( runST, ST )++import Data.Array.ST ( newArray, castSTUArray, readArray, MArray, STUArray )+import Data.Word ( Word32, Word64 )+import Data.Serialize.Get+import Data.Serialize.Put++-- | Read a Float in little endian IEEE-754 format+getFloat32le :: Get Float+getFloat32le = wordToFloat <$> getWord32le++-- | Read a Float in big endian IEEE-754 format+getFloat32be :: Get Float+getFloat32be = wordToFloat <$> getWord32be++-- | Read a Double in little endian IEEE-754 format+getFloat64le :: Get Double+getFloat64le = wordToDouble <$> getWord64le++-- | Read a Double in big endian IEEE-754 format+getFloat64be :: Get Double+getFloat64be = wordToDouble <$> getWord64be++-- | Write a Float in little endian IEEE-754 format+putFloat32le :: Float -> Put+putFloat32le = putWord32le . floatToWord++-- | Write a Float in big endian IEEE-754 format+putFloat32be :: Float -> Put+putFloat32be = putWord32be . floatToWord++-- | Write a Double in little endian IEEE-754 format+putFloat64le :: Double -> Put+putFloat64le = putWord64le . doubleToWord++-- | Write a Double in big endian IEEE-754 format+putFloat64be :: Double -> Put+putFloat64be = putWord64be . doubleToWord++{-# INLINE wordToFloat #-}+wordToFloat :: Word32 -> Float+wordToFloat x = runST (cast x)++{-# INLINE floatToWord #-}+floatToWord :: Float -> Word32+floatToWord x = runST (cast x)++{-# INLINE wordToDouble #-}+wordToDouble :: Word64 -> Double+wordToDouble x = runST (cast x)++{-# INLINE doubleToWord #-}+doubleToWord :: Double -> Word64+doubleToWord x = runST (cast x)++{-# INLINE cast #-}+cast :: (MArray (STUArray s) a (ST s),+         MArray (STUArray s) b (ST s)) =>+        a -> ST s b+cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0

@@ -14,6 +14,7 @@ import Data.Serialize import Data.Serialize.Get import Data.Serialize.Put+import Data.Serialize.IEEE754 import Data.Word (Word8,Word16,Word32,Word64) import Test.QuickCheck as QC @@ -34,6 +35,10 @@   , QC.label "Word16host    Round Trip" $ roundTrip putWord16host getWord16host   , QC.label "Word32host    Round Trip" $ roundTrip putWord32host getWord32host   , QC.label "Word64host    Round Trip" $ roundTrip putWord64host getWord64host+  , QC.label "Float32le     Round Trip" $ roundTrip putFloat32le  getFloat32le+  , QC.label "Float32be     Round Trip" $ roundTrip putFloat32be  getFloat32be+  , QC.label "Float64le     Round Trip" $ roundTrip putFloat64le  getFloat64le+  , QC.label "Float64be     Round Trip" $ roundTrip putFloat64be  getFloat64be      -- Containers   , QC.label "(Word8,Word8) Round Trip"