bytes-0.15.2/0000755000000000000000000000000012646611231011115 5ustar0000000000000000bytes-0.15.2/.ghci0000644000000000000000000000015612646611231012032 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -optP-Iincludes :set -v0 bytes-0.15.2/.gitignore0000644000000000000000000000010412646611231013100 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# bytes-0.15.2/.travis.yml0000644000000000000000000000716412646611231013236 0ustar0000000000000000# This file has been generated -- see https://github.com/hvr/multi-ghc-travis language: c sudo: false cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: include: - env: CABALVER=1.16 GHCVER=7.4.2 compiler: ": #GHC 7.4.2" addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources: [hvr-ghc]}} - env: CABALVER=1.16 GHCVER=7.6.3 compiler: ": #GHC 7.6.3" addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}} - env: CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=7.10.2 compiler: ": #GHC 7.10.2" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=8.0.1 compiler: ": #GHC 8.0.1" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} before_install: - unset CC - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH install: - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install --only-dependencies --enable-tests --enable-benchmarks; fi # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test - cabal sdist # tests that a source-distribution can be generated # Check that the resulting source distribution can be built & installed. # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ") notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313bytes\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" # EOF bytes-0.15.2/.vim.custom0000644000000000000000000000137712646611231013232 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.15.2/AUTHORS.markdown0000644000000000000000000000141212646611231014004 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.15.2/bytes.cabal0000644000000000000000000000515012646611231013230 0ustar0000000000000000name: bytes category: Data, Serialization version: 0.15.2 license: BSD3 cabal-version: >= 1.8 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: Custom tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2 synopsis: Sharing code for serialization between binary and cereal description: Sharing code for serialization between binary and cereal extra-source-files: .travis.yml .ghci .gitignore .vim.custom travis/cabal-apt-install travis/config AUTHORS.markdown README.markdown CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/bytes.git -- 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 library build-depends: base >= 4.5 && < 5, binary >= 0.5.1 && < 0.9, bytestring >= 0.9 && < 0.11, cereal >= 0.3.5 && < 0.6, containers >= 0.3 && < 1, hashable >= 1.0.1.1 && < 1.4, mtl >= 2.0 && < 2.3, text >= 0.2 && < 1.3, time >= 1.2 && < 1.7, transformers >= 0.2 && < 0.6, transformers-compat >= 0.3 && < 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 -- hack around the buggy unused matches check for class associated types in ghc 8 rc1 if impl(ghc >= 8) ghc-options: -fno-warn-unused-matches exposed-modules: Data.Bytes.Get Data.Bytes.Put Data.Bytes.Serial Data.Bytes.Signed Data.Bytes.VarInt ghc-options: -Wall -fwarn-tabs -O2 c-sources: cbits/i2d.c hs-source-dirs: src test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests if !flag(test-doctests) || impl(ghc >= 8) buildable: False else build-depends: base, bytes, directory >= 1.0, doctest >= 0.9.1, filepath >= 1.2 bytes-0.15.2/CHANGELOG.markdown0000644000000000000000000000407712646611231014160 0ustar00000000000000000.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.15.2/LICENSE0000644000000000000000000000266012646611231012126 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.15.2/README.markdown0000644000000000000000000000106612646611231013621 0ustar0000000000000000bytes ===== [![Hackage](https://img.shields.io/hackage/v/bytes.svg)](https://hackage.haskell.org/package/bytes) [![Build Status](https://secure.travis-ci.org/ekmett/bytes.png?branch=master)](http://travis-ci.org/ekmett/bytes) 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.15.2/Setup.lhs0000644000000000000000000000464412646611231012735 0ustar0000000000000000#!/usr/bin/runhaskell \begin{code} {-# OPTIONS_GHC -Wall #-} module Main (main) where import Data.List ( nub ) import Data.Version ( showVersion ) import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName ) import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) import Distribution.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) import System.FilePath ( () ) main :: IO () main = defaultMainWithHooks simpleUserHooks { buildHook = \pkg lbi hooks flags -> do generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi buildHook simpleUserHooks pkg lbi hooks flags , postHaddock = \args flags pkg lbi -> do copyFiles normal (haddockOutputDir flags pkg) [] postHaddock simpleUserHooks args flags pkg lbi } haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath haddockOutputDir flags pkg = destDir where baseDir = case haddockDistPref flags of NoFlag -> "." Flag x -> x destDir = baseDir "doc" "html" display (packageName pkg) generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule verbosity pkg lbi = do let dir = autogenModulesDir lbi createDirectoryIfMissingVerbose verbosity True dir withLibLBI pkg lbi $ \_ libcfg -> do withTestLBI pkg lbi $ \suite suitecfg -> do rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines [ "module Build_" ++ testName suite ++ " where" , "deps :: [String]" , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) ] where formatdeps = map (formatone . snd) formatone p = case packageName p of PackageName n -> n ++ "-" ++ showVersion (packageVersion p) testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys \end{code} bytes-0.15.2/cbits/0000755000000000000000000000000012646611231012221 5ustar0000000000000000bytes-0.15.2/cbits/i2d.c0000644000000000000000000000075212646611231013047 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.15.2/src/0000755000000000000000000000000012646611231011704 5ustar0000000000000000bytes-0.15.2/src/Data/0000755000000000000000000000000012646611231012555 5ustar0000000000000000bytes-0.15.2/src/Data/Bytes/0000755000000000000000000000000012646611231013643 5ustar0000000000000000bytes-0.15.2/src/Data/Bytes/Get.hs0000644000000000000000000003572712646611231014734 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE Trustworthy #-} {-# 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 #endif import Control.Monad.Reader import Control.Monad.Trans.Except as Except import Control.Monad.RWS.Lazy as Lazy import Control.Monad.RWS.Strict as Strict import Control.Monad.State.Lazy as Lazy import Control.Monad.State.Strict as Strict import Control.Monad.Writer.Lazy as Lazy import Control.Monad.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 class (Integral (Remaining m), Monad 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) => m (Remaining n) 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 endianess. 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 "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.15.2/src/Data/Bytes/Put.hs0000644000000000000000000002054712646611231014757 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 #endif import Control.Monad.Reader import Control.Monad.Trans.Except as Except import Control.Monad.RWS.Lazy as Lazy import Control.Monad.RWS.Strict as Strict import Control.Monad.State.Lazy as Lazy import Control.Monad.State.Strict as Strict import Control.Monad.Writer.Lazy as Lazy import Control.Monad.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.15.2/src/Data/Bytes/Serial.hs0000644000000000000000000007006012646611231015421 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Trustworthy #-} #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 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 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 #if MIN_VERSION_base(4,8,0) import Numeric.Natural #endif foreign import ccall floatToWord32 :: Float -> Word32 foreign import ccall word32ToFloat :: Word32 -> Float foreign import ccall doubleToWord64 :: Double -> Word64 foreign import ccall word64ToDouble :: Word64 -> Double ------------------------------------------------------------------------------ -- 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) 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 = 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 = 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, 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 #-} -- | -- $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 #if MIN_VERSION_base(4,8,0) -- | -- >>> runGetL deserialize (runPutL (serialize (10^10::Natural))) :: Natural -- 10000000000 instance Serial Natural where serialize = serialize . VarInt . toInteger deserialize = fromInteger . unVarInt <$> deserialize #endif -- | -- >>> (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 _ = fail "I looked into the void." gdeserialize = 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 _ -> 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 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 _ = fail "I looked into the void." gdeserializeWith _ = 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) _ -> 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 _ -> 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.15.2/src/Data/Bytes/Signed.hs0000644000000000000000000000306612646611231015415 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.15.2/src/Data/Bytes/VarInt.hs0000644000000000000000000000233412646611231015404 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) bytes-0.15.2/tests/0000755000000000000000000000000012646611231012257 5ustar0000000000000000bytes-0.15.2/tests/doctests.hsc0000644000000000000000000000463012646611231014611 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-13 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides doctests for a project based on the actual versions -- of the packages it was built with. It requires a corresponding Setup.lhs -- to be added to the project ----------------------------------------------------------------------------- module Main where import Build_doctests (deps) import Control.Applicative import Control.Monad import Data.List import System.Directory import System.FilePath import Test.DocTest ##if defined(mingw32_HOST_OS) ##if defined(i386_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##elif defined(x86_64_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##endif ##endif -- | Run in a modified codepage where we can print UTF-8 values on Windows. withUnicode :: IO a -> IO a ##ifdef USE_CP withUnicode m = do cp <- c_GetConsoleCP (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp ##else withUnicode m = m ##endif main :: IO () main = withUnicode $ getSources >>= \sources -> doctest $ "-isrc" : "-idist/build/autogen" : "-optP-include" : "-optPdist/build/autogen/cabal_macros.h" : "-hide-all-packages" : "-Iincludes" : "dist/build/cbits/i2d.o" : map ("-package="++) (filter (not . ("bytes-" `isPrefixOf`)) deps) ++ sources getSources :: IO [FilePath] getSources = filter (isSuffixOf ".hs") <$> go "src" where go dir = do (dirs, files) <- getFilesAndDirectories dir (files ++) . concat <$> mapM go dirs getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) getFilesAndDirectories dir = do c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c bytes-0.15.2/travis/0000755000000000000000000000000012646611231012425 5ustar0000000000000000bytes-0.15.2/travis/cabal-apt-install0000755000000000000000000000127212646611231015645 0ustar0000000000000000#! /bin/bash set -eu APT="sudo apt-get -q -y" CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall" $APT update $APT install dctrl-tools # Find potential system packages to satisfy cabal dependencies deps() { local M='^\([^ ]\+\)-[0-9.]\+ (.*$' local G=' -o ( -FPackage -X libghc-\L\1\E-dev )' local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \ | sed -ne "s/$M/$G/p" | sort -u)" grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u } $APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special $CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage if ! $APT install hlint ; then $APT install $(deps hlint) cabal install hlint fi bytes-0.15.2/travis/config0000644000000000000000000000120612646611231013614 0ustar0000000000000000-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix -- -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. -- -- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive remote-repo-cache: ~/.cabal/packages world-file: ~/.cabal/world build-summary: ~/.cabal/logs/build.log remote-build-reporting: anonymous install-dirs user install-dirs global