{-# LANGUAGE Safe #-}
module GHC.Fingerprint (
Fingerprint(..), fingerprint0,
fingerprintData,
fingerprintString,
fingerprintFingerprints,
getFileHash
) where
import GHC.Internal.Fingerprint
import Data.Function (($))
import Control.Monad (return, when)
import Data.Bool (not, (&&))
import Data.List ((++))
import Data.Maybe (Maybe (Nothing, Just))
import Data.Int (Int)
import Data.Word (Word8)
import Data.Eq ((/=))
import Text.Show (show)
import System.IO
(
IO,
FilePath,
IOMode (ReadMode),
withBinaryFile,
hGetBuf,
hIsEOF
)
import Foreign.Ptr (Ptr)
import GHC.Err (errorWithoutStackTrace)
getFileHash :: FilePath -> IO Fingerprint
getFileHash :: FilePath -> IO Fingerprint
getFileHash FilePath
path = FilePath -> IOMode -> (Handle -> IO Fingerprint) -> IO Fingerprint
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
path IOMode
ReadMode ((Handle -> IO Fingerprint) -> IO Fingerprint)
-> (Handle -> IO Fingerprint) -> IO Fingerprint
forall a b. (a -> b) -> a -> b
$ \ Handle
hdl ->
let
readChunk :: Ptr Word8 -> Int -> IO (Maybe Int)
readChunk :: Ptr Word8 -> Int -> IO (Maybe Int)
readChunk Ptr Word8
bufferPtr Int
bufferSize = do
chunkSize <- Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hdl Ptr Word8
bufferPtr Int
bufferSize
isFinished <- hIsEOF hdl
when (chunkSize /= bufferSize && not isFinished)
(
errorWithoutStackTrace $
"GHC.Fingerprint.getFileHash: could only read " ++
show chunkSize ++
" bytes, but more are available"
)
return (if isFinished then Just chunkSize else Nothing)
in (Ptr Word8 -> Int -> IO (Maybe Int)) -> IO Fingerprint
fingerprintBufferedStream Ptr Word8 -> Int -> IO (Maybe Int)
readChunk