diff --git a/Codec/Archive/Zip.hs b/Codec/Archive/Zip.hs index f566782..aa3c5c3 100644 --- a/Codec/Archive/Zip.hs +++ b/Codec/Archive/Zip.hs @@ -156,12 +156,12 @@ import Control.Monad.State.Strict import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Monad.Trans.Resource (MonadResource, ResourceT) import Data.ByteString (ByteString) -import Data.Conduit ((.|), ConduitT) +import Data.Conduit (ConduitT, (.|)) import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import qualified Data.DList as DList -import Data.Map.Strict ((!), Map) +import Data.Map.Strict (Map, (!)) import qualified Data.Map.Strict as M import Data.Sequence (Seq, (|>)) import qualified Data.Sequence as S diff --git a/Codec/Archive/Zip/Internal.hs b/Codec/Archive/Zip/Internal.hs index 9d8a915..2ffa8b2 100644 --- a/Codec/Archive/Zip/Internal.hs +++ b/Codec/Archive/Zip/Internal.hs @@ -26,7 +26,7 @@ where import Codec.Archive.Zip.CP437 (decodeCP437) import Codec.Archive.Zip.Type import Conduit (PrimMonad) -import Control.Applicative ((<|>), many) +import Control.Applicative (many, (<|>)) import Control.Exception (bracketOnError, catchJust) import Control.Monad import Control.Monad.Catch (MonadThrow (..)) @@ -37,7 +37,7 @@ import Data.Bool (bool) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Char (ord) -import Data.Conduit ((.|), ConduitT, ZipSink (..)) +import Data.Conduit (ConduitT, ZipSink (..), (.|)) import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL @@ -45,10 +45,10 @@ import qualified Data.Conduit.Zlib as Z import Data.Digest.CRC32 (crc32Update) import Data.Fixed (Fixed (..)) import Data.Foldable (foldl') -import Data.Map.Strict ((!), Map) +import Data.Map.Strict (Map, (!)) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromJust, isNothing) -import Data.Sequence ((><), Seq, (|>)) +import Data.Sequence (Seq, (><), (|>)) import qualified Data.Sequence as S import Data.Serialize import qualified Data.Set as E @@ -864,9 +864,9 @@ putZip64ECDLocator :: putZip64ECDLocator ecdOffset = do putWord32le 0x07064b50 -- zip64 end of central dir locator signature putWord32le 0 -- number of the disk with the start of the zip64 end of - -- central directory + -- central directory putWord64le (fromIntegral ecdOffset) -- relative offset of the zip64 end - -- of central directory record + -- of central directory record putWord32le 1 -- total number of disks -- | Parse end of central directory record or Zip64 end of central directory @@ -986,7 +986,7 @@ locateECD path h = sizeCheck || -- ↑ happens when zip 64 archive is empty cdSig == 0x06054b50 - then-- ↑ happens when vanilla archive is empty + then -- ↑ happens when vanilla archive is empty Just pos else Nothing checkZip64 pos = diff --git a/tests/Main.hs b/tests/Main.hs index 16b6722..bfe2918 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -20,7 +20,7 @@ import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.DList as DList import Data.List (intercalate) -import Data.Map ((!), Map) +import Data.Map (Map, (!)) import qualified Data.Map.Strict as M import Data.Maybe (fromJust) import qualified Data.Set as E @@ -219,64 +219,54 @@ mkEntrySelectorSpec = do accepts x = do s <- mkEntrySelector x getEntryName s `shouldBe` T.pack x - context "when absolute paths are passed" - $ it "they are rejected" - $ property - $ \(RelPath x) -> - rejects ('/' : x) - context "when paths with trailing path separator are passed" - $ it "they are rejected" - $ do + context "when absolute paths are passed" $ + it "they are rejected" $ + property $ \(RelPath x) -> + rejects ('/' : x) + context "when paths with trailing path separator are passed" $ + it "they are rejected" $ do rejects "foo/" rejects "foo/bar/" - context "when paths with dot as path segment are passed" - $ it "they are rejected" - $ do + context "when paths with dot as path segment are passed" $ + it "they are rejected" $ do rejects "./foo/bar" rejects "foo/./bar" rejects "foo/bar/." - context "when paths with double dot as path segment are passed" - $ it "they are rejected" - $ do + context "when paths with double dot as path segment are passed" $ + it "they are rejected" $ do rejects "../foo/bar" rejects "foo/../bar" rejects "foo/bar/.." - context "when too long paths are passed" - $ it "rejects them" - $ do + context "when too long paths are passed" $ + it "rejects them" $ do let path = replicate 0x10000 'a' mkEntrySelector path `shouldThrow` isEntrySelectorException path - context "when correct paths are passed" - $ it "adequately represents them" - $ do + context "when correct paths are passed" $ + it "adequately represents them" $ do accepts "foo" accepts "one/two/three" accepts "something.txt" unEntrySelectorSpec :: Spec unEntrySelectorSpec = - context "when entry selector exists" - $ it "has corresponding path" . property - $ \s -> + context "when entry selector exists" $ + it "has corresponding path" . property $ \s -> not . null . unEntrySelector $ s getEntryNameSpec :: Spec getEntryNameSpec = - context "when entry selector exists" - $ it "has corresponding representation" . property - $ \s -> + context "when entry selector exists" $ + it "has corresponding representation" . property $ \s -> not . T.null . getEntryName $ s decodeCP437Spec :: Spec decodeCP437Spec = do - context "when ASCII-compatible subset is used" - $ it "has the same result as decoding UTF-8" . property - $ forAll binASCII - $ \bin -> - decodeCP437 bin `shouldBe` T.decodeUtf8 bin - context "when non-ASCII subset is used" - $ it "is decoded correctly" - $ do + context "when ASCII-compatible subset is used" $ + it "has the same result as decoding UTF-8" . property $ + forAll binASCII $ \bin -> + decodeCP437 bin `shouldBe` T.decodeUtf8 bin + context "when non-ASCII subset is used" $ + it "is decoded correctly" $ do let c b t = decodeCP437 (B.pack b) `shouldBe` t c [0x80 .. 0x9f] "ÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜ¢£¥₧ƒ" c [0xa0 .. 0xbf] "áíóúñѪº¿⌐¬½¼¡«»░▒▓│┤╡╢╖╕╣║╗╝╜╛┐" @@ -297,105 +287,98 @@ fromFileModeSpec = createArchiveSpec :: SpecWith FilePath createArchiveSpec = do - context "when called with non-existent path and empty recipe" - $ it "creates correct representation of empty archive" - $ \path -> do + context "when called with non-existent path and empty recipe" $ + it "creates correct representation of empty archive" $ \path -> do createArchive path (return ()) B.readFile path `shouldReturn` emptyArchive - context "when called with an occupied path" - $ it "overwrites it" - $ \path -> do + context "when called with an occupied path" $ + it "overwrites it" $ \path -> do B.writeFile path B.empty createArchive path (return ()) B.readFile path `shouldNotReturn` B.empty withArchiveSpec :: SpecWith FilePath withArchiveSpec = do - context "when called with non-existent path" - $ it "throws 'isDoesNotExistError' exception" - $ \path -> + context "when called with non-existent path" $ + it "throws 'isDoesNotExistError' exception" $ \path -> withArchive path (return ()) `shouldThrow` isDoesNotExistError - context "when called with occupied path (empty file)" - $ it "throws 'ParsingFailed' exception" - $ \path -> do + context "when called with occupied path (empty file)" $ + it "throws 'ParsingFailed' exception" $ \path -> do B.writeFile path B.empty withArchive path (return ()) `shouldThrow` isParsingFailed path "Cannot locate end of central directory" - context "when called with occupied path (empty archive)" - $ it "does not overwrite the file unnecessarily" - $ \path -> do + context "when called with occupied path (empty archive)" $ + it "does not overwrite the file unnecessarily" $ \path -> do B.writeFile path emptyArchive - withArchive path - $ liftIO - $ B.writeFile path B.empty + withArchive path $ + liftIO $ + B.writeFile path B.empty B.readFile path `shouldNotReturn` emptyArchive archiveCommentSpec :: SpecWith FilePath archiveCommentSpec = do - context "when new archive is created" - $ it "returns no archive comment" - $ \path -> + context "when new archive is created" $ + it "returns no archive comment" $ \path -> createArchive path getArchiveComment `shouldReturn` Nothing - context "when comment contains end of central directory signature" - $ it "reads it without problems" - $ \path -> do + context "when comment contains end of central directory signature" $ + it "reads it without problems" $ \path -> do entries <- createArchive path $ do setArchiveComment "I saw you want to have PK\ENQ\ACK here." commit getEntries entries `shouldBe` M.empty - context "when comment is committed (delete/set)" - $ it "reads it and updates" - $ \path -> property $ \txt -> do - comment <- createArchive path $ do - deleteArchiveComment - setArchiveComment txt - commit - getArchiveComment - comment `shouldBe` Just txt - context "when comment is committed (set/delete)" - $ it "reads it and updates" - $ \path -> property $ \txt -> do - comment <- createArchive path $ do - setArchiveComment txt - deleteArchiveComment - commit - getArchiveComment - comment `shouldBe` Nothing - context "when pre-existing comment is overwritten" - $ it "returns the new comment" - $ \path -> property $ \txt txt' -> do - comment <- createArchive path $ do - setArchiveComment txt - commit - setArchiveComment txt' - commit - getArchiveComment - comment `shouldBe` Just txt' - context "when pre-existing comment is deleted" - $ it "actually deletes it" - $ \path -> property $ \txt -> do - comment <- createArchive path $ do - setArchiveComment txt - commit - deleteArchiveComment - commit - getArchiveComment - comment `shouldBe` Nothing + context "when comment is committed (delete/set)" $ + it "reads it and updates" $ \path -> + property $ \txt -> do + comment <- createArchive path $ do + deleteArchiveComment + setArchiveComment txt + commit + getArchiveComment + comment `shouldBe` Just txt + context "when comment is committed (set/delete)" $ + it "reads it and updates" $ \path -> + property $ \txt -> do + comment <- createArchive path $ do + setArchiveComment txt + deleteArchiveComment + commit + getArchiveComment + comment `shouldBe` Nothing + context "when pre-existing comment is overwritten" $ + it "returns the new comment" $ \path -> + property $ \txt txt' -> do + comment <- createArchive path $ do + setArchiveComment txt + commit + setArchiveComment txt' + commit + getArchiveComment + comment `shouldBe` Just txt' + context "when pre-existing comment is deleted" $ + it "actually deletes it" $ \path -> + property $ \txt -> do + comment <- createArchive path $ do + setArchiveComment txt + commit + deleteArchiveComment + commit + getArchiveComment + comment `shouldBe` Nothing getEntryDescSpec :: SpecWith FilePath getEntryDescSpec = - it "always returns correct description" $ - \path -> property $ \(EM s desc z) -> do + it "always returns correct description" $ \path -> + property $ \(EM s desc z) -> do desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s) desc' `shouldSatisfy` softEq desc versionNeededSpec :: SpecWith FilePath versionNeededSpec = - it "writes correct version that is needed to extract archive" $ + it "writes correct version that is needed to extract archive" $ \path -> -- NOTE for now we check only how version depends on compression method, -- it should be mentioned that the version also depends on Zip64 feature - \path -> property $ \(EM s desc z) -> do + property $ \(EM s desc z) -> do desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s) edVersionNeeded desc' `shouldBe` makeVersion @@ -407,267 +390,267 @@ versionNeededSpec = addEntrySpec :: SpecWith FilePath addEntrySpec = - context "when an entry is added" - $ it "is there" - $ \path -> property $ \m b s -> do - info <- createArchive path $ do - addEntry m b s - commit - (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) - info `shouldBe` (b, m) + context "when an entry is added" $ + it "is there" $ \path -> + property $ \m b s -> do + info <- createArchive path $ do + addEntry m b s + commit + (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) + info `shouldBe` (b, m) sinkEntrySpec :: SpecWith FilePath sinkEntrySpec = - context "when an entry is sunk" - $ it "is there" - $ \path -> property $ \m b s -> do - info <- createArchive path $ do - sinkEntry m (C.yield b) s - commit - (,) <$> sourceEntry s (CL.foldMap id) - <*> (edCompression . (! s) <$> getEntries) - info `shouldBe` (b, m) + context "when an entry is sunk" $ + it "is there" $ \path -> + property $ \m b s -> do + info <- createArchive path $ do + sinkEntry m (C.yield b) s + commit + (,) <$> sourceEntry s (CL.foldMap id) + <*> (edCompression . (! s) <$> getEntries) + info `shouldBe` (b, m) loadEntrySpec :: SpecWith FilePath loadEntrySpec = - context "when an entry is loaded" - $ it "is there" - $ \path -> property $ \m b s t -> do - let vpath = deriveVacant path - B.writeFile vpath b - setModificationTime vpath t - createArchive path $ do - loadEntry m s vpath - commit - liftIO (removeFile vpath) - saveEntry s vpath - B.readFile vpath `shouldReturn` b - modTime <- getModificationTime vpath - modTime `shouldSatisfy` isCloseTo t + context "when an entry is loaded" $ + it "is there" $ \path -> + property $ \m b s t -> do + let vpath = deriveVacant path + B.writeFile vpath b + setModificationTime vpath t + createArchive path $ do + loadEntry m s vpath + commit + liftIO (removeFile vpath) + saveEntry s vpath + B.readFile vpath `shouldReturn` b + modTime <- getModificationTime vpath + modTime `shouldSatisfy` isCloseTo t copyEntrySpec :: SpecWith FilePath copyEntrySpec = - context "when entry is copied form another archive" - $ it "is there" - $ \path -> property $ \m b s -> do - let vpath = deriveVacant path - createArchive vpath (addEntry m b s) - info <- createArchive path $ do - copyEntry vpath s s - commit - (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) - info `shouldBe` (b, m) + context "when entry is copied form another archive" $ + it "is there" $ \path -> + property $ \m b s -> do + let vpath = deriveVacant path + createArchive vpath (addEntry m b s) + info <- createArchive path $ do + copyEntry vpath s s + commit + (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) + info `shouldBe` (b, m) checkEntrySpec :: SpecWith FilePath checkEntrySpec = do - context "when entry is intact" - $ it "passes the check" - $ \path -> property $ \m b s -> do - check <- createArchive path $ do - addEntry m b s - commit - checkEntry s - check `shouldBe` True - context "when entry is corrupted" - $ it "does not pass the check" - $ \path -> property $ \b s -> - not (B.null b) ==> do - let r = 50 + (B.length . T.encodeUtf8 . getEntryName $ s) - offset <- createArchive path $ do - addEntry Store b s + context "when entry is intact" $ + it "passes the check" $ \path -> + property $ \m b s -> do + check <- createArchive path $ do + addEntry m b s commit - fromIntegral . edOffset . (! s) <$> getEntries - withFile path ReadWriteMode $ \h -> do - hSeek h AbsoluteSeek (offset + fromIntegral r) - byte <- B.map complement <$> B.hGet h 1 - hSeek h RelativeSeek (-1) - B.hPut h byte - withArchive path (checkEntry s) `shouldReturn` False + checkEntry s + check `shouldBe` True + context "when entry is corrupted" $ + it "does not pass the check" $ \path -> + property $ \b s -> + not (B.null b) ==> do + let r = 50 + (B.length . T.encodeUtf8 . getEntryName $ s) + offset <- createArchive path $ do + addEntry Store b s + commit + fromIntegral . edOffset . (! s) <$> getEntries + withFile path ReadWriteMode $ \h -> do + hSeek h AbsoluteSeek (offset + fromIntegral r) + byte <- B.map complement <$> B.hGet h 1 + hSeek h RelativeSeek (-1) + B.hPut h byte + withArchive path (checkEntry s) `shouldReturn` False recompressSpec :: SpecWith FilePath recompressSpec = - context "when recompression is used" - $ it "gets recompressed" - $ \path -> property $ \m m' b s -> do - info <- createArchive path $ do - addEntry m b s - commit - recompress m' s - commit - (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) - info `shouldBe` (b, m') + context "when recompression is used" $ + it "gets recompressed" $ \path -> + property $ \m m' b s -> do + info <- createArchive path $ do + addEntry m b s + commit + recompress m' s + commit + (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) + info `shouldBe` (b, m') entryCommentSpec :: SpecWith FilePath entryCommentSpec = do - context "when comment is committed (delete/set)" - $ it "reads it and updates" - $ \path -> property $ \txt s -> do - comment <- createArchive path $ do - addEntry Store "foo" s - deleteEntryComment s - setEntryComment txt s - commit - edComment . (! s) <$> getEntries - comment `shouldBe` Just txt - context "when comment is committed (set/delete)" - $ it "reads it and updates" - $ \path -> property $ \txt s -> do - comment <- createArchive path $ do - addEntry Store "foo" s - setEntryComment txt s - deleteEntryComment s - commit - edComment . (! s) <$> getEntries - comment `shouldBe` Nothing - context "when pre-existing comment is overwritten" - $ it "returns the new comment" - $ \path -> property $ \txt txt' s -> do - comment <- createArchive path $ do - addEntry Store "foo" s - setEntryComment txt s - commit - setEntryComment txt' s - commit - edComment . (! s) <$> getEntries - comment `shouldBe` Just txt' - context "when pre-existing comment is deleted" - $ it "actually deletes it" - $ \path -> property $ \txt s -> do - comment <- createArchive path $ do - addEntry Store "foo" s - setEntryComment txt s - commit - deleteEntryComment s - commit - edComment . (! s) <$> getEntries - comment `shouldBe` Nothing + context "when comment is committed (delete/set)" $ + it "reads it and updates" $ \path -> + property $ \txt s -> do + comment <- createArchive path $ do + addEntry Store "foo" s + deleteEntryComment s + setEntryComment txt s + commit + edComment . (! s) <$> getEntries + comment `shouldBe` Just txt + context "when comment is committed (set/delete)" $ + it "reads it and updates" $ \path -> + property $ \txt s -> do + comment <- createArchive path $ do + addEntry Store "foo" s + setEntryComment txt s + deleteEntryComment s + commit + edComment . (! s) <$> getEntries + comment `shouldBe` Nothing + context "when pre-existing comment is overwritten" $ + it "returns the new comment" $ \path -> + property $ \txt txt' s -> do + comment <- createArchive path $ do + addEntry Store "foo" s + setEntryComment txt s + commit + setEntryComment txt' s + commit + edComment . (! s) <$> getEntries + comment `shouldBe` Just txt' + context "when pre-existing comment is deleted" $ + it "actually deletes it" $ \path -> + property $ \txt s -> do + comment <- createArchive path $ do + addEntry Store "foo" s + setEntryComment txt s + commit + deleteEntryComment s + commit + edComment . (! s) <$> getEntries + comment `shouldBe` Nothing setModTimeSpec :: SpecWith FilePath setModTimeSpec = do - context "when mod time is set (after creation)" - $ it "reads it and updates" - $ \path -> property $ \time s -> do - modTime <- createArchive path $ do - addEntry Store "foo" s - setModTime time s - commit - edModTime . (! s) <$> getEntries - modTime `shouldSatisfy` isCloseTo time - context "when mod time is set (before creation)" - $ it "has no effect" - $ \path -> property $ \time time' s -> - not (isCloseTo time time') ==> do + context "when mod time is set (after creation)" $ + it "reads it and updates" $ \path -> + property $ \time s -> do modTime <- createArchive path $ do - setModTime time s addEntry Store "foo" s + setModTime time s commit edModTime . (! s) <$> getEntries - modTime `shouldNotSatisfy` isCloseTo time + modTime `shouldSatisfy` isCloseTo time + context "when mod time is set (before creation)" $ + it "has no effect" $ \path -> + property $ \time time' s -> + not (isCloseTo time time') ==> do + modTime <- createArchive path $ do + setModTime time s + addEntry Store "foo" s + commit + edModTime . (! s) <$> getEntries + modTime `shouldNotSatisfy` isCloseTo time extraFieldSpec :: SpecWith FilePath extraFieldSpec = do - context "when extra field is committed (delete/set)" - $ it "reads it and updates" - $ \path -> property $ \n b s -> - n /= 1 ==> do - efield <- createArchive path $ do - addEntry Store "foo" s - deleteExtraField n s - addExtraField n b s - commit - M.lookup n . edExtraField . (! s) <$> getEntries - efield `shouldBe` Just b - context "when extra field is committed (set/delete)" - $ it "reads it and updates" - $ \path -> property $ \n b s -> - n /= 1 ==> do - efield <- createArchive path $ do - addEntry Store "foo" s - addExtraField n b s - deleteExtraField n s - commit - M.lookup n . edExtraField . (! s) <$> getEntries - efield `shouldBe` Nothing - context "when pre-existing extra field is overwritten" - $ it "reads it and updates" - $ \path -> property $ \n b b' s -> - n /= 1 ==> do - efield <- createArchive path $ do - addEntry Store "foo" s - addExtraField n b s - commit - addExtraField n b' s - commit - M.lookup n . edExtraField . (! s) <$> getEntries - efield `shouldBe` Just b' - context "when pre-existing extra field is deleted" - $ it "actually deletes it" - $ \path -> property $ \n b s -> - n /= 1 ==> do - efield <- createArchive path $ do - addEntry Store "foo" s - addExtraField n b s - commit - deleteExtraField n s - commit - M.lookup n . edExtraField . (! s) <$> getEntries - efield `shouldBe` Nothing + context "when extra field is committed (delete/set)" $ + it "reads it and updates" $ \path -> + property $ \n b s -> + n /= 1 ==> do + efield <- createArchive path $ do + addEntry Store "foo" s + deleteExtraField n s + addExtraField n b s + commit + M.lookup n . edExtraField . (! s) <$> getEntries + efield `shouldBe` Just b + context "when extra field is committed (set/delete)" $ + it "reads it and updates" $ \path -> + property $ \n b s -> + n /= 1 ==> do + efield <- createArchive path $ do + addEntry Store "foo" s + addExtraField n b s + deleteExtraField n s + commit + M.lookup n . edExtraField . (! s) <$> getEntries + efield `shouldBe` Nothing + context "when pre-existing extra field is overwritten" $ + it "reads it and updates" $ \path -> + property $ \n b b' s -> + n /= 1 ==> do + efield <- createArchive path $ do + addEntry Store "foo" s + addExtraField n b s + commit + addExtraField n b' s + commit + M.lookup n . edExtraField . (! s) <$> getEntries + efield `shouldBe` Just b' + context "when pre-existing extra field is deleted" $ + it "actually deletes it" $ \path -> + property $ \n b s -> + n /= 1 ==> do + efield <- createArchive path $ do + addEntry Store "foo" s + addExtraField n b s + commit + deleteExtraField n s + commit + M.lookup n . edExtraField . (! s) <$> getEntries + efield `shouldBe` Nothing setExternalFileAttrsSpec :: SpecWith FilePath setExternalFileAttrsSpec = - context "when an external file attribute is added (after creation)" - $ it "sets a custom external file attribute" - $ \path -> property $ \attr s -> do - attr' <- createArchive path $ do - addEntry Store "foo" s - setExternalFileAttrs attr s - commit - edExternalFileAttrs . (! s) <$> getEntries - attr' `shouldBe` attr + context "when an external file attribute is added (after creation)" $ + it "sets a custom external file attribute" $ \path -> + property $ \attr s -> do + attr' <- createArchive path $ do + addEntry Store "foo" s + setExternalFileAttrs attr s + commit + edExternalFileAttrs . (! s) <$> getEntries + attr' `shouldBe` attr renameEntrySpec :: SpecWith FilePath renameEntrySpec = do - context "when renaming after editing of new entry" - $ it "produces correct result" - $ \path -> property $ \(EM s desc z) s' -> do - desc' <- createArchive path $ do - z - renameEntry s s' - commit - (! s') <$> getEntries - desc' `shouldSatisfy` softEq desc - context "when renaming existing entry" - $ it "gets renamed" - $ \path -> property $ \(EM s desc z) s' -> do - desc' <- createArchive path $ do - z - commit - renameEntry s s' - commit - (! s') <$> getEntries - desc' `shouldSatisfy` softEq desc + context "when renaming after editing of new entry" $ + it "produces correct result" $ \path -> + property $ \(EM s desc z) s' -> do + desc' <- createArchive path $ do + z + renameEntry s s' + commit + (! s') <$> getEntries + desc' `shouldSatisfy` softEq desc + context "when renaming existing entry" $ + it "gets renamed" $ \path -> + property $ \(EM s desc z) s' -> do + desc' <- createArchive path $ do + z + commit + renameEntry s s' + commit + (! s') <$> getEntries + desc' `shouldSatisfy` softEq desc deleteEntrySpec :: SpecWith FilePath deleteEntrySpec = do - context "when deleting after editing of new entry" - $ it "produces correct result" - $ \path -> property $ \(EM s _ z) -> do - member <- createArchive path $ do - z - deleteEntry s - commit - doesEntryExist s - member `shouldBe` False - context "when deleting existing entry" - $ it "gets deleted" - $ \path -> property $ \(EM s _ z) -> do - member <- createArchive path $ do - z - commit - deleteEntry s - commit - doesEntryExist s - member `shouldBe` False + context "when deleting after editing of new entry" $ + it "produces correct result" $ \path -> + property $ \(EM s _ z) -> do + member <- createArchive path $ do + z + deleteEntry s + commit + doesEntryExist s + member `shouldBe` False + context "when deleting existing entry" $ + it "gets deleted" $ \path -> + property $ \(EM s _ z) -> do + member <- createArchive path $ do + z + commit + deleteEntry s + commit + doesEntryExist s + member `shouldBe` False forEntriesSpec :: SpecWith FilePath forEntriesSpec = @@ -727,8 +710,8 @@ undoAllSpec = consistencySpec :: SpecWith FilePath consistencySpec = - it "can save and restore arbitrary archive" $ - \path -> property $ \(EC m z) txt -> do + it "can save and restore arbitrary archive" $ \path -> + property $ \(EC m z) txt -> do (txt', m') <- createArchive path $ do z setArchiveComment txt @@ -739,10 +722,9 @@ consistencySpec = packDirRecur'Spec :: SpecWith FilePath packDirRecur'Spec = - it "packs arbitrary directory recursively" $ - \path -> property - $ forAll (downScale arbitrary) - $ \contents -> + it "packs arbitrary directory recursively" $ \path -> + property $ + forAll (downScale arbitrary) $ \contents -> withSystemTempDirectory "zip-sandbox" $ \dir -> do forM_ contents $ \s -> do let item = dir unEntrySelector s @@ -764,8 +746,8 @@ packDirRecur'Spec = unpackIntoSpec :: SpecWith FilePath unpackIntoSpec = - it "unpacks archive contents into directory" $ - \path -> property $ \(EC m z) -> + it "unpacks archive contents into directory" $ \path -> + property $ \(EC m z) -> withSystemTempDirectory "zip-sandbox" $ \dir -> do createArchive path $ do z