Hello community, here is the log from the commit of package ghc-conduit-extra for openSUSE:Factory checked in at 2016-04-03 23:07:20 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-conduit-extra (Old) and /work/SRC/openSUSE:Factory/.ghc-conduit-extra.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-conduit-extra" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-conduit-extra/ghc-conduit-extra.changes 2016-03-16 10:33:35.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-conduit-extra.new/ghc-conduit-extra.changes 2016-04-03 23:07:38.000000000 +0200 @@ -1,0 +2,13 @@ +Sun Apr 3 15:14:52 UTC 2016 - mimi...@gmail.com + +- update to 1.1.13.1 +* Add sinkStorable and sinkStorableEx + +------------------------------------------------------------------- +Thu Mar 31 08:36:42 UTC 2016 - mimi...@gmail.com + +- update to 1.1.12.1 +* Add sourceProcessWithStreams +* Fix accidentally breaking change in sourceProcessWithConsumer type signature + +------------------------------------------------------------------- Old: ---- conduit-extra-1.1.11.tar.gz New: ---- conduit-extra-1.1.13.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-conduit-extra.spec ++++++ --- /var/tmp/diff_new_pack.WmnG3u/_old 2016-04-03 23:07:39.000000000 +0200 +++ /var/tmp/diff_new_pack.WmnG3u/_new 2016-04-03 23:07:39.000000000 +0200 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-conduit-extra -Version: 1.1.11 +Version: 1.1.13.1 Release: 0 Summary: Batteries included conduit: adapters for common libraries License: MIT @@ -34,6 +34,7 @@ BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros # Begin cabal-rpm deps: +BuildRequires: ghc-async-devel BuildRequires: ghc-attoparsec-devel BuildRequires: ghc-blaze-builder-devel BuildRequires: ghc-bytestring-devel ++++++ conduit-extra-1.1.11.tar.gz -> conduit-extra-1.1.13.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/ChangeLog.md new/conduit-extra-1.1.13.1/ChangeLog.md --- old/conduit-extra-1.1.11/ChangeLog.md 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/ChangeLog.md 2016-04-02 19:35:12.000000000 +0200 @@ -1,3 +1,20 @@ +## 1.1.13.1 + +* Fix an incorrect comment + +## 1.1.13 + +* Add `sinkStorable` and `sinkStorableEx` + +## 1.1.12.1 + +* Fix build for GHC `<= 7.8` [#260](https://github.com/snoyberg/conduit/issues/260) +* Fix accidentally breaking change in `sourceProcessWithConsumer` type signature + +## 1.1.12 + +* Add sourceProcessWithStreams [#258](https://github.com/snoyberg/conduit/pull/258) + ## 1.1.11 * `withCheckedProcessCleanup` diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Attoparsec.hs new/conduit-extra-1.1.13.1/Data/Conduit/Attoparsec.hs --- old/conduit-extra-1.1.11/Data/Conduit/Attoparsec.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Attoparsec.hs 2016-04-02 19:35:12.000000000 +0200 @@ -105,7 +105,7 @@ f (Position l c) ch | ch == '\n' = Position (l + 1) 0 | otherwise = Position l (c + 1) stripFromEnd (TI.Text arr1 off1 len1) (TI.Text _ _ len2) = - TI.textP arr1 off1 (len1 - len2) + TI.text arr1 off1 (len1 - len2) -- | Convert an Attoparsec 'A.Parser' into a 'Sink'. The parser will -- be streamed bytes until it returns 'A.Done' or 'A.Fail'. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Binary.hs new/conduit-extra-1.1.13.1/Data/Conduit/Binary.hs --- old/conduit-extra-1.1.11/Data/Conduit/Binary.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Binary.hs 2016-04-02 19:35:12.000000000 +0200 @@ -1,4 +1,6 @@ {-# LANGUAGE CPP, RankNTypes #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Functions for interacting with bytes. -- -- For many purposes, it's recommended to use the conduit-combinators library, @@ -36,6 +38,9 @@ , sinkCacheLength , sinkLbs , mapM_ + -- *** Storable + , sinkStorable + , sinkStorableEx -- ** Conduits , isolate , takeWhile @@ -45,6 +50,7 @@ import qualified Data.Streaming.FileRead as FR import Prelude hiding (head, take, drop, takeWhile, dropWhile, mapM_) import qualified Data.ByteString as S +import Data.ByteString.Unsafe (unsafeUseAsCString) import qualified Data.ByteString.Lazy as L import Data.Conduit import Data.Conduit.List (sourceList, consume) @@ -55,16 +61,21 @@ import Control.Monad.Trans.Class (lift) import qualified System.IO as IO import Data.Word (Word8, Word64) +#if (__GLASGOW_HASKELL__ < 710) import Control.Applicative ((<$>)) +#endif import System.Directory (getTemporaryDirectory, removeFile) import Data.ByteString.Lazy.Internal (defaultChunkSize) import Data.ByteString.Internal (ByteString (PS), inlinePerformIO) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.ForeignPtr (touchForeignPtr) -import Foreign.Ptr (plusPtr) -import Foreign.Storable (peek) +import Foreign.Ptr (plusPtr, castPtr) +import Foreign.Storable (Storable, peek, sizeOf) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) import Control.Monad.Trans.Resource (MonadResource) +import Control.Monad.Catch (MonadThrow (..)) +import Control.Exception (Exception) +import Data.Typeable (Typeable) -- | Stream the contents of a file as binary data. -- @@ -373,7 +384,7 @@ Just (_, second') -> yield (S.concat $ reverse $ first:acc) >> go [] second' Nothing -> loop $ more:acc where - (first, second) = S.breakByte 10 more + (first, second) = S.break (== 10) more -- | Stream the chunks from a lazy bytestring. -- @@ -435,3 +446,64 @@ mapM_ :: Monad m => (Word8 -> m ()) -> Consumer S.ByteString m () mapM_ f = awaitForever (lift . mapM_BS f) {-# INLINE mapM_ #-} + +-- | Consume some instance of @Storable@ from the incoming byte stream. In the +-- event of insufficient bytes in the stream, returns a @Nothing@ and returns +-- all unused input as leftovers. +-- +-- @since 1.1.13 +sinkStorable :: (Monad m, Storable a) => Consumer S.ByteString m (Maybe a) +sinkStorable = sinkStorableHelper Just (return Nothing) + +-- | Same as 'sinkStorable', but throws a 'SinkStorableInsufficientBytes' +-- exception (via 'throwM') in the event of insufficient bytes. This can be +-- more efficient to use than 'sinkStorable' as it avoids the need to +-- construct/deconstruct a @Maybe@ wrapper in the success case. +-- +-- @since 1.1.13 +sinkStorableEx :: (MonadThrow m, Storable a) => Consumer S.ByteString m a +sinkStorableEx = sinkStorableHelper id (throwM SinkStorableInsufficientBytes) + +sinkStorableHelper :: forall m a b. (Monad m, Storable a) + => (a -> b) + -> (Consumer S.ByteString m b) + -> Consumer S.ByteString m b +sinkStorableHelper wrap failure = do + start + where + size = sizeOf (undefined :: a) + + -- try the optimal case: next chunk has all the data we need + start = do + mbs <- await + case mbs of + Nothing -> failure + Just bs + | S.null bs -> start + | otherwise -> + case compare (S.length bs) size of + LT -> do + -- looks like we're stuck concating + leftover bs + lbs <- take size + let bs = S.concat $ L.toChunks lbs + case compare (S.length bs) size of + LT -> do + leftover bs + failure + EQ -> process bs + GT -> assert False (process bs) + EQ -> process bs + GT -> do + let (x, y) = S.splitAt size bs + leftover y + process x + + -- Given a bytestring of exactly the correct size, grab the value + process bs = return $! wrap $! inlinePerformIO $! + unsafeUseAsCString bs (peek . castPtr) +{-# INLINE sinkStorableHelper #-} + +data SinkStorableException = SinkStorableInsufficientBytes + deriving (Show, Typeable) +instance Exception SinkStorableException diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Lazy.hs new/conduit-extra-1.1.13.1/Data/Conduit/Lazy.hs --- old/conduit-extra-1.1.11/Data/Conduit/Lazy.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Lazy.hs 2016-04-02 19:35:12.000000000 +0200 @@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Trustworthy #-} + +{-# OPTIONS_GHC -fno-warn-deprecations #-} -- Suppress warnings around Control.Monad.Trans.Error -- | Use lazy I\/O for consuming the contents of a source. Warning: All normal -- warnings of lazy I\/O apply. In particular, if you are using this with a -- @ResourceT@ transformer, you must force the list to be evaluated before @@ -31,7 +33,9 @@ import qualified Control.Monad.Trans.State.Strict as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) +#if (__GLASGOW_HASKELL__ < 710) import Data.Monoid (Monoid) +#endif import Control.Monad.ST (ST) import qualified Control.Monad.ST.Lazy as Lazy import Data.Functor.Identity (Identity) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Network/UDP.hs new/conduit-extra-1.1.13.1/Data/Conduit/Network/UDP.hs --- old/conduit-extra-1.1.11/Data/Conduit/Network/UDP.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Network/UDP.hs 2016-04-02 19:35:12.000000000 +0200 @@ -13,8 +13,7 @@ ) where import Data.Conduit -import Network.Socket (AddrInfo, SockAddr, Socket) -import qualified Network.Socket as NS +import Network.Socket (Socket) import Network.Socket.ByteString (recvFrom, send, sendAll, sendTo, sendAllTo) import Data.ByteString (ByteString) import Control.Monad.IO.Class (MonadIO (liftIO)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Network/Unix.hs new/conduit-extra-1.1.13.1/Data/Conduit/Network/Unix.hs --- old/conduit-extra-1.1.11/Data/Conduit/Network/Unix.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Network/Unix.hs 2016-04-02 19:35:12.000000000 +0200 @@ -26,20 +26,11 @@ , SN.setAfterBind ) where -import Data.Conduit -import Network.Socket (Socket) -import qualified Network.Socket as NS import Data.Conduit.Network (appSource, appSink, sourceSocket, sinkSocket) import qualified Data.Streaming.Network as SN -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Exception (throwIO, SomeException, try, finally, bracket, - bracketOnError, catch) -import Control.Monad (forever, void) -import Control.Monad.Trans.Control (control) -import Control.Concurrent (forkIO) -import System.Directory (removeFile) -import System.IO.Error (isDoesNotExistError) -import Control.Monad.Trans.Resource (MonadBaseControl) +clientSettings :: FilePath -> SN.ClientSettingsUnix clientSettings = SN.clientSettingsUnix + +serverSettings :: FilePath -> SN.ServerSettingsUnix serverSettings = SN.serverSettingsUnix diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Network.hs new/conduit-extra-1.1.13.1/Data/Conduit/Network.hs --- old/conduit-extra-1.1.11/Data/Conduit/Network.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Network.hs 2016-04-02 19:35:12.000000000 +0200 @@ -38,17 +38,14 @@ , SN.HostPreference ) where -import Prelude hiding (catch) +import Prelude import Data.Conduit -import qualified Network.Socket as NS import Network.Socket (Socket) -import Network.Socket.ByteString (sendAll, recv) +import Network.Socket.ByteString (sendAll) import Data.ByteString (ByteString) import qualified GHC.Conc as Conc (yield) import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Exception (throwIO, SomeException, try, finally, bracket, IOException, catch) import Control.Monad (unless, void) import Control.Monad.Trans.Control (MonadBaseControl, control, liftBaseWith) import Control.Monad.Trans.Class (lift) @@ -81,7 +78,10 @@ where loop = await >>= maybe (return ()) (\bs -> lift (liftIO $ sendAll socket bs) >> loop) +serverSettings :: Int -> SN.HostPreference -> SN.ServerSettings serverSettings = SN.serverSettingsTCP + +clientSettings :: Int -> ByteString -> SN.ClientSettings clientSettings = SN.clientSettingsTCP appSource :: (SN.HasReadWrite ad, MonadIO m) => ad -> Producer m ByteString diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Process.hs new/conduit-extra-1.1.13.1/Data/Conduit/Process.hs --- old/conduit-extra-1.1.11/Data/Conduit/Process.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Process.hs 2016-04-02 19:35:12.000000000 +0200 @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | A full tutorial for this module is available on FP School of Haskell: -- <https://www.fpcomplete.com/user/snoyberg/library-documentation/data-conduit-process>. @@ -14,6 +15,8 @@ ( -- * Functions sourceCmdWithConsumer , sourceProcessWithConsumer + , sourceCmdWithStreams + , sourceProcessWithStreams , withCheckedProcessCleanup -- * Reexport , module Data.Streaming.Process @@ -27,7 +30,11 @@ import Data.Conduit import Data.Conduit.Binary (sourceHandle, sinkHandle) import Data.ByteString (ByteString) -import Control.Monad.Catch (MonadMask, onException, throwM) +import Control.Concurrent.Async (runConcurrently, Concurrently(..)) +import Control.Monad.Catch (MonadMask, onException, throwM, finally) +#if (__GLASGOW_HASKELL__ < 710) +import Control.Applicative ((<$>), (<*>)) +#endif instance (r ~ (), MonadIO m, i ~ ByteString) => InputSource (ConduitM i o m r) where isStdStream = (\(Just h) -> return $ sinkHandle h, Just CreatePipe) @@ -44,8 +51,15 @@ -- return a tuple of the @ExitCode@ from the process and the output collected -- from the @Consumer@. -- +-- Note that, if an exception is raised by the consumer, the process is /not/ +-- terminated. This behavior is different from 'sourceProcessWithStreams' due +-- to historical reasons. +-- -- Since 1.1.2 -sourceProcessWithConsumer :: MonadIO m => CreateProcess -> Consumer ByteString m a -> m (ExitCode, a) +sourceProcessWithConsumer :: MonadIO m + => CreateProcess + -> Consumer ByteString m a -- ^ stdout + -> m (ExitCode, a) sourceProcessWithConsumer cp consumer = do (ClosedStream, (source, close), ClosedStream, cph) <- streamingProcess cp res <- source $$ consumer @@ -57,11 +71,65 @@ -- a @String@. -- -- Since 1.1.2 -sourceCmdWithConsumer :: MonadIO m => String -> Consumer ByteString m a -> m (ExitCode, a) +sourceCmdWithConsumer :: MonadIO m + => String -- ^command + -> Consumer ByteString m a -- ^stdout + -> m (ExitCode, a) sourceCmdWithConsumer cmd = sourceProcessWithConsumer (shell cmd) + +-- | Given a @CreateProcess@, run the process +-- and feed the provided @Producer@ +-- to the stdin @Sink@ of the process. +-- Use the process outputs (stdout, stderr) as @Source@s +-- and feed it to the provided @Consumer@s. +-- Once the process has completed, +-- return a tuple of the @ExitCode@ from the process +-- and the results collected from the @Consumer@s. +-- +-- If an exception is raised by any of the streams, +-- the process is terminated. +-- +-- IO is required because the streams are run concurrently +-- using the <https://hackage.haskell.org/package/async async> package +-- +-- @since 1.1.12 +sourceProcessWithStreams :: CreateProcess + -> Producer IO ByteString -- ^stdin + -> Consumer ByteString IO a -- ^stdout + -> Consumer ByteString IO b -- ^stderr + -> IO (ExitCode, a, b) +sourceProcessWithStreams cp producerStdin consumerStdout consumerStderr = do + ( (sinkStdin, closeStdin) + , (sourceStdout, closeStdout) + , (sourceStderr, closeStderr) + , sph) <- streamingProcess cp + (_, resStdout, resStderr) <- + runConcurrently ( + (,,) + <$> Concurrently ((producerStdin $$ sinkStdin) `finally` closeStdin) + <*> Concurrently (sourceStdout $$ consumerStdout) + <*> Concurrently (sourceStderr $$ consumerStderr)) + `finally` (closeStdout >> closeStderr) + `onException` terminateStreamingProcess sph + ec <- waitForStreamingProcess sph + return (ec, resStdout, resStderr) + +-- | Like @sourceProcessWithStreams@ but providing the command to be run as +-- a @String@. +-- +-- @since 1.1.12 +sourceCmdWithStreams :: String -- ^command + -> Producer IO ByteString -- ^stdin + -> Consumer ByteString IO a -- ^stdout + -> Consumer ByteString IO b -- ^stderr + -> IO (ExitCode, a, b) +sourceCmdWithStreams cmd = sourceProcessWithStreams (shell cmd) + -- | Same as 'withCheckedProcess', but kills the child process in the case of -- an exception being thrown by the provided callback function. +-- +-- @since 1.1.11 withCheckedProcessCleanup :: ( InputSource stdin , OutputSink stderr @@ -74,9 +142,12 @@ -> m b withCheckedProcessCleanup cp f = do (x, y, z, sph) <- streamingProcess cp - res <- f x y z `onException` - liftIO (terminateProcess (streamingProcessHandleRaw sph)) + res <- f x y z `onException` liftIO (terminateStreamingProcess sph) ec <- waitForStreamingProcess sph if ec == ExitSuccess then return res else throwM $ ProcessExitedUnsuccessfully cp ec + + +terminateStreamingProcess :: StreamingProcessHandle -> IO () +terminateStreamingProcess = terminateProcess . streamingProcessHandleRaw diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/Data/Conduit/Text.hs new/conduit-extra-1.1.13.1/Data/Conduit/Text.hs --- old/conduit-extra-1.1.11/Data/Conduit/Text.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/Data/Conduit/Text.hs 2016-04-02 19:35:12.000000000 +0200 @@ -38,7 +38,6 @@ , detectUtf ) where -import qualified Prelude import Prelude hiding (head, drop, takeWhile, lines, zip, zip3, zipWith, zipWith3, take, dropWhile) import qualified Control.Exception as Exc @@ -61,7 +60,7 @@ -- -- Since 0.3.0 data Codec = Codec - { codecName :: T.Text + { _codecName :: T.Text , codecEncode :: T.Text -> (B.ByteString, Maybe (TextException, T.Text)) @@ -74,7 +73,7 @@ | NewCodec T.Text (T.Text -> B.ByteString) (B.ByteString -> DecodeResult) instance Show Codec where - showsPrec d c = + showsPrec d c = let (cnst, name) = case c of Codec t _ _ -> ("Codec ", t) NewCodec t _ _ -> ("NewCodec ", t) @@ -150,7 +149,7 @@ -> Int -> (B.ByteString -> DecodeResult) -> Conduit B.ByteString m T.Text -decodeNew onFailure name = +decodeNew onFailure _name = loop where loop consumed dec = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/conduit-extra.cabal new/conduit-extra-1.1.13.1/conduit-extra.cabal --- old/conduit-extra-1.1.11/conduit-extra.cabal 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/conduit-extra.cabal 2016-04-02 19:35:12.000000000 +0200 @@ -1,5 +1,5 @@ Name: conduit-extra -Version: 1.1.11 +Version: 1.1.13.1 Synopsis: Batteries included conduit: adapters for common libraries. Description: The conduit package itself maintains relative small dependencies. The purpose of this package is to collect commonly used utility functions wrapping other library dependencies, without depending on heavier-weight dependencies. The basic idea is that this package should only depend on haskell-platform packages and conduit. @@ -45,6 +45,7 @@ , transformers , transformers-base + , async , attoparsec >= 0.10 , blaze-builder >= 0.3 , directory @@ -77,6 +78,7 @@ , exceptions , process , resourcet + , QuickCheck , stm , streaming-commons , text diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/test/Data/Conduit/BinarySpec.hs new/conduit-extra-1.1.13.1/test/Data/Conduit/BinarySpec.hs --- old/conduit-extra-1.1.11/test/Data/Conduit/BinarySpec.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/test/Data/Conduit/BinarySpec.hs 2016-04-02 19:35:12.000000000 +0200 @@ -1,3 +1,5 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} module Data.Conduit.BinarySpec (spec) where @@ -15,6 +17,13 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import Data.Functor.Identity +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import Test.QuickCheck.Gen (Gen, oneof) +import Data.Word (Word8) +import Foreign.Storable (Storable, sizeOf, pokeByteOff) +import Data.Typeable (Typeable) +import Data.ByteString.Internal (unsafeCreate) +import Control.Applicative ((<$>), (<*>)) spec :: Spec spec = describe "Data.Conduit.Binary" $ do @@ -189,5 +198,98 @@ src C.$= CB.isolate 10 C.$$ CL.head x `shouldBe` Just "foobarbazb" + describe "Storable" $ do + let test name func = describe name $ do + let test' size = + prop ("chunk size " ++ show size) $ \stores0 -> do + let src = + loop (someStorables stores0) + where + loop bs + | S.null bs = return () + | otherwise = do + let (x, y) = S.splitAt size bs + C.yield x + loop y + + sink :: [SomeStorable] + -> C.Sink S.ByteString IO () + sink [] = do + mw <- CB.head + case mw of + Nothing -> return () + Just _ -> error "trailing bytes" + sink (next:rest) = do + withSomeStorable next checkOne + sink rest + + checkOne :: (Storable a, Eq a, Show a) + => a + -> C.Sink S.ByteString IO () + checkOne expected = do + mactual <- + if func + then CB.sinkStorable + else fmap Just CB.sinkStorableEx + actual <- + case mactual of + Nothing -> error "got Nothing" + Just actual -> return actual + liftIO $ actual `shouldBe` expected + + src C.$$ sink stores0 :: IO () + mapM_ test' [1, 5, 10, 100] + + test "sink Maybe" True + test "sink exception" False + + it' "insufficient bytes are leftovers, one chunk" $ do + let src = C.yield $ S.singleton 1 + src C.$$ do + mactual <- CB.sinkStorable + liftIO $ mactual `shouldBe` (Nothing :: Maybe Int) + lbs <- CB.sinkLbs + liftIO $ lbs `shouldBe` L.singleton 1 + + it' "insufficient bytes are leftovers, multiple chunks" $ do + let src = do + C.yield $ S.singleton 1 + C.yield $ S.singleton 2 + src C.$$ do + mactual <- CB.sinkStorable + liftIO $ mactual `shouldBe` (Nothing :: Maybe Int) + lbs <- CB.sinkLbs + liftIO $ lbs `shouldBe` L.pack [1, 2] + +data SomeStorable where + SomeStorable :: (Storable a, Eq a, Show a, Typeable a) => a -> SomeStorable +instance Show SomeStorable where + show (SomeStorable x) = show x +instance Arbitrary SomeStorable where + arbitrary = oneof + [ SomeStorable <$> (arbitrary :: Gen Int) + , SomeStorable <$> (arbitrary :: Gen Word8) + , SomeStorable <$> (arbitrary :: Gen Double) + ] + +withSomeStorable :: SomeStorable + -> (forall a. (Storable a, Eq a, Show a) => a -> b) + -> b +withSomeStorable (SomeStorable x) f = f x + +someStorables :: [SomeStorable] -> S.ByteString +someStorables stores0 = + unsafeCreate size start + where + size = sum $ map (\x -> withSomeStorable x sizeOf) stores0 + + start ptr = + go stores0 0 + where + go [] _ = return () + go (x:rest) off = do + withSomeStorable x (pokeByteOff ptr off) + go rest (off + withSomeStorable x sizeOf) + it' :: String -> IO () -> Spec it' = it diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.1.11/test/Data/Conduit/ProcessSpec.hs new/conduit-extra-1.1.13.1/test/Data/Conduit/ProcessSpec.hs --- old/conduit-extra-1.1.11/test/Data/Conduit/ProcessSpec.hs 2016-03-03 10:58:27.000000000 +0100 +++ new/conduit-extra-1.1.13.1/test/Data/Conduit/ProcessSpec.hs 2016-04-02 19:35:12.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Data.Conduit.ProcessSpec (spec, main) where import Test.Hspec @@ -9,6 +10,7 @@ import Control.Concurrent.Async (concurrently) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 import System.Exit import Control.Concurrent (threadDelay) @@ -45,6 +47,36 @@ `shouldReturn` (ExitFailure 11, ()) (sourceCmdWithConsumer "exit 12" CL.sinkNull) `shouldReturn` (ExitFailure 12, ()) + (sourceCmdWithStreams "exit 0" CL.sourceNull CL.sinkNull CL.sinkNull) + `shouldReturn` (ExitSuccess, (), ()) + (sourceCmdWithStreams "exit 11" CL.sourceNull CL.sinkNull CL.sinkNull) + `shouldReturn` (ExitFailure 11, (), ()) + (sourceCmdWithStreams "exit 12" CL.sourceNull CL.sinkNull CL.sinkNull) + `shouldReturn` (ExitFailure 12, (), ()) + + it "consumes stdout" $ do + let mystr = "this is a test string" :: String + sourceCmdWithStreams ("bash -c \"echo -n " ++ mystr ++ "\"") + CL.sourceNull + CL.consume -- stdout + CL.consume -- stderr + `shouldReturn` (ExitSuccess, [S8.pack mystr], []) + + it "consumes stderr" $ do + let mystr = "this is a test string" :: String + sourceCmdWithStreams ("bash -c \">&2 echo -n " ++ mystr ++ "\"") + CL.sourceNull + CL.consume -- stdout + CL.consume -- stderr + `shouldReturn` (ExitSuccess, [], [S8.pack mystr]) + + it "feeds stdin" $ do + let mystr = "this is a test string" :: S.ByteString + sourceCmdWithStreams "cat" + (mapM_ yield . L.toChunks $ L.fromStrict mystr) + CL.consume -- stdout + CL.consume -- stderr + `shouldReturn` (ExitSuccess, [mystr], []) #endif it "blocking vs non-blocking" $ do (ClosedStream, ClosedStream, ClosedStream, cph) <- streamingProcess (shell "sleep 1") @@ -64,7 +96,7 @@ threadDelay 500000 loop (pred i) Just _ -> mec2 `shouldBe` Just ExitSuccess - loop 5 + loop (5 :: Int) ec <- waitForStreamingProcess cph ec `shouldBe` ExitSuccess
