summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CHANGELOG.md4
-rw-r--r--libarchive.cabal2
-rw-r--r--src/Codec/Archive/Common.hs10
-rw-r--r--src/Codec/Archive/Unpack.hs25
-rw-r--r--test/Spec.hs18
5 files changed, 18 insertions, 41 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index bf37756..72a8527 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,9 +1,5 @@
# 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
diff --git a/libarchive.cabal b/libarchive.cabal
index 35ff198..e10ae8a 100644
--- a/libarchive.cabal
+++ b/libarchive.cabal
@@ -1,6 +1,6 @@
cabal-version: 1.18
name: libarchive
-version: 2.2.0.1
+version: 2.2.0.0
license: BSD3
license-file: LICENSE
copyright: Copyright: (c) 2018-2019 Vanessa McHale
diff --git a/src/Codec/Archive/Common.hs b/src/Codec/Archive/Common.hs
index b369e20..a1d1af2 100644
--- a/src/Codec/Archive/Common.hs
+++ b/src/Codec/Archive/Common.hs
@@ -4,7 +4,6 @@ module Codec.Archive.Common ( actFree
) where
import Codec.Archive.Foreign
-import Codec.Archive.Monad (ArchiveM, bracketM)
import Control.Composition ((.**))
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO (..))
@@ -20,10 +19,11 @@ hmemcpy :: Ptr a -> Ptr b -> CSize -> IO ()
hmemcpy = void .** memcpy
-- | Do something with an 'Archive' and then free it
-actFree :: IO (Ptr Archive)
- -> (Ptr Archive -> ArchiveM a)
- -> ArchiveM a
-actFree get = bracketM get archiveFree
+actFree :: MonadIO m
+ => (Ptr Archive -> m a)
+ -> Ptr Archive
+ -> m a
+actFree fact a = fact a <* liftIO (archiveFree a)
actFreeCallback :: MonadIO m
=> (Ptr Archive -> m a)
diff --git a/src/Codec/Archive/Unpack.hs b/src/Codec/Archive/Unpack.hs
index 937b1cc..0f10b26 100644
--- a/src/Codec/Archive/Unpack.hs
+++ b/src/Codec/Archive/Unpack.hs
@@ -45,13 +45,14 @@ bsToArchive bs = do
--
-- @since 1.0.0.0
readArchiveFile :: FilePath -> ArchiveM [Entry]
-readArchiveFile fp = actFree archiveReadNew (\a -> archiveFile fp a *> hsEntries a)
--- actFree hsEntries <=< a dorchiveFile
+readArchiveFile = actFree hsEntries <=< archiveFile
-archiveFile :: FilePath -> Ptr Archive -> ArchiveM ()
-archiveFile fp a = withCStringArchiveM fp $ \cpath ->
- ignore (archiveReadSupportFormatAll a) *>
- handle (archiveReadOpenFilename a cpath 10240)
+archiveFile :: FilePath -> ArchiveM (Ptr Archive)
+archiveFile fp = withCStringArchiveM fp $ \cpath -> do
+ a <- liftIO archiveReadNew
+ ignore $ archiveReadSupportFormatAll a
+ handle $ archiveReadOpenFilename a cpath 10240
+ pure a
-- | This is more efficient than
--
@@ -61,13 +62,11 @@ archiveFile fp a = withCStringArchiveM fp $ \cpath ->
unpackArchive :: FilePath -- ^ Filepath pointing to archive
-> FilePath -- ^ Dirctory to unpack in
-> ArchiveM ()
-unpackArchive tarFp dirFp =
- bracketM
- archiveReadNew
- archiveFree
- (\a ->
- archiveFile tarFp a *>
- unpackEntriesFp a dirFp)
+unpackArchive tarFp dirFp = do
+ -- TODO: bracket here
+ a <- archiveFile tarFp
+ unpackEntriesFp a dirFp
+ ignore $ archiveFree a
readEntry :: Ptr Archive -> Ptr ArchiveEntry -> IO Entry
readEntry a entry =
diff --git a/test/Spec.hs b/test/Spec.hs
index c1805d4..2243462 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -8,7 +8,6 @@ import Data.Either (isRight)
import Data.Foldable (traverse_)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath ((</>))
-import System.IO.Temp (withSystemTempDirectory)
import Test.Hspec
testFp :: FilePath -> Spec
@@ -23,21 +22,6 @@ testFpFreaky :: FilePath -> Spec
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
@@ -51,8 +35,6 @@ main = do
traverse_ testFp tarPaths
traverse_ testFpFreaky tarPaths
traverse_ testFpStrict tarPaths
- traverse_ testUnpackLibarchive tarPaths
- traverse_ testReadArchiveFile tarPaths
context "with symlinks" $ do
let entries =