streaming-commons-0.2.2.6/Data/0000755000000000000000000000000014412473304014362 5ustar0000000000000000streaming-commons-0.2.2.6/Data/Streaming/0000755000000000000000000000000014412473731016317 5ustar0000000000000000streaming-commons-0.2.2.6/Data/Streaming/ByteString/0000755000000000000000000000000014412473304020405 5ustar0000000000000000streaming-commons-0.2.2.6/Data/Streaming/ByteString/Builder/0000755000000000000000000000000014412473304021773 5ustar0000000000000000streaming-commons-0.2.2.6/Data/Streaming/Network/0000755000000000000000000000000014412473304017744 5ustar0000000000000000streaming-commons-0.2.2.6/Data/Streaming/Process/0000755000000000000000000000000014412473304017731 5ustar0000000000000000streaming-commons-0.2.2.6/Data/Streaming/Zlib/0000755000000000000000000000000014412473304017213 5ustar0000000000000000streaming-commons-0.2.2.6/System/0000755000000000000000000000000014412473304014775 5ustar0000000000000000streaming-commons-0.2.2.6/bench/0000755000000000000000000000000014412473304014570 5ustar0000000000000000streaming-commons-0.2.2.6/cbits/0000755000000000000000000000000014412474021014612 5ustar0000000000000000streaming-commons-0.2.2.6/include/0000755000000000000000000000000014412546674015147 5ustar0000000000000000streaming-commons-0.2.2.6/test/0000755000000000000000000000000014412473304014470 5ustar0000000000000000streaming-commons-0.2.2.6/test/Data/0000755000000000000000000000000014412473304015341 5ustar0000000000000000streaming-commons-0.2.2.6/test/Data/Streaming/0000755000000000000000000000000014412473304017272 5ustar0000000000000000streaming-commons-0.2.2.6/test/Data/Streaming/ByteString/0000755000000000000000000000000014412473304021364 5ustar0000000000000000streaming-commons-0.2.2.6/test/filesystem/0000755000000000000000000000000014412473304016654 5ustar0000000000000000streaming-commons-0.2.2.6/test/filesystem/bin/0000755000000000000000000000000014412473304017424 5ustar0000000000000000streaming-commons-0.2.2.6/Data/Streaming/ByteString/Builder.hs0000644000000000000000000001654114412473304022336 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} -- | Convert a stream of bytestring @Builder@s into a stream of @ByteString@s. -- -- Adapted from blaze-builder-enumerator, written by Michael Snoyman and Simon Meier. -- -- Note that the functions here can work in any monad built on top of @IO@ or -- @ST@. -- -- Also provides @toByteStringIO*@ like "Blaze.ByteString.Builder"s, for -- "Data.ByteString.Builder". -- -- Since 0.1.9 -- module Data.Streaming.ByteString.Builder ( BuilderRecv , BuilderPopper , BuilderFinish , newBuilderRecv , newByteStringBuilderRecv -- * toByteStringIO , toByteStringIO , toByteStringIOWith , toByteStringIOWithBuffer -- * Buffers , Buffer -- ** Status information , freeSize , sliceSize , bufferSize -- ** Creation and modification , allocBuffer , reuseBuffer , nextSlice -- ** Conversion to bytestings , unsafeFreezeBuffer , unsafeFreezeNonEmptyBuffer -- * Buffer allocation strategies , BufferAllocStrategy , allNewBuffersStrategy , reuseBufferStrategy , defaultStrategy ) where import Control.Monad (when,unless) import qualified Data.ByteString as S import Data.ByteString.Builder (Builder) import Data.ByteString.Builder.Extra (runBuilder, BufferWriter, Next(Done, More, Chunk)) import Data.ByteString.Internal (mallocByteString, ByteString(PS)) import Data.ByteString.Lazy.Internal (defaultChunkSize) import Data.IORef (newIORef, writeIORef, readIORef) import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (plusPtr, minusPtr) import Data.Streaming.ByteString.Builder.Buffer -- | Provides a series of @ByteString@s until empty, at which point it provides -- an empty @ByteString@. -- -- Since 0.1.10.0 -- type BuilderPopper = IO S.ByteString type BuilderRecv = Builder -> IO BuilderPopper type BuilderFinish = IO (Maybe S.ByteString) newBuilderRecv :: BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish) newBuilderRecv = newByteStringBuilderRecv {-# INLINE newBuilderRecv #-} newByteStringBuilderRecv :: BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish) newByteStringBuilderRecv (ioBufInit, nextBuf) = do refBuf <- newIORef ioBufInit return (push refBuf, finish refBuf) where finish refBuf = do ioBuf <- readIORef refBuf buf <- ioBuf return $ unsafeFreezeNonEmptyBuffer buf push refBuf builder = do refWri <- newIORef $ Left $ runBuilder builder return $ popper refBuf refWri popper refBuf refWri = do ioBuf <- readIORef refBuf ebWri <- readIORef refWri case ebWri of Left bWri -> do !buf@(Buffer _ _ op ope) <- ioBuf (bytes, next) <- bWri op (ope `minusPtr` op) let op' = op `plusPtr` bytes case next of Done -> do writeIORef refBuf $ return $ updateEndOfSlice buf op' return S.empty More minSize bWri' -> do let buf' = updateEndOfSlice buf op' {-# INLINE cont #-} cont mbs = do -- sequencing the computation of the next buffer -- construction here ensures that the reference to the -- foreign pointer `fp` is lost as soon as possible. ioBuf' <- nextBuf minSize buf' writeIORef refBuf ioBuf' writeIORef refWri $ Left bWri' case mbs of Just bs | not $ S.null bs -> return bs _ -> popper refBuf refWri cont $ unsafeFreezeNonEmptyBuffer buf' Chunk bs bWri' -> do let buf' = updateEndOfSlice buf op' let yieldBS = do nextBuf 1 buf' >>= writeIORef refBuf writeIORef refWri $ Left bWri' if S.null bs then popper refBuf refWri else return bs case unsafeFreezeNonEmptyBuffer buf' of Nothing -> yieldBS Just bs' -> do writeIORef refWri $ Right yieldBS return bs' Right action -> action -- | Use a pre-existing buffer to 'toByteStringIOWith'. -- -- Since 0.1.9 -- toByteStringIOWithBuffer :: Int -> (ByteString -> IO ()) -> Builder -> ForeignPtr Word8 -> IO () toByteStringIOWithBuffer initBufSize io b initBuf = do go initBufSize initBuf (runBuilder b) where go bufSize buf = loop where loop :: BufferWriter -> IO () loop wr = do (len, next) <- withForeignPtr buf (flip wr bufSize) when (len > 0) (io $! PS buf 0 len) case next of Done -> return () More newBufSize nextWr | newBufSize > bufSize -> do newBuf <- mallocByteString newBufSize go newBufSize newBuf nextWr | otherwise -> loop nextWr Chunk s nextWr -> do unless (S.null s) (io s) loop nextWr -- | @toByteStringIOWith bufSize io b@ runs the builder @b@ with a buffer of -- at least the size @bufSize@ and executes the 'IO' action @io@ whenever the -- buffer is full. -- -- Compared to 'toLazyByteStringWith' this function requires less allocation, -- as the output buffer is only allocated once at the start of the -- serialization and whenever something bigger than the current buffer size has -- to be copied into the buffer, which should happen very seldomly for the -- default buffer size of 32kb. Hence, the pressure on the garbage collector is -- reduced, which can be an advantage when building long sequences of bytes. -- -- Since 0.1.9 -- toByteStringIOWith :: Int -- ^ Buffer size (upper bounds -- the number of bytes forced -- per call to the 'IO' action). -> (ByteString -> IO ()) -- ^ 'IO' action to execute per -- full buffer, which is -- referenced by a strict -- 'S.ByteString'. -> Builder -- ^ 'Builder' to run. -> IO () toByteStringIOWith bufSize io b = toByteStringIOWithBuffer bufSize io b =<< mallocByteString bufSize {-# INLINE toByteStringIOWith #-} -- | Run the builder with a 'defaultChunkSize'd buffer and execute the given -- 'IO' action whenever the buffer is full or gets flushed. -- -- @ 'toByteStringIO' = 'toByteStringIOWith' 'defaultChunkSize'@ -- -- Since 0.1.9 -- toByteStringIO :: (ByteString -> IO ()) -> Builder -> IO () toByteStringIO = toByteStringIOWith defaultChunkSize {-# INLINE toByteStringIO #-} streaming-commons-0.2.2.6/Data/Streaming/ByteString/Builder/Buffer.hs0000644000000000000000000001476514412473304023555 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} -- | Buffers for 'Builder's. This is a partial copy of blaze-builder-0.3.3.4's -- "Blaze.ByteString.Builder.Internal.Buffer" module, which was removed in -- blaze-builder-0.4. -- -- If you are using blaze-builder 0.3.*, this module just re-exports from -- "Blaze.ByteString.Builder.Internal.Buffer". -- -- Since 0.1.10.0 -- module Data.Streaming.ByteString.Builder.Buffer ( -- * Buffers Buffer (..) -- ** Status information , freeSize , sliceSize , bufferSize -- ** Creation and modification , allocBuffer , reuseBuffer , nextSlice , updateEndOfSlice -- ** Conversion to bytestings , unsafeFreezeBuffer , unsafeFreezeNonEmptyBuffer -- * Buffer allocation strategies , BufferAllocStrategy , allNewBuffersStrategy , reuseBufferStrategy , defaultStrategy ) where import Data.ByteString.Lazy.Internal (defaultChunkSize) import qualified Data.ByteString as S import qualified Data.ByteString.Internal as S import Foreign (Word8, ForeignPtr, Ptr, plusPtr, minusPtr) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) ------------------------------------------------------------------------------ -- Buffers ------------------------------------------------------------------------------ -- | A buffer @Buffer fpbuf p0 op ope@ describes a buffer with the underlying -- byte array @fpbuf..ope@, the currently written slice @p0..op@ and the free -- space @op..ope@. -- -- Since 0.1.10.0 -- data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array {-# UNPACK #-} !(Ptr Word8) -- beginning of slice {-# UNPACK #-} !(Ptr Word8) -- next free byte {-# UNPACK #-} !(Ptr Word8) -- first byte after buffer -- | The size of the free space of the buffer. -- -- Since 0.1.10.0 -- freeSize :: Buffer -> Int freeSize (Buffer _ _ op ope) = ope `minusPtr` op -- | The size of the written slice in the buffer. -- -- Since 0.1.10.0 -- sliceSize :: Buffer -> Int sliceSize (Buffer _ p0 op _) = op `minusPtr` p0 -- | The size of the whole byte array underlying the buffer. -- -- Since 0.1.10.0 -- bufferSize :: Buffer -> Int bufferSize (Buffer fpbuf _ _ ope) = ope `minusPtr` unsafeForeignPtrToPtr fpbuf -- | @allocBuffer size@ allocates a new buffer of size @size@. -- -- Since 0.1.10.0 -- {-# INLINE allocBuffer #-} allocBuffer :: Int -> IO Buffer allocBuffer size = do fpbuf <- S.mallocByteString size let !pbuf = unsafeForeignPtrToPtr fpbuf return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size) -- | Resets the beginning of the next slice and the next free byte such that -- the whole buffer can be filled again. -- -- Since 0.1.10.0 -- {-# INLINE reuseBuffer #-} reuseBuffer :: Buffer -> Buffer reuseBuffer (Buffer fpbuf _ _ ope) = Buffer fpbuf p0 p0 ope where p0 = unsafeForeignPtrToPtr fpbuf -- | Convert the buffer to a bytestring. This operation is unsafe in the sense -- that created bytestring shares the underlying byte array with the buffer. -- Hence, depending on the later use of this buffer (e.g., if it gets reset and -- filled again) referential transparency may be lost. -- -- Since 0.1.10.0 -- {-# INLINE unsafeFreezeBuffer #-} unsafeFreezeBuffer :: Buffer -> S.ByteString unsafeFreezeBuffer (Buffer fpbuf p0 op _) = S.PS fpbuf (p0 `minusPtr` unsafeForeignPtrToPtr fpbuf) (op `minusPtr` p0) -- | Convert a buffer to a non-empty bytestring. See 'unsafeFreezeBuffer' for -- the explanation of why this operation may be unsafe. -- -- Since 0.1.10.0 -- {-# INLINE unsafeFreezeNonEmptyBuffer #-} unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString unsafeFreezeNonEmptyBuffer buf | sliceSize buf <= 0 = Nothing | otherwise = Just $ unsafeFreezeBuffer buf -- | Update the end of slice pointer. -- -- Since 0.1.10.0 -- {-# INLINE updateEndOfSlice #-} updateEndOfSlice :: Buffer -- Old buffer -> Ptr Word8 -- New end of slice -> Buffer -- Updated buffer updateEndOfSlice (Buffer fpbuf p0 _ ope) op' = Buffer fpbuf p0 op' ope -- | Move the beginning of the slice to the next free byte such that the -- remaining free space of the buffer can be filled further. This operation -- is safe and can be used to fill the remaining part of the buffer after a -- direct insertion of a bytestring or a flush. -- -- Since 0.1.10.0 -- {-# INLINE nextSlice #-} nextSlice :: Int -> Buffer -> Maybe Buffer nextSlice minSize (Buffer fpbuf _ op ope) | ope `minusPtr` op <= minSize = Nothing | otherwise = Just (Buffer fpbuf op op ope) ------------------------------------------------------------------------------ -- Buffer allocation strategies ------------------------------------------------------------------------------ -- | A buffer allocation strategy @(buf0, nextBuf)@ specifies the initial -- buffer to use and how to compute a new buffer @nextBuf minSize buf@ with at -- least size @minSize@ from a filled buffer @buf@. The double nesting of the -- @IO@ monad helps to ensure that the reference to the filled buffer @buf@ is -- lost as soon as possible, but the new buffer doesn't have to be allocated -- too early. -- -- Since 0.1.10.0 -- type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer)) -- | The simplest buffer allocation strategy: whenever a buffer is requested, -- allocate a new one that is big enough for the next build step to execute. -- -- NOTE that this allocation strategy may spill quite some memory upon direct -- insertion of a bytestring by the builder. Thats no problem for garbage -- collection, but it may lead to unreasonably high memory consumption in -- special circumstances. -- -- Since 0.1.10.0 -- allNewBuffersStrategy :: Int -- Minimal buffer size. -> BufferAllocStrategy allNewBuffersStrategy bufSize = ( allocBuffer bufSize , \reqSize _ -> return (allocBuffer (max reqSize bufSize)) ) -- | An unsafe, but possibly more efficient buffer allocation strategy: -- reuse the buffer, if it is big enough for the next build step to execute. -- -- Since 0.1.10.0 -- reuseBufferStrategy :: IO Buffer -> BufferAllocStrategy reuseBufferStrategy buf0 = (buf0, tryReuseBuffer) where tryReuseBuffer reqSize buf | bufferSize buf >= reqSize = return $ return (reuseBuffer buf) | otherwise = return $ allocBuffer reqSize defaultStrategy :: BufferAllocStrategy defaultStrategy = allNewBuffersStrategy defaultChunkSize streaming-commons-0.2.2.6/Data/Streaming/FileRead.hs0000644000000000000000000000166114412473304020326 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | The standard @openFile@ call on Windows causing problematic file locking -- in some cases. This module provides a cross-platform file reading API -- without the file locking problems on Windows. -- -- This module /always/ opens files in binary mode. -- -- @readChunk@ will return an empty @ByteString@ on EOF. module Data.Streaming.FileRead ( ReadHandle , openFile , closeFile , readChunk ) where #if WINDOWS import System.Win32File #else import qualified System.IO as IO import qualified Data.ByteString as S import Data.ByteString.Lazy.Internal (defaultChunkSize) newtype ReadHandle = ReadHandle IO.Handle openFile :: FilePath -> IO ReadHandle openFile fp = ReadHandle `fmap` IO.openBinaryFile fp IO.ReadMode closeFile :: ReadHandle -> IO () closeFile (ReadHandle h) = IO.hClose h readChunk :: ReadHandle -> IO S.ByteString readChunk (ReadHandle h) = S.hGetSome h defaultChunkSize #endif streaming-commons-0.2.2.6/Data/Streaming/Filesystem.hs0000644000000000000000000000576314412473304021006 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Streaming functions for interacting with the filesystem. module Data.Streaming.Filesystem ( DirStream , openDirStream , readDirStream , closeDirStream , FileType (..) , getFileType ) where import Data.Typeable (Typeable) #if WINDOWS import qualified System.Win32 as Win32 import System.FilePath (()) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import System.Directory (doesFileExist, doesDirectoryExist) data DirStream = DirStream !Win32.HANDLE !Win32.FindData !(IORef Bool) deriving Typeable openDirStream :: FilePath -> IO DirStream openDirStream fp = do (h, fdat) <- Win32.findFirstFile $ fp "*" imore <- newIORef True -- always at least two records, "." and ".." return $! DirStream h fdat imore closeDirStream :: DirStream -> IO () closeDirStream (DirStream h _ _) = Win32.findClose h readDirStream :: DirStream -> IO (Maybe FilePath) readDirStream ds@(DirStream h fdat imore) = do more <- readIORef imore if more then do filename <- Win32.getFindDataFileName fdat Win32.findNextFile h fdat >>= writeIORef imore if filename == "." || filename == ".." then readDirStream ds else return $ Just filename else return Nothing isSymlink :: FilePath -> IO Bool isSymlink _ = return False getFileType :: FilePath -> IO FileType getFileType fp = do isFile <- doesFileExist fp if isFile then return FTFile else do isDir <- doesDirectoryExist fp return $ if isDir then FTDirectory else FTOther #else import System.Posix.Directory (DirStream, openDirStream, closeDirStream) import qualified System.Posix.Directory as Posix import qualified System.Posix.Files as PosixF import Control.Exception (try, IOException) readDirStream :: DirStream -> IO (Maybe FilePath) readDirStream ds = do fp <- Posix.readDirStream ds case fp of "" -> return Nothing "." -> readDirStream ds ".." -> readDirStream ds _ -> return $ Just fp getFileType :: FilePath -> IO FileType getFileType fp = do s <- PosixF.getSymbolicLinkStatus fp case () of () | PosixF.isRegularFile s -> return FTFile | PosixF.isDirectory s -> return FTDirectory | PosixF.isSymbolicLink s -> do es' <- try $ PosixF.getFileStatus fp case es' of Left (_ :: IOException) -> return FTOther Right s' | PosixF.isRegularFile s' -> return FTFileSym | PosixF.isDirectory s' -> return FTDirectorySym | otherwise -> return FTOther | otherwise -> return FTOther #endif data FileType = FTFile | FTFileSym -- ^ symlink to file | FTDirectory | FTDirectorySym -- ^ symlink to a directory | FTOther deriving (Show, Read, Eq, Ord, Typeable) streaming-commons-0.2.2.6/Data/Streaming/Network.hs0000644000000000000000000005524414412473304020312 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} module Data.Streaming.Network ( -- * Types ServerSettings , ClientSettings , HostPreference , Message (..) , AppData #if !WINDOWS , ServerSettingsUnix , ClientSettingsUnix , AppDataUnix #endif -- ** Smart constructors , serverSettingsTCP , serverSettingsTCPSocket , clientSettingsTCP , serverSettingsUDP , clientSettingsUDP #if !WINDOWS , serverSettingsUnix , clientSettingsUnix #endif , message -- ** Classes , HasPort (..) , HasAfterBind (..) , HasReadWrite (..) , HasReadBufferSize (..) #if !WINDOWS , HasPath (..) #endif -- ** Setters , setPort , setHost , setAddrFamily , setAfterBind , setNeedLocalAddr , setReadBufferSize #if !WINDOWS , setPath #endif -- ** Getters , getPort , getHost , getAddrFamily , getAfterBind , getNeedLocalAddr , getReadBufferSize #if !WINDOWS , getPath #endif , appRead , appWrite , appSockAddr , appLocalAddr , appCloseConnection , appRawSocket -- * Functions -- ** General , bindPortGen , bindPortGenEx , bindRandomPortGen , getSocketGen , getSocketFamilyGen , acceptSafe , unassignedPorts , getUnassignedPort -- ** TCP , bindPortTCP , bindRandomPortTCP , getSocketTCP , getSocketFamilyTCP , safeRecv , runTCPServer , runTCPClient , ConnectionHandle() , runTCPServerWithHandle -- ** UDP , bindPortUDP , bindRandomPortUDP , getSocketUDP #if !WINDOWS -- ** Unix , bindPath , getSocketUnix , runUnixServer , runUnixClient #endif ) where import qualified Network.Socket as NS import Data.Streaming.Network.Internal import Control.Concurrent (threadDelay) import Control.Exception (IOException, try, SomeException, throwIO, bracketOnError, bracket) import Network.Socket (Socket, AddrInfo, SocketType) import Network.Socket.ByteString (recv, sendAll) import System.IO.Error (isDoesNotExistError) import qualified Data.ByteString.Char8 as S8 import qualified Control.Exception as E import Data.ByteString (ByteString) import System.Directory (removeFile) import Data.Functor.Constant (Constant (Constant), getConstant) import Data.Functor.Identity (Identity (Identity), runIdentity) import Control.Concurrent (forkIO) import Control.Monad (forever) import Data.IORef (IORef, newIORef, atomicModifyIORef) import Data.Array.Unboxed ((!), UArray, listArray) import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO) import System.Random (randomRIO) import System.IO.Error (isFullErrorType, ioeGetErrorType) #if WINDOWS import Control.Concurrent.MVar (putMVar, takeMVar, newEmptyMVar) #endif getPossibleAddrs :: SocketType -> String -> Int -> NS.Family -> IO [AddrInfo] getPossibleAddrs sockettype host' port' af = NS.getAddrInfo (Just hints) (Just host') (Just $ show port') where hints = NS.defaultHints { NS.addrSocketType = sockettype , NS.addrFamily = af } -- | Attempt to connect to the given host/port/address family using given @SocketType@. -- -- Since 0.1.3 getSocketFamilyGen :: SocketType -> String -> Int -> NS.Family -> IO (Socket, AddrInfo) getSocketFamilyGen sockettype host' port' af = do (addr:_) <- getPossibleAddrs sockettype host' port' af sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr) return (sock, addr) -- | Attempt to connect to the given host/port using given @SocketType@. getSocketGen :: SocketType -> String -> Int -> IO (Socket, AddrInfo) getSocketGen sockettype host port = getSocketFamilyGen sockettype host port NS.AF_UNSPEC defaultSocketOptions :: SocketType -> [(NS.SocketOption, Int)] defaultSocketOptions sockettype = case sockettype of NS.Datagram -> [(NS.ReuseAddr,1)] _ -> [(NS.NoDelay,1), (NS.ReuseAddr,1)] -- | Attempt to bind a listening @Socket@ on the given host/port using given -- @SocketType@. If no host is given, will use the first address available. bindPortGen :: SocketType -> Int -> HostPreference -> IO Socket bindPortGen sockettype = bindPortGenEx (defaultSocketOptions sockettype) sockettype -- | Attempt to bind a listening @Socket@ on the given host/port using given -- socket options and @SocketType@. If no host is given, will use the first address available. -- -- Since 0.1.17 bindPortGenEx :: [(NS.SocketOption, Int)] -> SocketType -> Int -> HostPreference -> IO Socket bindPortGenEx sockOpts sockettype p s = do let hints = NS.defaultHints { NS.addrFlags = [NS.AI_PASSIVE] , NS.addrSocketType = sockettype } host = case s of Host s' -> Just s' _ -> Nothing port = Just . show $ p addrs <- NS.getAddrInfo (Just hints) host port -- Choose an IPv6 socket if exists. This ensures the socket can -- handle both IPv4 and IPv6 if v6only is false. let addrs4 = filter (\x -> NS.addrFamily x /= NS.AF_INET6) addrs addrs6 = filter (\x -> NS.addrFamily x == NS.AF_INET6) addrs addrs' = case s of HostIPv4 -> addrs4 ++ addrs6 HostIPv4Only -> addrs4 HostIPv6 -> addrs6 ++ addrs4 HostIPv6Only -> addrs6 _ -> addrs tryAddrs (addr1:rest@(_:_)) = E.catch (theBody addr1) (\(_ :: IOException) -> tryAddrs rest) tryAddrs (addr1:[]) = theBody addr1 tryAddrs _ = error "bindPort: addrs is empty" theBody addr = bracketOnError (NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr)) NS.close (\sock -> do mapM_ (\(opt,v) -> NS.setSocketOption sock opt v) sockOpts NS.bind sock (NS.addrAddress addr) return sock ) tryAddrs addrs' -- | Bind to a random port number. Especially useful for writing network tests. -- -- Since 0.1.1 bindRandomPortGen :: SocketType -> HostPreference -> IO (Int, Socket) bindRandomPortGen sockettype s = do socket <- bindPortGen sockettype 0 s port <- NS.socketPort socket return (fromIntegral port, socket) -- | Top 10 Largest IANA unassigned port ranges with no unauthorized uses known unassignedPortsList :: [Int] unassignedPortsList = concat [ [43124..44320] , [28120..29166] , [45967..46997] , [28241..29117] , [40001..40840] , [29170..29998] , [38866..39680] , [43442..44122] , [41122..41793] , [35358..36000] ] unassignedPorts :: UArray Int Int unassignedPorts = listArray (unassignedPortsMin, unassignedPortsMax) unassignedPortsList unassignedPortsMin, unassignedPortsMax :: Int unassignedPortsMin = 0 unassignedPortsMax = length unassignedPortsList - 1 nextUnusedPort :: IORef Int nextUnusedPort = unsafePerformIO $ randomRIO (unassignedPortsMin, unassignedPortsMax) >>= newIORef {-# NOINLINE nextUnusedPort #-} -- | Get a port from the IANA list of unassigned ports. -- -- Internally, this function uses an @IORef@ to cycle through the list of ports getUnassignedPort :: IO Int getUnassignedPort = do port <- atomicModifyIORef nextUnusedPort go return $! port where go i | i > unassignedPortsMax = (succ unassignedPortsMin, unassignedPorts ! unassignedPortsMin) | otherwise = (succ i, unassignedPorts ! i) -- | Attempt to connect to the given host/port. getSocketUDP :: String -> Int -> IO (Socket, AddrInfo) getSocketUDP = getSocketGen NS.Datagram -- | Attempt to bind a listening @Socket@ on the given host/port. If no host is -- given, will use the first address available. bindPortUDP :: Int -> HostPreference -> IO Socket bindPortUDP = bindPortGen NS.Datagram -- | Bind a random UDP port. -- -- See 'bindRandomPortGen' -- -- Since 0.1.1 bindRandomPortUDP :: HostPreference -> IO (Int, Socket) bindRandomPortUDP = bindRandomPortGen NS.Datagram {-# NOINLINE defaultReadBufferSize #-} defaultReadBufferSize :: Int defaultReadBufferSize = unsafeDupablePerformIO $ bracket (NS.socket NS.AF_INET NS.Stream 0) NS.close (\sock -> NS.getSocketOption sock NS.RecvBuffer) #if !WINDOWS -- | Attempt to connect to the given Unix domain socket path. getSocketUnix :: FilePath -> IO Socket getSocketUnix path = do sock <- NS.socket NS.AF_UNIX NS.Stream 0 ee <- try' $ NS.connect sock (NS.SockAddrUnix path) case ee of Left e -> NS.close sock >> throwIO e Right () -> return sock where try' :: IO a -> IO (Either SomeException a) try' = try -- | Attempt to bind a listening Unix domain socket at the given path. bindPath :: FilePath -> IO Socket bindPath path = do sock <- bracketOnError (NS.socket NS.AF_UNIX NS.Stream 0) NS.close (\sock -> do removeFileSafe path -- Cannot bind if the socket file exists. NS.bind sock (NS.SockAddrUnix path) return sock) NS.listen sock (max 2048 NS.maxListenQueue) return sock removeFileSafe :: FilePath -> IO () removeFileSafe path = removeFile path `E.catch` handleExists where handleExists e | isDoesNotExistError e = return () | otherwise = throwIO e -- | Smart constructor. serverSettingsUnix :: FilePath -- ^ path to bind to -> ServerSettingsUnix serverSettingsUnix path = ServerSettingsUnix { serverPath = path , serverAfterBindUnix = const $ return () , serverReadBufferSizeUnix = defaultReadBufferSize } -- | Smart constructor. clientSettingsUnix :: FilePath -- ^ path to connect to -> ClientSettingsUnix clientSettingsUnix path = ClientSettingsUnix { clientPath = path , clientReadBufferSizeUnix = defaultReadBufferSize } #endif #if defined(__GLASGOW_HASKELL__) && WINDOWS -- Socket recv and accept calls on Windows platform cannot be interrupted when compiled with -threaded. -- See https://ghc.haskell.org/trac/ghc/ticket/5797 for details. -- The following enables simple workaround #define SOCKET_ACCEPT_RECV_WORKAROUND #endif safeRecv :: Socket -> Int -> IO ByteString #ifndef SOCKET_ACCEPT_RECV_WORKAROUND safeRecv = recv #else safeRecv s buf = do var <- newEmptyMVar forkIO $ recv s buf `E.catch` (\(_::IOException) -> return S8.empty) >>= putMVar var takeMVar var #endif -- | Smart constructor. serverSettingsUDP :: Int -- ^ port to bind to -> HostPreference -- ^ host binding preferences -> ServerSettings serverSettingsUDP = serverSettingsTCP -- | Smart constructor. serverSettingsTCP :: Int -- ^ port to bind to -> HostPreference -- ^ host binding preferences -> ServerSettings serverSettingsTCP port host = ServerSettings { serverPort = port , serverHost = host , serverSocket = Nothing , serverAfterBind = const $ return () , serverNeedLocalAddr = False , serverReadBufferSize = defaultReadBufferSize } -- | Create a server settings that uses an already available listening socket. -- Any port and host modifications made to this value will be ignored. -- -- Since 0.1.1 serverSettingsTCPSocket :: Socket -> ServerSettings serverSettingsTCPSocket lsocket = ServerSettings { serverPort = 0 , serverHost = HostAny , serverSocket = Just lsocket , serverAfterBind = const $ return () , serverNeedLocalAddr = False , serverReadBufferSize = defaultReadBufferSize } -- | Smart constructor. clientSettingsUDP :: Int -- ^ port to connect to -> ByteString -- ^ host to connect to -> ClientSettings clientSettingsUDP = clientSettingsTCP -- | Smart constructor. clientSettingsTCP :: Int -- ^ port to connect to -> ByteString -- ^ host to connect to -> ClientSettings clientSettingsTCP port host = ClientSettings { clientPort = port , clientHost = host , clientAddrFamily = NS.AF_UNSPEC , clientReadBufferSize = defaultReadBufferSize } -- | Attempt to connect to the given host/port/address family. -- -- Since 0.1.3 getSocketFamilyTCP :: ByteString -> Int -> NS.Family -> IO (NS.Socket, NS.SockAddr) getSocketFamilyTCP host' port' addrFamily = do addrsInfo <- getPossibleAddrs NS.Stream (S8.unpack host') port' addrFamily firstSuccess addrsInfo where firstSuccess [ai] = connect ai firstSuccess (ai:ais) = connect ai `E.catch` \(_ :: IOException) -> firstSuccess ais firstSuccess _ = error "getSocketFamilyTCP: can't happen" createSocket addrInfo = do sock <- NS.socket (NS.addrFamily addrInfo) (NS.addrSocketType addrInfo) (NS.addrProtocol addrInfo) NS.setSocketOption sock NS.NoDelay 1 return sock connect addrInfo = E.bracketOnError (createSocket addrInfo) NS.close $ \sock -> do NS.connect sock (NS.addrAddress addrInfo) return (sock, NS.addrAddress addrInfo) -- | Attempt to connect to the given host/port. getSocketTCP :: ByteString -> Int -> IO (NS.Socket, NS.SockAddr) getSocketTCP host port = getSocketFamilyTCP host port NS.AF_UNSPEC -- | Attempt to bind a listening @Socket@ on the given host/port. If no host is -- given, will use the first address available. -- 'maxListenQueue' is topically 128 which is too short for -- high performance servers. So, we specify 'max 2048 maxListenQueue' to -- the listen queue. bindPortTCP :: Int -> HostPreference -> IO Socket bindPortTCP p s = do sock <- bindPortGen NS.Stream p s NS.listen sock (max 2048 NS.maxListenQueue) return sock -- | Bind a random TCP port. -- -- See 'bindRandomPortGen'. -- -- Since 0.1.1 bindRandomPortTCP :: HostPreference -> IO (Int, Socket) bindRandomPortTCP s = do (port, sock) <- bindRandomPortGen NS.Stream s NS.listen sock (max 2048 NS.maxListenQueue) return (port, sock) -- | Try to accept a connection, recovering automatically from exceptions. -- -- As reported by Kazu against Warp, "resource exhausted (Too many open files)" -- may be thrown by accept(). This function will catch that exception, wait a -- second, and then try again. acceptSafe :: Socket -> IO (Socket, NS.SockAddr) acceptSafe socket = #ifndef SOCKET_ACCEPT_RECV_WORKAROUND loop #else do var <- newEmptyMVar forkIO $ loop >>= putMVar var takeMVar var #endif where loop = NS.accept socket `E.catch` \e -> if isFullErrorType (ioeGetErrorType e) then do threadDelay 1000000 loop else E.throwIO e message :: ByteString -> NS.SockAddr -> Message message = Message class HasPort a where portLens :: Functor f => (Int -> f Int) -> a -> f a instance HasPort ServerSettings where portLens f ss = fmap (\p -> ss { serverPort = p }) (f (serverPort ss)) instance HasPort ClientSettings where portLens f ss = fmap (\p -> ss { clientPort = p }) (f (clientPort ss)) getPort :: HasPort a => a -> Int getPort = getConstant . portLens Constant setPort :: HasPort a => Int -> a -> a setPort p = runIdentity . portLens (const (Identity p)) setHost :: ByteString -> ClientSettings -> ClientSettings setHost hp ss = ss { clientHost = hp } getHost :: ClientSettings -> ByteString getHost = clientHost -- | Set the address family for the given settings. -- -- Since 0.1.3 setAddrFamily :: NS.Family -> ClientSettings -> ClientSettings setAddrFamily af cs = cs { clientAddrFamily = af } -- | Get the address family for the given settings. -- -- Since 0.1.3 getAddrFamily :: ClientSettings -> NS.Family getAddrFamily = clientAddrFamily #if !WINDOWS class HasPath a where pathLens :: Functor f => (FilePath -> f FilePath) -> a -> f a instance HasPath ServerSettingsUnix where pathLens f ss = fmap (\p -> ss { serverPath = p }) (f (serverPath ss)) instance HasPath ClientSettingsUnix where pathLens f ss = fmap (\p -> ss { clientPath = p }) (f (clientPath ss)) getPath :: HasPath a => a -> FilePath getPath = getConstant . pathLens Constant setPath :: HasPath a => FilePath -> a -> a setPath p = runIdentity . pathLens (const (Identity p)) #endif setNeedLocalAddr :: Bool -> ServerSettings -> ServerSettings setNeedLocalAddr x y = y { serverNeedLocalAddr = x } getNeedLocalAddr :: ServerSettings -> Bool getNeedLocalAddr = serverNeedLocalAddr class HasAfterBind a where afterBindLens :: Functor f => ((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a instance HasAfterBind ServerSettings where afterBindLens f ss = fmap (\p -> ss { serverAfterBind = p }) (f (serverAfterBind ss)) #if !WINDOWS instance HasAfterBind ServerSettingsUnix where afterBindLens f ss = fmap (\p -> ss { serverAfterBindUnix = p }) (f (serverAfterBindUnix ss)) #endif getAfterBind :: HasAfterBind a => a -> (Socket -> IO ()) getAfterBind = getConstant . afterBindLens Constant setAfterBind :: HasAfterBind a => (Socket -> IO ()) -> a -> a setAfterBind p = runIdentity . afterBindLens (const (Identity p)) -- | Since 0.1.13 class HasReadBufferSize a where readBufferSizeLens :: Functor f => (Int -> f Int) -> a -> f a -- | Since 0.1.13 instance HasReadBufferSize ServerSettings where readBufferSizeLens f ss = fmap (\p -> ss { serverReadBufferSize = p }) (f (serverReadBufferSize ss)) -- | Since 0.1.13 instance HasReadBufferSize ClientSettings where readBufferSizeLens f cs = fmap (\p -> cs { clientReadBufferSize = p }) (f (clientReadBufferSize cs)) #if !WINDOWS -- | Since 0.1.13 instance HasReadBufferSize ServerSettingsUnix where readBufferSizeLens f ss = fmap (\p -> ss { serverReadBufferSizeUnix = p }) (f (serverReadBufferSizeUnix ss)) -- | Since 0.1.14 instance HasReadBufferSize ClientSettingsUnix where readBufferSizeLens f ss = fmap (\p -> ss { clientReadBufferSizeUnix = p }) (f (clientReadBufferSizeUnix ss)) #endif -- | Get buffer size used when reading from socket. -- -- Since 0.1.13 getReadBufferSize :: HasReadBufferSize a => a -> Int getReadBufferSize = getConstant . readBufferSizeLens Constant -- | Set buffer size used when reading from socket. -- -- Since 0.1.13 setReadBufferSize :: HasReadBufferSize a => Int -> a -> a setReadBufferSize p = runIdentity . readBufferSizeLens (const (Identity p)) type ConnectionHandle = Socket -> NS.SockAddr -> Maybe NS.SockAddr -> IO () runTCPServerWithHandle :: ServerSettings -> ConnectionHandle -> IO a runTCPServerWithHandle (ServerSettings port host msocket afterBind needLocalAddr _) handle = case msocket of Nothing -> E.bracket (bindPortTCP port host) NS.close inner Just lsocket -> inner lsocket where inner lsocket = afterBind lsocket >> forever (serve lsocket) serve lsocket = E.bracketOnError (acceptSafe lsocket) (\(socket, _) -> NS.close socket) $ \(socket, addr) -> do mlocal <- if needLocalAddr then fmap Just $ NS.getSocketName socket else return Nothing _ <- E.mask $ \restore -> forkIO $ restore (handle socket addr mlocal) `E.finally` NS.close socket return () -- | Run an @Application@ with the given settings. This function will create a -- new listening socket, accept connections on it, and spawn a new thread for -- each connection. runTCPServer :: ServerSettings -> (AppData -> IO ()) -> IO a runTCPServer settings app = runTCPServerWithHandle settings app' where app' socket addr mlocal = let ad = AppData { appRead' = safeRecv socket $ getReadBufferSize settings , appWrite' = sendAll socket , appSockAddr' = addr , appLocalAddr' = mlocal , appCloseConnection' = NS.close socket , appRawSocket' = Just socket } in app ad -- | Run an @Application@ by connecting to the specified server. runTCPClient :: ClientSettings -> (AppData -> IO a) -> IO a runTCPClient (ClientSettings port host addrFamily readBufferSize) app = E.bracket (getSocketFamilyTCP host port addrFamily) (NS.close . fst) (\(s, address) -> app AppData { appRead' = safeRecv s readBufferSize , appWrite' = sendAll s , appSockAddr' = address , appLocalAddr' = Nothing , appCloseConnection' = NS.close s , appRawSocket' = Just s }) appLocalAddr :: AppData -> Maybe NS.SockAddr appLocalAddr = appLocalAddr' appSockAddr :: AppData -> NS.SockAddr appSockAddr = appSockAddr' -- | Close the underlying connection. One possible use case is simulating -- connection failures in a test suite. -- -- Since 0.1.6 appCloseConnection :: AppData -> IO () appCloseConnection = appCloseConnection' -- | Get the raw socket for this @AppData@, if available. -- -- Since 0.1.12 appRawSocket :: AppData -> Maybe NS.Socket appRawSocket = appRawSocket' class HasReadWrite a where readLens :: Functor f => (IO ByteString -> f (IO ByteString)) -> a -> f a writeLens :: Functor f => ((ByteString -> IO ()) -> f (ByteString -> IO ())) -> a -> f a instance HasReadWrite AppData where readLens f a = fmap (\x -> a { appRead' = x }) (f (appRead' a)) writeLens f a = fmap (\x -> a { appWrite' = x }) (f (appWrite' a)) #if !WINDOWS instance HasReadWrite AppDataUnix where readLens f a = fmap (\x -> a { appReadUnix = x }) (f (appReadUnix a)) writeLens f a = fmap (\x -> a { appWriteUnix = x }) (f (appWriteUnix a)) #endif appRead :: HasReadWrite a => a -> IO ByteString appRead = getConstant . readLens Constant appWrite :: HasReadWrite a => a -> ByteString -> IO () appWrite = getConstant . writeLens Constant #if !WINDOWS -- | Run an @Application@ with the given settings. This function will create a -- new listening socket, accept connections on it, and spawn a new thread for -- each connection. runUnixServer :: ServerSettingsUnix -> (AppDataUnix -> IO ()) -> IO a runUnixServer (ServerSettingsUnix path afterBind readBufferSize) app = E.bracket (bindPath path) NS.close (\socket -> do afterBind socket forever $ serve socket) where serve lsocket = E.bracketOnError (acceptSafe lsocket) (\(socket, _) -> NS.close socket) $ \(socket, _) -> do let ad = AppDataUnix { appReadUnix = safeRecv socket readBufferSize , appWriteUnix = sendAll socket } _ <- E.mask $ \restore -> forkIO $ restore (app ad) `E.finally` NS.close socket return () -- | Run an @Application@ by connecting to the specified server. runUnixClient :: ClientSettingsUnix -> (AppDataUnix -> IO a) -> IO a runUnixClient (ClientSettingsUnix path readBufferSize) app = E.bracket (getSocketUnix path) NS.close (\sock -> app AppDataUnix { appReadUnix = safeRecv sock readBufferSize , appWriteUnix = sendAll sock }) #endif streaming-commons-0.2.2.6/Data/Streaming/Network/Internal.hs0000644000000000000000000000634114412473304022060 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Streaming.Network.Internal ( ServerSettings (..) , ClientSettings (..) , HostPreference (..) , Message (..) , AppData (..) #if !WINDOWS , ServerSettingsUnix (..) , ClientSettingsUnix (..) , AppDataUnix (..) #endif ) where import Data.String (IsString (..)) import Data.ByteString (ByteString) import Network.Socket (Socket, SockAddr, Family) -- | Settings for a TCP server. It takes a port to listen on, and an optional -- hostname to bind to. data ServerSettings = ServerSettings { serverPort :: !Int , serverHost :: !HostPreference , serverSocket :: !(Maybe Socket) -- ^ listening socket , serverAfterBind :: !(Socket -> IO ()) , serverNeedLocalAddr :: !Bool , serverReadBufferSize :: !Int } -- | Settings for a TCP client, specifying how to connect to the server. data ClientSettings = ClientSettings { clientPort :: !Int , clientHost :: !ByteString , clientAddrFamily :: !Family , clientReadBufferSize :: !Int } -- | Which host to bind. -- -- Note: The @IsString@ instance recognizes the following special values: -- -- * @*@ means @HostAny@ - "any IPv4 or IPv6 hostname" -- -- * @*4@ means @HostIPv4@ - "any IPv4 or IPv6 hostname, IPv4 preferred" -- -- * @!4@ means @HostIPv4Only@ - "any IPv4 hostname" -- -- * @*6@ means @HostIPv6@@ - "any IPv4 or IPv6 hostname, IPv6 preferred" -- -- * @!6@ means @HostIPv6Only@ - "any IPv6 hostname" -- -- Note that the permissive @*@ values allow binding to an IPv4 or an -- IPv6 hostname, which means you might be able to successfully bind -- to a port more times than you expect (eg once on the IPv4 localhost -- 127.0.0.1 and again on the IPv6 localhost 0:0:0:0:0:0:0:1). -- -- Any other value is treated as a hostname. As an example, to bind to the -- IPv4 local host only, use \"127.0.0.1\". data HostPreference = HostAny | HostIPv4 | HostIPv4Only | HostIPv6 | HostIPv6Only | Host String deriving (Eq, Ord, Show, Read) instance IsString HostPreference where fromString "*" = HostAny fromString "*4" = HostIPv4 fromString "!4" = HostIPv4Only fromString "*6" = HostIPv6 fromString "!6" = HostIPv6Only fromString s = Host s #if !WINDOWS -- | Settings for a Unix domain sockets server. data ServerSettingsUnix = ServerSettingsUnix { serverPath :: !FilePath , serverAfterBindUnix :: !(Socket -> IO ()) , serverReadBufferSizeUnix :: !Int } -- | Settings for a Unix domain sockets client. data ClientSettingsUnix = ClientSettingsUnix { clientPath :: !FilePath , clientReadBufferSizeUnix :: !Int } -- | The data passed to a Unix domain sockets @Application@. data AppDataUnix = AppDataUnix { appReadUnix :: !(IO ByteString) , appWriteUnix :: !(ByteString -> IO ()) } #endif -- | Representation of a single UDP message data Message = Message { msgData :: {-# UNPACK #-} !ByteString , msgSender :: !SockAddr } -- | The data passed to an @Application@. data AppData = AppData { appRead' :: !(IO ByteString) , appWrite' :: !(ByteString -> IO ()) , appSockAddr' :: !SockAddr , appLocalAddr' :: !(Maybe SockAddr) , appCloseConnection' :: !(IO ()) , appRawSocket' :: Maybe Socket } streaming-commons-0.2.2.6/Data/Streaming/Process.hs0000644000000000000000000002160514412473304020271 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} -- | A full tutorial for this module is available at: -- . -- -- Note that, while the tutorial covers @Data.Conduit.Process@, that module closely -- follows the present one, and almost all concepts in the tutorial apply here. module Data.Streaming.Process ( -- * Functions streamingProcess , closeStreamingProcessHandle -- * Specialized streaming types , Inherited (..) , ClosedStream (..) , UseProvidedHandle (..) -- * Process handle , StreamingProcessHandle , waitForStreamingProcess , waitForStreamingProcessSTM , getStreamingProcessExitCode , getStreamingProcessExitCodeSTM , streamingProcessHandleRaw , streamingProcessHandleTMVar -- * Type classes , InputSource , OutputSink -- * Checked processes , withCheckedProcess , ProcessExitedUnsuccessfully (..) -- * Reexport , module System.Process ) where import Control.Applicative as A ((<$>), (<*>)) import Control.Concurrent (forkIOWithUnmask) import Control.Concurrent.STM (STM, TMVar, atomically, newEmptyTMVar, putTMVar, readTMVar) import Control.Exception (Exception, throwIO, try, throw, SomeException, finally) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Maybe (fromMaybe) import Data.Streaming.Process.Internal import Data.Typeable (Typeable) import System.Exit (ExitCode (ExitSuccess)) import System.IO (hClose) import System.Process #if MIN_VERSION_process(1,2,0) import qualified System.Process.Internals as PI #endif #if MIN_VERSION_stm(2,3,0) import Control.Concurrent.STM (tryReadTMVar) #else import Control.Concurrent.STM (tryTakeTMVar, putTMVar) tryReadTMVar :: TMVar a -> STM (Maybe a) tryReadTMVar var = do mx <- tryTakeTMVar var case mx of Nothing -> return () Just x -> putTMVar var x return mx #endif -- | Use the @Handle@ provided by the @CreateProcess@ value. This would allow -- you, for example, to open up a @Handle@ to a file, set it as @std_out@, and -- avoid any additional overhead of dealing with providing that data to your -- process. -- -- Since 0.1.4 data UseProvidedHandle = UseProvidedHandle -- | Inherit the stream from the current process. -- -- Since 0.1.4 data Inherited = Inherited -- | Close the stream with the child process. -- -- You usually do not want to use this, as it will leave the corresponding file -- descriptor unassigned and hence available for re-use in the child process. -- -- Since 0.1.4 data ClosedStream = ClosedStream instance InputSource ClosedStream where isStdStream = (\(Just h) -> hClose h >> return ClosedStream, Just CreatePipe) instance InputSource Inherited where isStdStream = (\Nothing -> return Inherited, Just Inherit) instance InputSource UseProvidedHandle where isStdStream = (\Nothing -> return UseProvidedHandle, Nothing) instance OutputSink ClosedStream where osStdStream = (\(Just h) -> hClose h >> return ClosedStream, Just CreatePipe) instance OutputSink Inherited where osStdStream = (\Nothing -> return Inherited, Just Inherit) instance OutputSink UseProvidedHandle where osStdStream = (\Nothing -> return UseProvidedHandle, Nothing) -- | Blocking call to wait for a process to exit. -- -- Since 0.1.4 waitForStreamingProcess :: MonadIO m => StreamingProcessHandle -> m ExitCode waitForStreamingProcess = liftIO . atomically . waitForStreamingProcessSTM -- | STM version of @waitForStreamingProcess@. -- -- Since 0.1.4 waitForStreamingProcessSTM :: StreamingProcessHandle -> STM ExitCode waitForStreamingProcessSTM = readTMVar . streamingProcessHandleTMVar -- | Non-blocking call to check for a process exit code. -- -- Since 0.1.4 getStreamingProcessExitCode :: MonadIO m => StreamingProcessHandle -> m (Maybe ExitCode) getStreamingProcessExitCode = liftIO . atomically . getStreamingProcessExitCodeSTM -- | STM version of @getStreamingProcessExitCode@. -- -- Since 0.1.4 getStreamingProcessExitCodeSTM :: StreamingProcessHandle -> STM (Maybe ExitCode) getStreamingProcessExitCodeSTM = tryReadTMVar . streamingProcessHandleTMVar -- | Get the raw @ProcessHandle@ from a @StreamingProcessHandle@. Note that -- you should avoid using this to get the process exit code, and instead -- use the provided functions. -- -- Since 0.1.4 streamingProcessHandleRaw :: StreamingProcessHandle -> ProcessHandle streamingProcessHandleRaw (StreamingProcessHandle ph _ _) = ph -- | Get the @TMVar@ storing the process exit code. In general, one of the -- above functions should be used instead to avoid accidentally corrupting the variable\'s state.. -- -- Since 0.1.4 streamingProcessHandleTMVar :: StreamingProcessHandle -> TMVar ExitCode streamingProcessHandleTMVar (StreamingProcessHandle _ var _) = var -- | The primary function for running a process. Note that, with the -- exception of 'UseProvidedHandle', the values for @std_in@, @std_out@ -- and @std_err@ will be ignored by this function. -- -- Since 0.1.4 streamingProcess :: (MonadIO m, InputSource stdin, OutputSink stdout, OutputSink stderr) => CreateProcess -> m (stdin, stdout, stderr, StreamingProcessHandle) streamingProcess cp = liftIO $ do let (getStdin, stdinStream) = isStdStream (getStdout, stdoutStream) = osStdStream (getStderr, stderrStream) = osStdStream #if MIN_VERSION_process(1,2,0) (stdinH, stdoutH, stderrH, ph) <- PI.createProcess_ "streamingProcess" cp #else (stdinH, stdoutH, stderrH, ph) <- createProcess cp #endif { std_in = fromMaybe (std_in cp) stdinStream , std_out = fromMaybe (std_out cp) stdoutStream , std_err = fromMaybe (std_err cp) stderrStream } ec <- atomically newEmptyTMVar -- Apparently waitForProcess can throw an exception itself when -- delegate_ctlc is True, so to avoid this TMVar from being left empty, we -- capture any exceptions and store them as an impure exception in the -- TMVar _ <- forkIOWithUnmask $ \_unmask -> try (waitForProcess ph) >>= atomically . putTMVar ec . either (throw :: SomeException -> a) id let close = mclose stdinH `finally` mclose stdoutH `finally` mclose stderrH where mclose = maybe (return ()) hClose (,,,) A.<$> getStdin stdinH A.<*> getStdout stdoutH <*> getStderr stderrH <*> return (StreamingProcessHandle ph ec close) -- | Free any resources (e.g. @Handle@s) acquired by a call to 'streamingProcess'. -- -- @since 0.1.16 closeStreamingProcessHandle :: MonadIO m => StreamingProcessHandle -> m () closeStreamingProcessHandle (StreamingProcessHandle _ _ f) = liftIO f -- | Indicates that a process exited with an non-success exit code. -- -- Since 0.1.7 data ProcessExitedUnsuccessfully = ProcessExitedUnsuccessfully CreateProcess ExitCode deriving Typeable instance Show ProcessExitedUnsuccessfully where show (ProcessExitedUnsuccessfully cp ec) = concat [ "Process exited with " , show ec , ": " , showCmdSpec (cmdspec cp) ] where showCmdSpec (ShellCommand str) = str showCmdSpec (RawCommand x xs) = unwords (x:map showArg xs) -- Ensure that strings that need to be escaped are showArg x | any (\c -> c == '"' || c == ' ') x = show x | otherwise = x instance Exception ProcessExitedUnsuccessfully -- | Run a process and supply its streams to the given callback function. After -- the callback completes, wait for the process to complete and check its exit -- code. If the exit code is not a success, throw a -- 'ProcessExitedUnsuccessfully'. -- -- NOTE: This function does not kill the child process or ensure -- resources are cleaned up in the event of an exception from the -- provided function. For that, please use @withCheckedProcessCleanup@ -- from the @conduit-extra@ package. -- -- Since 0.1.7 withCheckedProcess :: ( InputSource stdin , OutputSink stderr , OutputSink stdout , MonadIO m ) => CreateProcess -> (stdin -> stdout -> stderr -> m b) -> m b withCheckedProcess cp f = do (x, y, z, sph) <- streamingProcess cp res <- f x y z liftIO $ do ec <- waitForStreamingProcess sph `finally` closeStreamingProcessHandle sph if ec == ExitSuccess then return res else throwIO $ ProcessExitedUnsuccessfully cp ec streaming-commons-0.2.2.6/Data/Streaming/Process/Internal.hs0000644000000000000000000000227514412473304022047 0ustar0000000000000000module Data.Streaming.Process.Internal ( StreamingProcessHandle (..) , InputSource (..) , OutputSink (..) ) where import Control.Concurrent.STM (TMVar) import System.Exit (ExitCode) import System.IO (Handle) import System.Process (ProcessHandle, StdStream (CreatePipe)) -- | Class for all things which can be used to provide standard input. -- -- Since 0.1.4 class InputSource a where isStdStream :: (Maybe Handle -> IO a, Maybe StdStream) instance InputSource Handle where isStdStream = (\(Just h) -> return h, Just CreatePipe) -- | Class for all things which can be used to consume standard output or -- error. -- -- Since 0.1.4 class OutputSink a where osStdStream :: (Maybe Handle -> IO a, Maybe StdStream) instance OutputSink Handle where osStdStream = (\(Just h) -> return h, Just CreatePipe) -- | Wraps up the standard @ProcessHandle@ to avoid the @waitForProcess@ -- deadlock. See the linked documentation from the module header for more -- information. -- -- Since 0.1.4 data StreamingProcessHandle = StreamingProcessHandle ProcessHandle (TMVar ExitCode) (IO ()) -- cleanup resources streaming-commons-0.2.2.6/Data/Streaming/Text.hs0000644000000000000000000005634614412473731017615 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnliftedFFITypes #-} -- -- Module : Data.Text.Lazy.Encoding.Fusion -- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- /Warning/: this is an internal module, and does not have a stable -- API or name. Functions in this module may not check or enforce -- preconditions expected by public modules. Use at your own risk! -- -- Fusible 'Stream'-oriented functions for converting between lazy -- 'Text' and several common encodings. -- | Provides a stream-based approach to decoding Unicode data. Each function -- below works the same way: you give it a chunk of data, and it gives back a -- @DecodeResult@. If the parse was a success, then you get a chunk of @Text@ -- (possibly empty) and a continuation parsing function. If the parse was a -- failure, you get a chunk of successfully decoded @Text@ (possibly empty) and -- the unconsumed bytes. -- -- In order to indicate end of stream, you pass an empty @ByteString@ to the -- decode function. This call may result in a failure, if there were unused -- bytes left over from a previous step which formed part of a code sequence. module Data.Streaming.Text ( -- * Streaming decodeUtf8 , decodeUtf8Pure , decodeUtf16LE , decodeUtf16BE , decodeUtf32LE , decodeUtf32BE -- * Type , DecodeResult (..) ) where import Control.Monad.ST (ST, runST) import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) import Data.Bits ((.|.), shiftL) import qualified Data.ByteString as B import Data.ByteString.Internal (ByteString (PS)) import qualified Data.ByteString.Unsafe as B import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Array as A import Data.Text.Internal (text) import qualified Data.Text.Internal.Encoding.Utf16 as U16 import qualified Data.Text.Internal.Encoding.Utf32 as U32 import qualified Data.Text.Internal.Encoding.Utf8 as U8 import Data.Text.Internal.Unsafe.Char (unsafeWrite, unsafeChr32, unsafeChr8) import Data.Word (Word32, Word8) import Foreign.C.Types (CSize (..)) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) import Foreign.Storable (Storable, peek, poke) import GHC.Base (MutableByteArray#) #if MIN_VERSION_text(2,0,0) import Control.Exception (try, evaluate) import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE import Data.Text.Internal.Unsafe.Char (unsafeChr16) import System.IO.Unsafe (unsafePerformIO) #else import Data.Text.Internal.Unsafe.Char (unsafeChr) unsafeChr16 = unsafeChr #endif data S = S0 | S1 {-# UNPACK #-} !Word8 | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 deriving Show data DecodeResult = DecodeResultSuccess !Text !(B.ByteString -> DecodeResult) | DecodeResultFailure !Text !B.ByteString toBS :: S -> B.ByteString toBS S0 = B.empty toBS (S1 a) = B.pack [a] toBS (S2 a b) = B.pack [a, b] toBS (S3 a b c) = B.pack [a, b, c] {-# INLINE toBS #-} getText :: Int -> A.MArray s -> ST s Text getText j marr = do arr <- A.unsafeFreeze marr return $! text arr 0 j {-# INLINE getText #-} #include "text_cbits.h" foreign import ccall unsafe "_hs_streaming_commons_decode_utf8_state" c_decode_utf8_with_state :: MutableByteArray# s -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr Word8 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8) newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable) newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable) -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using -- UTF-8 encoding. decodeUtf8 :: B.ByteString -> DecodeResult #if MIN_VERSION_text(2,0,0) decodeUtf8 = go mempty TE.streamDecodeUtf8 where go :: B.ByteString -> (B.ByteString -> TE.Decoding) -> B.ByteString -> DecodeResult go prev decoder curr = case unsafePerformIO (try (evaluate (decoder curr))) of -- Caught exception does not allow to reconstruct 'DecodeResultFailure', -- so delegating this to 'decodeUtf8Pure' Left (_ :: TE.UnicodeException) -> decodeUtf8Pure (prev <> curr) Right (TE.Some decoded undecoded cont) -- An empty bytestring indicates end-of-input, if we still have undecoded bytes that -- becomes a failure. | B.null curr && not (B.null undecoded) -> DecodeResultFailure decoded undecoded | otherwise -> DecodeResultSuccess decoded (go undecoded cont) #else decodeUtf8 = decodeChunk B.empty 0 0 where decodeChunkCheck :: B.ByteString -> CodePoint -> DecoderState -> B.ByteString -> DecodeResult decodeChunkCheck bsOld codepoint state bs | B.null bs = if B.null bsOld then DecodeResultSuccess T.empty decodeUtf8 else DecodeResultFailure T.empty bsOld | otherwise = decodeChunk bsOld codepoint state bs -- We create a slightly larger than necessary buffer to accommodate a -- potential surrogate pair started in the last buffer decodeChunk :: B.ByteString -> CodePoint -> DecoderState -> B.ByteString -> DecodeResult decodeChunk bsOld codepoint0 state0 bs@(PS fp off len) = runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1) where decodeChunkToBuffer :: A.MArray s -> IO DecodeResult decodeChunkToBuffer dest = withForeignPtr fp $ \ptr -> with (0::CSize) $ \destOffPtr -> with codepoint0 $ \codepointPtr -> with state0 $ \statePtr -> with nullPtr $ \curPtrPtr -> let end = ptr `plusPtr` (off + len) loop curPtr = do poke curPtrPtr curPtr _ <- c_decode_utf8_with_state (A.maBA dest) destOffPtr curPtrPtr end codepointPtr statePtr state <- peek statePtr n <- peek destOffPtr chunkText <- unsafeSTToIO $ do arr <- A.unsafeFreeze dest return $! text arr 0 (fromIntegral n) lastPtr <- peek curPtrPtr let left = lastPtr `minusPtr` curPtr -- The logic here is: if any text was generated, then the -- previous leftovers were completely consumed already. -- If no text was generated, then any leftovers from the -- previous step are still leftovers now. unused | not $ T.null chunkText = B.unsafeDrop left bs | B.null bsOld = bs | otherwise = B.append bsOld bs case unused `seq` state of UTF8_REJECT -> -- We encountered an encoding error return $! DecodeResultFailure chunkText unused _ -> do codepoint <- peek codepointPtr return $! DecodeResultSuccess chunkText $! decodeChunkCheck unused codepoint state in loop (ptr `plusPtr` off) #endif -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using -- UTF-8 encoding. decodeUtf8Pure :: B.ByteString -> DecodeResult decodeUtf8Pure = beginChunk S0 where beginChunk :: S -> B.ByteString -> DecodeResult beginChunk s bs | B.null bs = case s of S0 -> DecodeResultSuccess T.empty (beginChunk S0) _ -> DecodeResultFailure T.empty $ toBS s beginChunk s0 ps = runST $ do let initLen = B.length ps #if MIN_VERSION_text(2,0,0) -- Worst-case scenario: the very first byte finishes a 4-byte sequence, -- so decoding results in 4 + (initLen - 1) bytes. marr <- A.new (initLen + 3) #else marr <- A.new (initLen + 1) #endif let start !i !j | i >= len = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk S0) | U8.validate1 a = addChar' 1 (unsafeChr8 a) | i + 1 < len && U8.validate2 a b = addChar' 2 (U8.chr2 a b) | i + 2 < len && U8.validate3 a b c = addChar' 3 (U8.chr3 a b c) | i + 3 < len && U8.validate4 a b c d = addChar' 4 (U8.chr4 a b c d) | i + 3 < len = do t <- getText j marr return $! DecodeResultFailure t (B.unsafeDrop i ps) | i + 2 < len = continue (S3 a b c) | i + 1 < len = continue (S2 a b) | otherwise = continue (S1 a) where a = B.unsafeIndex ps i b = B.unsafeIndex ps (i+1) c = B.unsafeIndex ps (i+2) d = B.unsafeIndex ps (i+3) addChar' deltai char = do deltaj <- unsafeWrite marr j char start (i + deltai) (j + deltaj) continue s = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk s) checkCont s !i | i >= len = return $! DecodeResultSuccess T.empty (beginChunk s) checkCont s !i = case s of S0 -> start i 0 S1 a | U8.validate2 a x -> addChar' (U8.chr2 a x) | otherwise -> checkCont (S2 a x) (i + 1) S2 a b | U8.validate3 a b x -> addChar' (U8.chr3 a b x) | otherwise -> checkCont (S3 a b x) (i + 1) S3 a b c | U8.validate4 a b c x -> addChar' (U8.chr4 a b c x) _ -> return $! DecodeResultFailure T.empty $! B.append (toBS s) (B.unsafeDrop i ps) where x = B.unsafeIndex ps i addChar' c = do d <- unsafeWrite marr 0 c start (i + 1) d checkCont s0 0 where len = B.length ps {-# INLINE beginChunk #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little -- endian UTF-16 encoding. decodeUtf16LE :: B.ByteString -> DecodeResult decodeUtf16LE = beginChunk S0 where beginChunk :: S -> B.ByteString -> DecodeResult beginChunk s bs | B.null bs = case s of S0 -> DecodeResultSuccess T.empty (beginChunk S0) _ -> DecodeResultFailure T.empty $ toBS s beginChunk s0 ps = runST $ do let initLen = B.length ps #if MIN_VERSION_text(2,0,0) -- Worst-case scenario: each Word16 in UTF16 gives three Word8 in UTF8 -- and left-over from a previous chunk gives four Word8 in UTF8 marr <- A.new ((initLen `div` 2) * 3 + 4) -- of Word8 #else marr <- A.new (initLen + 1) -- of Word16 #endif let start !i !j | i >= len = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk S0) | i + 1 < len && U16.validate1 x1 = addChar' 2 (unsafeChr16 x1) | i + 3 < len && U16.validate2 x1 x2 = addChar' 4 (U16.chr2 x1 x2) | i + 3 < len = do t <- getText j marr return $! DecodeResultFailure t (B.unsafeDrop i ps) | i + 2 < len = continue (S3 a b c) | i + 1 < len = continue (S2 a b) | otherwise = continue (S1 a) where a = B.unsafeIndex ps i b = B.unsafeIndex ps (i+1) c = B.unsafeIndex ps (i+2) d = B.unsafeIndex ps (i+3) x1 = combine a b x2 = combine c d addChar' deltai char = do deltaj <- unsafeWrite marr j char start (i + deltai) (j + deltaj) continue s = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk s) checkCont s !i | i >= len = return $! DecodeResultSuccess T.empty (beginChunk s) checkCont s !i = case s of S0 -> start i 0 S1 a -> let x1 = combine a x in if U16.validate1 x1 then addChar' (unsafeChr16 x1) else checkCont (S2 a x) (i + 1) S2 a b -> checkCont (S3 a b x) (i + 1) S3 a b c -> let x1 = combine a b x2 = combine c x in if U16.validate2 x1 x2 then addChar' (U16.chr2 x1 x2) else return $! DecodeResultFailure T.empty $! B.append (toBS s) (B.unsafeDrop i ps) where x = B.unsafeIndex ps i addChar' c = do d <- unsafeWrite marr 0 c start (i + 1) d checkCont s0 0 where len = B.length ps combine w1 w2 = fromIntegral w1 .|. (fromIntegral w2 `shiftL` 8) {-# INLINE beginChunk #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big -- endian UTF-16 encoding. decodeUtf16BE :: B.ByteString -> DecodeResult decodeUtf16BE = beginChunk S0 where beginChunk :: S -> B.ByteString -> DecodeResult beginChunk s bs | B.null bs = case s of S0 -> DecodeResultSuccess T.empty (beginChunk S0) _ -> DecodeResultFailure T.empty $ toBS s beginChunk s0 ps = runST $ do let initLen = B.length ps #if MIN_VERSION_text(2,0,0) -- Worst-case scenario: each Word16 in UTF16 gives three Word8 in UTF8 -- and left-over from a previous chunk gives four Word8 in UTF8 marr <- A.new ((initLen `div` 2) * 3 + 4) -- of Word8 #else marr <- A.new (initLen + 1) -- of Word16 #endif let start !i !j | i >= len = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk S0) | i + 1 < len && U16.validate1 x1 = addChar' 2 (unsafeChr16 x1) | i + 3 < len && U16.validate2 x1 x2 = addChar' 4 (U16.chr2 x1 x2) | i + 3 < len = do t <- getText j marr return $! DecodeResultFailure t (B.unsafeDrop i ps) | i + 2 < len = continue (S3 a b c) | i + 1 < len = continue (S2 a b) | otherwise = continue (S1 a) where a = B.unsafeIndex ps i b = B.unsafeIndex ps (i+1) c = B.unsafeIndex ps (i+2) d = B.unsafeIndex ps (i+3) x1 = combine a b x2 = combine c d addChar' deltai char = do deltaj <- unsafeWrite marr j char start (i + deltai) (j + deltaj) continue s = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk s) checkCont s !i | i >= len = return $! DecodeResultSuccess T.empty (beginChunk s) checkCont s !i = case s of S0 -> start i 0 S1 a -> let x1 = combine a x in if U16.validate1 x1 then addChar' (unsafeChr16 x1) else checkCont (S2 a x) (i + 1) S2 a b -> checkCont (S3 a b x) (i + 1) S3 a b c -> let x1 = combine a b x2 = combine c x in if U16.validate2 x1 x2 then addChar' (U16.chr2 x1 x2) else return $! DecodeResultFailure T.empty $! B.append (toBS s) (B.unsafeDrop i ps) where x = B.unsafeIndex ps i addChar' c = do d <- unsafeWrite marr 0 c start (i + 1) d checkCont s0 0 where len = B.length ps combine w1 w2 = (fromIntegral w1 `shiftL` 8) .|. fromIntegral w2 {-# INLINE beginChunk #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little -- endian UTF-32 encoding. decodeUtf32LE :: B.ByteString -> DecodeResult decodeUtf32LE = beginChunk S0 where beginChunk :: S -> B.ByteString -> DecodeResult beginChunk s bs | B.null bs = case s of S0 -> DecodeResultSuccess T.empty (beginChunk S0) _ -> DecodeResultFailure T.empty $ toBS s beginChunk s0 ps = runST $ do let initLen = B.length ps `div` 2 #if MIN_VERSION_text(2,0,0) -- Worst-case scenario: the very first byte finishes a 4-byte UTF8 sequence, -- and other codepoints have 4-byte UTF8 representation as well. -- This gives 4 + (B.length ps - 1), or (for odd B.length) initLen * 2 + 4. marr <- A.new (initLen * 2 + 4) -- of Word8 #else marr <- A.new (initLen + 1) -- of Word16 #endif let start !i !j | i >= len = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk S0) | i + 3 < len && U32.validate x1 = addChar' 4 (unsafeChr32 x1) | i + 3 < len = do t <- getText j marr return $! DecodeResultFailure t (B.unsafeDrop i ps) | i + 2 < len = continue (S3 a b c) | i + 1 < len = continue (S2 a b) | otherwise = continue (S1 a) where a = B.unsafeIndex ps i b = B.unsafeIndex ps (i+1) c = B.unsafeIndex ps (i+2) d = B.unsafeIndex ps (i+3) x1 = combine a b c d addChar' deltai char = do deltaj <- unsafeWrite marr j char start (i + deltai) (j + deltaj) continue s = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk s) checkCont s !i | i >= len = return $! DecodeResultSuccess T.empty (beginChunk s) checkCont s !i = case s of S0 -> start i 0 S1 a -> checkCont (S2 a x) (i + 1) S2 a b -> checkCont (S3 a b x) (i + 1) S3 a b c -> let x1 = combine a b c x in if U32.validate x1 then addChar' (unsafeChr32 x1) else return $! DecodeResultFailure T.empty $! B.append (toBS s) (B.unsafeDrop i ps) where x = B.unsafeIndex ps i addChar' c = do d <- unsafeWrite marr 0 c start (i + 1) d checkCont s0 0 where len = B.length ps combine w1 w2 w3 w4 = shiftL (fromIntegral w4) 24 .|. shiftL (fromIntegral w3) 16 .|. shiftL (fromIntegral w2) 8 .|. (fromIntegral w1) {-# INLINE beginChunk #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big -- endian UTF-32 encoding. decodeUtf32BE :: B.ByteString -> DecodeResult decodeUtf32BE = beginChunk S0 where beginChunk :: S -> B.ByteString -> DecodeResult beginChunk s bs | B.null bs = case s of S0 -> DecodeResultSuccess T.empty (beginChunk S0) _ -> DecodeResultFailure T.empty $ toBS s beginChunk s0 ps = runST $ do let initLen = B.length ps `div` 2 #if MIN_VERSION_text(2,0,0) -- Worst-case scenario: the very first byte finishes a 4-byte UTF8 sequence, -- and other codepoints have 4-byte UTF8 representation as well. -- This gives 4 + (B.length ps - 1), or (for odd B.length) initLen * 2 + 4. marr <- A.new (initLen * 2 + 4) -- of Word8 #else marr <- A.new (initLen + 1) -- of Word16 #endif let start !i !j | i >= len = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk S0) | i + 3 < len && U32.validate x1 = addChar' 4 (unsafeChr32 x1) | i + 3 < len = do t <- getText j marr return $! DecodeResultFailure t (B.unsafeDrop i ps) | i + 2 < len = continue (S3 a b c) | i + 1 < len = continue (S2 a b) | otherwise = continue (S1 a) where a = B.unsafeIndex ps i b = B.unsafeIndex ps (i+1) c = B.unsafeIndex ps (i+2) d = B.unsafeIndex ps (i+3) x1 = combine a b c d addChar' deltai char = do deltaj <- unsafeWrite marr j char start (i + deltai) (j + deltaj) continue s = do t <- getText j marr return $! DecodeResultSuccess t (beginChunk s) checkCont s !i | i >= len = return $! DecodeResultSuccess T.empty (beginChunk s) checkCont s !i = case s of S0 -> start i 0 S1 a -> checkCont (S2 a x) (i + 1) S2 a b -> checkCont (S3 a b x) (i + 1) S3 a b c -> let x1 = combine a b c x in if U32.validate x1 then addChar' (unsafeChr32 x1) else return $! DecodeResultFailure T.empty $! B.append (toBS s) (B.unsafeDrop i ps) where x = B.unsafeIndex ps i addChar' c = do d <- unsafeWrite marr 0 c start (i + 1) d checkCont s0 0 where len = B.length ps combine w1 w2 w3 w4 = shiftL (fromIntegral w1) 24 .|. shiftL (fromIntegral w2) 16 .|. shiftL (fromIntegral w3) 8 .|. (fromIntegral w4) {-# INLINE beginChunk #-} streaming-commons-0.2.2.6/Data/Streaming/Zlib.hs0000644000000000000000000003105214412473304017550 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | This is a middle-level wrapper around the zlib C API. It allows you to -- work fully with bytestrings and not touch the FFI at all, but is still -- low-level enough to allow you to implement high-level abstractions such as -- enumerators. Significantly, it does not use lazy IO. -- -- You'll probably need to reference the docs a bit to understand the -- WindowBits parameters below, but a basic rule of thumb is 15 is for zlib -- compression, and 31 for gzip compression. -- -- A simple streaming compressor in pseudo-code would look like: -- -- > def <- initDeflate ... -- > popper <- feedDeflate def rawContent -- > pullPopper popper -- > ... -- > finishDeflate def sendCompressedData -- -- You can see a more complete example is available in the included -- file-test.hs. module Data.Streaming.Zlib ( -- * Inflate Inflate , initInflate , initInflateWithDictionary , feedInflate , finishInflate , flushInflate , getUnusedInflate , isCompleteInflate -- * Deflate , Deflate , initDeflate , initDeflateWithDictionary , feedDeflate , finishDeflate , flushDeflate , fullFlushDeflate -- * Data types , WindowBits (..) , defaultWindowBits , ZlibException (..) , Popper , PopperRes (..) ) where import Data.Streaming.Zlib.Lowlevel import Foreign.ForeignPtr import Foreign.C.Types import Data.ByteString.Unsafe import Codec.Compression.Zlib (WindowBits(WindowBits), defaultWindowBits) import qualified Data.ByteString as S 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) -- | The state of an inflation (eg, decompression) process. All allocated -- memory is automatically reclaimed by the garbage collector. -- Also can contain the inflation dictionary that is used for decompression. 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 -- is automatically reclaimed by the garbage collector. newtype Deflate = Deflate ZStreamPair -- | Exception that can be thrown from the FFI code. The parameter is the -- numerical error code from the zlib library. Quoting the zlib.h file -- directly: -- -- * #define Z_OK 0 -- -- * #define Z_STREAM_END 1 -- -- * #define Z_NEED_DICT 2 -- -- * #define Z_ERRNO (-1) -- -- * #define Z_STREAM_ERROR (-2) -- -- * #define Z_DATA_ERROR (-3) -- -- * #define Z_MEM_ERROR (-4) -- -- * #define Z_BUF_ERROR (-5) -- -- * #define Z_VERSION_ERROR (-6) data ZlibException = ZlibException Int deriving (Show, Typeable) instance Exception ZlibException -- | Some constants for the error codes, used internally zStreamEnd :: CInt zStreamEnd = 1 zNeedDict :: CInt zNeedDict = 2 zBufError :: CInt zBufError = -5 -- | Initialize an inflation process with the given 'WindowBits'. You will need -- to call 'feedInflate' to feed compressed data to this and -- 'finishInflate' to extract the final chunk of decompressed data. initInflate :: WindowBits -> IO Inflate initInflate w = do zstr <- zstreamNew inflateInit2 zstr w fzstr <- newForeignPtr c_free_z_stream_inflate zstr fbuff <- mallocForeignPtrBytes defaultChunkSize withForeignPtr fbuff $ \buff -> c_set_avail_out zstr buff $ fromIntegral defaultChunkSize lastBS <- newIORef S.empty complete <- newIORef False return $ Inflate (fzstr, fbuff) lastBS complete Nothing -- | 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 initInflateWithDictionary w bs = do zstr <- zstreamNew inflateInit2 zstr w fzstr <- newForeignPtr c_free_z_stream_inflate zstr fbuff <- mallocForeignPtrBytes defaultChunkSize withForeignPtr fbuff $ \buff -> c_set_avail_out zstr buff $ fromIntegral defaultChunkSize lastBS <- newIORef S.empty 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 -- data to this and 'finishDeflate' to extract the final chunks of compressed -- data. initDeflate :: Int -- ^ Compression level -> WindowBits -> IO Deflate initDeflate level w = do zstr <- zstreamNew deflateInit2 zstr level w 8 StrategyDefault fzstr <- newForeignPtr c_free_z_stream_deflate zstr fbuff <- mallocForeignPtrBytes defaultChunkSize withForeignPtr fbuff $ \buff -> c_set_avail_out zstr buff $ fromIntegral defaultChunkSize return $ Deflate (fzstr, fbuff) -- | Initialize an deflation process with the given compression level and -- 'WindowBits'. -- Unlike initDeflate a dictionary for deflation is set. initDeflateWithDictionary :: Int -- ^ Compression level -> S.ByteString -- ^ Deflate dictionary -> WindowBits -> IO Deflate initDeflateWithDictionary level bs w = do zstr <- zstreamNew deflateInit2 zstr level w 8 StrategyDefault fzstr <- newForeignPtr c_free_z_stream_deflate zstr fbuff <- mallocForeignPtrBytes defaultChunkSize unsafeUseAsCStringLen bs $ \(cstr, len) -> do c_call_deflate_set_dictionary zstr cstr $ fromIntegral len withForeignPtr fbuff $ \buff -> c_set_avail_out zstr buff $ fromIntegral defaultChunkSize return $ Deflate (fzstr, fbuff) -- | Feed the given 'S.ByteString' to the inflater. Return a 'Popper', -- an IO action that returns the decompressed data a chunk at a time. -- The 'Popper' must be called to exhaustion before using the 'Inflate' -- object again. -- -- Note that this function automatically buffers the output to -- 'defaultChunkSize', and therefore you won't get any data from the popper -- until that much decompressed data is available. After you have fed all of -- the compressed data to this function, you can extract your final chunk of -- decompressed data using 'finishInflate'. feedInflate :: Inflate -> S.ByteString -> IO Popper 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 -- reference to the ForeignPtr, so the GC may decide to collect the -- ByteString in the interim. writeIORef lastBS bs withForeignPtr fzstr $ \zstr -> unsafeUseAsCStringLen bs $ \(cstr, len) -> c_set_avail_in zstr cstr $ fromIntegral len return $ drain fbuff fzstr (Just bs) inflate False where inflate zstr = do res <- c_call_inflate_noflush zstr 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 'PRDone' when -- there is no more data to be popped. type Popper = IO PopperRes data PopperRes = PRDone | PRNext !S.ByteString | PRError !ZlibException deriving (Show, Typeable) -- | Ensure that the given @ByteString@ is not deallocated. keepAlive :: Maybe S.ByteString -> IO a -> IO a keepAlive Nothing = id keepAlive (Just bs) = unsafeUseAsCStringLen bs . const drain :: ForeignPtr CChar -> ForeignPtr ZStreamStruct -> Maybe S.ByteString -> (ZStream' -> IO CInt) -> Bool -> Popper drain fbuff fzstr mbs func isFinish = withForeignPtr fzstr $ \zstr -> keepAlive mbs $ do res <- func zstr if res < 0 && res /= zBufError then return $ PRError $ ZlibException $ fromIntegral res else do avail <- c_get_avail_out zstr let size = defaultChunkSize - fromIntegral avail toOutput = avail == 0 || (isFinish && size /= 0) if toOutput then withForeignPtr fbuff $ \buff -> do bs <- S.packCStringLen (buff, size) c_set_avail_out zstr buff $ fromIntegral defaultChunkSize return $ PRNext bs else return PRDone -- | As explained in 'feedInflate', inflation buffers your decompressed -- data. After you call 'feedInflate' with your last chunk of compressed -- 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) _ _ _) = withForeignPtr fzstr $ \zstr -> withForeignPtr fbuff $ \buff -> do avail <- c_get_avail_out zstr let size = defaultChunkSize - fromIntegral avail bs <- S.packCStringLen (buff, size) c_set_avail_out zstr buff $ fromIntegral defaultChunkSize return bs -- | Flush the inflation buffer. Useful for interactive application. -- -- This is actually a synonym for 'finishInflate'. It is provided for its more -- semantic name. -- -- Since 0.0.3 flushInflate :: Inflate -> IO S.ByteString flushInflate = finishInflate -- | Retrieve any data remaining after inflating. For more information on motivation, see: -- -- -- -- Since 0.1.11 getUnusedInflate :: Inflate -> IO S.ByteString 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' -- object again. -- -- Note that this function automatically buffers the output to -- 'defaultChunkSize', and therefore you won't get any data from the popper -- until that much compressed data is available. After you have fed all of the -- decompressed data to this function, you can extract your final chunks of -- compressed data using 'finishDeflate'. feedDeflate :: Deflate -> S.ByteString -> IO Popper feedDeflate (Deflate (fzstr, fbuff)) bs = do withForeignPtr fzstr $ \zstr -> unsafeUseAsCStringLen bs $ \(cstr, len) -> do c_set_avail_in zstr cstr $ fromIntegral len return $ drain fbuff fzstr (Just bs) c_call_deflate_noflush False -- | As explained in 'feedDeflate', deflation buffers your compressed -- data. After you call 'feedDeflate' with your last chunk of uncompressed -- data, use this to flush the rest of the data and signal end of input. finishDeflate :: Deflate -> Popper finishDeflate (Deflate (fzstr, fbuff)) = drain fbuff fzstr Nothing c_call_deflate_finish True -- | Flush the deflation buffer. Useful for interactive application. -- Internally this passes Z_SYNC_FLUSH to the zlib library. -- -- Unlike 'finishDeflate', 'flushDeflate' does not signal end of input, -- meaning you can feed more uncompressed data afterward. -- -- Since 0.0.3 flushDeflate :: Deflate -> Popper flushDeflate (Deflate (fzstr, fbuff)) = drain fbuff fzstr Nothing c_call_deflate_flush True -- | Full flush the deflation buffer. Useful for interactive -- applications where previously streamed data may not be -- available. Using `fullFlushDeflate` too often can seriously degrade -- compression. Internally this passes Z_FULL_FLUSH to the zlib -- library. -- -- Like 'flushDeflate', 'fullFlushDeflate' does not signal end of input, -- meaning you can feed more uncompressed data afterward. -- -- Since 0.1.5 fullFlushDeflate :: Deflate -> Popper fullFlushDeflate (Deflate (fzstr, fbuff)) = drain fbuff fzstr Nothing c_call_deflate_full_flush True streaming-commons-0.2.2.6/Data/Streaming/Zlib/Lowlevel.hs0000644000000000000000000000665514412473304021354 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE EmptyDataDecls #-} module Data.Streaming.Zlib.Lowlevel ( ZStreamStruct , ZStream' , zstreamNew , Strategy(..) , deflateInit2 , inflateInit2 , c_free_z_stream_inflate , c_free_z_stream_deflate , c_set_avail_in , c_set_avail_out , c_get_avail_out , c_get_avail_in , c_get_next_in , c_call_inflate_noflush , c_call_deflate_noflush , c_call_deflate_finish , c_call_deflate_flush , c_call_deflate_full_flush , c_call_deflate_set_dictionary , c_call_inflate_set_dictionary ) where import Foreign.C import Foreign.Ptr import Codec.Compression.Zlib (WindowBits (WindowBits)) data ZStreamStruct type ZStream' = Ptr ZStreamStruct data Strategy = StrategyDefault | StrategyFiltered | StrategyHuffman | StrategyRLE | StrategyFixed deriving (Show,Eq,Ord,Enum) foreign import ccall unsafe "streaming_commons_create_z_stream" zstreamNew :: IO ZStream' foreign import ccall unsafe "streaming_commons_deflate_init2" c_deflateInit2 :: ZStream' -> CInt -> CInt -> CInt -> CInt -> IO () deflateInit2 :: ZStream' -> Int -> WindowBits -> Int -> Strategy -> IO () deflateInit2 zstream level windowBits memlevel strategy = c_deflateInit2 zstream (fromIntegral level) (wbToInt windowBits) (fromIntegral memlevel) (fromIntegral $ fromEnum strategy) foreign import ccall unsafe "streaming_commons_inflate_init2" c_inflateInit2 :: ZStream' -> CInt -> IO () inflateInit2 :: ZStream' -> WindowBits -> IO () inflateInit2 zstream wb = c_inflateInit2 zstream (wbToInt wb) foreign import ccall unsafe "&streaming_commons_free_z_stream_inflate" c_free_z_stream_inflate :: FunPtr (ZStream' -> IO ()) foreign import ccall unsafe "&streaming_commons_free_z_stream_deflate" c_free_z_stream_deflate :: FunPtr (ZStream' -> IO ()) foreign import ccall unsafe "streaming_commons_set_avail_in" c_set_avail_in :: ZStream' -> Ptr CChar -> CUInt -> IO () foreign import ccall unsafe "streaming_commons_set_avail_out" c_set_avail_out :: ZStream' -> Ptr CChar -> CUInt -> IO () foreign import ccall unsafe "streaming_commons_get_avail_out" c_get_avail_out :: ZStream' -> IO CUInt foreign import ccall unsafe "streaming_commons_get_avail_in" c_get_avail_in :: ZStream' -> IO CUInt foreign import ccall unsafe "streaming_commons_get_next_in" c_get_next_in :: ZStream' -> IO (Ptr CChar) foreign import ccall unsafe "streaming_commons_call_inflate_noflush" c_call_inflate_noflush :: ZStream' -> IO CInt foreign import ccall unsafe "streaming_commons_call_deflate_noflush" c_call_deflate_noflush :: ZStream' -> IO CInt foreign import ccall unsafe "streaming_commons_call_deflate_finish" c_call_deflate_finish :: ZStream' -> IO CInt foreign import ccall unsafe "streaming_commons_call_deflate_flush" c_call_deflate_flush :: ZStream' -> IO CInt foreign import ccall unsafe "streaming_commons_call_deflate_full_flush" c_call_deflate_full_flush :: ZStream' -> IO CInt foreign import ccall unsafe "streaming_commons_deflate_set_dictionary" c_call_deflate_set_dictionary :: ZStream' -> Ptr CChar -> CUInt -> IO () foreign import ccall unsafe "streaming_commons_inflate_set_dictionary" c_call_inflate_set_dictionary :: ZStream' -> Ptr CChar -> CUInt -> IO () wbToInt :: WindowBits -> CInt wbToInt (WindowBits i) = fromIntegral i wbToInt _ = 15 streaming-commons-0.2.2.6/System/Win32File.hsc0000644000000000000000000000531614412473304017203 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module System.Win32File ( openFile , readChunk , closeFile , ReadHandle ) where import Foreign.C.String (CString) import Foreign.Ptr (castPtr) import Foreign.Marshal.Alloc (mallocBytes, free) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) #if __GLASGOW_HASKELL__ >= 704 import Foreign.C.Types (CInt (..)) #else import Foreign.C.Types (CInt) #endif import Foreign.C.Error (throwErrnoIfMinus1Retry) import Foreign.Ptr (Ptr) import Data.Bits (Bits, (.|.)) import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as BU import qualified Data.ByteString.Internal as BI import Data.Text (pack) import Data.Text.Encoding (encodeUtf16LE) import Data.Word (Word8) import Prelude hiding (read) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) import Data.ByteString.Lazy.Internal (defaultChunkSize) #include #include #include #include newtype OFlag = OFlag CInt deriving (Num, Bits, Show, Eq) #{enum OFlag, OFlag , oBinary = _O_BINARY , oRdonly = _O_RDONLY , oWronly = _O_WRONLY , oCreat = _O_CREAT } newtype SHFlag = SHFlag CInt deriving (Num, Bits, Show, Eq) #{enum SHFlag, SHFlag , shDenyno = _SH_DENYNO } newtype PMode = PMode CInt deriving (Num, Bits, Show, Eq) #{enum PMode, PMode , pIread = _S_IREAD , pIwrite = _S_IWRITE } foreign import ccall "_wsopen" c_wsopen :: CString -> OFlag -> SHFlag -> PMode -> IO CInt foreign import ccall "_read" c_read :: ReadHandle -> Ptr Word8 -> CInt -> IO CInt foreign import ccall "_write" c_write :: ReadHandle -> Ptr Word8 -> CInt -> IO CInt foreign import ccall "_close" closeFile :: ReadHandle -> IO () newtype ReadHandle = ReadHandle CInt openFile :: FilePath -> IO ReadHandle openFile fp = do -- need to append a null char -- note that useAsCString is not sufficient, as we need to have two -- null octets to account for UTF16 encoding let bs = encodeUtf16LE $ pack $ fp ++ "\0" h <- BU.unsafeUseAsCString bs $ \str -> throwErrnoIfMinus1Retry "Data.Streaming.FileRead.openFile" $ c_wsopen str (oBinary .|. oRdonly) shDenyno pIread return $ ReadHandle h readChunk :: ReadHandle -> IO S.ByteString readChunk fd = do fp <- mallocPlainForeignPtrBytes defaultChunkSize withForeignPtr fp $ \p -> do len <- throwErrnoIfMinus1Retry "System.Win32File.read" $ c_read fd p (fromIntegral defaultChunkSize) if len == 0 then return $! S.empty else return $! BI.PS fp 0 (fromIntegral len) streaming-commons-0.2.2.6/cbits/zlib-helper.c0000644000000000000000000000461014412473304017177 0ustar0000000000000000#include #include z_stream * streaming_commons_create_z_stream(void) { z_stream *ret = malloc(sizeof(z_stream)); if (ret) { ret->zalloc = Z_NULL; ret->zfree = Z_NULL; ret->opaque = Z_NULL; ret->next_in = NULL; ret->avail_in = 0; ret->next_out = NULL; ret->avail_out = 0; } return ret; } int streaming_commons_inflate_init2(z_stream *stream, int window_bits) { return inflateInit2(stream, window_bits); } int streaming_commons_deflate_init2(z_stream *stream, int level, int methodBits, int memlevel, int strategy) { return deflateInit2(stream, level, Z_DEFLATED, methodBits, memlevel, strategy); } int streaming_commons_inflate_set_dictionary(z_stream *stream, const char* dictionary, unsigned int dictLength) { return inflateSetDictionary(stream, (const Bytef *)dictionary, dictLength); } int streaming_commons_deflate_set_dictionary(z_stream *stream, const char* dictionary, unsigned int dictLength) { return deflateSetDictionary(stream, (const Bytef *)dictionary, dictLength); } void streaming_commons_free_z_stream_inflate (z_stream *stream) { inflateEnd(stream); free(stream); } void streaming_commons_set_avail_in (z_stream *stream, char *buff, unsigned int avail) { stream->next_in = (Bytef *)buff; stream->avail_in = avail; } void streaming_commons_set_avail_out (z_stream *stream, char *buff, unsigned int avail) { stream->next_out = (Bytef *)buff; stream->avail_out = avail; } int streaming_commons_call_inflate_noflush (z_stream *stream) { return inflate(stream, Z_NO_FLUSH); } unsigned int streaming_commons_get_avail_in (z_stream *stream) { return stream->avail_in; } unsigned int streaming_commons_get_avail_out (z_stream *stream) { return stream->avail_out; } char* streaming_commons_get_next_in (z_stream *stream) { return (char *)stream->next_in; } void streaming_commons_free_z_stream_deflate (z_stream *stream) { deflateEnd(stream); free(stream); } int streaming_commons_call_deflate_noflush (z_stream *stream) { return deflate(stream, Z_NO_FLUSH); } int streaming_commons_call_deflate_flush (z_stream *stream) { return deflate(stream, Z_SYNC_FLUSH); } int streaming_commons_call_deflate_full_flush (z_stream *stream) { return deflate(stream, Z_FULL_FLUSH); } int streaming_commons_call_deflate_finish (z_stream *stream) { return deflate(stream, Z_FINISH); } streaming-commons-0.2.2.6/cbits/text-helper.c0000644000000000000000000002113514412473731017230 0ustar0000000000000000/* * Copyright (c) 2011 Bryan O'Sullivan . * * Portions copyright (c) 2008-2010 Björn Höhrmann . * * See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details. */ #include #include #include #include "text_cbits.h" void _hs_streaming_commons_memcpy(void *dest, size_t doff, const void *src, size_t soff, size_t n) { char *cdest = dest; const char *csrc = src; memcpy(cdest + (doff<<1), csrc + (soff<<1), n<<1); } int _hs_streaming_commons_memcmp(const void *a, size_t aoff, const void *b, size_t boff, size_t n) { const char *ca = a; const char *cb = b; return memcmp(ca + (aoff<<1), cb + (boff<<1), n<<1); } #define UTF8_ACCEPT 0 #define UTF8_REJECT 12 static const uint8_t utf8d[] = { /* * The first part of the table maps bytes to character classes that * to reduce the size of the transition table and create bitmasks. */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8, /* * The second part is a transition table that maps a combination of * a state of the automaton and a character class to a state. */ 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12, 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12, 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12, 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,12,12,12,12,12, }; static inline uint32_t decode(uint32_t *state, uint32_t* codep, uint32_t byte) { uint32_t type = utf8d[byte]; *codep = (*state != UTF8_ACCEPT) ? (byte & 0x3fu) | (*codep << 6) : (0xff >> type) & (byte); return *state = utf8d[256 + *state + type]; } /* * The ISO 8859-1 (aka latin-1) code points correspond exactly to the first 256 unicode * code-points, therefore we can trivially convert from a latin-1 encoded bytestring to * an UTF16 array */ void _hs_streaming_commons_decode_latin1(uint16_t *dest, const uint8_t *src, const uint8_t *srcend) { const uint8_t *p = src; #if defined(__i386__) || defined(__x86_64__) /* This optimization works on a little-endian systems by using (aligned) 32-bit loads instead of 8-bit loads */ /* consume unaligned prefix */ while (p != srcend && (uintptr_t)p & 0x3) *dest++ = *p++; /* iterate over 32-bit aligned loads */ while (p < srcend - 3) { const uint32_t w = *((const uint32_t *)p); *dest++ = w & 0xff; *dest++ = (w >> 8) & 0xff; *dest++ = (w >> 16) & 0xff; *dest++ = (w >> 24) & 0xff; p += 4; } #endif /* handle unaligned suffix */ while (p != srcend) *dest++ = *p++; } /* * A best-effort decoder. Runs until it hits either end of input or * the start of an invalid byte sequence. * * At exit, we update *destoff with the next offset to write to, *src * with the next source location past the last one successfully * decoded, and return the next source location to read from. * * Moreover, we expose the internal decoder state (state0 and * codepoint0), allowing one to restart the decoder after it * terminates (say, due to a partial codepoint). * * In particular, there are a few possible outcomes, * * 1) We decoded the buffer entirely: * In this case we return srcend * state0 == UTF8_ACCEPT * * 2) We met an invalid encoding * In this case we return the address of the first invalid byte * state0 == UTF8_REJECT * * 3) We reached the end of the buffer while decoding a codepoint * In this case we return a pointer to the first byte of the partial codepoint * state0 != UTF8_ACCEPT, UTF8_REJECT * */ #if defined(__GNUC__) || defined(__clang__) static inline uint8_t const * _hs_streaming_commons_decode_utf8_int(uint16_t *const dest, size_t *destoff, const uint8_t **src, const uint8_t *srcend, uint32_t *codepoint0, uint32_t *state0) __attribute((always_inline)); #endif static inline uint8_t const * _hs_streaming_commons_decode_utf8_int(uint16_t *const dest, size_t *destoff, const uint8_t **src, const uint8_t *srcend, uint32_t *codepoint0, uint32_t *state0) { uint16_t *d = dest + *destoff; const uint8_t *s = *src, *last = *src; uint32_t state = *state0; uint32_t codepoint = *codepoint0; while (s < srcend) { #if defined(__i386__) || defined(__x86_64__) /* * This code will only work on a little-endian system that * supports unaligned loads. * * It gives a substantial speed win on data that is purely or * partly ASCII (e.g. HTML), at only a slight cost on purely * non-ASCII text. */ if (state == UTF8_ACCEPT) { while (s < srcend - 4) { codepoint = *((const uint32_t *) s); if ((codepoint & 0x80808080) != 0) break; s += 4; /* * Tried 32-bit stores here, but the extra bit-twiddling * slowed the code down. */ *d++ = (uint16_t) (codepoint & 0xff); *d++ = (uint16_t) ((codepoint >> 8) & 0xff); *d++ = (uint16_t) ((codepoint >> 16) & 0xff); *d++ = (uint16_t) ((codepoint >> 24) & 0xff); } last = s; } #endif if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) { if (state != UTF8_REJECT) continue; break; } if (codepoint <= 0xffff) *d++ = (uint16_t) codepoint; else { *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10)); *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF)); } last = s; } *destoff = d - dest; *codepoint0 = codepoint; *state0 = state; *src = last; return s; } uint8_t const * _hs_streaming_commons_decode_utf8_state(uint16_t *const dest, size_t *destoff, const uint8_t **src, const uint8_t *srcend, uint32_t *codepoint0, uint32_t *state0) { uint8_t const *ret = _hs_streaming_commons_decode_utf8_int(dest, destoff, src, srcend, codepoint0, state0); if (*state0 == UTF8_REJECT) ret -=1; return ret; } /* * Helper to decode buffer and discard final decoder state */ const uint8_t * _hs_streaming_commons_decode_utf8(uint16_t *const dest, size_t *destoff, const uint8_t *src, const uint8_t *const srcend) { uint32_t codepoint; uint32_t state = UTF8_ACCEPT; uint8_t const *ret = _hs_streaming_commons_decode_utf8_int(dest, destoff, &src, srcend, &codepoint, &state); /* Back up if we have an incomplete or invalid encoding */ if (state != UTF8_ACCEPT) ret -= 1; return ret; } void _hs_streaming_commons_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff, size_t srclen) { const uint16_t *srcend; uint8_t *dest = *destp; src += srcoff; srcend = src + srclen; ascii: #if defined(__x86_64__) while (srcend - src >= 4) { uint64_t w = *((const uint64_t *) src); if (w & 0xFF80FF80FF80FF80ULL) { if (!(w & 0x000000000000FF80ULL)) { *dest++ = w & 0xFFFF; src++; if (!(w & 0x00000000FF800000ULL)) { *dest++ = (w >> 16) & 0xFFFF; src++; if (!(w & 0x0000FF8000000000ULL)) { *dest++ = (w >> 32) & 0xFFFF; src++; } } } break; } *dest++ = w & 0xFFFF; *dest++ = (w >> 16) & 0xFFFF; *dest++ = (w >> 32) & 0xFFFF; *dest++ = w >> 48; src += 4; } #endif #if defined(__i386__) while (srcend - src >= 2) { uint32_t w = *((uint32_t *) src); if (w & 0xFF80FF80) break; *dest++ = w & 0xFFFF; *dest++ = w >> 16; src += 2; } #endif while (src < srcend) { uint16_t w = *src++; if (w <= 0x7F) { *dest++ = w; /* An ASCII byte is likely to begin a run of ASCII bytes. Falling back into the fast path really helps performance. */ goto ascii; } else if (w <= 0x7FF) { *dest++ = (w >> 6) | 0xC0; *dest++ = (w & 0x3f) | 0x80; } else if (w < 0xD800 || w > 0xDBFF) { *dest++ = (w >> 12) | 0xE0; *dest++ = ((w >> 6) & 0x3F) | 0x80; *dest++ = (w & 0x3F) | 0x80; } else { uint32_t c = ((((uint32_t) w) - 0xD800) << 10) + (((uint32_t) *src++) - 0xDC00) + 0x10000; *dest++ = (c >> 18) | 0xF0; *dest++ = ((c >> 12) & 0x3F) | 0x80; *dest++ = ((c >> 6) & 0x3F) | 0x80; *dest++ = (c & 0x3F) | 0x80; } } *destp = dest; } streaming-commons-0.2.2.6/test/Spec.hs0000644000000000000000000000005414412473304015715 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} streaming-commons-0.2.2.6/test/Data/Streaming/ByteString/BuilderSpec.hs0000644000000000000000000001126514412473304024126 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.Streaming.ByteString.BuilderSpec ( spec ) where import qualified Data.ByteString as S import Data.ByteString.Char8 () import qualified Data.ByteString.Builder as B import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder.Internal as B import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Char8 () import Data.IORef import Data.Maybe import Data.Monoid import Test.Hspec import Test.Hspec.QuickCheck (prop) import Data.Streaming.ByteString.Builder tester :: BufferAllocStrategy -> [Builder] -> IO [S.ByteString] tester strat builders0 = do (recv, finish) <- newBuilderRecv strat let loop front [] = do mbs <- finish return $ front $ maybe [] return mbs loop front0 (bu:bus) = do popper <- recv bu let go front = do bs <- popper if S.null bs then loop front bus else go (front . (bs:)) go front0 loop id builders0 testerFlush :: BufferAllocStrategy -> [Maybe Builder] -> IO [Maybe S.ByteString] testerFlush strat builders0 = do (recv, finish) <- newBuilderRecv strat let loop front [] = do mbs <- finish return $ front $ maybe [] (return . Just) mbs loop front0 (mbu:bus) = do popper <- recv $ fromMaybe B.flush mbu let go front = do bs <- popper if S.null bs then case mbu of Nothing -> loop (front . (Nothing:)) bus Just _ -> loop front bus else go (front . (Just bs:)) go front0 loop id builders0 builderSpec :: Spec builderSpec = do prop "idempotent to toLazyByteString" $ \bss' -> do let bss = map S.pack bss' let builders = map B.byteString bss let lbs = B.toLazyByteString $ mconcat builders outBss <- tester defaultStrategy builders L.fromChunks outBss `shouldBe` lbs it "works for large input" $ do let builders = replicate 10000 (B.byteString "hello world!") let lbs = B.toLazyByteString $ mconcat builders outBss <- tester defaultStrategy builders L.fromChunks outBss `shouldBe` lbs it "works for lazy bytestring insertion" $ do let builders = replicate 10000 (B.lazyByteStringInsert "hello world!") let lbs = B.toLazyByteString $ mconcat builders outBss <- tester defaultStrategy builders L.fromChunks outBss `shouldBe` lbs prop "works for strict bytestring insertion" $ \bs' -> do let bs = S.pack bs' let builders = replicate 10000 (B.byteStringCopy bs `Data.Monoid.mappend` B.byteStringInsert bs) let lbs = B.toLazyByteString $ mconcat builders outBss <- tester defaultStrategy builders L.fromChunks outBss `shouldBe` lbs it "flush shouldn't bring in empty strings." $ do let dat = ["hello", "world"] builders = map ((`mappend` B.flush) . B.byteString) dat out <- tester defaultStrategy builders dat `shouldBe` out prop "flushing" $ \bss' -> do let bss = concatMap (\bs -> [Just $ S.pack bs, Nothing]) $ filter (not . null) bss' let builders = map (fmap B.byteString) bss outBss <- testerFlush defaultStrategy builders outBss `shouldBe` bss it "large flush input" $ do let lbs = L.pack $ concat $ replicate 100000 [0..255] chunks = map (Just . B.byteString) (L.toChunks lbs) bss <- testerFlush defaultStrategy chunks L.fromChunks (catMaybes bss) `shouldBe` lbs spec :: Spec spec = describe "Data.Streaming.ByteString.Builder" $ do builderSpec let prop_idempotent i bss' = do let bss = mconcat (map (B.byteString . S.pack) bss') ior <- newIORef [] toByteStringIOWith 16 (\s -> do let s' = S.copy s s' `seq` modifyIORef ior (s' :)) bss chunks <- readIORef ior let have = L.unpack (L.fromChunks (reverse chunks)) want = L.unpack (B.toLazyByteString bss) (i, have) `shouldBe` (i, want) prop "toByteStringIO idempotent to toLazyByteString" (prop_idempotent (0::Int)) it "toByteStringIO idempotent to toLazyBytestring, specific case" $ do let bss' = replicate 10 [0..255] mapM_ (\i -> prop_idempotent i bss') [(1::Int)..100] streaming-commons-0.2.2.6/test/Data/Streaming/FileReadSpec.hs0000644000000000000000000000122714412473304022116 0ustar0000000000000000module Data.Streaming.FileReadSpec (spec) where import Test.Hspec import qualified Data.ByteString as S import qualified Data.Streaming.FileRead as F import Control.Exception (bracket) spec :: Spec spec = describe "Data.Streaming.FileRead" $ do it "works" $ do let fp = "LICENSE" expected <- S.readFile fp actual <- bracket (F.openFile fp) F.closeFile $ \fh -> do let loop front = do bs <- F.readChunk fh if S.null bs then return $ S.concat $ front [] else loop (front . (bs:)) loop id actual `shouldBe` expected streaming-commons-0.2.2.6/test/Data/Streaming/FilesystemSpec.hs0000644000000000000000000000456414412473304022576 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Streaming.FilesystemSpec (spec) where import Test.Hspec import Data.Streaming.Filesystem import Control.Exception (bracket) import Data.List (sort) #if !WINDOWS import System.Posix.Files (removeLink, createSymbolicLink, createNamedPipe) import Control.Exception (try, IOException) #endif spec :: Spec spec = describe "Data.Streaming.Filesystem" $ do it "dirstream" $ do res <- bracket (openDirStream "test/filesystem") closeDirStream $ \ds -> do Just w <- readDirStream ds Just x <- readDirStream ds Just y <- readDirStream ds Just z <- readDirStream ds return $ sort [w, x, y, z] res `shouldBe` ["bar.txt", "baz.txt", "bin", "foo.txt"] describe "getFileType" $ do it "file" $ getFileType "streaming-commons.cabal" >>= (`shouldBe` FTFile) it "dir" $ getFileType "Data" >>= (`shouldBe` FTDirectory) #if !WINDOWS it "file sym" $ do _ <- tryIO $ removeLink "tmp" createSymbolicLink "streaming-commons.cabal" "tmp" ft <- getFileType "tmp" _ <- tryIO $ removeLink "tmp" ft `shouldBe` FTFileSym it "file sym" $ do _ <- tryIO $ removeLink "tmp" createSymbolicLink "Data" "tmp" ft <- getFileType "tmp" _ <- tryIO $ removeLink "tmp" ft `shouldBe` FTDirectorySym it "other" $ do _ <- tryIO $ removeLink "tmp" e <- tryIO $ createNamedPipe "tmp" 0 case e of -- Creating named pipe might fail on some filesystems Left _ -> return () Right _ -> do ft <- getFileType "tmp" _ <- tryIO $ removeLink "tmp" ft `shouldBe` FTOther it "recursive symlink is other" $ do _ <- tryIO $ removeLink "tmp" createSymbolicLink "tmp" "tmp" ft <- getFileType "tmp" _ <- tryIO $ removeLink "tmp" ft `shouldBe` FTOther it "dangling symlink is other" $ do _ <- tryIO $ removeLink "tmp" createSymbolicLink "doesnotexist" "tmp" ft <- getFileType "tmp" _ <- tryIO $ removeLink "tmp" ft `shouldBe` FTOther tryIO :: IO a -> IO (Either IOException a) tryIO = try #endif streaming-commons-0.2.2.6/test/Data/Streaming/NetworkSpec.hs0000644000000000000000000000321114412473304022067 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Data.Streaming.NetworkSpec where import Control.Concurrent.Async (withAsync) import Control.Exception (bracket) import Control.Monad (forever, replicateM_) import Data.Array.Unboxed (elems) import qualified Data.ByteString.Char8 as S8 import Data.Char (toUpper) import Data.Streaming.Network import Network.Socket (close) import Test.Hspec import Test.Hspec.QuickCheck spec :: Spec spec = do describe "getDefaultReadBufferSize" $ do it "sanity" $ do getReadBufferSize (clientSettingsTCP 8080 "localhost") >= 4096 `shouldBe` True describe "getUnassignedPort" $ do it "sanity" $ replicateM_ 100000 $ do port <- getUnassignedPort (port `elem` elems unassignedPorts) `shouldBe` True describe "bindRandomPortTCP" $ do modifyMaxSuccess (const 5) $ prop "sanity" $ \content -> bracket (bindRandomPortTCP "*4") (close . snd) $ \(port, socket) -> do let server ad = forever $ appRead ad >>= appWrite ad . S8.map toUpper client ad = do appWrite ad bs appRead ad >>= (`shouldBe` S8.map toUpper bs) bs | null content = "hello" | otherwise = S8.pack $ take 1000 content withAsync (runTCPServer (serverSettingsTCPSocket socket) server) $ \_ -> do runTCPClient (clientSettingsTCP port "localhost") client streaming-commons-0.2.2.6/test/Data/Streaming/ProcessSpec.hs0000644000000000000000000000335614412473304022066 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Streaming.ProcessSpec (spec, main) where import Test.Hspec import Test.Hspec.QuickCheck (prop) import Control.Concurrent.Async (concurrently) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S import System.Exit import Control.Concurrent (threadDelay) import Data.Streaming.Process import System.IO (hClose) main :: IO () main = hspec spec spec :: Spec spec = do #ifndef WINDOWS prop "cat" $ \wss -> do let lbs = L.fromChunks $ map S.pack wss (sink, source, Inherited, cph) <- streamingProcess (shell "cat") ((), bs) <- concurrently (do L.hPut sink lbs hClose sink) (S.hGetContents source) L.fromChunks [bs] `shouldBe` lbs ec <- waitForStreamingProcess cph ec `shouldBe` ExitSuccess it "closed stream" $ do (ClosedStream, source, Inherited, cph) <- streamingProcess (shell "cat") bss <- S.hGetContents source bss `shouldBe` S.empty ec <- waitForStreamingProcess cph ec `shouldBe` ExitSuccess it "checked process" $ do let isRightException ProcessExitedUnsuccessfully {} = True withCheckedProcess (proc "false" []) (\Inherited Inherited Inherited -> return ()) `shouldThrow` isRightException #endif it "blocking vs non-blocking" $ do (ClosedStream, ClosedStream, ClosedStream, cph) <- streamingProcess (shell "sleep 1") mec1 <- getStreamingProcessExitCode cph mec1 `shouldBe` Nothing threadDelay 1500000 mec2 <- getStreamingProcessExitCode cph mec2 `shouldBe` Just ExitSuccess ec <- waitForStreamingProcess cph ec `shouldBe` ExitSuccess streaming-commons-0.2.2.6/test/Data/Streaming/TextSpec.hs0000644000000000000000000001355714412473304021400 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Data.Streaming.TextSpec (spec) where import Test.Hspec import Test.Hspec.QuickCheck import qualified Data.Streaming.Text as SD import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Control.Exception (evaluate, try, SomeException) import Control.DeepSeq (deepseq, NFData) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Control.Monad (forM_) import Data.ByteString.Char8 () try' :: NFData a => a -> IO (Either SomeException a) try' a = try $ evaluate (a `deepseq` a) spec :: Spec spec = describe "Data.Streaming.TextSpec" $ {-modifyMaxSuccess (const 10000) $ -}do let test name lazy stream encodeLazy encodeStrict = describe name $ do prop "bytes" $ check lazy stream prop "chars" $ \css -> do let ts = map T.pack css lt = TL.fromChunks ts lbs = encodeLazy lt bss = L.toChunks lbs wss = map S.unpack bss in check lazy stream wss it "high code points" $ forM_ [100, 200..50000] $ \cnt -> do let t = T.replicate cnt "\x10000" bs = encodeStrict t case stream bs of SD.DecodeResultSuccess t' dec -> do t' `shouldBe` t case dec S.empty of SD.DecodeResultSuccess _ _ -> return () SD.DecodeResultFailure _ _ -> error "unexpected failure 1" SD.DecodeResultFailure _ _ -> error "unexpected failure 2" check lazy stream wss = do let bss = map S.pack wss lbs = L.fromChunks bss x <- try' $ feedLazy stream lbs y <- try' $ lazy lbs case (x, y) of (Right x', Right y') -> x' `shouldBe` y' (Left _, Left _) -> return () _ -> error $ show (x, y) test "UTF8" TLE.decodeUtf8 SD.decodeUtf8 TLE.encodeUtf8 TE.encodeUtf8 test "UTF8 pure" TLE.decodeUtf8 SD.decodeUtf8Pure TLE.encodeUtf8 TE.encodeUtf8 test "UTF16LE" TLE.decodeUtf16LE SD.decodeUtf16LE TLE.encodeUtf16LE TE.encodeUtf16LE test "UTF16BE" TLE.decodeUtf16BE SD.decodeUtf16BE TLE.encodeUtf16BE TE.encodeUtf16BE test "UTF32LE" TLE.decodeUtf32LE SD.decodeUtf32LE TLE.encodeUtf32LE TE.encodeUtf32LE test "UTF32BE" TLE.decodeUtf32BE SD.decodeUtf32BE TLE.encodeUtf32BE TE.encodeUtf32BE describe "UTF8 leftovers" $ do describe "C" $ do it "single chunk" $ do let bs = "good\128\128bad" case SD.decodeUtf8 bs of SD.DecodeResultSuccess _ _ -> error "Shouldn't have succeeded" SD.DecodeResultFailure t bs' -> do t `shouldBe` "good" bs' `shouldBe` "\128\128bad" it "multi chunk, no good" $ do let bs1 = "\226" bs2 = "\130" bs3 = "ABC" case SD.decodeUtf8 bs1 of SD.DecodeResultSuccess "" dec2 -> case dec2 bs2 of SD.DecodeResultSuccess "" dec3 -> case dec3 bs3 of SD.DecodeResultFailure "" bs -> bs `shouldBe` "\226\130ABC" _ -> error "fail on dec3" _ -> error "fail on dec2" _ -> error "fail on dec1" it "multi chunk, good in the middle" $ do let bs1 = "\226" bs2 = "\130\172\226" bs3 = "\130ABC" case SD.decodeUtf8 bs1 of SD.DecodeResultSuccess "" dec2 -> case dec2 bs2 of SD.DecodeResultSuccess "\x20AC" dec3 -> case dec3 bs3 of SD.DecodeResultFailure "" bs -> bs `shouldBe` "\226\130ABC" _ -> error "fail on dec3" _ -> error "fail on dec2" _ -> error "fail on dec1" describe "pure" $ do it "multi chunk, no good" $ do let bs1 = "\226" bs2 = "\130" bs3 = "ABC" case SD.decodeUtf8Pure bs1 of SD.DecodeResultSuccess "" dec2 -> case dec2 bs2 of SD.DecodeResultSuccess "" dec3 -> case dec3 bs3 of SD.DecodeResultFailure "" bs -> bs `shouldBe` "\226\130ABC" _ -> error "fail on dec3" _ -> error "fail on dec2" _ -> error "fail on dec1" describe "UTF16LE spot checks" $ do it "[[0,216,0],[220,0,0,0,0,0,0]]" $ do let bss = map S.pack [[0,216,0],[220,0,0,0,0,0,0]] lbs = L.fromChunks bss x <- try' $ feedLazy SD.decodeUtf16LE lbs y <- try' $ TLE.decodeUtf16LE lbs case (x, y) of (Right x', Right y') -> x' `shouldBe` y' (Left _, Left _) -> return () _ -> error $ show (x, y) feedLazy :: (S.ByteString -> SD.DecodeResult) -> L.ByteString -> TL.Text feedLazy start = TL.fromChunks . loop start . L.toChunks where loop dec [] = case dec S.empty of SD.DecodeResultSuccess t _ -> [t] SD.DecodeResultFailure _ _ -> [error "invalid sequence 1"] loop dec (bs:bss) = case dec bs of SD.DecodeResultSuccess t dec' -> t : loop dec' bss SD.DecodeResultFailure _ _ -> [error "invalid sequence 2"] streaming-commons-0.2.2.6/test/Data/Streaming/ZlibSpec.hs0000644000000000000000000002551714412473304021353 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings #-} module Data.Streaming.ZlibSpec (spec) where import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Arbitrary (..)) import Control.Exception (throwIO) import Data.Streaming.Zlib import Codec.Compression.Zlib import qualified Codec.Compression.GZip as Gzip import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as LI import Control.Monad (foldM, forM_, forM) import System.IO.Unsafe (unsafePerformIO) import qualified Codec.Compression.Zlib.Raw as Raw decompress' :: L.ByteString -> L.ByteString decompress' gziped = unsafePerformIO $ do inf <- initInflate defaultWindowBits ungziped <- foldM (go' inf) id $ L.toChunks gziped final <- finishInflate inf return $ L.fromChunks $ ungziped [final] where go' inf front bs = feedInflate inf bs >>= go front go front x = do y <- x 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 instance Arbitrary S.ByteString where arbitrary = S.pack `fmap` arbitrary compress' :: L.ByteString -> L.ByteString compress' raw = unsafePerformIO $ do def <- initDeflate 7 defaultWindowBits gziped <- foldM (go' def) id $ L.toChunks raw gziped' <- go gziped $ finishDeflate def return $ L.fromChunks $ gziped' [] where go' def front bs = feedDeflate def bs >>= go front go front x = do y <- x 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" exampleDict :: S.ByteString exampleDict = "INITIALDICTIONARY" deflateWithDict :: S.ByteString -> L.ByteString -> L.ByteString deflateWithDict dict raw = unsafePerformIO $ do def <- initDeflateWithDictionary 7 dict $ WindowBits 15 compressed <- foldM (go' def) id $ L.toChunks raw compressed' <- go compressed $ finishDeflate def return $ L.fromChunks $ compressed' [] where go' def front bs = feedDeflate def bs >>= go front go front x = do y <- x 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 inf <- initInflateWithDictionary (WindowBits 15) dict decompressed <- foldM (go' inf) id $ L.toChunks compressed final <- finishInflate inf return $ L.fromChunks $ decompressed [final] where go' inf front bs = feedInflate inf bs >>= go front go front x = do y <- x case y of PRDone -> return front PRNext z -> go (front . (:) z) x PRError e -> throwIO e spec :: Spec spec = describe "Data.Streaming.Zlib" $ do describe "inflate/deflate" $ do prop "decompress'" $ \lbs -> lbs == decompress' (compress lbs) prop "compress'" $ \lbs -> lbs == decompress (compress' lbs) prop "with dictionary" $ \bs -> bs == (inflateWithDict exampleDict . deflateWithDict exampleDict) bs it "different dict" $ do raw <- L.readFile "LICENSE" deflated <- return $ deflateWithDict exampleDict raw inflated <- return $ inflateWithDict (S.drop 1 exampleDict) deflated inflated `shouldSatisfy` L.null describe "license" $ do it "single deflate" $ do let go front x = do y <- x 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 let raw' = L.fromChunks [license] raw' `shouldBe` Gzip.decompress (L.fromChunks $ gziped' []) it "single inflate" $ do let go front x = do y <- x 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 ungziped <- go id popper final <- finishInflate inf license `shouldBe` (S.concat $ ungziped [final]) it "multi deflate" $ do let go' inf front bs = feedDeflate inf bs >>= go front go front x = do y <- x 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 let raw' = L.fromChunks [license] raw' `shouldBe` (Gzip.decompress $ L.fromChunks $ gziped' []) it "multi inflate" $ do let go' inf front bs = feedInflate inf bs >>= go front go front x = do y <- x 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 ungziped' <- foldM (go' inf) id gziped' final <- finishInflate inf license `shouldBe` (S.concat $ ungziped' [final]) describe "lbs zlib" $ do prop "inflate" $ \lbs -> unsafePerformIO $ do let glbs = compress lbs go' inf front bs = feedInflate inf bs >>= go front go front x = do y <- x 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 return $ lbs == L.fromChunks (inflated [final]) prop "deflate" $ \lbs -> unsafePerformIO $ do let go' inf front bs = feedDeflate inf bs >>= go front go front x = do y <- x 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 return $ lbs == decompress (L.fromChunks (deflated' [])) describe "flushing" $ do let helper wb = do let bss0 = replicate 5000 "abc" def <- initDeflate 9 wb inf <- initInflate wb let popList pop = do mx <- pop case mx of PRDone -> return [] PRNext x -> do xs <- popList pop return $ x : xs PRError e -> throwIO e let callback name expected pop = do bssDeflated <- popList pop bsInflated <- fmap (S.concat . concat) $ forM bssDeflated $ \bs -> do x <- feedInflate inf bs >>= popList y <- flushInflate inf return $ x ++ [y] if bsInflated == expected then return () else error $ "callback " ++ name ++ ", got: " ++ show bsInflated ++ ", expected: " ++ show expected forM_ (zip [1..] bss0) $ \(i, bs) -> do feedDeflate def bs >>= callback ("loop" ++ show (i :: Int)) "" callback ("loop" ++ show (i :: Int)) bs $ flushDeflate def callback "finish" "" $ finishDeflate def it "zlib" $ helper defaultWindowBits it "gzip" $ helper $ WindowBits 31 describe "large raw #9" $ do let size = fromIntegral $ LI.defaultChunkSize * 4 + 1 input = L.replicate size 10 it "compressing" $ do output <- fmap Raw.decompress $ compressRaw input L.all (== 10) output `shouldBe` True L.length output `shouldBe` L.length input it "decompressing" $ do output <- decompressRaw $ Raw.compress input L.all (== 10) output `shouldBe` True L.length output `shouldBe` L.length input it "getUnusedInflate" $ do let c = "This data is stored compressed." u = "This data isn't." def <- initDeflate 5 defaultWindowBits let loop front popper = do res <- popper case res of PRDone -> return front PRNext bs -> loop (S.append front bs) popper PRError e -> throwIO e c' <- feedDeflate def c >>= loop S.empty >>= flip loop (finishDeflate def) inf <- initInflate defaultWindowBits x <- feedInflate inf (S.append c' u) >>= loop S.empty y <- finishInflate inf S.append x y `shouldBe` c z <- getUnusedInflate inf z `shouldBe` u rawWindowBits :: WindowBits rawWindowBits = WindowBits (-15) decompressRaw :: L.ByteString -> IO L.ByteString decompressRaw gziped = do inf <- initInflate rawWindowBits ungziped <- foldM (go' inf) id $ L.toChunks gziped final <- finishInflate inf return $ L.fromChunks $ ungziped [final] where go' inf front bs = feedInflate inf bs >>= go front go front x = do y <- x 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 def <- initDeflate 1 rawWindowBits gziped <- foldM (go' def) id $ L.toChunks raw gziped' <- go gziped $ finishDeflate def return $ L.fromChunks $ gziped' [] where go' def front bs = feedDeflate def bs >>= go front go front x = do y <- x case y of PRDone -> return front PRNext z -> go (front . (:) z) x PRError e -> throwIO e streaming-commons-0.2.2.6/bench/builder-to-bytestring-io.hs0000644000000000000000000000243614412473304021774 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} import Gauge.Main import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Builder as BB 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 "Data.ByteString.Builder.toLazyByteString" (benchmarks bLazy b100_10000 b10000_100 b10000_10000) ] where bIO = whnfIO . BB.toByteStringIO (const (return ())) bLazy = nf BB.toLazyByteString benchmarks run bld100_10000 bld10000_100 bld10000_10000 = [ bench' run bld100_10000 100 10000 , bench' run bld10000_100 10000 100 , bench' run bld10000_10000 10000 10000 ] bench' :: (b -> Benchmarkable) -> b -> Int -> Int -> Benchmark bench' run bld' len reps = bench (show len ++ "/" ++ show reps) (run bld') b100_10000 = bld BB.byteString 100 10000 b10000_100 = bld BB.byteString 10000 100 b10000_10000 = bld BB.byteString 10000 10000 bld :: Data.Monoid.Monoid a => (S.ByteString -> a) -> Int -> Int -> a bld f len reps = mconcat (replicate reps (f (S.replicate len 'x'))) streaming-commons-0.2.2.6/bench/decode-memory-usage.hs0000644000000000000000000000156414412473304020765 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Data.ByteString (ByteString) import Data.Streaming.Text import System.Environment (getArgs) input :: [ByteString] input = replicate 1000000 "Hello World!\n" main :: IO () main = do args <- getArgs let dec = case args of ["16le"] -> decodeUtf16LE ["16be"] -> decodeUtf16BE ["32le"] -> decodeUtf32LE ["32be"] -> decodeUtf32BE ["8pure"] -> decodeUtf8Pure _ -> decodeUtf8 loop dec input loop :: (ByteString -> DecodeResult) -> [ByteString] -> IO () loop dec [] = case dec "" of DecodeResultSuccess _ _ -> return () DecodeResultFailure _ _ -> error "failure1" loop dec (bs:bss) = case dec bs of DecodeResultSuccess _ dec' -> loop dec' bss DecodeResultFailure _ _ -> error "failure2" streaming-commons-0.2.2.6/bench/count-chars.hs0000644000000000000000000000306214412473304017353 0ustar0000000000000000import Gauge.Main import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Internal (ByteString (..)) import Data.Streaming.Text calcLen :: (S.ByteString -> DecodeResult) -> L.ByteString -> Int calcLen = loop 0 where loop total _ Empty = total loop total dec (Chunk bs bss) = total' `seq` loop total' dec' bss where DecodeResultSuccess t dec' = dec bs total' = total + T.length t handleEncoding :: ( String , TL.Text -> L.ByteString , L.ByteString -> TL.Text , S.ByteString -> DecodeResult ) -> Benchmark handleEncoding (name, encodeLazy, decodeLazy, decodeStream) = bgroup name [ bench "lazy" $ whnf (TL.length . decodeLazy) lbs , bench "stream" $ whnf (calcLen decodeStream) lbs ] where text = TL.pack $ concat $ replicate 10 ['\27'..'\2003'] lbs = encodeLazy text main :: IO () main = defaultMain $ map handleEncoding [ ("UTF-8", TLE.encodeUtf8, TLE.decodeUtf8, decodeUtf8) , ("UTF-8 pure", TLE.encodeUtf8, TLE.decodeUtf8, decodeUtf8Pure) , ("UTF-16LE", TLE.encodeUtf16LE, TLE.decodeUtf16LE, decodeUtf16LE) , ("UTF-16BE", TLE.encodeUtf16BE, TLE.decodeUtf16BE, decodeUtf16BE) , ("UTF-32LE", TLE.encodeUtf32LE, TLE.decodeUtf32LE, decodeUtf32LE) , ("UTF-32BE", TLE.encodeUtf32BE, TLE.decodeUtf32BE, decodeUtf32BE) ] streaming-commons-0.2.2.6/LICENSE0000644000000000000000000000206514412473304014521 0ustar0000000000000000The MIT License (MIT) Copyright (c) 2014 FP Complete Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.streaming-commons-0.2.2.6/Setup.hs0000644000000000000000000000005614412473304015146 0ustar0000000000000000import Distribution.Simple main = defaultMain streaming-commons-0.2.2.6/streaming-commons.cabal0000644000000000000000000001131514412546765020154 0ustar0000000000000000name: streaming-commons version: 0.2.2.6 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 license: MIT license-file: LICENSE author: Michael Snoyman, Emanuel Borsboom maintainer: michael@snoyman.com -- copyright: category: Data build-type: Simple cabal-version: >=1.10 extra-source-files: test/filesystem/*.txt test/filesystem/bin/*.txt include/*.h cbits/*.c test/LICENSE.gz ChangeLog.md README.md flag use-bytestring-builder description: Use bytestring-builder package default: False library default-language: Haskell2010 exposed-modules: Data.Streaming.ByteString.Builder Data.Streaming.ByteString.Builder.Buffer Data.Streaming.FileRead Data.Streaming.Filesystem Data.Streaming.Network Data.Streaming.Network.Internal Data.Streaming.Process Data.Streaming.Process.Internal Data.Streaming.Text Data.Streaming.Zlib Data.Streaming.Zlib.Lowlevel build-depends: base >= 4.12 && < 5 , array , async , bytestring , directory , network >= 2.4.0.0 , random , process , stm , text >= 1.2 && < 1.3 || >= 2.0 && < 2.1 , transformers , zlib c-sources: cbits/zlib-helper.c cbits/text-helper.c include-dirs: include if os(windows) build-depends: Win32 , filepath cpp-options: -DWINDOWS other-modules: System.Win32File else build-depends: unix if flag(use-bytestring-builder) build-depends: bytestring < 0.10.2.0 , bytestring-builder else build-depends: bytestring >= 0.10.2.0 test-suite test default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs type: exitcode-stdio-1.0 ghc-options: -Wall -threaded other-modules: Data.Streaming.ByteString.BuilderSpec Data.Streaming.FileReadSpec Data.Streaming.FilesystemSpec Data.Streaming.NetworkSpec Data.Streaming.ProcessSpec Data.Streaming.TextSpec Data.Streaming.ZlibSpec build-depends: base , streaming-commons , hspec >= 1.8 , QuickCheck , array , async , bytestring , deepseq , network >= 2.4.0.0 , text , zlib build-tool-depends: hspec-discover:hspec-discover if flag(use-bytestring-builder) build-depends: bytestring < 0.10.2.0 , bytestring-builder else build-depends: bytestring >= 0.10.2.0 if os(windows) cpp-options: -DWINDOWS else build-depends: unix benchmark count-chars default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: bench build-depends: base , gauge , bytestring , text , streaming-commons main-is: count-chars.hs ghc-options: -Wall -O2 benchmark decode-memory-usage default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: bench build-depends: base , bytestring , text , streaming-commons main-is: decode-memory-usage.hs ghc-options: -Wall -O2 -with-rtsopts=-s benchmark builder-to-bytestring-io default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: builder-to-bytestring-io.hs ghc-options: -Wall -O2 build-depends: base , bytestring >= 0.10.2 , gauge , deepseq , streaming-commons if flag(use-bytestring-builder) build-depends: bytestring < 0.10.2.0 , bytestring-builder else build-depends: bytestring >= 0.10.2.0 source-repository head type: git location: git://github.com/fpco/streaming-commons.git streaming-commons-0.2.2.6/test/filesystem/foo.txt0000644000000000000000000000000014412473304020166 0ustar0000000000000000streaming-commons-0.2.2.6/test/filesystem/baz.txt0000644000000000000000000000000014412473304020157 0ustar0000000000000000streaming-commons-0.2.2.6/test/filesystem/bar.txt0000644000000000000000000000000014412473304020147 0ustar0000000000000000streaming-commons-0.2.2.6/test/filesystem/bin/bin.txt0000644000000000000000000000000014412473304020723 0ustar0000000000000000streaming-commons-0.2.2.6/include/text_cbits.h0000644000000000000000000000024714412473655017471 0ustar0000000000000000/* * Copyright (c) 2013 Bryan O'Sullivan . */ #ifndef _text_cbits_h #define _text_cbits_h #define UTF8_ACCEPT 0 #define UTF8_REJECT 12 #endif streaming-commons-0.2.2.6/test/LICENSE.gz0000644000000000000000000000122414412473304016113 0ustar0000000000000000Fj.SLICENSE]RK0W8Jz3Y8rR!1UL`wJHhkYHk,<`Xɝ#|JHymv:dp!6d-#4]=lC=hpa; dq:߸lXG;xh|QYu4{_"L65đҒq@9|`Hz |&p;ҿcCB@p ԜoPO~`!CswY~@k&q/ӀvƴO6+M}+Ek:J3fpTo;g#ZY?^> ]p.+D!ûO1P-R+ZEf"^$fpCA{!,Ԣ@i&7e.dLϰD\3"Q@w*)*"KKOJ8WJk#m5[]J|,VUF U = 0.4. Add `newByteStringBuilderRecv` to Data.Streaming.ByteString.Builder; add modules Data.Streaming.ByteString.Builder.Buffer and Data.Streaming.ByteString.Builder.Class. ## 0.1.9 Add Data.Streaming.ByteString.Builder ## 0.1.8 Generalise types of run\*Server which never cleanly return [#13](https://github.com/fpco/streaming-commons/pull/13) ## 0.1.7.1 Fix `streamingProcess` so that it doesn't close `Handle`s passed in with `UseProvidedHandle`. ## 0.1.7 `withCheckedProcess` added. ## 0.1.6 Provide `appCloseConnection` to get the underlying connection from an `AppData`. streaming-commons-0.2.2.6/README.md0000644000000000000000000000223314412473304014770 0ustar0000000000000000streaming-commons ================= Common lower-level functions needed by various streaming data libraries. Intended to be shared by libraries like conduit and pipes. [![Build status](https://github.com/fpco/streaming-commons/actions/workflows/tests.yml/badge.svg)](https://github.com/fpco/streaming-commons/actions/workflows/tests.yml) Dependencies ------------ One of the requirements of this package is to restrict ourselves to "core" dependencies. The definition of core is still to be decided, but here's a working start: * *No* dependency on system libraries, beyond that which is required by other dependencies. * Anything which ships with GHC. *However*, we must retain compatibility with versions of those packages going back to at least GHC 7.4, and preferably earlier. * text, once again with backwards compatibility for versions included with legacy Haskell Platform. In other words, 0.11.2 support is required. * network, support back to 2.3. We do *not* need to support the network/network-bytestring split. * stm, preferably all the way back to 2.1. * transformers For debate: * Other Haskell Platform packages, especially vector and attoparsec.