-- | @since 0.1.1.0
module BZip.File ( decompressFromFile
                 , compressToFile
                 ) where

import           BZip
import           Control.Composition  ((.@))
import qualified Data.ByteString.Lazy as BSL

-- | Read data from a compressed file
decompressFromFile :: FilePath -> IO BSL.ByteString
decompressFromFile :: FilePath -> IO ByteString
decompressFromFile = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
decompress (IO ByteString -> IO ByteString)
-> (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BSL.readFile

-- | Write data to a compressed file
compressToFile :: FilePath -> BSL.ByteString -> IO ()
compressToFile :: FilePath -> ByteString -> IO ()
compressToFile = ByteString -> ByteString
compress (ByteString -> ByteString)
-> (FilePath -> ByteString -> IO ())
-> FilePath
-> ByteString
-> IO ()
forall b c a d. (b -> c) -> (a -> c -> d) -> a -> b -> d
.@ FilePath -> ByteString -> IO ()
BSL.writeFile