diff --git a/Codec/Archive/Zip/Conduit/Internal.hs b/Codec/Archive/Zip/Conduit/Internal.hs index 0be2654..2c4ade1 100644 --- a/Codec/Archive/Zip/Conduit/Internal.hs +++ b/Codec/Archive/Zip/Conduit/Internal.hs @@ -30,7 +30,7 @@ osVersion = 0 -- DOS zipError :: MonadThrow m => String -> m a zipError = throwM . ZipError -idConduit :: Monad m => C.Conduit a m a +idConduit :: Monad m => C.ConduitT a a m () idConduit = C.awaitForever C.yield 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 = 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) -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 (CI.ConduitM src) = CI.ConduitM $ \rest -> let +inputSize (CI.ConduitT src) = CI.ConduitT $ \rest -> let go n (CI.Done ()) = rest n 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.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) in go 0 (src CI.Done) diff --git a/Codec/Archive/Zip/Conduit/Types.hs b/Codec/Archive/Zip/Conduit/Types.hs index 320c82e..2ab9e9f 100644 --- a/Codec/Archive/Zip/Conduit/Types.hs +++ b/Codec/Archive/Zip/Conduit/Types.hs @@ -36,7 +36,7 @@ data ZipEntry = ZipEntry -- |The data contents for a 'ZipEntry'. For empty entries (e.g., directories), use 'mempty'. data ZipData m = 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 mempty = ZipDataByteString BSL.empty @@ -44,7 +44,7 @@ instance Monad m => Monoid (ZipData m) where mappend a b = ZipDataSource $ mappend (sourceZipData a) (sourceZipData b) -- |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 (ZipDataSource s) = s diff --git a/Codec/Archive/Zip/Conduit/UnZip.hs b/Codec/Archive/Zip/Conduit/UnZip.hs index 4debd1b..853c38f 100644 --- a/Codec/Archive/Zip/Conduit/UnZip.hs +++ b/Codec/Archive/Zip/Conduit/UnZip.hs @@ -28,7 +28,7 @@ import Codec.Archive.Zip.Conduit.Internal data Header m = FileHeader - { fileDecompress :: C.Conduit BS.ByteString m BS.ByteString + { fileDecompress :: C.ConduitT BS.ByteString BS.ByteString m () , fileEntry :: !ZipEntry , fileCRC :: !Word32 , 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 n = C.await >>= maybe (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. -- 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'). -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 next = do -- local header, or start central directory h <- sinkGet $ do diff --git a/Codec/Archive/Zip/Conduit/Zip.hs b/Codec/Archive/Zip/Conduit/Zip.hs index 7bf80b0..5451c53 100644 --- a/Codec/Archive/Zip/Conduit/Zip.hs +++ b/Codec/Archive/Zip/Conduit/Zip.hs @@ -14,7 +14,6 @@ module Codec.Archive.Zip.Conduit.Zip import qualified Codec.Compression.Zlib.Raw as Z import Control.Arrow ((&&&), (+++), left) import Control.Monad (when) -import Control.Monad.Base (MonadBase) import Control.Monad.Catch (MonadThrow) import Control.Monad.Primitive (PrimMonad) import Control.Monad.State.Strict (StateT, get) @@ -63,7 +62,7 @@ False ?* _ = 0 zipFileData :: MonadResource m => FilePath -> ZipData m 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 (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 ) -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 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. -- 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 (cnt, cdir) <- next 0 (return ()) cdoff <- get diff --git a/cmd/unzip.hs b/cmd/unzip.hs index a676e8e..b8d7854 100644 --- a/cmd/unzip.hs +++ b/cmd/unzip.hs @@ -19,7 +19,7 @@ import System.IO (stdin, openFile, IOMode(WriteMode), hClose, hSetFile 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 start (Left ZipEntry{..}) = do liftIO $ BSC.putStrLn zipEntryName diff --git a/cmd/zip.hs b/cmd/zip.hs index 98304e4..03e8d74 100644 --- a/cmd/zip.hs +++ b/cmd/zip.hs @@ -10,7 +10,7 @@ import Data.Time.LocalTime (utcToLocalTime, utc) import qualified System.Console.GetOpt as Opt import System.Directory (doesDirectoryExist, getModificationTime #if MIN_VERSION_directory(1,2,6) - , isSymbolicLink, listDirectory + , pathIsSymbolicLink, listDirectory #else , getDirectoryContents #endif @@ -34,7 +34,7 @@ opts = "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 t <- liftIO $ getModificationTime p let e = ZipEntry @@ -46,7 +46,7 @@ generate (p:paths) = do if isd then do #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 dl <- liftIO $ filter (`notElem` [".",".."]) . map (p ) <$> getDirectoryContents p #endif diff --git a/zip-stream.cabal b/zip-stream.cabal index 70ebb71..3d899c3 100644 --- a/zip-stream.cabal +++ b/zip-stream.cabal @@ -1,5 +1,5 @@ name: zip-stream -version: 0.1.0.1 +version: 0.2.0.0 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). license: BSD3 @@ -29,7 +29,7 @@ library binary >= 0.7.2, binary-conduit, bytestring, - conduit, + conduit >= 1.3 && <1.4, conduit-extra, digest, exceptions,