-- | -- Module : Data.Git.Storage.FileWriter -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unix -- module Data.Git.Storage.FileWriter where import Data.Git.Ref import Data.IORef import qualified Data.ByteString as B import Codec.Zlib import Control.Exception (bracket) import qualified Crypto.Hash.SHA1 as SHA1 import System.IO (hClose) import Filesystem defaultCompression = 6 -- this is a copy of modifyIORef' found in base 4.6 (ghc 7.6), -- for older version of base. modifyIORefStrict :: IORef a -> (a -> a) -> IO () modifyIORefStrict ref f = do x <- readIORef ref let x' = f x x' `seq` writeIORef ref x' data FileWriter = FileWriter { writerHandle :: Handle , writerDeflate :: Deflate , writerDigest :: IORef SHA1.Ctx } fileWriterNew handle = do deflate <- initDeflate defaultCompression defaultWindowBits digest <- newIORef SHA1.init return $ FileWriter { writerHandle = handle , writerDeflate = deflate , writerDigest = digest } withFileWriter path f = bracket (openFile path WriteMode) (hClose) $ \handle -> bracket (fileWriterNew handle) (fileWriterClose) f postDeflate handle = maybe (return ()) (B.hPut handle) fileWriterOutput (FileWriter { writerHandle = handle, writerDigest = digest, writerDeflate = deflate }) bs = do modifyIORefStrict digest (\ctx -> SHA1.update ctx bs) (>>= postDeflate handle) =<< feedDeflate deflate bs fileWriterClose (FileWriter { writerHandle = handle, writerDeflate = deflate }) = postDeflate handle =<< finishDeflate deflate fileWriterGetDigest (FileWriter { writerDigest = digest }) = (fromBinary . SHA1.finalize) `fmap` readIORef digest