diff --git a/Codec/Archive/Zip/Conduit/Internal.hs b/Codec/Archive/Zip/Conduit/Internal.hs index 0be2654..ce8722e 100644 --- a/Codec/Archive/Zip/Conduit/Internal.hs +++ b/Codec/Archive/Zip/Conduit/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Codec.Archive.Zip.Conduit.Internal ( osVersion, zipVersion , zipError @@ -19,6 +20,13 @@ import Data.Word (Word8, Word32, Word64) import Codec.Archive.Zip.Conduit.Types +#if MIN_VERSION_conduit(1,3,0) +#define ConduitM ConduitT +#define PRE13(x) +#else +#define PRE13(x) x +#endif + -- | The version of this zip program, really just rough indicator of compatibility zipVersion :: Word8 zipVersion = 48 @@ -30,7 +38,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.ConduitM a a m () idConduit = C.awaitForever C.yield passthroughFold :: Monad m => (a -> b -> a) -> a -> C.ConduitM b b m a @@ -46,16 +54,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.ConduitM 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.ConduitM 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 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 PRE13(f) o) = CI.HaveOutput (go n p) PRE13(f) 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/UnZip.hs b/Codec/Archive/Zip/Conduit/UnZip.hs index 4debd1b..95af05a 100644 --- a/Codec/Archive/Zip/Conduit/UnZip.hs +++ b/Codec/Archive/Zip/Conduit/UnZip.hs @@ -1,4 +1,5 @@ -- |Stream the extraction of a zip file, e.g., as it's being downloaded. +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RankNTypes #-} module Codec.Archive.Zip.Conduit.UnZip @@ -9,7 +10,9 @@ module Codec.Archive.Zip.Conduit.UnZip import Control.Applicative ((<|>), empty) import Control.Monad (when, unless, guard) +#if !MIN_VERSION_conduit(1,3,0) import Control.Monad.Base (MonadBase) +#endif import Control.Monad.Catch (MonadThrow) import Control.Monad.Primitive (PrimMonad) import qualified Data.Binary.Get as G @@ -28,7 +31,7 @@ import Codec.Archive.Zip.Conduit.Internal data Header m = FileHeader - { fileDecompress :: C.Conduit BS.ByteString m BS.ByteString + { fileDecompress :: C.ConduitM BS.ByteString BS.ByteString m () , fileEntry :: !ZipEntry , fileCRC :: !Word32 , fileCSize :: !Word64 @@ -53,7 +56,7 @@ data ExtField = ExtField } -} -pass :: (MonadThrow m, Integral n) => n -> C.Conduit BS.ByteString m BS.ByteString +pass :: (MonadThrow m, Integral n) => n -> C.ConduitM 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 +97,14 @@ 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 :: + ( MonadThrow m +#if MIN_VERSION_conduit(1,3,0) + , PrimMonad m +#else + , MonadBase b m, PrimMonad b +#endif + ) => 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..5422f05 100644 --- a/Codec/Archive/Zip/Conduit/Zip.hs +++ b/Codec/Archive/Zip/Conduit/Zip.hs @@ -1,4 +1,5 @@ -- |Stream the creation of a zip file, e.g., as it's being uploaded. +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Codec.Archive.Zip.Conduit.Zip @@ -14,7 +15,9 @@ module Codec.Archive.Zip.Conduit.Zip import qualified Codec.Compression.Zlib.Raw as Z import Control.Arrow ((&&&), (+++), left) import Control.Monad (when) +#if !MIN_VERSION_conduit(1,3,0) import Control.Monad.Base (MonadBase) +#endif import Control.Monad.Catch (MonadThrow) import Control.Monad.Primitive (PrimMonad) import Control.Monad.State.Strict (StateT, get) @@ -63,7 +66,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.ConduitM () BS.ByteString m ()) BSL.ByteString zipData (ZipDataByteString b) = Right b zipData (ZipDataSource s) = Left s @@ -77,7 +80,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.ConduitM i BS.ByteString m () -> C.ConduitM 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 +95,14 @@ 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 :: + ( MonadThrow m +#if MIN_VERSION_conduit(1,3,0) + , PrimMonad m +#else + , MonadBase b m, PrimMonad b +#endif + ) => 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..738568d 100644 --- a/cmd/unzip.hs +++ b/cmd/unzip.hs @@ -7,6 +7,7 @@ import qualified Data.ByteString.Char8 as BSC import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import Data.Time.LocalTime (localTimeToUTC, utc) +import Data.Void (Void) import System.Directory (createDirectoryIfMissing #if MIN_VERSION_directory(1,2,3) , setModificationTime @@ -19,7 +20,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.ConduitM (Either ZipEntry BS.ByteString) 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..d29f909 100644 --- a/cmd/zip.hs +++ b/cmd/zip.hs @@ -10,7 +10,12 @@ 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 +#if MIN_VERSION_directory(1,3,0) + , pathIsSymbolicLink +#else + , isSymbolicLink +#endif + , listDirectory #else , getDirectoryContents #endif @@ -34,7 +39,7 @@ opts = "set zip comment" ] -generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.Source m (ZipEntry, ZipData m) +generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.ConduitM () (ZipEntry, ZipData m) m () generate (p:paths) = do t <- liftIO $ getModificationTime p let e = ZipEntry @@ -45,10 +50,17 @@ generate (p:paths) = do isd <- liftIO $ doesDirectoryExist p if isd then do + dl <- liftIO $ #if MIN_VERSION_directory(1,2,6) - dl <- liftIO $ filterM (fmap not . isSymbolicLink) . map (p ) =<< listDirectory p + filterM (fmap not . +#if MIN_VERSION_directory(1,3,0) + pathIsSymbolicLink #else - dl <- liftIO $ filter (`notElem` [".",".."]) . map (p ) <$> getDirectoryContents p + isSymbolicLink +#endif + ) . map (p ) =<< listDirectory p +#else + filter (`notElem` [".",".."]) . map (p ) <$> getDirectoryContents p #endif C.yield (e{ zipEntryName = zipEntryName e `BSC.snoc` '/', zipEntrySize = Just 0 }, mempty) generate $ dl ++ paths diff --git a/stack.yaml b/stack.yaml index 6b0e9ac..7af5a28 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-9.9 +resolver: lts-11.1 packages: - '.' extra-deps: [] diff --git a/zip-stream.cabal b/zip-stream.cabal index 70ebb71..5ae5feb 100644 --- a/zip-stream.cabal +++ b/zip-stream.cabal @@ -23,7 +23,7 @@ library other-modules: Codec.Archive.Zip.Conduit.Internal default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -Werror build-depends: base >= 4.8 && < 5, binary >= 0.7.2, @@ -44,7 +44,7 @@ executable unzip-stream main-is: unzip.hs hs-source-dirs: cmd default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -Werror build-depends: base >=4.8 && <5, bytestring, @@ -60,7 +60,7 @@ executable zip-stream main-is: zip.hs hs-source-dirs: cmd default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -Werror build-depends: base >=4.8 && <5, bytestring,