summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.ghci2
-rw-r--r--.gitignore13
-rw-r--r--.travis.yml24
-rw-r--r--.vim.custom31
-rw-r--r--AUTHORS.markdown11
-rw-r--r--CHANGELOG.markdown3
-rw-r--r--LICENSE30
-rw-r--r--README.markdown15
-rw-r--r--Setup.lhs55
-rw-r--r--bytes.cabal78
-rw-r--r--src/Data/Bytes/Get.hs410
-rw-r--r--src/Data/Bytes/Put.hs231
-rw-r--r--tests/doctests.hsc74
-rwxr-xr-xtravis/cabal-apt-install27
-rw-r--r--travis/config16
15 files changed, 1020 insertions, 0 deletions
diff --git a/.ghci b/.ghci
new file mode 100644
index 0000000..7b065da
--- /dev/null
+++ b/.ghci
@@ -0,0 +1,2 @@
+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -optP-Iincludes
+:set -v0
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..bbcd5d4
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,13 @@
+dist
+docs
+wiki
+TAGS
+tags
+wip
+.DS_Store
+.*.swp
+.*.swo
+*.o
+*.hi
+*~
+*#
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..be60415
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,24 @@
+language: haskell
+before_install:
+ # Uncomment whenever hackage is down.
+ # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update
+ # - cabal update
+ - travis/cabal-apt-install $mode
+
+install:
+ - cabal configure -flib-Werror $mode
+ - cabal build
+
+script:
+ - $script && hlint src --cpp-define HLINT
+
+notifications:
+ irc:
+ channels:
+ - "irc.freenode.org#haskell-lens"
+ skip_join: true
+ template:
+ - "\x0313bytes\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"
+
+env:
+ - mode="--enable-tests" script="cabal test --show-details=always"
diff --git a/.vim.custom b/.vim.custom
new file mode 100644
index 0000000..86321a8
--- /dev/null
+++ b/.vim.custom
@@ -0,0 +1,31 @@
+" 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 <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>
+
+" 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"
diff --git a/AUTHORS.markdown b/AUTHORS.markdown
new file mode 100644
index 0000000..ef93bf5
--- /dev/null
+++ b/AUTHORS.markdown
@@ -0,0 +1,11 @@
+Analytics 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
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
new file mode 100644
index 0000000..d86ca8a
--- /dev/null
+++ b/CHANGELOG.markdown
@@ -0,0 +1,3 @@
+0.1
+---
+* Repository initialized
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..c6aa839
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright 2013 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.
diff --git a/README.markdown b/README.markdown
new file mode 100644
index 0000000..4b20e25
--- /dev/null
+++ b/README.markdown
@@ -0,0 +1,15 @@
+bytes
+=====
+
+[![Build Status](https://secure.travis-ci.org/analytics/bytes.png)](http://travis-ci.org/analytics/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
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
index 0000000..f459974
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,55 @@
+#!/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}
diff --git a/bytes.cabal b/bytes.cabal
new file mode 100644
index 0000000..813bdbc
--- /dev/null
+++ b/bytes.cabal
@@ -0,0 +1,78 @@
+name: bytes
+category: Data, Serialization
+version: 0.1
+license: BSD3
+cabal-version: >= 1.8
+license-file: LICENSE
+author: Edward A. Kmett
+maintainer: Edward A. Kmett <ekmett@gmail.com>
+stability: experimental
+homepage: http://github.com/analytics/bytes
+bug-reports: http://github.com/analytics/bytes/issues
+copyright: Copyright (C) 2013 Edward A. Kmett
+build-type: Custom
+tested-with: GHC == 7.4.1, GHC == 7.6.1
+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/analytics/bytes.git
+
+-- You can disable the doctests test suite with -f-test-doctests
+flag test-doctests
+ default: True
+ manual: True
+
+flag lib-Werror
+ default: False
+ manual: True
+
+library
+ build-depends:
+ base >= 4.3 && < 5,
+ binary >= 0.5 && < 0.8,
+ bytestring >= 0.9 && < 0.11,
+ cereal >= 0.3.5 && < 0.4,
+ mtl >= 2.0 && < 2.2,
+ transformers >= 0.2 && < 0.4,
+ transformers-compat >= 0.1 && < 1
+
+ exposed-modules:
+ Data.Bytes.Get
+ Data.Bytes.Put
+
+ if flag(lib-Werror)
+ ghc-options: -Werror
+
+ ghc-options: -Wall -fwarn-tabs -O2
+ 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)
+ buildable: False
+ else
+ build-depends:
+ base,
+ directory >= 1.0,
+ doctest >= 0.9.1,
+ filepath >= 1.2
+
+ if impl(ghc<7.6.1)
+ ghc-options: -Werror
diff --git a/src/Data/Bytes/Get.hs b/src/Data/Bytes/Get.hs
new file mode 100644
index 0000000..af4e245
--- /dev/null
+++ b/src/Data/Bytes/Get.hs
@@ -0,0 +1,410 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DefaultSignatures #-}
+--------------------------------------------------------------------
+-- |
+-- Copyright : (c) Edward Kmett 2013
+-- License : BSD3
+-- Maintainer: Edward Kmett <ekmett@gmail.com>
+-- 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(..)
+ ) where
+
+import Control.Monad.Reader
+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 (Unchecked m), Monad m) => MonadGet m where
+ -- | An 'Integral' number type used for unchecked skips and counting.
+ type Unchecked 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
+
+ -- | Skip ahead @n@ bytes. No error if there isn't enough bytes.
+ uncheckedSkip :: Unchecked m -> m ()
+#ifndef HLINT
+ default uncheckedSkip :: (MonadTrans t, MonadGet n, m ~ t n) => Unchecked n -> m ()
+ uncheckedSkip = lift . uncheckedSkip
+#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)
+
+ -- | Get the next up to @n@ bytes as a lazy ByteString, without consuming them.
+ uncheckedLookAhead :: Unchecked m -> m (Bytes m)
+#ifndef HLINT
+ default uncheckedLookAhead :: (MonadTrans t, MonadGet n, m ~ t n) => Unchecked n -> m (Bytes n)
+ uncheckedLookAhead = lift . uncheckedLookAhead
+#endif
+
+ -- | 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 (Unchecked m)
+#ifndef HLINT
+ default remaining :: (MonadTrans t, MonadGet n, m ~ t n) => m (Unchecked 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 Unchecked B.Get = Int64
+ type Bytes B.Get = Lazy.ByteString
+ skip = B.skip
+ {-# INLINE skip #-}
+ uncheckedSkip = B.uncheckedSkip
+ {-# INLINE uncheckedSkip #-}
+ lookAhead = B.lookAhead
+ {-# INLINE lookAhead #-}
+ lookAheadM = B.lookAheadM
+ {-# INLINE lookAheadM #-}
+ lookAheadE = B.lookAheadE
+ {-# INLINE lookAheadE #-}
+ uncheckedLookAhead = B.uncheckedLookAhead
+ {-# INLINE uncheckedLookAhead #-}
+ getBytes = B.getBytes
+ {-# 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 Unchecked S.Get = Int
+ type Bytes S.Get = Strict.ByteString
+ skip = S.skip
+ {-# INLINE skip #-}
+ uncheckedSkip = S.uncheckedSkip
+ {-# INLINE uncheckedSkip #-}
+ lookAhead = S.lookAhead
+ {-# INLINE lookAhead #-}
+ lookAheadM = S.lookAheadM
+ {-# INLINE lookAheadM #-}
+ lookAheadE = S.lookAheadE
+ {-# INLINE lookAheadE #-}
+ uncheckedLookAhead = S.uncheckedLookAhead
+ {-# INLINE uncheckedLookAhead #-}
+ getBytes = S.getBytes
+ {-# INLINE getBytes #-}
+ 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 Unchecked (Lazy.StateT s m) = Unchecked 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 Unchecked (Strict.StateT s m) = Unchecked 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 Unchecked (ReaderT e m) = Unchecked 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 Unchecked (Lazy.WriterT w m) = Unchecked 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 Unchecked (Strict.WriterT w m) = Unchecked 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 Unchecked (Strict.RWST r w s m) = Unchecked 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 Unchecked (Lazy.RWST r w s m) = Unchecked 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 #-}
diff --git a/src/Data/Bytes/Put.hs b/src/Data/Bytes/Put.hs
new file mode 100644
index 0000000..6085dfc
--- /dev/null
+++ b/src/Data/Bytes/Put.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+--------------------------------------------------------------------
+-- |
+-- Copyright : (c) Edward Kmett 2013
+-- License : BSD3
+-- Maintainer: Edward Kmett <ekmett@gmail.com>
+-- 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(..)
+ ) where
+
+import Control.Monad.Reader
+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
+
+class 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)
diff --git a/tests/doctests.hsc b/tests/doctests.hsc
new file mode 100644
index 0000000..9868333
--- /dev/null
+++ b/tests/doctests.hsc
@@ -0,0 +1,74 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Main (doctests)
+-- Copyright : (C) 2012-13 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+-- Maintainer : Edward Kmett <ekmett@gmail.com>
+-- 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"
+ : map ("-package="++) 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
diff --git a/travis/cabal-apt-install b/travis/cabal-apt-install
new file mode 100755
index 0000000..a53e851
--- /dev/null
+++ b/travis/cabal-apt-install
@@ -0,0 +1,27 @@
+#! /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
+
diff --git a/travis/config b/travis/config
new file mode 100644
index 0000000..a9287ce
--- /dev/null
+++ b/travis/config
@@ -0,0 +1,16 @@
+-- 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