cereal 0.3.5.2 → 0.4.0.0
raw patch · 4 files changed
+76/−27 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- cereal.cabal +2/−2
- src/Data/Serialize.hs +33/−2
- src/Data/Serialize/Get.hs +32/−21
- src/Data/Serialize/IEEE754.hs +9/−2
cereal.cabal view
@@ -1,5 +1,5 @@ name: cereal-version: 0.3.5.2+version: 0.4.0.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin <kolmodin@dtek.chalmers.se>,@@ -57,5 +57,5 @@ Rank2Types, MagicHash - ghc-options: -Wall -funbox-strict-fields+ ghc-options: -Wall -O2 -funbox-strict-fields ghc-prof-options: -prof -auto-all
src/Data/Serialize.hs view
@@ -7,8 +7,7 @@ , TypeOperators , BangPatterns , KindSignatures- , ScopedTypeVariables- #-}+ , ScopedTypeVariables #-} #endif -----------------------------------------------------------------------------@@ -55,6 +54,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Map as Map+import qualified Data.Monoid as M import qualified Data.Set as Set import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet@@ -344,6 +344,37 @@ put (a,b,c,d,e,f,g,h,i,j) = put (a,(b,c,d,e,f,g,h,i,j)) get = do (a,(b,c,d,e,f,g,h,i,j)) <- get return (a,b,c,d,e,f,g,h,i,j)++------------------------------------------------------------------------+-- Monoid newtype wrappers++instance Serialize a => Serialize (M.Dual a) where+ put = put . M.getDual+ get = fmap M.Dual get++instance Serialize M.All where+ put = put . M.getAll+ get = fmap M.All get++instance Serialize M.Any where+ put = put . M.getAny+ get = fmap M.Any get++instance Serialize a => Serialize (M.Sum a) where+ put = put . M.getSum+ get = fmap M.Sum get++instance Serialize a => Serialize (M.Product a) where+ put = put . M.getProduct+ get = fmap M.Product get++instance Serialize a => Serialize (M.First a) where+ put = put . M.getFirst+ get = fmap M.First get++instance Serialize a => Serialize (M.Last a) where+ put = put . M.getLast+ get = fmap M.Last get ------------------------------------------------------------------------ -- Container types
src/Data/Serialize/Get.hs view
@@ -112,7 +112,7 @@ #endif -- | The result of a parse.-data Result r = Fail String+data Result r = Fail String B.ByteString -- ^ The parse failed. The 'String' is the -- message describing the error, if any. | Partial (B.ByteString -> Result r)@@ -125,14 +125,14 @@ -- the parse succeeded. instance Show r => Show (Result r) where- show (Fail msg) = "Fail " ++ show msg- show (Partial _) = "Partial _"- show (Done r bs) = "Done " ++ show r ++ " " ++ show bs+ show (Fail msg _) = "Fail " ++ show msg+ show (Partial _) = "Partial _"+ show (Done r bs) = "Done " ++ show r ++ " " ++ show bs instance Functor Result where- fmap _ (Fail msg) = Fail msg- fmap f (Partial k) = Partial (fmap f . k)- fmap f (Done r bs) = Done (f r) bs+ fmap _ (Fail msg rest) = Fail msg rest+ fmap f (Partial k) = Partial (fmap f . k)+ fmap f (Done r bs) = Done (f r) bs -- | The Get monad is an Exception and State monad. newtype Get a = Get@@ -222,13 +222,14 @@ finalK s _ _ a = Done a s failK :: Failure a-failK _ _ _ ls s = Fail (unlines [s, formatTrace ls])+failK s b _ ls msg =+ Fail (unlines [msg, formatTrace ls]) (s `B.append` bufferBytes b) -- | Run the Get monad applies a 'get'-based parser on the input ByteString runGet :: Get a -> B.ByteString -> Either String a runGet m str = case unGet m str Nothing Complete failK finalK of- Fail i -> Left i+ Fail i _ -> Left i Done a _ -> Right a Partial{} -> Left "Failed reading: Internal error: unexpected Partial." {-# INLINE runGet #-}@@ -244,14 +245,25 @@ -- consumed bytes and the rest of the input. runGetState :: Get a -> B.ByteString -> Int -> Either String (a, B.ByteString)-runGetState m str off =- case unGet m (B.drop off str) Nothing Complete failK finalK of- Fail i -> Left i- Done a bs -> Right (a, bs)- Partial{} -> Left "Failed reading: Internal error: unexpected Partial."+runGetState m str off = case runGetState' m str off of+ (Right a,bs) -> Right (a,bs)+ (Left i,_) -> Left i {-# INLINE runGetState #-} +-- | Run the Get monad applies a 'get'-based parser on the input+-- ByteString. Additional to the result of get it returns the number of+-- consumed bytes and the rest of the input, even in the event of a failure.+runGetState' :: Get a -> B.ByteString -> Int+ -> (Either String a, B.ByteString)+runGetState' m str off =+ case unGet m (B.drop off str) Nothing Complete failK finalK of+ Fail i bs -> (Left i,bs)+ Done a bs -> (Right a, bs)+ Partial{} -> (Left "Failed reading: Internal error: unexpected Partial.",B.empty)+{-# INLINE runGetState' #-} ++ -- Lazy Get -------------------------------------------------------------------- runGetLazy' :: Get a -> L.ByteString -> (Either String a,L.ByteString)@@ -263,15 +275,14 @@ loop k chunks = case chunks of c:cs -> case k c of- Fail str -> (Left str,L.empty)- Partial k' -> loop k' cs- Done r c' -> (Right r,L.fromChunks (c':cs))+ Fail str rest -> (Left str,L.fromChunks [rest])+ Partial k' -> loop k' cs+ Done r c' -> (Right r,L.fromChunks (c':cs)) [] -> case k B.empty of- Fail str -> (Left str,L.empty)- Partial k' -> (Left "Failed reading: Internal error: unexpected end of input",L.empty)- Done r c' -> (Right r,L.empty)-+ Fail str rest -> (Left str,L.fromChunks [rest])+ Partial _ -> (Left "Failed reading: Internal error: unexpected end of input",L.empty)+ Done r rest -> (Right r,L.fromChunks [rest]) {-# INLINE runGetLazy' #-} -- | Run the Get monad over a Lazy ByteString. Note that this will not run the
src/Data/Serialize/IEEE754.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-} -- | 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+-- <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 ( @@ -23,10 +24,16 @@ import Control.Applicative ( (<$>) ) import Control.Monad.ST ( runST, ST ) -import Data.Array.ST ( newArray, castSTUArray, readArray, MArray, STUArray )+import Data.Array.ST ( newArray, readArray, MArray, STUArray ) import Data.Word ( Word32, Word64 ) import Data.Serialize.Get import Data.Serialize.Put++#if __GLASGOW_HASKELL__ >= 704+import Data.Array.Unsafe (castSTUArray)+#else+import Data.Array.ST (castSTUArray)+#endif -- | Read a Float in little endian IEEE-754 format getFloat32le :: Get Float