bytes-0.17.3/0000755000000000000000000000000007346545000011121 5ustar0000000000000000bytes-0.17.3/.gitignore0000644000000000000000000000043007346545000013106 0ustar0000000000000000dist dist-newstyle docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# .stack-work/ cabal-dev *.chi *.chs.h *.dyn_o *.dyn_hi .hpc .hsenv .cabal-sandbox/ cabal.sandbox.config *.prof *.aux *.hp *.eventlog cabal.project.local cabal.project.local~ .HTF/ .ghc.environment.* bytes-0.17.3/.hlint.yaml0000644000000000000000000000011507346545000013176 0ustar0000000000000000- arguments: [--cpp-define=HLINT, --cpp-ansi] - ignore: {name: Use uncurry} bytes-0.17.3/.vim.custom0000644000000000000000000000137707346545000013236 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" bytes-0.17.3/AUTHORS.markdown0000644000000000000000000000141207346545000014010 0ustar0000000000000000Analytics was started by [Edward Kmett](https://github.com/ekmett) in response to a question by [Alec Heller](https://github.com/deviant-logic) about if he should use `bound` to implement datalog. It has since somewhat expanded in scope. `bytes` was spun out of work that was being done on the `analytics` repository, mainly because Edward was sick of duplicating code to work with [`binary`](http://hackage.haskell.org/package/binary) and [`cereal`](http://hackage.haskell.org/package/cereal). You can watch contributors carry on the quest for bragging rights in the [contributors graph](https://github.com/analytics/bytes/graphs/contributors). Omission from this list is by no means an attempt to discount your contribution. Thank you for all of your help! -Edward Kmett bytes-0.17.3/CHANGELOG.markdown0000644000000000000000000000674107346545000014164 0ustar00000000000000000.17.3 [2023.08.06] ------------------- * Remove `mtl` dependency in favor `transformers`, as `bytes` was only using `mtl` for its `transformers` re-exports. 0.17.2 [2022.05.07] ------------------- * Allow building with `mtl-2.3.*` and `transformers-0.6.*`. 0.17.1 [2021.02.17] ------------------- * The build-type has been changed from `Custom` to `Simple`. To achieve this, the `doctests` test suite has been removed in favor of using [`cabal-docspec`](https://github.com/phadej/cabal-extras/tree/master/cabal-docspec) to run the doctests. * Provide the `Serial Natural` instance unconditionally. * Allow building with `bytestring-0.11.*`. 0.17 [2020.02.03] ----------------- * Give `MonadGet m` a superclass of `forall a b. Coercible a b => Coercible (m a) (m b)` when built against GHC 8.6 or later. This allows `Serial` instances to be derived using `GeneralizedNewtypeDeriving` or `DerivingVia` when using in tandem with `StandaloneDeriving`. 0.16 [2019.08.27] ----------------- * Support GHC-8.8. * `MonadGet` now requires `MonadFail` as a superclass. 0.15.5 [2018.07.03] ------------------- * Add `Serial(1)` instances for `NonEmpty`. 0.15.4 [2018.04.05] ------------------- * Use a significantly simpler `Setup.hs` script. 0.15.3 ------ * Support GHC 8.2 * Revamp `Setup.hs` to use `cabal-doctest`. This makes it build with `Cabal-2.0`, and makes the `doctest`s work with `cabal new-build` and sandboxes. 0.15.2 ------ * Support ghc 8 * Support `time` 1.6 * Support `binary` 0.8 * Support `transformers` 0.5 0.15.1 ------ * Drop `Trustworthy` claim in `Data.Bytes.Put` as we now can sometimes infer `Safe`. * Bump `cereal` bound for 0.5.0.0 * Add instance `Serial Natural` 0.15.0.1 -------- * Updated github URLs in the .cabal file. * We now compile without warnings on GHC 7.10. 0.15 ---- * Fixed a serious bug in the semantics of generic `Serial1` generation for the recursive case and improved `Generic1` support for `:.:`. 0.14.1.2 -------- * Support `void` 0.7 / GHC 7.10 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 0.13 ---- * Fixed an issue caused by [deserializing illegal maps](http://www.reddit.com/r/haskell/comments/1q4r3b/mindbending_behavior_for_deserialization_in/). 0.11.5 ------ * Fixed issue #7, permitting the doctests to function against bytestring 0.9 0.11.4 ------ * Fixed issue #6 with regards to the test harness performance. 0.11.3 ------ * Fixed the doctests from 0.11.2 0.11.2 ------ * Constraint `binary` version for issue #5. 0.11.1 ------ * Liberalized containers dependency to allow `containers` versions all the way back to 0.3 for stackage purposes 0.11 ---- * Added `Data.Bytes.VarInt` and `Data.Bytes.Signed`. 0.10.2 ------ * Switched to to get more portable size correctness. 0.10.1 ------ * Fixed typo in `cbits/i2d.c` that was causing a linking error. 0.10 ---- * Changed all of the byte orders to big-endian by default *except* for `Word` and `Int`, which are variable sized. 0.9 ----- * Added proper support for `binary` 0.7. * Restored `lookAheadM` and `lookAheadE`, thanks to the return of `lookAheadE` in `binary` 0.7. * Renamed `Unchecked` to `Remaining`, and removed the `uncheckedLookAhead` function, as it is no longer supported downstream. 0.8 ----- * Trustworthiness 0.4 --- * Added a missing () instance 0.3 ----- * Added `Serial2` and various missing `Serial1` instances. 0.2 --- * Added `Serial` and `Serial1`. 0.1 --- * Repository initialized bytes-0.17.3/LICENSE0000644000000000000000000000266007346545000012132 0ustar0000000000000000Copyright 2013-2015 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bytes-0.17.3/README.markdown0000644000000000000000000000113307346545000013620 0ustar0000000000000000bytes ===== [![Hackage](https://img.shields.io/hackage/v/bytes.svg)](https://hackage.haskell.org/package/bytes) [![Build Status](https://github.com/ekmett/bytes/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/bytes/actions?query=workflow%3AHaskell-CI) This package provides a simple compatibility shim that lets you work with both `binary` and `cereal` with one chunk of serialization code. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett bytes-0.17.3/Setup.lhs0000644000000000000000000000016507346545000012733 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain bytes-0.17.3/bytes.cabal0000644000000000000000000000464507346545000013244 0ustar0000000000000000name: bytes category: Data, Serialization version: 0.17.3 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: experimental homepage: https://github.com/ekmett/bytes bug-reports: https://github.com/ekmett/bytes/issues copyright: Copyright (C) 2013-2015 Edward A. Kmett build-type: Simple tested-with: GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.7 , GHC == 9.4.5 , GHC == 9.6.2 synopsis: Sharing code for serialization between binary and cereal description: Sharing code for serialization between binary and cereal. extra-source-files: .gitignore .hlint.yaml .vim.custom AUTHORS.markdown README.markdown CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/bytes.git library build-depends: base >= 4.5 && < 5, binary >= 0.5.1 && < 0.9, binary-orphans >= 1.0.1 && < 1.1, bytestring >= 0.9 && < 0.13, cereal >= 0.5.2 && < 0.6, containers >= 0.3 && < 1, hashable >= 1.0.1.1 && < 1.5, text >= 0.2 && < 2.1, time >= 1.2 && < 1.13, transformers >= 0.2 && < 0.7, transformers-compat >= 0.6.5 && < 1, unordered-containers >= 0.2 && < 0.3, scientific >= 0.0 && < 1, void >= 0.6 && < 1 if impl(ghc >= 7.4 && < 7.6) build-depends: ghc-prim if !impl(ghc >= 7.10) build-depends: nats >= 1.1.2 && < 1.2 if !impl(ghc >= 8.0) build-depends: semigroups >= 0.5 && < 1 , fail >= 4.9.0.0 && < 4.10 exposed-modules: Data.Bytes.Get Data.Bytes.Put Data.Bytes.Serial Data.Bytes.Signed Data.Bytes.VarInt ghc-options: -Wall -fwarn-tabs -O2 if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type c-sources: cbits/i2d.c hs-source-dirs: src default-language: Haskell2010 bytes-0.17.3/cbits/0000755000000000000000000000000007346545000012225 5ustar0000000000000000bytes-0.17.3/cbits/i2d.c0000644000000000000000000000075207346545000013053 0ustar0000000000000000#include uint64_t doubleToWord64(double input) { union { double d; uint64_t l; } u; u.d = input; return u.l; } double word64ToDouble(uint64_t input) { union { double d; uint64_t l; } u; u.l = input; return u.d; } uint32_t floatToWord32(float input) { union { float f; uint32_t l; } u; u.f = input; return u.l; } float word32ToFloat(uint32_t input) { union { float f; uint32_t l; } u; u.l = input; return u.f; } bytes-0.17.3/src/Data/Bytes/0000755000000000000000000000000007346545000013647 5ustar0000000000000000bytes-0.17.3/src/Data/Bytes/Get.hs0000644000000000000000000003745507346545000014740 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE Trustworthy #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE QuantifiedConstraints #-} #endif {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2015 -- License : BSD3 -- Maintainer: Edward Kmett -- Stability : experimental -- Portability: type-families -- -- This module generalizes the @binary@ 'B.Get' and @cereal@ 'S.Get' -- monads in an ad hoc fashion to permit code to be written that is -- compatible across them. -- -- Moreover, this class permits code to be written to be portable over -- various monad transformers applied to these as base monads. -------------------------------------------------------------------- module Data.Bytes.Get ( MonadGet(..) , runGetL , runGetS ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative import Data.Monoid (Monoid(..)) #endif import Control.Monad (liftM, unless) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Except as Except import Control.Monad.Trans.Reader (ReaderT(..)) import Control.Monad.Trans.RWS.Lazy as Lazy import Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import qualified Data.Binary.Get as B import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString as Strict import Data.Int import qualified Data.Serialize.Get as S import Data.Word import Control.Monad.Trans.Instances () import Data.Binary.Orphans () import qualified Control.Monad.Fail as Fail #if __GLASGOW_HASKELL__ >= 806 import Data.Coerce (Coercible) #endif class ( #if __GLASGOW_HASKELL__ >= 806 -- This superclass exists for the benefit of Serial, which uses MonadGet -- in one of its methods. Giving MonadGet this superclass allows Serial to -- be derived using GeneralizedNewtypeDeriving/DerivingVia. forall a b. Coercible a b => Coercible (m a) (m b), #endif Integral (Remaining m), Fail.MonadFail m, Applicative m) => MonadGet m where -- | An 'Integral' number type used for unchecked skips and counting. type Remaining m :: * -- | The underlying ByteString type used by this instance type Bytes m :: * -- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available. skip :: Int -> m () #ifndef HLINT default skip :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m () skip = lift . skip #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 -- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'. -- Fails if @gma@ fails. lookAheadM :: m (Maybe a) -> m (Maybe a) -- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'. -- Fails if @gea@ fails. lookAheadE :: m (Either a b) -> m (Either a b) -- | Pull @n@ bytes from the input, as a strict ByteString. getBytes :: Int -> m Strict.ByteString #ifndef HLINT default getBytes :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m Strict.ByteString getBytes = lift . getBytes #endif -- | Get the number of remaining unparsed bytes. -- Useful for checking whether all input has been consumed. -- Note that this forces the rest of the input. remaining :: m (Remaining m) #ifndef HLINT default remaining :: (MonadTrans t, MonadGet n, m ~ t n, Remaining m ~ Remaining n) => m (Remaining m) remaining = lift remaining #endif -- | Test whether all input has been consumed, -- i.e. there are no remaining unparsed bytes. isEmpty :: m Bool #ifndef HLINT default isEmpty :: (MonadTrans t, MonadGet n, m ~ t n) => m Bool isEmpty = lift isEmpty #endif -- | Read a Word8 from the monad state getWord8 :: m Word8 #ifndef HLINT default getWord8 :: (MonadTrans t, MonadGet n, m ~ t n) => m Word8 getWord8 = lift getWord8 #endif -- | An efficient 'get' method for strict ByteStrings. Fails if fewer -- than @n@ bytes are left in the input. getByteString :: Int -> m Strict.ByteString #ifndef HLINT default getByteString :: (MonadTrans t, MonadGet n, m ~ t n) => Int -> m Strict.ByteString getByteString = lift . getByteString #endif -- | An efficient 'get' method for lazy ByteStrings. Does not fail if fewer than -- @n@ bytes are left in the input. getLazyByteString :: Int64 -> m Lazy.ByteString #ifndef HLINT default getLazyByteString :: (MonadTrans t, MonadGet n, m ~ t n) => Int64 -> m Lazy.ByteString getLazyByteString = lift . getLazyByteString #endif -- | Read a 'Word16' in big endian format getWord16be :: m Word16 #ifndef HLINT default getWord16be :: (MonadTrans t, MonadGet n, m ~ t n) => m Word16 getWord16be = lift getWord16be #endif -- | Read a 'Word16' in little endian format getWord16le :: m Word16 #ifndef HLINT default getWord16le :: (MonadTrans t, MonadGet n, m ~ t n) => m Word16 getWord16le = lift getWord16le #endif -- | /O(1)./ Read a 2 byte 'Word16' in native host order and host endianness. getWord16host :: m Word16 #ifndef HLINT default getWord16host :: (MonadTrans t, MonadGet n, m ~ t n) => m Word16 getWord16host = lift getWord16host #endif -- | Read a 'Word32' in big endian format getWord32be :: m Word32 #ifndef HLINT default getWord32be :: (MonadTrans t, MonadGet n, m ~ t n) => m Word32 getWord32be = lift getWord32be #endif -- | Read a 'Word32' in little endian format getWord32le :: m Word32 #ifndef HLINT default getWord32le :: (MonadTrans t, MonadGet n, m ~ t n) => m Word32 getWord32le = lift getWord32le #endif -- | /O(1)./ Read a 'Word32' in native host order and host endianness. getWord32host :: m Word32 #ifndef HLINT default getWord32host :: (MonadTrans t, MonadGet n, m ~ t n) => m Word32 getWord32host = lift getWord32host #endif -- | Read a 'Word64' in big endian format getWord64be :: m Word64 #ifndef HLINT default getWord64be :: (MonadTrans t, MonadGet n, m ~ t n) => m Word64 getWord64be = lift getWord64be #endif -- | Read a 'Word64' in little endian format getWord64le :: m Word64 #ifndef HLINT default getWord64le :: (MonadTrans t, MonadGet n, m ~ t n) => m Word64 getWord64le = lift getWord64le #endif -- | /O(1)./ Read a 'Word64' in native host order and host endianness. getWord64host :: m Word64 #ifndef HLINT default getWord64host :: (MonadTrans t, MonadGet n, m ~ t n) => m Word64 getWord64host = lift getWord64host #endif -- | /O(1)./ Read a single native machine word. The word is read in -- host order, host endian form, for the machine you're on. On a 64 bit -- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes. getWordhost :: m Word #ifndef HLINT default getWordhost :: (MonadTrans t, MonadGet n, m ~ t n) => m Word getWordhost = lift getWordhost #endif instance MonadGet B.Get where type Remaining B.Get = Int64 type Bytes B.Get = Lazy.ByteString skip = B.skip {-# INLINE skip #-} lookAhead = B.lookAhead {-# INLINE lookAhead #-} lookAheadM = B.lookAheadM {-# INLINE lookAheadM #-} lookAheadE = B.lookAheadE {-# INLINE lookAheadE #-} ensure n = do bs <- lookAhead $ getByteString n unless (Strict.length bs >= n) $ Fail.fail "ensure: Required more bytes" return bs {-# INLINE ensure #-} getBytes = B.getByteString {-# INLINE getBytes #-} remaining = B.remaining {-# INLINE remaining #-} isEmpty = B.isEmpty {-# INLINE isEmpty #-} getWord8 = B.getWord8 {-# INLINE getWord8 #-} getByteString = B.getByteString {-# INLINE getByteString #-} getLazyByteString = B.getLazyByteString {-# INLINE getLazyByteString #-} getWord16be = B.getWord16be {-# INLINE getWord16be #-} getWord16le = B.getWord16le {-# INLINE getWord16le #-} getWord16host = B.getWord16host {-# INLINE getWord16host #-} getWord32be = B.getWord32be {-# INLINE getWord32be #-} getWord32le = B.getWord32le {-# INLINE getWord32le #-} getWord32host = B.getWord32host {-# INLINE getWord32host #-} getWord64be = B.getWord64be {-# INLINE getWord64be #-} getWord64le = B.getWord64le {-# INLINE getWord64le #-} getWord64host = B.getWord64host {-# INLINE getWord64host #-} getWordhost = B.getWordhost {-# INLINE getWordhost #-} instance MonadGet S.Get where type Remaining S.Get = Int type Bytes S.Get = Strict.ByteString skip = S.skip {-# INLINE skip #-} lookAhead = S.lookAhead {-# INLINE lookAhead #-} lookAheadM = S.lookAheadM {-# INLINE lookAheadM #-} lookAheadE = S.lookAheadE {-# INLINE lookAheadE #-} getBytes = S.getBytes {-# INLINE getBytes #-} ensure = S.ensure {-# INLINE ensure #-} remaining = S.remaining {-# INLINE remaining #-} isEmpty = S.isEmpty {-# INLINE isEmpty #-} getWord8 = S.getWord8 {-# INLINE getWord8 #-} getByteString = S.getByteString {-# INLINE getByteString #-} getLazyByteString = S.getLazyByteString {-# INLINE getLazyByteString #-} getWord16be = S.getWord16be {-# INLINE getWord16be #-} getWord16le = S.getWord16le {-# INLINE getWord16le #-} getWord16host = S.getWord16host {-# INLINE getWord16host #-} getWord32be = S.getWord32be {-# INLINE getWord32be #-} getWord32le = S.getWord32le {-# INLINE getWord32le #-} getWord32host = S.getWord32host {-# INLINE getWord32host #-} getWord64be = S.getWord64be {-# INLINE getWord64be #-} getWord64le = S.getWord64le {-# INLINE getWord64le #-} getWord64host = S.getWord64host {-# INLINE getWord64host #-} getWordhost = S.getWordhost {-# INLINE getWordhost #-} instance MonadGet m => MonadGet (Lazy.StateT s m) where type Remaining (Lazy.StateT s m) = Remaining m type Bytes (Lazy.StateT s m) = Bytes m lookAhead (Lazy.StateT m) = Lazy.StateT (lookAhead . m) {-# INLINE lookAhead #-} lookAheadM (Lazy.StateT m) = Lazy.StateT (liftM factor . lookAheadE . liftM distribute . m) where distribute (Nothing, s') = Left (Nothing, s') distribute (Just a, s') = Right (Just a, s') factor = either id id {-# INLINE lookAheadM #-} lookAheadE (Lazy.StateT m) = Lazy.StateT (liftM factor . lookAheadE . liftM distribute . m) where distribute (Left a, s') = Left (Left a, s') distribute (Right b, s') = Right (Right b, s') factor = either id id {-# INLINE lookAheadE #-} instance MonadGet m => MonadGet (Strict.StateT s m) where type Remaining (Strict.StateT s m) = Remaining m type Bytes (Strict.StateT s m) = Bytes m lookAhead (Strict.StateT m) = Strict.StateT (lookAhead . m) {-# INLINE lookAhead #-} lookAheadM (Strict.StateT m) = Strict.StateT (liftM factor . lookAheadE . liftM distribute . m) where distribute (Nothing, s') = Left (Nothing, s') distribute (Just a, s') = Right (Just a, s') factor = either id id {-# INLINE lookAheadM #-} lookAheadE (Strict.StateT m) = Strict.StateT (liftM factor . lookAheadE . liftM distribute . m) where distribute (Left a, s') = Left (Left a, s') distribute (Right b, s') = Right (Right b, s') factor = either id id {-# INLINE lookAheadE #-} instance MonadGet m => MonadGet (ReaderT e m) where type Remaining (ReaderT e m) = Remaining m type Bytes (ReaderT e m) = Bytes m lookAhead (ReaderT m) = ReaderT (lookAhead . m) {-# INLINE lookAhead #-} lookAheadM (ReaderT m) = ReaderT (lookAheadM . m) {-# INLINE lookAheadM #-} lookAheadE (ReaderT m) = ReaderT (lookAheadE . m) {-# INLINE lookAheadE #-} instance (MonadGet m, Monoid w) => MonadGet (Lazy.WriterT w m) where type Remaining (Lazy.WriterT w m) = Remaining m type Bytes (Lazy.WriterT w m) = Bytes m lookAhead (Lazy.WriterT m) = Lazy.WriterT (lookAhead m) {-# INLINE lookAhead #-} lookAheadM (Lazy.WriterT m) = Lazy.WriterT (liftM factor $ lookAheadE $ liftM distribute m) where distribute (Nothing, s') = Left (Nothing, s') distribute (Just a, s') = Right (Just a, s') factor = either id id {-# INLINE lookAheadM #-} lookAheadE (Lazy.WriterT m) = Lazy.WriterT (liftM factor $ lookAheadE $ liftM distribute m) where distribute (Left a, s') = Left (Left a, s') distribute (Right b, s') = Right (Right b, s') factor = either id id {-# INLINE lookAheadE #-} instance (MonadGet m, Monoid w) => MonadGet (Strict.WriterT w m) where type Remaining (Strict.WriterT w m) = Remaining m type Bytes (Strict.WriterT w m) = Bytes m lookAhead (Strict.WriterT m) = Strict.WriterT (lookAhead m) {-# INLINE lookAhead #-} lookAheadM (Strict.WriterT m) = Strict.WriterT (liftM factor $ lookAheadE $ liftM distribute m) where distribute (Nothing, s') = Left (Nothing, s') distribute (Just a, s') = Right (Just a, s') factor = either id id {-# INLINE lookAheadM #-} lookAheadE (Strict.WriterT m) = Strict.WriterT (liftM factor $ lookAheadE $ liftM distribute m) where distribute (Left a, s') = Left (Left a, s') distribute (Right b, s') = Right (Right b, s') factor = either id id {-# INLINE lookAheadE #-} instance (MonadGet m, Monoid w) => MonadGet (Strict.RWST r w s m) where type Remaining (Strict.RWST r w s m) = Remaining m type Bytes (Strict.RWST r w s m) = Bytes m lookAhead (Strict.RWST m) = Strict.RWST $ \r s -> lookAhead (m r s) {-# INLINE lookAhead #-} lookAheadM (Strict.RWST m) = Strict.RWST (\r s -> liftM factor $ lookAheadE $ liftM distribute $ m r s ) where distribute (Nothing, s',w') = Left (Nothing, s', w') distribute (Just a, s',w') = Right (Just a, s', w') factor = either id id {-# INLINE lookAheadM #-} lookAheadE (Strict.RWST m) = Strict.RWST (\r s -> liftM factor $ lookAheadE $ liftM distribute $ m r s) where distribute (Left a, s', w') = Left (Left a, s', w') distribute (Right b, s', w') = Right (Right b, s', w') factor = either id id {-# INLINE lookAheadE #-} instance (MonadGet m, Monoid w) => MonadGet (Lazy.RWST r w s m) where type Remaining (Lazy.RWST r w s m) = Remaining m type Bytes (Lazy.RWST r w s m) = Bytes m lookAhead (Lazy.RWST m) = Lazy.RWST $ \r s -> lookAhead (m r s) {-# INLINE lookAhead #-} lookAheadM (Lazy.RWST m) = Lazy.RWST (\r s -> liftM factor $ lookAheadE $ liftM distribute $ m r s ) where distribute (Nothing, s',w') = Left (Nothing, s', w') distribute (Just a, s',w') = Right (Just a, s', w') factor = either id id {-# INLINE lookAheadM #-} lookAheadE (Lazy.RWST m) = Lazy.RWST (\r s -> liftM factor $ lookAheadE $ liftM distribute $ m r s) where distribute (Left a, s', w') = Left (Left a, s', w') distribute (Right b, s', w') = Right (Right b, s', w') factor = either id id {-# INLINE lookAheadE #-} instance MonadGet m => MonadGet (ExceptT e m) where type Remaining (ExceptT e m) = Remaining m type Bytes (ExceptT e m) = Bytes m lookAhead = mapExceptT lookAhead {-# INLINE lookAhead #-} lookAheadM (ExceptT m) = ExceptT (liftM factor $ lookAheadE $ liftM distribute m) where distribute (Left e) = (Left (Left e)) distribute (Right j) = (Right (Right j)) factor = either id id {-# INLINE lookAheadM #-} lookAheadE (ExceptT m) = ExceptT (liftM factor $ lookAheadE $ liftM distribute m) where distribute (Left e) = (Left (Left e)) distribute (Right a) = (Right (Right a)) factor = either id id {-# INLINE lookAheadE #-} -- | Get something from a lazy 'Lazy.ByteString' using 'B.runGet'. runGetL :: B.Get a -> Lazy.ByteString -> a runGetL = B.runGet -- | Get something from a strict 'Strict.ByteString' using 'S.runGet'. runGetS :: S.Get a -> Strict.ByteString -> Either String a runGetS = S.runGet bytes-0.17.3/src/Data/Bytes/Put.hs0000644000000000000000000002076107346545000014761 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2015 -- License : BSD3 -- Maintainer: Edward Kmett -- Stability : experimental -- Portability: non-portable -- -- This module generalizes the @binary@ 'B.PutM' and @cereal@ 'S.PutM' -- monads in an ad hoc fashion to permit code to be written that is -- compatible across them. -- -- Moreover, this class permits code to be written to be portable over -- various monad transformers applied to these as base monads. -------------------------------------------------------------------- module Data.Bytes.Put ( MonadPut(..) , runPutL , runPutS ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative import Data.Monoid (Monoid(..)) #endif import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Except as Except import Control.Monad.Trans.Reader (ReaderT(..)) import Control.Monad.Trans.RWS.Lazy as Lazy import Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import qualified Data.Binary.Put as B import Data.ByteString as Strict import Data.ByteString.Lazy as Lazy import qualified Data.Serialize.Put as S import Data.Word ------------------------------------------------------------------------------ -- MonadPut ------------------------------------------------------------------------------ class (Applicative m, Monad m) => MonadPut m where -- | Efficiently write a byte into the output buffer putWord8 :: Word8 -> m () #ifndef HLINT default putWord8 :: (m ~ t n, MonadTrans t, MonadPut n) => Word8 -> m () putWord8 = lift . putWord8 {-# INLINE putWord8 #-} #endif -- | An efficient primitive to write a strict 'Strict.ByteString' into the output buffer. -- -- In @binary@ this flushes the current buffer, and writes the argument into a new chunk. putByteString :: Strict.ByteString -> m () #ifndef HLINT default putByteString :: (m ~ t n, MonadTrans t, MonadPut n) => Strict.ByteString -> m () putByteString = lift . putByteString {-# INLINE putByteString #-} #endif -- | Write a lazy 'Lazy.ByteString' efficiently. -- -- With @binary@, this simply appends the chunks to the output buffer putLazyByteString :: Lazy.ByteString -> m () #ifndef HLINT default putLazyByteString :: (m ~ t n, MonadTrans t, MonadPut n) => Lazy.ByteString -> m () putLazyByteString = lift . putLazyByteString {-# INLINE putLazyByteString #-} #endif -- | Pop the 'ByteString' we have constructed so far, if any, yielding a -- new chunk in the result 'ByteString'. -- -- If we're building a strict 'Strict.ByteString' with @cereal@ then this does nothing. flush :: m () #ifndef HLINT default flush :: (m ~ t n, MonadTrans t, MonadPut n) => m () flush = lift flush {-# INLINE flush #-} #endif -- | Write a 'Word16' in little endian format putWord16le :: Word16 -> m () #ifndef HLINT default putWord16le :: (m ~ t n, MonadTrans t, MonadPut n) => Word16 -> m () putWord16le = lift . putWord16le {-# INLINE putWord16le #-} #endif -- | Write a 'Word16' in big endian format putWord16be :: Word16 -> m () #ifndef HLINT default putWord16be :: (m ~ t n, MonadTrans t, MonadPut n) => Word16 -> m () putWord16be = lift . putWord16be {-# INLINE putWord16be #-} #endif -- | /O(1)./ Write a 'Word16' in native host order and host endianness. -- For portability issues see 'putWordhost'. putWord16host :: Word16 -> m () #ifndef HLINT default putWord16host :: (m ~ t n, MonadTrans t, MonadPut n) => Word16 -> m () putWord16host = lift . putWord16host {-# INLINE putWord16host #-} #endif -- | Write a 'Word32' in little endian format putWord32le :: Word32 -> m () #ifndef HLINT default putWord32le :: (m ~ t n, MonadTrans t, MonadPut n) => Word32 -> m () putWord32le = lift . putWord32le {-# INLINE putWord32le #-} #endif -- | Write a 'Word32' in big endian format putWord32be :: Word32 -> m () #ifndef HLINT default putWord32be :: (m ~ t n, MonadTrans t, MonadPut n) => Word32 -> m () putWord32be = lift . putWord32be {-# INLINE putWord32be #-} #endif -- | /O(1)./ Write a 'Word32' in native host order and host endianness. -- For portability issues see @putWordhost@. putWord32host :: Word32 -> m () #ifndef HLINT default putWord32host :: (m ~ t n, MonadTrans t, MonadPut n) => Word32 -> m () putWord32host = lift . putWord32host {-# INLINE putWord32host #-} #endif -- | Write a 'Word64' in little endian format putWord64le :: Word64 -> m () #ifndef HLINT default putWord64le :: (m ~ t n, MonadTrans t, MonadPut n) => Word64 -> m () putWord64le = lift . putWord64le {-# INLINE putWord64le #-} #endif -- | Write a 'Word64' in big endian format putWord64be :: Word64 -> m () #ifndef HLINT default putWord64be :: (m ~ t n, MonadTrans t, MonadPut n) => Word64 -> m () putWord64be = lift . putWord64be {-# INLINE putWord64be #-} #endif -- | /O(1)./ Write a 'Word64' in native host order and host endianness. -- For portability issues see @putWordhost@. putWord64host :: Word64 -> m () #ifndef HLINT default putWord64host :: (m ~ t n, MonadTrans t, MonadPut n) => Word64 -> m () putWord64host = lift . putWord64host {-# INLINE putWord64host #-} #endif -- | /O(1)./ Write a single native machine word. The word is -- written in host order, host endian form, for the machine you're on. -- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine, -- 4 bytes. Values written this way are not portable to -- different endian or word sized machines, without conversion. putWordhost :: Word -> m () #ifndef HLINT default putWordhost :: (m ~ t n, MonadTrans t, MonadPut n) => Word -> m () putWordhost = lift . putWordhost {-# INLINE putWordhost #-} #endif instance MonadPut B.PutM where putWord8 = B.putWord8 {-# INLINE putWord8 #-} putByteString = B.putByteString {-# INLINE putByteString #-} putLazyByteString = B.putLazyByteString {-# INLINE putLazyByteString #-} flush = B.flush {-# INLINE flush #-} putWord16le = B.putWord16le {-# INLINE putWord16le #-} putWord16be = B.putWord16be {-# INLINE putWord16be #-} putWord16host = B.putWord16host {-# INLINE putWord16host #-} putWord32le = B.putWord32le {-# INLINE putWord32le #-} putWord32be = B.putWord32be {-# INLINE putWord32be #-} putWord32host = B.putWord32host {-# INLINE putWord32host #-} putWord64le = B.putWord64le {-# INLINE putWord64le #-} putWord64be = B.putWord64be {-# INLINE putWord64be #-} putWord64host = B.putWord64host {-# INLINE putWord64host #-} putWordhost = B.putWordhost {-# INLINE putWordhost #-} instance MonadPut S.PutM where putWord8 = S.putWord8 {-# INLINE putWord8 #-} putByteString = S.putByteString {-# INLINE putByteString #-} putLazyByteString = S.putLazyByteString {-# INLINE putLazyByteString #-} flush = S.flush {-# INLINE flush #-} putWord16le = S.putWord16le {-# INLINE putWord16le #-} putWord16be = S.putWord16be {-# INLINE putWord16be #-} putWord16host = S.putWord16host {-# INLINE putWord16host #-} putWord32le = S.putWord32le {-# INLINE putWord32le #-} putWord32be = S.putWord32be {-# INLINE putWord32be #-} putWord32host = S.putWord32host {-# INLINE putWord32host #-} putWord64le = S.putWord64le {-# INLINE putWord64le #-} putWord64be = S.putWord64be {-# INLINE putWord64be #-} putWord64host = S.putWord64host {-# INLINE putWord64host #-} putWordhost = S.putWordhost {-# INLINE putWordhost #-} instance MonadPut m => MonadPut (Lazy.StateT s m) instance MonadPut m => MonadPut (Strict.StateT s m) instance MonadPut m => MonadPut (ReaderT e m) instance (MonadPut m, Monoid w) => MonadPut (Lazy.WriterT w m) instance (MonadPut m, Monoid w) => MonadPut (Strict.WriterT w m) instance (MonadPut m, Monoid w) => MonadPut (Lazy.RWST r w s m) instance (MonadPut m, Monoid w) => MonadPut (Strict.RWST r w s m) instance (MonadPut m) => MonadPut (ExceptT e m) where -- | Put a value into a lazy 'Lazy.ByteString' using 'B.runPut'. runPutL :: B.Put -> Lazy.ByteString runPutL = B.runPut -- | Put a value into a strict 'Strict.ByteString' using 'S.runPut'. runPutS :: S.Put -> Strict.ByteString runPutS = S.runPut bytes-0.17.3/src/Data/Bytes/Serial.hs0000644000000000000000000007164307346545000015435 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} #if defined(__GLASGOW_HASKELL__) # if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Trustworthy #-} # endif # if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE EmptyCase #-} # endif #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2015 -- License : BSD3 -- Maintainer: Edward Kmett -- Stability : experimental -- Portability: non-portable -- -- This module contains two main classes, each providing methods to -- serialize and deserialize types. 'Serial' is the primary class, -- to be used for the canonical way to serialize a specific -- type. 'SerialEndian' is used to provide endian-specific methods -- for serializing a type. -------------------------------------------------------------------- module Data.Bytes.Serial ( -- * Serialization Serial(..) -- * Specifying endianness , SerialEndian(..) -- * Higher-order -- $higher , Serial1(..) , serialize1, deserialize1 , Serial2(..) , serialize2, deserialize2 -- * Storable , store, restore -- * Generics -- $generics , GSerial(..) , GSerialEndian(..) , GSerial1(..) ) where import Control.Applicative import Control.Monad import qualified Control.Monad.Fail as MonadFail 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.Functor.Identity as Functor import Data.Functor.Constant as Functor import Data.Functor.Product as Functor import Data.Functor.Reverse as Functor import Data.Hashable (Hashable) import qualified Data.HashMap.Lazy as HMap import qualified Data.HashSet as HSet import qualified Data.List.NonEmpty as NEL 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 import qualified Data.Scientific as Sci import qualified Data.Sequence as Seq import qualified Data.Set as Set 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 import GHC.Exts (Down(..)) import GHC.Generics import System.IO.Unsafe import Numeric.Natural foreign import ccall floatToWord32 :: Float -> Word32 foreign import ccall word32ToFloat :: Word32 -> Float foreign import ccall doubleToWord64 :: Double -> Word64 foreign import ccall word64ToDouble :: Word64 -> Double -- $setup -- >>> import Data.Bytes.Get -- >>> import Data.Bytes.Put -- >>> import Data.Bytes.VarInt -- >>> import Data.Fixed -- >>> import Data.Ratio (Ratio, (%)) -- >>> import Data.Time -- >>> import Data.Time.Clock -- >>> import Data.Time.Clock.TAI -- >>> import Data.Word -- >>> import Numeric.Natural ------------------------------------------------------------------------------ -- Endianness-Dependant Serialization ------------------------------------------------------------------------------ {-| Methods to serialize and deserialize type 'a' to a big and little endian binary representations. Methods suffixed with "host" are automatically defined to use equal the methods corresponding to the current machine's native endianness, but they can be overridden. -} class SerialEndian a where serializeBE :: MonadPut m => a -> m () #ifndef HLINT default serializeBE :: (MonadPut m, GSerialEndian (Rep a), Generic a) => a -> m () serializeBE = gserializeBE . from #endif deserializeBE :: MonadGet m => m a #ifndef HLINT default deserializeBE :: (MonadGet m, GSerialEndian (Rep a), Generic a) => m a deserializeBE = liftM to gdeserializeBE #endif serializeLE :: MonadPut m => a -> m () #ifndef HLINT default serializeLE :: (MonadPut m, GSerialEndian (Rep a), Generic a) => a -> m () serializeLE = gserializeLE . from #endif deserializeLE :: MonadGet m => m a #ifndef HLINT default deserializeLE :: (MonadGet m, GSerialEndian (Rep a), Generic a) => m a deserializeLE = liftM to gdeserializeLE #endif serializeHost :: MonadPut m => a -> m () deserializeHost :: MonadGet m => m a #ifdef WORDS_BIGENDIAN serializeHost = serializeBE deserializeHost = deserializeBE #else serializeHost = serializeLE deserializeHost = deserializeLE #endif instance SerialEndian Double where serializeBE = serializeBE . doubleToWord64 deserializeBE = liftM word64ToDouble deserializeBE serializeLE = serializeLE . doubleToWord64 deserializeLE = liftM word64ToDouble deserializeLE instance SerialEndian Float where serializeBE = serializeBE . floatToWord32 deserializeBE = liftM word32ToFloat deserializeBE serializeLE = serializeLE . floatToWord32 deserializeLE = liftM word32ToFloat deserializeLE instance SerialEndian Char where serializeBE = putWord32be . fromIntegral . fromEnum deserializeBE = liftM (toEnum . fromIntegral) getWord32be serializeLE = putWord32le . fromIntegral . fromEnum deserializeLE = liftM (toEnum . fromIntegral) getWord32le instance SerialEndian Word64 where serializeBE = putWord64be deserializeBE = getWord64be serializeLE = putWord64le deserializeLE = getWord64le instance SerialEndian Word32 where serializeBE = putWord32be deserializeBE = getWord32be serializeLE = putWord32le deserializeLE = getWord32le instance SerialEndian Word16 where serializeBE = putWord16be deserializeBE = getWord16be serializeLE = putWord16le deserializeLE = getWord16le instance SerialEndian Int64 where serializeBE = putWord64be . fromIntegral deserializeBE = liftM fromIntegral getWord64be serializeLE = putWord64le . fromIntegral deserializeLE = liftM fromIntegral getWord64le instance SerialEndian Int32 where serializeBE = putWord32be . fromIntegral deserializeBE = liftM fromIntegral getWord32be serializeLE = putWord32le . fromIntegral deserializeLE = liftM fromIntegral getWord32le instance SerialEndian Int16 where serializeBE = putWord16be . fromIntegral deserializeBE = liftM fromIntegral getWord16be serializeLE = putWord16le . fromIntegral deserializeLE = liftM fromIntegral getWord16le ------------------------------------------------------------------------------ -- Serialization ------------------------------------------------------------------------------ {-| Methods to serialize and deserialize type 'a' to a binary representation Instances provided here for fixed-with Integers and Words are big endian. Instances for strict and lazy bytestrings store also the length of bytestring big endian. Instances for Word and Int are host endian as they are machine-specific types. -} class Serial a where serialize :: MonadPut m => a -> m () #ifndef HLINT default serialize :: (MonadPut m, GSerial (Rep a), Generic a) => a -> m () serialize = gserialize . from #endif deserialize :: MonadGet m => m a #ifndef HLINT default deserialize :: (MonadGet m, GSerial (Rep a), Generic a) => m a deserialize = liftM to gdeserialize #endif instance Serial Strict.ByteString where serialize bs = putWord32be (fromIntegral (Strict.length bs)) >> putByteString bs deserialize = do n <- getWord32be getByteString (fromIntegral n) instance Serial Lazy.ByteString where serialize bs = putWord64be (fromIntegral (Lazy.length bs)) >> putLazyByteString bs deserialize = do n <- getWord64be getLazyByteString (fromIntegral n) instance Serial SText.Text where serialize = serialize . SText.encodeUtf8 deserialize = SText.decodeUtf8 `fmap` deserialize instance Serial LText.Text where serialize = serialize . LText.encodeUtf8 deserialize = LText.decodeUtf8 `fmap` deserialize instance Serial () instance Serial a => Serial [a] instance Serial a => Serial (Maybe a) instance (Serial a, Serial b) => Serial (Either a b) instance (Serial a, Serial b) => Serial (a, b) instance (Serial a, Serial b, Serial c) => Serial (a, b, c) instance (Serial a, Serial b, Serial c, Serial d) => Serial (a, b, c, d) instance (Serial a, Serial b, Serial c, Serial d, Serial e) => Serial (a, b, c, d, e) instance Serial Bool -- | serialize any 'Storable' in a host-specific format. store :: (MonadPut m, Storable a) => a -> m () store a = putByteString bs where bs = unsafePerformIO $ create (sizeOf a) $ \ p -> poke (castPtr p) a -- | deserialize any 'Storable' in a host-specific format. restore :: forall m a. (MonadGet m, Storable a) => m a restore = do let required = sizeOf (undefined :: a) #if MIN_VERSION_bytestring(0,11,0) let o = 0 BS fp n #else PS fp o n #endif <- getByteString required unless (n >= required) $ MonadFail.fail "restore: Required more bytes" return $ unsafePerformIO $ withForeignPtr fp $ \p -> peekByteOff p o instance Serial Double where serialize = serializeBE deserialize = deserializeBE instance Serial Float where serialize = serializeBE deserialize = deserializeBE instance Serial Char where serialize = serializeBE deserialize = deserializeBE -- host endian instance Serial Word where serialize = putWordhost deserialize = getWordhost instance Serial Word64 where serialize = serializeBE deserialize = deserializeBE instance Serial Word32 where serialize = serializeBE deserialize = deserializeBE instance Serial Word16 where serialize = serializeBE deserialize = deserializeBE instance Serial Word8 where serialize = putWord8 deserialize = getWord8 -- host endian instance Serial Int where serialize = putWordhost . fromIntegral deserialize = liftM fromIntegral getWordhost instance Serial Int64 where serialize = serializeBE deserialize = deserializeBE instance Serial Int32 where serialize = serializeBE deserialize = deserializeBE instance Serial Int16 where serialize = serializeBE deserialize = deserializeBE instance Serial Int8 where serialize = putWord8 . fromIntegral deserialize = liftM fromIntegral getWord8 instance Serial Sci.Scientific where serialize s = serialize (Sci.coefficient s, Sci.base10Exponent s) deserialize = uncurry Sci.scientific <$> deserialize instance Serial Void where serialize = absurd deserialize = MonadFail.fail "I looked into the void." instance Serial ISet.IntSet where serialize = serialize . ISet.toAscList deserialize = ISet.fromList `liftM` deserialize instance Serial a => Serial (Seq.Seq a) where serialize = serializeWith serialize deserialize = deserializeWith deserialize instance Serial a => Serial (NEL.NonEmpty a) where serialize = serializeWith serialize deserialize = deserializeWith deserialize instance (Serial a, Ord a) => Serial (Set.Set a) where serialize = serialize . Set.toAscList deserialize = Set.fromList `liftM` deserialize instance Serial v => Serial (IMap.IntMap v) where serialize = serializeWith serialize deserialize = deserializeWith deserialize instance (Serial k, Serial v, Ord k) => Serial (Map.Map k v) where serialize = serializeWith serialize deserialize = deserializeWith deserialize instance (Serial k, Serial v, Hashable k, Eq k) => Serial (HMap.HashMap k v) where serialize = serializeWith serialize deserialize = deserializeWith deserialize instance (Serial v, Hashable v, Eq v) => Serial (HSet.HashSet v) where serialize = serialize . HSet.toList deserialize = HSet.fromList `liftM` 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 #-} -- | 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 (10^10::Natural))) :: Natural -- 10000000000 instance Serial Natural where serialize = serialize . VarInt . toInteger deserialize = fromInteger . unVarInt <$> 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 ------------------------------------------------------------------------------ -- $generics -- -- You probably will never need to care that these exist except they -- provide us with default definitions for 'Serial' and 'SerialEndian' -- | Used internally to provide generic serialization class GSerial f where gserialize :: MonadPut m => f a -> m () gdeserialize :: MonadGet m => m (f a) instance GSerial U1 where gserialize U1 = return () gdeserialize = return U1 instance GSerial V1 where gserialize x = #if __GLASGOW_HASKELL__ >= 708 case x of {} #else x `seq` error "I looked into the void." #endif gdeserialize = MonadFail.fail "I looked into the void." instance (GSerial f, GSerial g) => GSerial (f :*: g) where gserialize (f :*: g) = do gserialize f gserialize g gdeserialize = liftM2 (:*:) gdeserialize gdeserialize instance (GSerial f, GSerial g) => GSerial (f :+: g) where gserialize (L1 x) = putWord8 0 >> gserialize x gserialize (R1 y) = putWord8 1 >> gserialize y gdeserialize = getWord8 >>= \a -> case a of 0 -> liftM L1 gdeserialize 1 -> liftM R1 gdeserialize _ -> MonadFail.fail "Missing case" instance GSerial f => GSerial (M1 i c f) where gserialize (M1 x) = gserialize x gdeserialize = liftM M1 gdeserialize instance Serial a => GSerial (K1 i a) where gserialize (K1 x) = serialize x gdeserialize = liftM K1 deserialize -- | Used internally to provide generic big-endian serialization class GSerialEndian f where gserializeBE :: MonadPut m => f a -> m () #ifndef HLINT default gserializeBE :: (MonadPut m, GSerial f) => f a -> m () gserializeBE = gserialize #endif gdeserializeBE :: MonadGet m => m (f a) #ifndef HLINT default gdeserializeBE :: (MonadGet m, GSerial f) => m (f a) gdeserializeBE = gdeserialize #endif gserializeLE :: MonadPut m => f a -> m () #ifndef HLINT default gserializeLE :: (MonadPut m, GSerial f) => f a -> m () gserializeLE = gserialize #endif gdeserializeLE :: MonadGet m => m (f a) #ifndef HLINT default gdeserializeLE :: (MonadGet m, GSerial f) => m (f a) gdeserializeLE = gdeserialize #endif -- only difference between GSerialEndian and GSerial instance SerialEndian a => GSerialEndian (K1 i a) where gserializeBE (K1 x) = serializeBE x gdeserializeBE = liftM K1 deserializeBE gserializeLE (K1 x) = serializeLE x gdeserializeLE = liftM K1 deserializeLE ------------------------------------------------------------------------------ -- Higher-Rank Serialization ------------------------------------------------------------------------------ -- $higher -- -- These classes provide us with the ability to serialize containers that need -- polymorphic recursion. class Serial1 f where serializeWith :: MonadPut m => (a -> m ()) -> f a -> m () #ifndef HLINT default serializeWith :: (MonadPut m, GSerial1 (Rep1 f), Generic1 f) => (a -> m ()) -> f a -> m () serializeWith f = gserializeWith f . from1 #endif deserializeWith :: MonadGet m => m a -> m (f a) #ifndef HLINT default deserializeWith :: (MonadGet m, GSerial1 (Rep1 f), Generic1 f) => m a -> m (f a) deserializeWith f = liftM to1 (gdeserializeWith f) #endif instance Serial1 [] where serializeWith _ [] = putWord8 0 serializeWith f (x:xs) = putWord8 1 >> f x >> serializeWith f xs deserializeWith m = getWord8 >>= \a -> case a of 0 -> return [] 1 -> liftM2 (:) m (deserializeWith m) _ -> error "[].deserializeWith: Missing case" instance Serial1 Maybe where serializeWith _ Nothing = putWord8 0 serializeWith f (Just a) = putWord8 1 >> f a deserializeWith m = getWord8 >>= \a -> case a of 0 -> return Nothing 1 -> liftM Just m _ -> error "Maybe.deserializeWith: Missing case" instance Serial a => Serial1 (Either a) where serializeWith = serializeWith2 serialize deserializeWith = deserializeWith2 deserialize instance Serial a => Serial1 ((,) a) where serializeWith = serializeWith2 serialize deserializeWith = deserializeWith2 deserialize instance (Serial a, Serial b) => Serial1 ((,,) a b) where serializeWith = serializeWith2 serialize deserializeWith = deserializeWith2 deserialize instance (Serial a, Serial b, Serial c) => Serial1 ((,,,) a b c) where serializeWith = serializeWith2 serialize deserializeWith = deserializeWith2 deserialize instance (Serial a, Serial b, Serial c, Serial d) => Serial1 ((,,,,) a b c d) where serializeWith = serializeWith2 serialize deserializeWith = deserializeWith2 deserialize instance Serial1 Seq.Seq where serializeWith pv = serializeWith pv . F.toList deserializeWith gv = Seq.fromList `liftM` deserializeWith gv instance Serial1 NEL.NonEmpty where serializeWith pv = serializeWith pv . F.toList deserializeWith gv = NEL.fromList `liftM` deserializeWith gv {- instance Serial1 Set.Set where serializeWith pv = serializeWith pv . Set.toAscList deserializeWith gv = Set.fromList `liftM` deserializeWith gv -} instance Serial1 IMap.IntMap where serializeWith pv = serializeWith (serializeWith2 serialize pv) . IMap.toAscList deserializeWith gv = IMap.fromList `liftM` deserializeWith (deserializeWith2 deserialize gv) instance (Ord k, Serial k) => Serial1 (Map.Map k) where -- serializeWith = serializeWith2 serialize -- deserializeWith = deserializeWith2 deserialize serializeWith pv = serializeWith (serializeWith2 serialize pv) . Map.toAscList deserializeWith gv = Map.fromList `liftM` deserializeWith (deserializeWith2 deserialize gv) instance (Hashable k, Eq k, Serial k) => Serial1 (HMap.HashMap k) where serializeWith pv = serializeWith (serializeWith2 serialize pv) . HMap.toList deserializeWith gv = HMap.fromList `liftM` deserializeWith (deserializeWith2 deserialize gv) serialize1 :: (MonadPut m, Serial1 f, Serial a) => f a -> m () serialize1 = serializeWith serialize {-# INLINE serialize1 #-} deserialize1 :: (MonadGet m, Serial1 f, Serial a) => m (f a) deserialize1 = deserializeWith deserialize {-# INLINE deserialize1 #-} ------------------------------------------------------------------------------ -- Higher-Rank Generic Serialization ------------------------------------------------------------------------------ -- | Used internally to provide generic serialization class GSerial1 f where gserializeWith :: MonadPut m => (a -> m ()) -> f a -> m () gdeserializeWith :: MonadGet m => m a -> m (f a) instance GSerial1 Par1 where gserializeWith f (Par1 a) = f a gdeserializeWith m = liftM Par1 m instance Serial1 f => GSerial1 (Rec1 f) where gserializeWith f (Rec1 fa) = serializeWith f fa gdeserializeWith m = liftM Rec1 (deserializeWith m) -- instance (Serial1 f, GSerial1 g) => GSerial1 (f :.: g) where instance GSerial1 U1 where gserializeWith _ U1 = return () gdeserializeWith _ = return U1 instance GSerial1 V1 where gserializeWith _ x = #if __GLASGOW_HASKELL__ >= 708 case x of {} #else x `seq` error "I looked into the void." #endif gdeserializeWith _ = MonadFail.fail "I looked into the void." instance (GSerial1 f, GSerial1 g) => GSerial1 (f :*: g) where gserializeWith f (a :*: b) = gserializeWith f a >> gserializeWith f b gdeserializeWith m = liftM2 (:*:) (gdeserializeWith m) (gdeserializeWith m) instance (GSerial1 f, GSerial1 g) => GSerial1 (f :+: g) where gserializeWith f (L1 x) = putWord8 0 >> gserializeWith f x gserializeWith f (R1 y) = putWord8 1 >> gserializeWith f y gdeserializeWith m = getWord8 >>= \a -> case a of 0 -> liftM L1 (gdeserializeWith m) 1 -> liftM R1 (gdeserializeWith m) _ -> MonadFail.fail "Missing case" instance (Serial1 f, GSerial1 g) => GSerial1 (f :.: g) where gserializeWith f (Comp1 m) = serializeWith (gserializeWith f) m gdeserializeWith m = Comp1 `liftM` deserializeWith (gdeserializeWith m) instance GSerial1 f => GSerial1 (M1 i c f) where gserializeWith f (M1 x) = gserializeWith f x gdeserializeWith = liftM M1 . gdeserializeWith instance Serial a => GSerial1 (K1 i a) where gserializeWith _ (K1 x) = serialize x gdeserializeWith _ = liftM K1 deserialize ------------------------------------------------------------------------------ -- Higher-Rank Serialization ------------------------------------------------------------------------------ class Serial2 f where serializeWith2 :: MonadPut m => (a -> m ()) -> (b -> m ()) -> f a b -> m () deserializeWith2 :: MonadGet m => m a -> m b -> m (f a b) serialize2 :: (MonadPut m, Serial2 f, Serial a, Serial b) => f a b -> m () serialize2 = serializeWith2 serialize serialize {-# INLINE serialize2 #-} deserialize2 :: (MonadGet m, Serial2 f, Serial a, Serial b) => m (f a b) deserialize2 = deserializeWith2 deserialize deserialize {-# INLINE deserialize2 #-} instance Serial2 Either where serializeWith2 f _ (Left x) = putWord8 0 >> f x serializeWith2 _ g (Right y) = putWord8 1 >> g y deserializeWith2 m n = getWord8 >>= \a -> case a of 0 -> liftM Left m 1 -> liftM Right n _ -> MonadFail.fail "Missing case" instance Serial2 (,) where serializeWith2 f g (a, b) = f a >> g b deserializeWith2 m n = liftM2 (,) m n instance Serial a => Serial2 ((,,) a) where serializeWith2 f g (a, b, c) = serialize a >> f b >> g c deserializeWith2 m n = liftM3 (,,) deserialize m n instance (Serial a, Serial b) => Serial2 ((,,,) a b) where serializeWith2 f g (a, b, c, d) = serialize a >> serialize b >> f c >> g d deserializeWith2 m n = liftM4 (,,,) deserialize deserialize m n instance (Serial a, Serial b, Serial c) => Serial2 ((,,,,) a b c) where serializeWith2 f g (a, b, c, d, e) = serialize a >> serialize b >> serialize c >> f d >> g e deserializeWith2 m n = liftM5 (,,,,) deserialize deserialize deserialize m n bytes-0.17.3/src/Data/Bytes/Signed.hs0000644000000000000000000000306607346545000015421 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} -------------------------------------------------------------------- -- | -- License : BSD3 -- Stability : experimental -- Portability: type-families -- -- When one wants to think of an 'Int' as a dumb bitstring, converting -- it to a 'Word' avoids pesky complications with respect to sign -- extension. -------------------------------------------------------------------- module Data.Bytes.Signed ( Unsigned, unsigned , Signed, signed ) where import Data.Int import Data.Word type family Unsigned i :: * type instance Unsigned Int = Word 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 type instance Unsigned Word16 = Word16 type instance Unsigned Word32 = Word32 type instance Unsigned Word64 = Word64 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 Integer = Integer type instance Signed Word = Int type instance Signed Word8 = Int8 type instance Signed Word16 = Int16 type instance Signed Word32 = Int32 type instance Signed Word64 = Int64 signed :: (Integral i, Num (Signed i)) => i -> Signed i signed = fromIntegral bytes-0.17.3/src/Data/Bytes/VarInt.hs0000644000000000000000000000233407346545000015410 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} -------------------------------------------------------------------- -- | -- License : BSD3 -- Stability : experimental -- Portability: type-families, generalized newtype deriving -- -- This module provides a 'VarInt' wrapper with a 'Serial' instance -- that generates base-128 variable-width ints. Values are encoded 7 -- bits at a time, with the most significant being a continuation bit. -- Thus, the numbers from 0 to 127 require only a single byte to -- encode, those from 128 to 16383 require two bytes, etc. -- -- This format is taken from Google's /Protocol Buffers/, which -- provides a bit more verbiage on the encoding: -- . -------------------------------------------------------------------- module Data.Bytes.VarInt ( VarInt(..) ) where import Data.Bits import Data.Bytes.Signed 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)