summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdwardKmett <>2014-02-21 13:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-02-21 13:32:00 (GMT)
commit1522840f79fdaca9bc2df81f98f872e1afcba267 (patch)
tree001fbe14dd58f8ddd73ed4ff26c45b844ddb781d
parentb40dd0587db8464a871e37f79af5cbeb378aa985 (diff)
version 0.140.14
-rw-r--r--.gitignore13
-rw-r--r--CHANGELOG.markdown5
-rw-r--r--bytes.cabal8
-rw-r--r--src/Data/Bytes/Serial.hs210
-rw-r--r--src/Data/Bytes/Signed.hs12
-rw-r--r--src/Data/Bytes/VarInt.hs38
6 files changed, 228 insertions, 58 deletions
diff --git a/.gitignore b/.gitignore
deleted file mode 100644
index bbcd5d4..0000000
--- a/.gitignore
+++ /dev/null
@@ -1,13 +0,0 @@
-dist
-docs
-wiki
-TAGS
-tags
-wip
-.DS_Store
-.*.swp
-.*.swo
-*.o
-*.hi
-*~
-*#
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index cd21508..ef1abb3 100644
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,8 @@
+0.14
+----
+* Lots of new instances
+* `text` bound bump to allow 1.1.
+
0.13.0.1
--------
* Bumped dependency on `text` to support 1.0
diff --git a/bytes.cabal b/bytes.cabal
index 6b9afdf..3768067 100644
--- a/bytes.cabal
+++ b/bytes.cabal
@@ -1,6 +1,6 @@
name: bytes
category: Data, Serialization
-version: 0.13.0.1
+version: 0.14
license: BSD3
cabal-version: >= 1.8
license-file: LICENSE
@@ -32,10 +32,13 @@ source-repository head
-- You can disable the doctests test suite with -f-test-doctests
flag test-doctests
+ description: Enable (or disable via f-test-doctests) the doctest suite when
+ using the enable-tests option for cabal.
default: True
manual: True
flag lib-Werror
+ description: Treat warnings as errors when building.
default: False
manual: True
@@ -48,7 +51,8 @@ library
containers >= 0.3 && < 1,
ghc-prim,
mtl >= 2.0 && < 2.2,
- text >= 0.2 && < 1.1,
+ text >= 0.2 && < 1.2,
+ time >= 1.2 && < 1.5,
transformers >= 0.2 && < 0.4,
transformers-compat >= 0.1 && < 1,
void >= 0.6 && < 0.7
diff --git a/src/Data/Bytes/Serial.hs b/src/Data/Bytes/Serial.hs
index adb27bf..055e9ef 100644
--- a/src/Data/Bytes/Serial.hs
+++ b/src/Data/Bytes/Serial.hs
@@ -45,14 +45,26 @@ module Data.Bytes.Serial
, GSerial1(..)
) where
+import Control.Applicative
import Control.Monad
import qualified Data.Foldable as F
import Data.Bytes.Get
import Data.Bytes.Put
+import Data.Bytes.Signed
+import Data.Bytes.VarInt
import Data.ByteString.Internal
import Data.ByteString.Lazy as Lazy
import Data.ByteString as Strict
import Data.Int
+import Data.Bits
+import Data.Monoid as Monoid
+import Data.Ord (Down(..))
+import Data.Functor.Identity as Functor
+import Data.Functor.Constant as Functor
+import Data.Functor.Product as Functor
+import Data.Functor.Reverse as Functor
+import Data.Time
+import Data.Time.Clock.TAI
import qualified Data.IntMap as IMap
import qualified Data.IntSet as ISet
import qualified Data.Map as Map
@@ -62,8 +74,11 @@ import Data.Text as SText
import Data.Text.Encoding as SText
import Data.Text.Lazy as LText
import Data.Text.Lazy.Encoding as LText
+import Data.Version (Version(..))
import Data.Void
import Data.Word
+import Data.Fixed
+import Data.Ratio
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
@@ -328,6 +343,201 @@ instance (Serial k, Serial v, Ord k) => Serial (Map.Map k v) where
serialize = serializeWith serialize
deserialize = deserializeWith deserialize
+putVarInt :: (MonadPut m, Integral a, Bits a) => a -> m ()
+putVarInt n
+ | n < 0x80 = putWord8 $ fromIntegral n
+ | otherwise = do
+ putWord8 $ setBit (fromIntegral n) 7
+ putVarInt $ shiftR n 7
+{-# INLINE putVarInt #-}
+
+getVarInt :: (MonadGet m, Num b, Bits b) => Word8 -> m b
+getVarInt n
+ | testBit n 7 = do
+ VarInt m <- getWord8 >>= getVarInt
+ return $ shiftL m 7 .|. clearBit (fromIntegral n) 7
+ | otherwise = return $ fromIntegral n
+{-# INLINE getVarInt #-}
+
+-- |
+-- $setup
+-- >>> import Data.Word
+-- >>> import Data.Fixed
+-- >>> import Data.Bytes.Serial
+
+-- | Integer/Word types serialized to base-128 variable-width ints.
+--
+-- >>> import Data.Monoid (mconcat)
+-- >>> import qualified Data.ByteString.Lazy as BSL
+-- >>> mconcat $ BSL.toChunks $ runPutL $ serialize (97 :: Word64)
+-- "\NUL\NUL\NUL\NUL\NUL\NUL\NULa"
+-- >>> mconcat $ BSL.toChunks $ runPutL $ serialize (97 :: VarInt Word64)
+-- "a"
+instance (Bits n, Integral n, Bits (Unsigned n), Integral (Unsigned n)) => Serial (VarInt n) where
+ serialize (VarInt n) = putVarInt $ unsigned n
+ {-# INLINE serialize #-}
+ deserialize = getWord8 >>= getVarInt
+ {-# INLINE deserialize #-}
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (1822304234^100::Integer))::Integer
+-- 115368812579128172803867366576339947332796540054052185472042218522037227934707037623902492207671987696439966697503243972076991940820348847422930433939639982092916577692754723458548819441583937289395076910527534916776189405228720063994377687015476947534961767053653973945346259230972683338173842343243493433367681264359887291905132383269175086733345253389374961758293922003996035662362278340494093804835649459223465051596978792130073960666112508481814461273829244289795707398202762289955919352549768394583446336873179280924584333491364188425976869717125645749497258775598562132278030402205794994603544837805140410310712693778605743100915046769381631247123664460203591228745772887977959388457679427407639421147498028487544882346912935398848298806021505673449774474457435816552278997100556732447852816961683577731381792363312695347606768120122976105200574809419685234274705929886121600174028733812771637390342332436695318974693376
+instance Serial Integer where
+ serialize = serialize . VarInt
+ deserialize = unVarInt `liftM` deserialize
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (1.82::Fixed E2))::Fixed E2
+-- 1.82
+instance HasResolution a => Serial (Fixed a) where
+ serialize f =
+ serialize i
+ where
+ i :: Integer
+ i = truncate . (* r) $ f
+ r = fromInteger $ resolution f
+ deserialize =
+ (((flip (/)) (fromInteger $ resolution (undefined::Fixed a))) . fromInteger) `liftM` deserialize
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (1.82::DiffTime))::DiffTime
+-- 1.82s
+instance Serial DiffTime where
+ serialize = serialize . (fromRational . toRational::DiffTime -> Pico)
+ deserialize = (fromRational . toRational::Pico -> DiffTime) `liftM` deserialize
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (1.82::DiffTime))::DiffTime
+-- 1.82s
+instance Serial NominalDiffTime where
+ serialize = serialize . (fromRational . toRational::NominalDiffTime -> Pico)
+ deserialize = (fromRational . toRational::Pico -> NominalDiffTime) `liftM` deserialize
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (ModifiedJulianDay 1))::Day
+-- 1858-11-18
+instance Serial Day where
+ serialize = serialize . toModifiedJulianDay
+ deserialize = ModifiedJulianDay `liftM` deserialize
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (read "2014-01-01 10:54:42.478031 UTC"::UTCTime))::UTCTime
+-- 2014-01-01 10:54:42.478031 UTC
+instance Serial UTCTime where
+ serialize (UTCTime d t) = serialize (d, t)
+ deserialize = deserialize >>= (\(d, t) -> return $ UTCTime d t)
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (addAbsoluteTime 18.2 taiEpoch))::AbsoluteTime
+-- 1858-11-17 00:00:18.2 TAI
+instance Serial AbsoluteTime where
+ serialize = serialize . ((flip diffAbsoluteTime) taiEpoch)
+ deserialize = ((flip addAbsoluteTime) taiEpoch) `liftM` deserialize
+
+-- |
+-- >>> (runGetL deserialize $ runPutL $ serialize (5 % 11::Ratio Int))::Ratio Int
+-- 5 % 11
+instance (Serial a, Integral a) => Serial (Ratio a) where
+ serialize r = serialize (numerator r, denominator r)
+ deserialize = (\(n, d) -> n % d) `liftM` deserialize
+
+-- |
+-- >>> getModJulianDate $ (runGetL deserialize $ runPutL $ serialize (ModJulianDate $ 5 % 11)::UniversalTime)
+-- 5 % 11
+instance Serial UniversalTime where
+ serialize = serialize . getModJulianDate
+ deserialize = ModJulianDate `liftM` deserialize
+
+instance Serial TimeZone where
+ serialize (TimeZone m s n) = serialize (m, s, n)
+ deserialize = (\(m, s, n) -> TimeZone m s n) `liftM` deserialize
+
+instance Serial TimeOfDay where
+ serialize (TimeOfDay h m s) = serialize (h, m, s)
+ deserialize = (\(h, m, s) -> TimeOfDay h m s) `liftM` deserialize
+
+instance Serial LocalTime where
+ serialize (LocalTime d t) = serialize (d, t)
+ deserialize = (\(d, t) -> LocalTime d t) `liftM` deserialize
+
+instance Serial ZonedTime where
+ serialize (ZonedTime l z) = serialize (l, z)
+ deserialize = (\(l, z) -> ZonedTime l z) `liftM` deserialize
+
+-- |
+-- >>> runGetL deserialize $ runPutL $ serialize LT::Ordering
+-- LT
+-- >>> runGetL deserialize $ runPutL $ serialize EQ::Ordering
+-- EQ
+-- >>> runGetL deserialize $ runPutL $ serialize GT::Ordering
+-- GT
+instance Serial Ordering where
+ serialize = serialize . (fromIntegral::Int -> Int8) . fromEnum
+ deserialize = (toEnum . (fromIntegral::Int8 -> Int)) `liftM` deserialize
+
+instance Serial a => Serial (Down a) where
+ serialize (Down a) = serialize a
+ deserialize = Down `liftM` deserialize
+
+instance Serial Version where
+ serialize (Version vb ts) = serialize (fmap VarInt vb, ts)
+ deserialize = do (vb,ts) <- deserialize
+ return $ Version (fmap unVarInt vb) ts
+
+instance Serial a => Serial (ZipList a) where
+ serialize = serialize . getZipList
+ deserialize = ZipList <$> deserialize
+
+instance Serial a => Serial (Identity a) where
+ serialize = serialize . runIdentity
+ deserialize = Identity `liftM` deserialize
+
+instance Serial a => Serial (Constant a b) where
+ serialize = serialize . getConstant
+ deserialize = Constant `liftM` deserialize
+
+instance (Serial (f a), Serial (g a)) => Serial (Functor.Product f g a) where
+ serialize (Pair f g) = serialize (f, g)
+ deserialize = uncurry Pair `liftM` deserialize
+
+instance Serial (f a) => Serial (Reverse f a) where
+ serialize = serialize . getReverse
+ deserialize = Reverse `liftM` deserialize
+
+------------------------------------------------------------------------------
+-- Serialization for newtypes from 'Data.Monoid'
+------------------------------------------------------------------------------
+
+instance Serial a => Serial (Dual a) where
+ serialize = serialize . getDual
+ deserialize = Dual `liftM` deserialize
+
+instance Serial All where
+ serialize = serialize . getAll
+ deserialize = All `liftM` deserialize
+
+instance Serial Any where
+ serialize = serialize . getAny
+ deserialize = Any `liftM` deserialize
+
+instance Serial a => Serial (Sum a) where
+ serialize = serialize . getSum
+ deserialize = Sum `liftM` deserialize
+
+instance Serial a => Serial (Monoid.Product a) where
+ serialize = serialize . getProduct
+ deserialize = Product `liftM` deserialize
+
+instance Serial a => Serial (First a) where
+ serialize = serialize . getFirst
+ deserialize = First `liftM` deserialize
+
+instance Serial a => Serial (Last a) where
+ serialize = serialize . getLast
+ deserialize = Last `liftM` deserialize
+
+
+
------------------------------------------------------------------------------
-- Generic Serialization
------------------------------------------------------------------------------
diff --git a/src/Data/Bytes/Signed.hs b/src/Data/Bytes/Signed.hs
index 3280ac4..0b016f9 100644
--- a/src/Data/Bytes/Signed.hs
+++ b/src/Data/Bytes/Signed.hs
@@ -26,6 +26,7 @@ type instance Unsigned Int8 = Word8
type instance Unsigned Int16 = Word16
type instance Unsigned Int32 = Word32
type instance Unsigned Int64 = Word64
+type instance Unsigned Integer = Integer
type instance Unsigned Word = Word
type instance Unsigned Word8 = Word8
@@ -37,11 +38,12 @@ unsigned :: (Integral i, Num (Unsigned i)) => i -> Unsigned i
unsigned = fromIntegral
type family Signed i :: *
-type instance Signed Int = Int
-type instance Signed Int8 = Int8
-type instance Signed Int16 = Int16
-type instance Signed Int32 = Int32
-type instance Signed Int64 = Int64
+type instance Signed Int = Int
+type instance Signed Int8 = Int8
+type instance Signed Int16 = Int16
+type instance Signed Int32 = Int32
+type instance Signed Int64 = Int64
+type instance Signed Integer = Integer
type instance Signed Word = Int
type instance Signed Word8 = Int8
diff --git a/src/Data/Bytes/VarInt.hs b/src/Data/Bytes/VarInt.hs
index 095c4d1..ab895e8 100644
--- a/src/Data/Bytes/VarInt.hs
+++ b/src/Data/Bytes/VarInt.hs
@@ -24,49 +24,11 @@ module Data.Bytes.VarInt
) where
import Data.Bits
-import Data.Bytes.Get
-import Data.Bytes.Put
-import Data.Bytes.Serial
import Data.Bytes.Signed
-import Data.Word
--- $setup
--- >>> import Data.Word
--- >>> import Data.Bytes.Serial
-
--- | Integer/Word types serialized to base-128 variable-width ints.
---
--- >>> import Data.Monoid (mconcat)
--- >>> import Data.ByteString.Lazy (toChunks)
--- >>> mconcat $ toChunks $ runPutL $ serialize (97 :: Word64)
--- "\NUL\NUL\NUL\NUL\NUL\NUL\NULa"
--- >>> mconcat $ toChunks $ runPutL $ serialize (97 :: VarInt Word64)
--- "a"
newtype VarInt n = VarInt { unVarInt :: n }
deriving (Eq, Ord, Show, Enum, Num, Integral, Bounded, Real, Bits)
type instance Unsigned (VarInt n) = VarInt (Unsigned n)
type instance Signed (VarInt n) = VarInt (Signed n)
-instance (Bits n, Integral n, Bits (Unsigned n), Integral (Unsigned n)) => Serial (VarInt n) where
- serialize (VarInt n) = putVarInt $ unsigned n
- {-# INLINE serialize #-}
-
- deserialize = getWord8 >>= getVarInt
- {-# INLINE deserialize #-}
-
-putVarInt :: (MonadPut m, Integral a, Bits a) => a -> m ()
-putVarInt n
- | n < 0x80 = putWord8 $ fromIntegral n
- | otherwise = do
- putWord8 $ setBit (fromIntegral n) 7
- putVarInt $ shiftR n 7
-{-# INLINE putVarInt #-}
-
-getVarInt :: (MonadGet m, Num b, Bits b) => Word8 -> m b
-getVarInt n
- | testBit n 7 = do
- VarInt m <- getWord8 >>= getVarInt
- return $ shiftL m 7 .|. clearBit (fromIntegral n) 7
- | otherwise = return $ fromIntegral n
-{-# INLINE getVarInt #-}