diff -Nru haskell-streaming-commons-0.1.17/bench/builder-to-bytestring-io.hs haskell-streaming-commons-0.1.19/bench/builder-to-bytestring-io.hs --- haskell-streaming-commons-0.1.17/bench/builder-to-bytestring-io.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/bench/builder-to-bytestring-io.hs 2018-01-19 08:39:56.000000000 +0000 @@ -1,27 +1,20 @@ {-# LANGUAGE ScopedTypeVariables #-} -import qualified Blaze.ByteString.Builder as ZB -import Criterion.Main +import Gauge.Main import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Builder as BB -import Data.Monoid (mconcat, Monoid) +import Data.Monoid import qualified Data.Streaming.ByteString.Builder as BB main :: IO () main = defaultMain [ bgroup "Data.Streaming.ByteString.Builder.toByteStringIO" (benchmarks bIO b100_10000 b10000_100 b10000_10000) - , bgroup "Blaze.ByteString.Builder.toByteStringIO" - (benchmarks zIO z100_10000 z10000_100 z10000_10000) , bgroup "Data.ByteString.Builder.toLazyByteString" (benchmarks bLazy b100_10000 b10000_100 b10000_10000) - , bgroup "Blaze.ByteString.Builder.toLazyByteString" - (benchmarks zLazy z100_10000 z10000_100 z10000_10000) ] where bIO = whnfIO . BB.toByteStringIO (const (return ())) - zIO = whnfIO . ZB.toByteStringIO (const (return ())) bLazy = nf BB.toLazyByteString - zLazy = nf ZB.toLazyByteString benchmarks run bld100_10000 bld10000_100 bld10000_10000 = [ bench' run bld100_10000 100 10000 , bench' run bld10000_100 10000 100 @@ -32,8 +25,5 @@ b100_10000 = bld BB.byteString 100 10000 b10000_100 = bld BB.byteString 10000 100 b10000_10000 = bld BB.byteString 10000 10000 - z100_10000 = bld ZB.fromByteString 100 10000 - z10000_100 = bld ZB.fromByteString 10000 100 - z10000_10000 = bld ZB.fromByteString 10000 10000 - bld :: Monoid a => (S.ByteString -> a) -> Int -> Int -> a + bld :: Data.Monoid.Monoid a => (S.ByteString -> a) -> Int -> Int -> a bld f len reps = mconcat (replicate reps (f (S.replicate len 'x'))) diff -Nru haskell-streaming-commons-0.1.17/bench/count-chars.hs haskell-streaming-commons-0.1.19/bench/count-chars.hs --- haskell-streaming-commons-0.1.17/bench/count-chars.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/bench/count-chars.hs 2018-01-19 08:37:53.000000000 +0000 @@ -1,4 +1,4 @@ -import Criterion.Main +import Gauge.Main import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE diff -Nru haskell-streaming-commons-0.1.17/ChangeLog.md haskell-streaming-commons-0.1.19/ChangeLog.md --- haskell-streaming-commons-0.1.17/ChangeLog.md 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/ChangeLog.md 2018-01-31 15:11:50.000000000 +0000 @@ -1,3 +1,11 @@ +## 0.1.19 + +* Update `getAddrInfo` hints to allow hostnames and portnames [#46](https://github.com/fpco/streaming-commons/issues/46) + +## 0.1.18 + +* Add `isCompleteInflate` + ## 0.1.17 * Add `bindPortGenEx` diff -Nru haskell-streaming-commons-0.1.17/Data/Streaming/ByteString/Builder/Class.hs haskell-streaming-commons-0.1.19/Data/Streaming/ByteString/Builder/Class.hs --- haskell-streaming-commons-0.1.17/Data/Streaming/ByteString/Builder/Class.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/Data/Streaming/ByteString/Builder/Class.hs 2018-01-19 08:41:43.000000000 +0000 @@ -34,7 +34,7 @@ -- -- Since 0.1.10.0 -- -class Monoid b => StreamingBuilder b where +class Data.Monoid.Monoid b => StreamingBuilder b where newBuilderRecv :: BufferAllocStrategy -> IO (b -> IO BuilderPopper, BuilderFinish) builderFlush :: b diff -Nru haskell-streaming-commons-0.1.17/Data/Streaming/Network.hs haskell-streaming-commons-0.1.19/Data/Streaming/Network.hs --- haskell-streaming-commons-0.1.17/Data/Streaming/Network.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/Data/Streaming/Network.hs 2018-01-31 15:11:50.000000000 +0000 @@ -158,8 +158,7 @@ bindPortGenEx sockOpts sockettype p s = do let hints = NS.defaultHints { NS.addrFlags = [ NS.AI_PASSIVE - , NS.AI_NUMERICSERV - , NS.AI_NUMERICHOST + , NS.AI_ADDRCONFIG ] , NS.addrSocketType = sockettype } diff -Nru haskell-streaming-commons-0.1.17/Data/Streaming/Process.hs haskell-streaming-commons-0.1.19/Data/Streaming/Process.hs --- haskell-streaming-commons-0.1.17/Data/Streaming/Process.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/Data/Streaming/Process.hs 2018-01-19 09:27:33.000000000 +0000 @@ -31,7 +31,7 @@ , module System.Process ) where -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative as A ((<$>), (<*>)) import Control.Concurrent (forkIOWithUnmask) import Control.Concurrent.STM (STM, TMVar, atomically, newEmptyTMVar, putTMVar, @@ -176,8 +176,8 @@ mclose = maybe (return ()) hClose (,,,) - <$> getStdin stdinH - <*> getStdout stdoutH + A.<$> getStdin stdinH + A.<*> getStdout stdoutH <*> getStderr stderrH <*> return (StreamingProcessHandle ph ec close) diff -Nru haskell-streaming-commons-0.1.17/Data/Streaming/Zlib.hs haskell-streaming-commons-0.1.19/Data/Streaming/Zlib.hs --- haskell-streaming-commons-0.1.17/Data/Streaming/Zlib.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/Data/Streaming/Zlib.hs 2018-01-19 08:28:57.000000000 +0000 @@ -27,6 +27,7 @@ , finishInflate , flushInflate , getUnusedInflate + , isCompleteInflate -- * Deflate , Deflate , initDeflate @@ -52,6 +53,7 @@ import Data.ByteString.Lazy.Internal (defaultChunkSize) import Data.Typeable (Typeable) import Control.Exception (Exception) +import Control.Monad (when) import Data.IORef type ZStreamPair = (ForeignPtr ZStreamStruct, ForeignPtr CChar) @@ -62,6 +64,7 @@ data Inflate = Inflate ZStreamPair (IORef S.ByteString) -- last ByteString fed in, needed for getUnusedInflate + (IORef Bool) -- set True when zlib indicates that inflation is complete (Maybe S.ByteString) -- dictionary -- | The state of a deflation (eg, compression) process. All allocated memory @@ -95,6 +98,9 @@ instance Exception ZlibException -- | Some constants for the error codes, used internally +zStreamEnd :: CInt +zStreamEnd = 1 + zNeedDict :: CInt zNeedDict = 2 @@ -113,9 +119,10 @@ withForeignPtr fbuff $ \buff -> c_set_avail_out zstr buff $ fromIntegral defaultChunkSize lastBS <- newIORef S.empty - return $ Inflate (fzstr, fbuff) lastBS Nothing + complete <- newIORef False + return $ Inflate (fzstr, fbuff) lastBS complete Nothing --- | Initialize an inflation process with the given 'WindowBits'. +-- | Initialize an inflation process with the given 'WindowBits'. -- Unlike initInflate a dictionary for inflation is set which must -- match the one set during compression. initInflateWithDictionary :: WindowBits -> S.ByteString -> IO Inflate @@ -128,7 +135,8 @@ withForeignPtr fbuff $ \buff -> c_set_avail_out zstr buff $ fromIntegral defaultChunkSize lastBS <- newIORef S.empty - return $ Inflate (fzstr, fbuff) lastBS (Just bs) + complete <- newIORef False + return $ Inflate (fzstr, fbuff) lastBS complete (Just bs) -- | Initialize a deflation process with the given compression level and -- 'WindowBits'. You will need to call 'feedDeflate' to feed uncompressed @@ -178,7 +186,7 @@ :: Inflate -> S.ByteString -> IO Popper -feedInflate (Inflate (fzstr, fbuff) lastBS inflateDictionary) bs = do +feedInflate (Inflate (fzstr, fbuff) lastBS complete inflateDictionary) bs = do -- Write the BS to lastBS for use by getUnusedInflate. This is -- theoretically unnecessary, since we could just grab the pointer from the -- fzstr when needed. However, in that case, we wouldn't be holding onto a @@ -193,15 +201,17 @@ where inflate zstr = do res <- c_call_inflate_noflush zstr - if (res == zNeedDict) + res2 <- if (res == zNeedDict) then maybe (return zNeedDict) (\dict -> (unsafeUseAsCStringLen dict $ \(cstr, len) -> do c_call_inflate_set_dictionary zstr cstr $ fromIntegral len c_call_inflate_noflush zstr)) inflateDictionary else return res + when (res2 == zStreamEnd) (writeIORef complete True) + return res2 --- | An IO action that returns the next chunk of data, returning 'Nothing' when +-- | An IO action that returns the next chunk of data, returning 'PRDone' when -- there is no more data to be popped. type Popper = IO PopperRes @@ -243,7 +253,7 @@ -- data, you will likely have some data still sitting in the buffer. This -- function will return it to you. finishInflate :: Inflate -> IO S.ByteString -finishInflate (Inflate (fzstr, fbuff) _ _) = +finishInflate (Inflate (fzstr, fbuff) _ _ _) = withForeignPtr fzstr $ \zstr -> withForeignPtr fbuff $ \buff -> do avail <- c_get_avail_out zstr @@ -267,11 +277,18 @@ -- -- Since 0.1.11 getUnusedInflate :: Inflate -> IO S.ByteString -getUnusedInflate (Inflate (fzstr, _) ref _) = do +getUnusedInflate (Inflate (fzstr, _) ref _ _) = do bs <- readIORef ref len <- withForeignPtr fzstr c_get_avail_in return $ S.drop (S.length bs - fromIntegral len) bs +-- | Returns True if the inflater has reached end-of-stream, or False if +-- it is still expecting more data. +-- +-- Since 0.1.18 +isCompleteInflate :: Inflate -> IO Bool +isCompleteInflate (Inflate _ _ complete _) = readIORef complete + -- | Feed the given 'S.ByteString' to the deflater. Return a 'Popper', -- an IO action that returns the compressed data a chunk at a time. -- The 'Popper' must be called to exhaustion before using the 'Deflate' diff -Nru haskell-streaming-commons-0.1.17/debian/changelog haskell-streaming-commons-0.1.19/debian/changelog --- haskell-streaming-commons-0.1.17/debian/changelog 2017-07-10 09:50:27.000000000 +0000 +++ haskell-streaming-commons-0.1.19/debian/changelog 2018-04-09 21:11:08.000000000 +0000 @@ -1,20 +1,18 @@ -haskell-streaming-commons (0.1.17-1build3) artful; urgency=medium +haskell-streaming-commons (0.1.19-1) unstable; urgency=medium - * Rebuild against new GHC ABI. + [ Ilias Tsitsimpis ] + * Change Priority to optional. Since Debian Policy version 4.0.1, + priority extra has been deprecated. + * Use the HTTPS form of the copyright-format URL + * Modify d/watch and Source field in d/copyright to use HTTPS + * Declare compliance with Debian policy 4.1.1 + * Use salsa.debian.org URLs in Vcs-{Browser,Git} fields + + [ Clint Adams ] + * Bump to Standards-Version 4.1.4. + * New upstream release - -- Gianfranco Costamagna Mon, 10 Jul 2017 11:50:27 +0200 - -haskell-streaming-commons (0.1.17-1build2) artful; urgency=medium - - * Rebuild against new GHC ABI. - - -- Gianfranco Costamagna Mon, 10 Jul 2017 08:42:40 +0200 - -haskell-streaming-commons (0.1.17-1build1) artful; urgency=medium - - * No-change rebuild for new GHC ABIs - - -- Steve Langasek Wed, 21 Jun 2017 05:49:19 +0000 + -- Clint Adams Mon, 09 Apr 2018 17:11:08 -0400 haskell-streaming-commons (0.1.17-1) unstable; urgency=medium diff -Nru haskell-streaming-commons-0.1.17/debian/control haskell-streaming-commons-0.1.19/debian/control --- haskell-streaming-commons-0.1.17/debian/control 2017-06-21 05:49:19.000000000 +0000 +++ haskell-streaming-commons-0.1.19/debian/control 2018-04-09 21:11:08.000000000 +0000 @@ -1,8 +1,7 @@ Source: haskell-streaming-commons -Maintainer: Ubuntu Developers -XSBC-Original-Maintainer: Debian Haskell Group +Maintainer: Debian Haskell Group Uploaders: Clint Adams -Priority: extra +Priority: optional Section: haskell Build-Depends: cdbs, @@ -37,10 +36,10 @@ libghc-stm-doc, libghc-text-doc, libghc-zlib-doc, -Standards-Version: 3.9.8 +Standards-Version: 4.1.4 Homepage: https://github.com/fpco/streaming-commons -Vcs-Browser: https://anonscm.debian.org/cgit/pkg-haskell/DHG_packages.git/tree/p/haskell-streaming-commons -Vcs-Git: https://anonscm.debian.org/git/pkg-haskell/DHG_packages.git +Vcs-Browser: https://salsa.debian.org/haskell-team/DHG_packages/tree/master/p/haskell-streaming-commons +Vcs-Git: https://salsa.debian.org/haskell-team/DHG_packages.git X-Description: common lower-level functions for various streaming data libraries Provides low-dependency functionality commonly needed by various streaming data libraries, such as conduit and pipes. diff -Nru haskell-streaming-commons-0.1.17/debian/copyright haskell-streaming-commons-0.1.19/debian/copyright --- haskell-streaming-commons-0.1.17/debian/copyright 2017-06-18 06:14:37.000000000 +0000 +++ haskell-streaming-commons-0.1.19/debian/copyright 2018-04-09 21:11:08.000000000 +0000 @@ -1,7 +1,7 @@ -Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: streaming-commons Upstream-Contact: Michael Snoyman -Source: http://hackage.haskell.org/package/streaming-commons +Source: https://hackage.haskell.org/package/streaming-commons Files: * Copyright: 2014 FP Complete diff -Nru haskell-streaming-commons-0.1.17/debian/watch haskell-streaming-commons-0.1.19/debian/watch --- haskell-streaming-commons-0.1.17/debian/watch 2017-06-18 06:14:37.000000000 +0000 +++ haskell-streaming-commons-0.1.19/debian/watch 2018-04-09 21:11:08.000000000 +0000 @@ -1,2 +1,2 @@ version=3 -http://hackage.haskell.org/package/streaming-commons/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) +https://hackage.haskell.org/package/streaming-commons/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) diff -Nru haskell-streaming-commons-0.1.17/README.md haskell-streaming-commons-0.1.19/README.md --- haskell-streaming-commons-0.1.17/README.md 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/README.md 2018-01-19 09:27:47.000000000 +0000 @@ -5,6 +5,7 @@ Intended to be shared by libraries like conduit and pipes. [![Build Status](https://travis-ci.org/fpco/streaming-commons.svg)](https://travis-ci.org/fpco/streaming-commons) +[![Build status](https://ci.appveyor.com/api/projects/status/gn0gn4po97su2iyk/branch/master?svg=true)](https://ci.appveyor.com/project/snoyberg/streaming-commons/branch/master) Dependencies ------------ diff -Nru haskell-streaming-commons-0.1.17/streaming-commons.cabal haskell-streaming-commons-0.1.19/streaming-commons.cabal --- haskell-streaming-commons-0.1.17/streaming-commons.cabal 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/streaming-commons.cabal 2018-01-31 15:11:50.000000000 +0000 @@ -1,5 +1,5 @@ name: streaming-commons -version: 0.1.17 +version: 0.1.19 synopsis: Common lower-level functions needed by various streaming data libraries description: Provides low-dependency functionality commonly needed by various streaming data libraries, such as conduit and pipes. homepage: https://github.com/fpco/streaming-commons @@ -7,7 +7,7 @@ license-file: LICENSE author: Michael Snoyman, Emanuel Borsboom maintainer: michael@snoyman.com --- copyright: +-- copyright: category: Data build-type: Simple cabal-version: >=1.8 @@ -47,7 +47,7 @@ Data.Text.Internal.Encoding.Utf16 Data.Text.Internal.Encoding.Utf32 - build-depends: base >= 4.4 && < 5 + build-depends: base >= 4.7 && < 5 , array , async , blaze-builder >= 0.3 && < 0.5 @@ -121,7 +121,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: bench build-depends: base - , criterion + , gauge , bytestring , text , streaming-commons @@ -145,8 +145,8 @@ ghc-options: -Wall -O2 build-depends: base , blaze-builder - , bytestring - , criterion + , bytestring >= 0.10.2 + , gauge , deepseq , streaming-commons diff -Nru haskell-streaming-commons-0.1.17/test/Data/Streaming/ByteString/BuilderSpec.hs haskell-streaming-commons-0.1.19/test/Data/Streaming/ByteString/BuilderSpec.hs --- haskell-streaming-commons-0.1.17/test/Data/Streaming/ByteString/BuilderSpec.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/test/Data/Streaming/ByteString/BuilderSpec.hs 2018-01-19 08:41:43.000000000 +0000 @@ -94,7 +94,7 @@ prop "works for strict bytestring insertion" $ \bs' -> do let bs = S.pack bs' let builders :: [b] - builders = replicate 10000 (bfCopyByteString bs `mappend` bfInsertByteString bs) + builders = replicate 10000 (bfCopyByteString bs `Data.Monoid.mappend` bfInsertByteString bs) let lbs = bfToLazyByteString $ mconcat builders outBss <- tester defaultStrategy builders L.fromChunks outBss `shouldBe` lbs diff -Nru haskell-streaming-commons-0.1.17/test/Data/Streaming/FilesystemSpec.hs haskell-streaming-commons-0.1.19/test/Data/Streaming/FilesystemSpec.hs --- haskell-streaming-commons-0.1.17/test/Data/Streaming/FilesystemSpec.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/test/Data/Streaming/FilesystemSpec.hs 2018-01-19 08:37:53.000000000 +0000 @@ -7,7 +7,7 @@ import Data.List (sort) #if !WINDOWS import System.Posix.Files (removeLink, createSymbolicLink, createNamedPipe) -import Control.Exception (bracket, try, IOException) +import Control.Exception (try, IOException) #endif spec :: Spec diff -Nru haskell-streaming-commons-0.1.17/test/Data/Streaming/ZlibSpec.hs haskell-streaming-commons-0.1.19/test/Data/Streaming/ZlibSpec.hs --- haskell-streaming-commons-0.1.17/test/Data/Streaming/ZlibSpec.hs 2017-01-23 14:00:32.000000000 +0000 +++ haskell-streaming-commons-0.1.19/test/Data/Streaming/ZlibSpec.hs 2018-01-19 08:37:53.000000000 +0000 @@ -31,6 +31,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e instance Arbitrary L.ByteString where arbitrary = L.fromChunks `fmap` arbitrary @@ -50,6 +51,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e license :: S.ByteString license = S8.filter (/= '\r') $ unsafePerformIO $ S.readFile "LICENSE" @@ -70,6 +72,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e inflateWithDict :: S.ByteString -> L.ByteString -> L.ByteString inflateWithDict dict compressed = unsafePerformIO $ do @@ -84,6 +87,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e spec :: Spec spec = describe "Data.Streaming.Zlib" $ do @@ -107,6 +111,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e def <- initDeflate 8 $ WindowBits 31 gziped <- feedDeflate def license >>= go id gziped' <- go gziped $ finishDeflate def @@ -119,6 +124,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e gziped <- S.readFile "test/LICENSE.gz" inf <- initInflate $ WindowBits 31 popper <- feedInflate inf gziped @@ -133,6 +139,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e def <- initDeflate 5 $ WindowBits 31 gziped <- foldM (go' def) id $ map S.singleton $ S.unpack license gziped' <- go gziped $ finishDeflate def @@ -146,6 +153,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e gziped <- S.readFile "test/LICENSE.gz" let gziped' = map S.singleton $ S.unpack gziped inf <- initInflate $ WindowBits 31 @@ -162,6 +170,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e inf <- initInflate defaultWindowBits inflated <- foldM (go' inf) id $ L.toChunks glbs final <- finishInflate inf @@ -173,6 +182,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e def <- initDeflate 7 defaultWindowBits deflated <- foldM (go' def) id $ L.toChunks lbs deflated' <- go deflated $ finishDeflate def @@ -191,6 +201,7 @@ PRNext x -> do xs <- popList pop return $ x : xs + PRError e -> throwIO e let callback name expected pop = do bssDeflated <- popList pop @@ -256,6 +267,7 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e compressRaw :: L.ByteString -> IO L.ByteString compressRaw raw = do @@ -270,3 +282,4 @@ case y of PRDone -> return front PRNext z -> go (front . (:) z) x + PRError e -> throwIO e