haskell/zip-stream
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Switch to conduit-1.3

Browse Source
This commit is contained in:
Yuras Shumovich 2018-03-21 16:52:26 +03:00
parent a4381f8746
commit 091cc6bcdf
7 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Codec/Archive/Zip/Conduit/Internal.hs
View File

@ -30,7 +30,7 @@ osVersion = 0 -- DOS
zipError :: MonadThrow m => String -> m a zipError :: MonadThrow m => String -> m a
zipError = throwM . ZipError zipError = throwM . ZipError
idConduit :: Monad m => C.Conduit a m a idConduit :: Monad m => C.ConduitT a a m ()
idConduit = C.awaitForever C.yield idConduit = C.awaitForever C.yield
passthroughFold :: Monad m => (a -> b -> a) -> a -> C.ConduitM b b m a passthroughFold :: Monad m => (a -> b -> a) -> a -> C.ConduitM b b m a
@ -46,16 +46,16 @@ sizeCRC = passthroughFold (\(l, c) b -> (l + fromIntegral (BS.length b), crc32Up
sizeC :: Monad m => C.ConduitM BS.ByteString BS.ByteString m Word64 sizeC :: Monad m => C.ConduitM BS.ByteString BS.ByteString m Word64
sizeC = passthroughFold (\l b -> l + fromIntegral (BS.length b)) 0 -- fst <$> sizeCRC sizeC = passthroughFold (\l b -> l + fromIntegral (BS.length b)) 0 -- fst <$> sizeCRC
outputSize :: Monad m => C.Conduit i m BS.ByteString -> C.ConduitM i BS.ByteString m Word64 outputSize :: Monad m => C.ConduitT i BS.ByteString m () -> C.ConduitM i BS.ByteString m Word64
outputSize = (C..| sizeC) outputSize = (C..| sizeC)
inputSize :: Monad m => C.Conduit BS.ByteString m o -> C.ConduitM BS.ByteString o m Word64 inputSize :: Monad m => C.ConduitT BS.ByteString o m () -> C.ConduitM BS.ByteString o m Word64
-- inputSize = fuseUpstream sizeC -- won't work because we need to deal with leftovers properly -- inputSize = fuseUpstream sizeC -- won't work because we need to deal with leftovers properly
inputSize (CI.ConduitM src) = CI.ConduitM $ \rest -> let inputSize (CI.ConduitT src) = CI.ConduitT $ \rest -> let
go n (CI.Done ()) = rest n go n (CI.Done ()) = rest n
go n (CI.PipeM m) = CI.PipeM $ go n <$> m go n (CI.PipeM m) = CI.PipeM $ go n <$> m
go n (CI.Leftover p b) = CI.Leftover (go (n - fromIntegral (BS.length b)) p) b go n (CI.Leftover p b) = CI.Leftover (go (n - fromIntegral (BS.length b)) p) b
go n (CI.HaveOutput p f o) = CI.HaveOutput (go n p) f o go n (CI.HaveOutput p o) = CI.HaveOutput (go n p) o
go n (CI.NeedInput p q) = CI.NeedInput (\b -> go (n + fromIntegral (BS.length b)) (p b)) (go n . q) go n (CI.NeedInput p q) = CI.NeedInput (\b -> go (n + fromIntegral (BS.length b)) (p b)) (go n . q)
in go 0 (src CI.Done) in go 0 (src CI.Done)

4
Codec/Archive/Zip/Conduit/Types.hs
View File

@ -36,7 +36,7 @@ data ZipEntry = ZipEntry
-- |The data contents for a 'ZipEntry'. For empty entries (e.g., directories), use 'mempty'. -- |The data contents for a 'ZipEntry'. For empty entries (e.g., directories), use 'mempty'.
data ZipData m data ZipData m
= ZipDataByteString BSL.ByteString -- ^A known ByteString, which will be fully evaluated (not streamed) = ZipDataByteString BSL.ByteString -- ^A known ByteString, which will be fully evaluated (not streamed)
| ZipDataSource (C.Source m ByteString) -- ^A byte stream producer, streamed (and compressed) directly into the zip | ZipDataSource (C.ConduitT () ByteString m ()) -- ^A byte stream producer, streamed (and compressed) directly into the zip
instance Monad m => Monoid (ZipData m) where instance Monad m => Monoid (ZipData m) where
mempty = ZipDataByteString BSL.empty mempty = ZipDataByteString BSL.empty
@ -44,7 +44,7 @@ instance Monad m => Monoid (ZipData m) where
mappend a b = ZipDataSource $ mappend (sourceZipData a) (sourceZipData b) mappend a b = ZipDataSource $ mappend (sourceZipData a) (sourceZipData b)
-- |Normalize any 'ZipData' to a simple source -- |Normalize any 'ZipData' to a simple source
sourceZipData :: Monad m => ZipData m -> C.Source m ByteString sourceZipData :: Monad m => ZipData m -> C.ConduitT () ByteString m ()
sourceZipData (ZipDataByteString b) = sourceLbs b sourceZipData (ZipDataByteString b) = sourceLbs b
sourceZipData (ZipDataSource s) = s sourceZipData (ZipDataSource s) = s

6
Codec/Archive/Zip/Conduit/UnZip.hs
View File

@ -28,7 +28,7 @@ import Codec.Archive.Zip.Conduit.Internal
data Header m data Header m
= FileHeader = FileHeader
{ fileDecompress :: C.Conduit BS.ByteString m BS.ByteString { fileDecompress :: C.ConduitT BS.ByteString BS.ByteString m ()
, fileEntry :: !ZipEntry , fileEntry :: !ZipEntry
, fileCRC :: !Word32 , fileCRC :: !Word32
, fileCSize :: !Word64 , fileCSize :: !Word64
@ -53,7 +53,7 @@ data ExtField = ExtField
} }
-} -}
pass :: (MonadThrow m, Integral n) => n -> C.Conduit BS.ByteString m BS.ByteString pass :: (MonadThrow m, Integral n) => n -> C.ConduitT BS.ByteString BS.ByteString m ()
pass 0 = return () pass 0 = return ()
pass n = C.await >>= maybe pass n = C.await >>= maybe
(zipError $ "EOF in file data, expecting " ++ show ni ++ " more bytes") (zipError $ "EOF in file data, expecting " ++ show ni ++ " more bytes")
@ -94,7 +94,7 @@ fromDOSTime time date = LocalTime
-- It does not (ironically) support uncompressed zip files that have been created as streams, where file sizes are not known beforehand. -- It does not (ironically) support uncompressed zip files that have been created as streams, where file sizes are not known beforehand.
-- Since it does not use the offset information at the end of the file, it assumes all entries are packed sequentially, which is usually the case. -- Since it does not use the offset information at the end of the file, it assumes all entries are packed sequentially, which is usually the case.
-- Any errors are thrown in the underlying monad (as 'ZipError's or 'Data.Conduit.Serialization.Binary.ParseError'). -- Any errors are thrown in the underlying monad (as 'ZipError's or 'Data.Conduit.Serialization.Binary.ParseError').
unZipStream :: (MonadBase b m, PrimMonad b, MonadThrow m) => C.ConduitM BS.ByteString (Either ZipEntry BS.ByteString) m ZipInfo unZipStream :: (MonadBase b m, PrimMonad b, MonadThrow m, PrimMonad m) => C.ConduitM BS.ByteString (Either ZipEntry BS.ByteString) m ZipInfo
unZipStream = next where unZipStream = next where
next = do -- local header, or start central directory next = do -- local header, or start central directory
h <- sinkGet $ do h <- sinkGet $ do

7
Codec/Archive/Zip/Conduit/Zip.hs
View File

@ -14,7 +14,6 @@ module Codec.Archive.Zip.Conduit.Zip
import qualified Codec.Compression.Zlib.Raw as Z import qualified Codec.Compression.Zlib.Raw as Z
import Control.Arrow ((&&&), (+++), left) import Control.Arrow ((&&&), (+++), left)
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Base (MonadBase)
import Control.Monad.Catch (MonadThrow) import Control.Monad.Catch (MonadThrow)
import Control.Monad.Primitive (PrimMonad) import Control.Monad.Primitive (PrimMonad)
import Control.Monad.State.Strict (StateT, get) import Control.Monad.State.Strict (StateT, get)
@ -63,7 +62,7 @@ False ?* _ = 0
zipFileData :: MonadResource m => FilePath -> ZipData m zipFileData :: MonadResource m => FilePath -> ZipData m
zipFileData = ZipDataSource . CB.sourceFile zipFileData = ZipDataSource . CB.sourceFile
zipData :: Monad m => ZipData m -> Either (C.Source m BS.ByteString) BSL.ByteString zipData :: Monad m => ZipData m -> Either (C.ConduitT () BS.ByteString m ()) BSL.ByteString
zipData (ZipDataByteString b) = Right b zipData (ZipDataByteString b) = Right b
zipData (ZipDataSource s) = Left s zipData (ZipDataSource s) = Left s
@ -77,7 +76,7 @@ toDOSTime (LocalTime (toGregorian -> (year, month, day)) (TimeOfDay hour mins se
, fromIntegral (year - 1980) `shiftL` 9 .|. fromIntegral month `shiftL` 5 .|. fromIntegral day , fromIntegral (year - 1980) `shiftL` 9 .|. fromIntegral month `shiftL` 5 .|. fromIntegral day
) )
countOutput :: Monad m => C.Conduit i m BS.ByteString -> C.Conduit i (StateT Word64 m) BS.ByteString countOutput :: Monad m => C.ConduitT i BS.ByteString m () -> C.ConduitT i BS.ByteString (StateT Word64 m) ()
countOutput c = stateC $ \s -> (,) () . (s +) <$> outputSize c countOutput c = stateC $ \s -> (,) () . (s +) <$> outputSize c
output :: MonadThrow m => P.Put -> C.ConduitM i BS.ByteString (StateT Word64 m) () output :: MonadThrow m => P.Put -> C.ConduitM i BS.ByteString (StateT Word64 m) ()
@ -92,7 +91,7 @@ maxBound16 = fromIntegral (maxBound :: Word16)
-- --
-- Depending on options, the resulting zip file should be compatible with most unzipping applications. -- Depending on options, the resulting zip file should be compatible with most unzipping applications.
-- Any errors are thrown in the underlying monad (as 'ZipError's). -- Any errors are thrown in the underlying monad (as 'ZipError's).
zipStream :: (MonadBase b m, PrimMonad b, MonadThrow m) => ZipOptions -> C.ConduitM (ZipEntry, ZipData m) BS.ByteString m Word64 zipStream :: ({-MonadBase b m,-} PrimMonad m, MonadThrow m) => ZipOptions -> C.ConduitM (ZipEntry, ZipData m) BS.ByteString m Word64
zipStream ZipOptions{..} = execStateC 0 $ do zipStream ZipOptions{..} = execStateC 0 $ do
(cnt, cdir) <- next 0 (return ()) (cnt, cdir) <- next 0 (return ())
cdoff <- get cdoff <- get

2
cmd/unzip.hs
View File

@ -19,7 +19,7 @@ import System.IO (stdin, openFile, IOMode(WriteMode), hClose, hSetFile
import Codec.Archive.Zip.Conduit.UnZip import Codec.Archive.Zip.Conduit.UnZip
extract :: C.Sink (Either ZipEntry BS.ByteString) IO () extract :: C.ConduitT (Either ZipEntry BS.ByteString) C.Void IO ()
extract = C.awaitForever start where extract = C.awaitForever start where
start (Left ZipEntry{..}) = do start (Left ZipEntry{..}) = do
liftIO $ BSC.putStrLn zipEntryName liftIO $ BSC.putStrLn zipEntryName

6
cmd/zip.hs
View File

@ -10,7 +10,7 @@ import Data.Time.LocalTime (utcToLocalTime, utc)
import qualified System.Console.GetOpt as Opt import qualified System.Console.GetOpt as Opt
import System.Directory (doesDirectoryExist, getModificationTime import System.Directory (doesDirectoryExist, getModificationTime
#if MIN_VERSION_directory(1,2,6) #if MIN_VERSION_directory(1,2,6)
, isSymbolicLink, listDirectory , pathIsSymbolicLink, listDirectory
#else #else
, getDirectoryContents , getDirectoryContents
#endif #endif
@ -34,7 +34,7 @@ opts =
"set zip comment" "set zip comment"
] ]
generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.Source m (ZipEntry, ZipData m) generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.ConduitT () (ZipEntry, ZipData m) m ()
generate (p:paths) = do generate (p:paths) = do
t <- liftIO $ getModificationTime p t <- liftIO $ getModificationTime p
let e = ZipEntry let e = ZipEntry
@ -46,7 +46,7 @@ generate (p:paths) = do
if isd if isd
then do then do
#if MIN_VERSION_directory(1,2,6) #if MIN_VERSION_directory(1,2,6)
dl <- liftIO $ filterM (fmap not . isSymbolicLink) . map (p </>) =<< listDirectory p dl <- liftIO $ filterM (fmap not . pathIsSymbolicLink) . map (p </>) =<< listDirectory p
#else #else
dl <- liftIO $ filter (`notElem` [".",".."]) . map (p </>) <$> getDirectoryContents p dl <- liftIO $ filter (`notElem` [".",".."]) . map (p </>) <$> getDirectoryContents p
#endif #endif

4
zip-stream.cabal
View File

@ -1,5 +1,5 @@
name: zip-stream name: zip-stream
version: 0.1.0.1 version: 0.2.0.0
synopsis: ZIP archive streaming using conduits synopsis: ZIP archive streaming using conduits
description: Process (extract and create) zip files as streams (e.g., over the network), accessing contained files without having to write the zip file to disk (unlike zip-conduit). description: Process (extract and create) zip files as streams (e.g., over the network), accessing contained files without having to write the zip file to disk (unlike zip-conduit).
license: BSD3 license: BSD3
@ -29,7 +29,7 @@ library
binary >= 0.7.2, binary >= 0.7.2,
binary-conduit, binary-conduit,
bytestring, bytestring,
conduit, conduit >= 1.3 && <1.4,
conduit-extra, conduit-extra,
digest, digest,
exceptions, exceptions,