zip 0.1.11 → 0.2.0
raw patch · 5 files changed
+82/−33 lines, 5 filesdep +monad-controldep +transformers-basedep ~conduitdep ~exceptions
Dependencies added: monad-control, transformers-base
Dependency ranges changed: conduit, exceptions
Files
- CHANGELOG.md +9/−0
- Codec/Archive/Zip.hs +34/−10
- Codec/Archive/Zip/Internal.hs +19/−15
- tests/Main.hs +12/−2
- zip.cabal +8/−6
CHANGELOG.md view
@@ -1,3 +1,12 @@+## Zip 0.2.0++* Added `MonadBase` and `MonadBaseControl` instances for the `ZipArchive`+ monad. Also exported the `ZipState` type without revealing its data+ constructor and records.++* Dropped `MonadThrow` and `MonadCatch` constraints for `createArchive` and+ `withArchive`.+ ## Zip 0.1.11 * Minor refactoring.
Codec/Archive/Zip.hs view
@@ -80,6 +80,8 @@ -- > B.putStrLn bs {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} module Codec.Archive.Zip ( -- * Types@@ -98,6 +100,7 @@ , ZipException (..) -- * Archive monad , ZipArchive+ , ZipState , createArchive , withArchive -- * Retrieving information@@ -141,11 +144,13 @@ import Codec.Archive.Zip.Type import Control.Monad+import Control.Monad.Base (MonadBase (..)) import Control.Monad.Catch import Control.Monad.State.Strict-import Control.Monad.Trans.Resource (ResourceT, runResourceT, MonadResource)+import Control.Monad.Trans.Control (MonadBaseControl (..))+import Control.Monad.Trans.Resource (ResourceT, MonadResource) import Data.ByteString (ByteString)-import Data.Conduit (Source, Sink, ($$), yield)+import Data.Conduit (Source, Sink, (.|)) import Data.Map.Strict (Map, (!)) import Data.Sequence (Seq, (|>)) import Data.Text (Text)@@ -154,6 +159,7 @@ import Path import Path.IO import qualified Codec.Archive.Zip.Internal as I+import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import qualified Data.Map.Strict as M@@ -178,8 +184,26 @@ , MonadCatch , MonadMask ) --- | Internal state record used by the 'ZipArchive' monad.+-- | @since 0.2.0 +instance MonadBase IO ZipArchive where+ liftBase = liftIO++-- | @since 0.2.0++instance MonadBaseControl IO ZipArchive where+ type StM ZipArchive a = (a, ZipState)+ liftBaseWith f = ZipArchive . StateT $ \s ->+ (\x -> (x, s)) <$> f (flip runStateT s . unZipArchive)+ {-# INLINEABLE liftBaseWith #-}+ restoreM = ZipArchive . StateT . const . return+ {-# INLINEABLE restoreM #-}++-- | Internal state record used by the 'ZipArchive' monad. This is only+-- exported for use with 'MonadBaseControl' methods, you can't look inside.+--+-- @since 0.2.0+ data ZipState = ZipState { zsFilePath :: Path Abs File -- ^ Absolute path to zip archive@@ -196,11 +220,11 @@ -- specified file if it already exists. See 'withArchive' if you want to -- work with an existing archive. -createArchive :: (MonadIO m, MonadCatch m)+createArchive :: MonadIO m => Path b File -- ^ Location of archive file to create -> ZipArchive a -- ^ Actions that form archive's content -> m a-createArchive path m = do+createArchive path m = liftIO $ do apath <- makeAbsolute path ignoringAbsence (removeFile apath) let st = ZipState@@ -209,7 +233,7 @@ , zsArchive = ArchiveDescription Nothing 0 0 , zsActions = S.empty } action = unZipArchive (liftM2 const m commit)- liftIO (evalStateT action st)+ evalStateT action st -- | Work with an existing archive. See 'createArchive' if you want to -- create a new archive instead.@@ -236,11 +260,11 @@ -- design decision to make it impossible to create non-portable archives -- with this library. -withArchive :: (MonadIO m, MonadThrow m)+withArchive :: MonadIO m => Path b File -- ^ Location of archive to work with -> ZipArchive a -- ^ Actions on that archive -> m a-withArchive path m = do+withArchive path m = liftIO $ do apath <- canonicalizePath path (desc, entries) <- liftIO (I.scanArchive apath) let st = ZipState@@ -323,7 +347,7 @@ -- ^ Contents of the entry (if found) sourceEntry s sink = do src <- getEntrySource s- (liftIO . runResourceT) (src $$ sink)+ (liftIO . C.runConduitRes) (src .| sink) -- | Save a specific archive entry as a file in the file system. --@@ -385,7 +409,7 @@ -> ByteString -- ^ Entry contents -> EntrySelector -- ^ Name of entry to add -> ZipArchive ()-addEntry t b s = addPending (I.SinkEntry t (yield b) s)+addEntry t b s = addPending (I.SinkEntry t (C.yield b) s) -- | Stream data from the specified source to an archive entry.
Codec/Archive/Zip/Internal.hs view
@@ -26,13 +26,12 @@ import Control.Monad import Control.Monad.Catch import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Resource (ResourceT, runResourceT, MonadResource)+import Control.Monad.Trans.Resource (ResourceT, MonadResource) import Data.Bits import Data.Bool (bool) import Data.ByteString (ByteString) import Data.Char (ord)-import Data.Conduit (Conduit, Source, Sink, (=$=), ($$), awaitForever, yield)-import Data.Conduit.Internal (zipSinks)+import Data.Conduit (Conduit, Source, Sink, (.|), ZipSink (..)) import Data.Digest.CRC32 (crc32Update) import Data.Fixed (Fixed (..)) import Data.Foldable (foldl')@@ -50,6 +49,7 @@ import System.IO import System.PlanB import qualified Data.ByteString as B+import qualified Data.Conduit as C import qualified Data.Conduit.BZlib as BZ import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL@@ -218,7 +218,7 @@ -> Bool -- ^ Should we stream uncompressed data? -> Source m ByteString -- ^ Source of uncompressed data sourceEntry path EntryDescription {..} d =- source =$= CB.isolate (fromIntegral edCompressedSize) =$= decompress+ source .| CB.isolate (fromIntegral edCompressedSize) .| decompress where source = CB.sourceIOHandle $ do h <- openFile (toFilePath path) ReadMode@@ -231,7 +231,7 @@ return h decompress = if d then decompressingPipe edCompression- else awaitForever yield+ else C.awaitForever C.yield -- | Undertake /all/ actions specified as the fourth argument of the -- function. This transforms given pending actions so they can be performed@@ -414,13 +414,13 @@ , edComment = M.lookup s eaEntryComment <|> oldComment , edExtraField = extraField } B.hPut h (runPut (putHeader LocalHeader s desc0))- DataDescriptor {..} <- runResourceT $+ DataDescriptor {..} <- C.runConduitRes $ if recompression then if compressed == Store- then src $$ sinkData h compression- else src =$= decompressingPipe compressed $$ sinkData h compression- else src $$ sinkData h Store+ then src .| sinkData h compression+ else src .| decompressingPipe compressed .| sinkData h compression+ else src .| sinkData h Store afterStreaming <- hTell h let desc1 = case o of GenericOrigin -> desc0@@ -453,16 +453,20 @@ -- ^ 'Sink' where to stream data sinkData h compression = do let sizeSink = CL.fold (\acc input -> fromIntegral (B.length input) + acc) 0- dataSink = fst <$> zipSinks sizeSink (CB.sinkHandle h)- withCompression = zipSinks (zipSinks sizeSink crc32Sink)- ((uncompressedSize, crc32), compressedSize) <-+ dataSink = getZipSink $+ ZipSink sizeSink <* ZipSink (CB.sinkHandle h)+ withCompression sink = getZipSink $+ (,,) <$> ZipSink sizeSink+ <*> ZipSink crc32Sink+ <*> ZipSink sink+ (uncompressedSize, crc32, compressedSize) <- case compression of Store -> withCompression dataSink Deflate -> withCompression $- Z.compress 9 (Z.WindowBits (-15)) =$= dataSink+ Z.compress 9 (Z.WindowBits (-15)) .| dataSink BZip2 -> withCompression $- BZ.bzip2 =$= dataSink+ BZ.bzip2 .| dataSink return DataDescriptor { ddCRC32 = fromIntegral crc32 , ddCompressedSize = compressedSize@@ -968,7 +972,7 @@ :: MonadResource m => CompressionMethod -> Conduit ByteString m ByteString-decompressingPipe Store = awaitForever yield+decompressingPipe Store = C.awaitForever C.yield decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15) decompressingPipe BZip2 = BZ.bunzip2
tests/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}@@ -12,7 +13,6 @@ import Control.Monad.IO.Class import Data.Bits (complement) import Data.ByteString (ByteString)-import Data.Conduit (yield) import Data.Foldable (foldl') import Data.List (intercalate) import Data.Map (Map, (!))@@ -30,6 +30,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB+import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Map as M import qualified Data.Set as E@@ -324,7 +325,7 @@ context "when an entry is sunk" $ it "is there" $ \path -> property $ \m b s -> do info <- createArchive path $ do- sinkEntry m (yield b) s+ sinkEntry m (C.yield b) s commit (,) <$> sourceEntry s (CL.foldMap id) <*> (edCompression . (! s) <$> getEntries)@@ -611,7 +612,12 @@ it "packs arbitrary directory recursively" $ \path -> property $ \contents -> do let dir = parent path+#if MIN_VERSION_path(0,6,0)+ f = stripProperPrefix dir >=> mkEntrySelector+#else f = stripDir dir >=> mkEntrySelector+#endif+ blew <- catchIOError (do forM_ contents $ \s -> do let item = dir </> unEntrySelector s@@ -638,7 +644,11 @@ when blew discard -- TODO removeFile path selectors <- listDirRecur dir >>=+#if MIN_VERSION_path(0,6,0)+ mapM (stripProperPrefix dir >=> mkEntrySelector) . snd+#else mapM (stripDir dir >=> mkEntrySelector) . snd+#endif E.fromList selectors `shouldBe` M.keysSet m ----------------------------------------------------------------------------
zip.cabal view
@@ -1,6 +1,6 @@ name: zip-version: 0.1.11-cabal-version: >= 1.10+version: 0.2.0+cabal-version: >= 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 license: BSD3 license-file: LICENSE.md@@ -26,20 +26,22 @@ , bzlib-conduit >= 0.2 && < 0.3 , case-insensitive >= 1.2.0.2 && < 1.3 , cereal >= 0.3 && < 0.6- , conduit >= 1.1 && < 2.0+ , conduit >= 1.2.8 && < 2.0 , conduit-extra >= 1.1 && < 2.0 , containers >= 0.5.6.2 && < 0.6 , digest < 0.1 , exceptions >= 0.6 && < 0.9 , filepath >= 1.2 && < 1.5+ , monad-control >= 1.0 && < 1.1 , mtl >= 2.0 && < 3.0- , path >= 0.5 && < 0.6+ , path >= 0.5 && < 0.7 , path-io >= 1.0.1 && < 2.0 , plan-b >= 0.2 && < 0.3 , resourcet >= 1.0 && < 2.0 , text >= 0.2 && < 1.3 , time >= 1.4 && < 1.9 , transformers >= 0.4 && < 0.6+ , transformers-base if !impl(ghc >= 8.0) build-depends: semigroups >= 0.16 default-extensions: RecordWildCards@@ -64,13 +66,13 @@ ghc-options: -O2 -Wall build-depends: base >= 4.8 && < 5.0 , bytestring >= 0.9 && < 0.11- , conduit >= 1.1 && < 2.0+ , conduit >= 1.2.8 && < 2.0 , containers >= 0.5.6.2 && < 0.6 , exceptions >= 0.6 && < 0.9 , filepath >= 1.2 && < 1.5 , QuickCheck >= 2.4 && < 3.0 , hspec >= 2.0 && < 3.0- , path >= 0.5 && < 6.0+ , path >= 0.5 && < 0.7 , path-io >= 1.0.1 && < 2.0 , text >= 0.2 && < 1.3 , time >= 1.4 && < 1.9