packages feed

bytes (empty) → 0.1

raw patch · 15 files changed

+1020/−0 lines, 15 filesdep +basedep +binarydep +bytestringbuild-type:Customsetup-changed

Dependencies added: base, binary, bytestring, cereal, directory, doctest, filepath, mtl, transformers, transformers-compat

Files

+ .ghci view
@@ -0,0 +1,2 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -optP-Iincludes+:set -v0
+ .gitignore view
@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#
+ .travis.yml view
@@ -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"
+ .vim.custom view
@@ -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"
+ AUTHORS.markdown view
@@ -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
+ CHANGELOG.markdown view
@@ -0,0 +1,3 @@+0.1+---+* Repository initialized
+ LICENSE view
@@ -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.
+ README.markdown view
@@ -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
+ Setup.lhs view
@@ -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}
+ bytes.cabal view
@@ -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
+ src/Data/Bytes/Get.hs view
@@ -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 #-}
+ src/Data/Bytes/Put.hs view
@@ -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)
+ tests/doctests.hsc view
@@ -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
+ travis/cabal-apt-install view
@@ -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+
+ travis/config view
@@ -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