module Codec.Archive.Pack.Lazy ( entriesToBSL
, entriesToBSL7zip
, entriesToBSLzip
) where
import Codec.Archive.Foreign
import Codec.Archive.Pack
import Codec.Archive.Types
import Control.Monad (void)
import Data.ByteString (packCStringLen)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.DList as DL
import Data.Foldable (toList)
import Data.Functor (($>))
import Data.IORef (modifyIORef', newIORef, readIORef)
import Foreign.Marshal.Alloc (free, mallocBytes)
import Foreign.Ptr
import System.IO.Unsafe (unsafePerformIO)
entriesToBSLzip :: Foldable t => t Entry -> BSL.ByteString
entriesToBSLzip = unsafePerformIO . entriesToBSLGeneral archive_write_set_format_zip
{-# NOINLINE entriesToBSLzip #-}
entriesToBSL7zip :: Foldable t => t Entry -> BSL.ByteString
entriesToBSL7zip = unsafePerformIO . entriesToBSLGeneral archive_write_set_format_7zip
{-# NOINLINE entriesToBSL7zip #-}
entriesToBSL :: Foldable t => t Entry -> BSL.ByteString
entriesToBSL = unsafePerformIO . entriesToBSLGeneral archive_write_set_format_pax_restricted
{-# NOINLINE entriesToBSL #-}
entriesToBSLGeneral :: Foldable t => (Ptr Archive -> IO ArchiveError) -> t Entry -> IO BSL.ByteString
entriesToBSLGeneral modifier hsEntries' = do
a <- archive_write_new
bsRef <- newIORef mempty
oc <- mkOpenCallback doNothing
wc <- mkWriteCallback (writeBSL bsRef)
cc <- mkCloseCallback (\_ ptr -> freeHaskellFunPtr oc *> freeHaskellFunPtr wc *> free ptr $> archiveOk)
nothingPtr <- mallocBytes 0
void $ modifier a
void $ archive_write_open a nothingPtr oc wc cc
packEntries a hsEntries'
void $ archive_write_free a
BSL.fromChunks . toList <$> readIORef bsRef
where writeBSL bsRef _ _ bufPtr sz = do
let bytesRead = min sz (32 * 1024)
bsl <- packCStringLen (bufPtr, fromIntegral bytesRead)
modifyIORef' bsRef (`DL.snoc` bsl)
pure bytesRead
doNothing _ _ = pure archiveOk