libarchive 2.2.0.0 → 2.2.0.1

raw patch · 5 files changed

+41/−18 lines, 5 files

Files

• CHANGELOG.md +4/−0
• libarchive.cabal +1/−1
• src/Codec/Archive/Common.hs +5/−5
• src/Codec/Archive/Unpack.hs +13/−12
• test/Spec.hs +18/−0

@@ -1,5 +1,9 @@ # libarchive +## 2.2.0.1++  * Use `bracket` in a few places where it doesn't crash GHC+ ## 2.2.0.0    * Haskell `Entry` type now includes `Symlink` field

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            libarchive-version:         2.2.0.0+version:         2.2.0.1 license:         BSD3 license-file:    LICENSE copyright:       Copyright: (c) 2018-2019 Vanessa McHale

@@ -4,6 +4,7 @@                             ) where  import           Codec.Archive.Foreign+import           Codec.Archive.Monad    (ArchiveM, bracketM) import           Control.Composition    ((.**)) import           Control.Monad          (void) import           Control.Monad.IO.Class (MonadIO (..))@@ -19,11 +20,10 @@ hmemcpy = void .** memcpy  -- | Do something with an 'Archive' and then free it-actFree :: MonadIO m-        => (Ptr Archive -> m a)-        -> Ptr Archive-        -> m a-actFree fact a = fact a <* liftIO (archiveFree a)+actFree :: IO (Ptr Archive)+        -> (Ptr Archive -> ArchiveM a)+        -> ArchiveM a+actFree get = bracketM get archiveFree  actFreeCallback :: MonadIO m                 => (Ptr Archive -> m a)

@@ -45,14 +45,13 @@ -- -- @since 1.0.0.0 readArchiveFile :: FilePath -> ArchiveM [Entry]-readArchiveFile = actFree hsEntries <=< archiveFile+readArchiveFile fp = actFree archiveReadNew (\a -> archiveFile fp a *> hsEntries a)+-- actFree hsEntries <=< a dorchiveFile -archiveFile :: FilePath -> ArchiveM (Ptr Archive)-archiveFile fp = withCStringArchiveM fp $ \cpath -> do-    a <- liftIO archiveReadNew-    ignore $ archiveReadSupportFormatAll a-    handle $ archiveReadOpenFilename a cpath 10240-    pure a+archiveFile :: FilePath -> Ptr Archive -> ArchiveM ()+archiveFile fp a = withCStringArchiveM fp $ \cpath ->+    ignore (archiveReadSupportFormatAll a) *>+    handle (archiveReadOpenFilename a cpath 10240)  -- | This is more efficient than --@@ -62,11 +61,13 @@ unpackArchive :: FilePath -- ^ Filepath pointing to archive               -> FilePath -- ^ Dirctory to unpack in               -> ArchiveM ()-unpackArchive tarFp dirFp = do-    -- TODO: bracket here-    a <- archiveFile tarFp-    unpackEntriesFp a dirFp-    ignore $ archiveFree a+unpackArchive tarFp dirFp =+    bracketM+        archiveReadNew+        archiveFree+        (\a ->+            archiveFile tarFp a *>+            unpackEntriesFp a dirFp)  readEntry :: Ptr Archive -> Ptr ArchiveEntry -> IO Entry readEntry a entry =

@@ -8,6 +8,7 @@ import           Data.Foldable           (traverse_) import           System.Directory        (doesDirectoryExist, listDirectory) import           System.FilePath         ((</>))+import           System.IO.Temp          (withSystemTempDirectory) import           Test.Hspec  testFp :: FilePath -> Spec@@ -22,6 +23,21 @@ testFpFreaky fp = parallel $ it ("works on nonstandard bytestring (" ++ fp ++ ")") $     roundtripFreaky fp >>= (`shouldSatisfy` isRight) +unpack :: FilePath -> IO (Either ArchiveResult ())+unpack fp = withSystemTempDirectory "libarchive" $+    \tmp -> runArchiveM $ unpackArchive fp tmp++readArchiveFile' :: FilePath -> IO (Either ArchiveResult [Entry])+readArchiveFile' = runArchiveM . readArchiveFile++testUnpackLibarchive :: FilePath -> Spec+testUnpackLibarchive fp = parallel $ it ("unpacks " ++ fp) $+    unpack fp >>= (`shouldSatisfy` isRight)++testReadArchiveFile :: FilePath -> Spec+testReadArchiveFile fp = parallel $ it ("reads " ++ fp) $+    readArchiveFile' fp >>= (`shouldSatisfy` isRight)+ main :: IO () main = do @@ -35,6 +51,8 @@             traverse_ testFp tarPaths             traverse_ testFpFreaky tarPaths             traverse_ testFpStrict tarPaths+            traverse_ testUnpackLibarchive tarPaths+            traverse_ testReadArchiveFile tarPaths              context "with symlinks" $ do                 let entries =