mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-09-17 15:17:10 +03:00
cbd0c5da8f
* Minimal test suite - Add support for urls with file: schema; both absolute (file:/path) and relative (file:path) paths are supported. - Log curl invocation in case of failure - Rename fetchRemoteAsset to fetchURL - Add verbosity flag - Bump GHC to 9.4.7 - Bump flake inputs * Apply suggestions from code review Co-authored-by: Michael Peyton Jones <me@michaelpj.com> * Add short option '-v' for '--verbosity' * Whitespace * Add comment explaining why the dot * Rename withFixture to inTemporaryDirectoryWithFixture * Small refactor of PrepareSource * Rename TarballSource to URISource - Move sourceUrl to Foliage.Meta.packageVersionSourceToUri * Simplify inTemporaryDirectoryWithFixture * Document tar and cp flags * Reformat --------- Co-authored-by: Michael Peyton Jones <me@michaelpj.com>
33 lines
1.1 KiB
Haskell
33 lines
1.1 KiB
Haskell
module Foliage.Tests.Tar where
|
|
|
|
import Codec.Archive.Tar qualified as Tar
|
|
import Codec.Archive.Tar.Entry (Entry (..))
|
|
import Codec.Archive.Tar.Index (TarIndexEntry (..))
|
|
import Codec.Archive.Tar.Index qualified as Tar
|
|
import Control.Monad (when)
|
|
import Data.ByteString.Lazy qualified as B
|
|
import System.IO
|
|
import Test.Tasty.HUnit
|
|
|
|
newtype TarballAccessFn = TarballAccessFn
|
|
{ lookupEntry :: FilePath -> IO (Maybe Entry)
|
|
}
|
|
|
|
withTarball :: (HasCallStack) => FilePath -> (TarballAccessFn -> IO r) -> IO r
|
|
withTarball path action = do
|
|
eIdx <- Tar.build . Tar.read <$> B.readFile path
|
|
case eIdx of
|
|
Left err ->
|
|
assertFailure (show err)
|
|
Right idx ->
|
|
withFile path ReadMode $ \handle -> do
|
|
hIsClosed handle >>= flip when (putStrLn "[after reading] it's closed!")
|
|
let lookupEntry :: FilePath -> IO (Maybe Entry)
|
|
lookupEntry filepath =
|
|
case Tar.lookup idx filepath of
|
|
Just (TarFileEntry offset) -> do
|
|
Just <$> Tar.hReadEntry handle offset
|
|
_otherwise ->
|
|
return Nothing
|
|
action $ TarballAccessFn{lookupEntry}
|