Add Haddock `/Since: 4.7.0.0/` comments to new symbols
[packages/base.git] / GHC / Fingerprint.hs
index d1b3831..1f712f5 100644 (file)
@@ -6,7 +6,7 @@
   #-}
 
 -- ----------------------------------------------------------------------------
--- 
+--
 --  (c) The University of Glasgow 2006
 --
 -- Fingerprints for recompilation checking and ABI versioning, and
 -- ----------------------------------------------------------------------------
 
 module GHC.Fingerprint (
-        Fingerprint(..), fingerprint0, 
+        Fingerprint(..), fingerprint0,
         fingerprintData,
         fingerprintString,
-        fingerprintFingerprints
+        fingerprintFingerprints,
+        getFileHash
    ) where
 
 import GHC.IO
@@ -26,8 +27,11 @@ import GHC.Base
 import GHC.Num
 import GHC.List
 import GHC.Real
+import GHC.Show
 import Foreign
 import Foreign.C
+import System.IO
+import Control.Monad (when)
 
 import GHC.Fingerprint.Type
 
@@ -67,12 +71,46 @@ fingerprintString str = unsafeDupablePerformIO $
                     fromIntegral (w32 `shiftR` 8),
                     fromIntegral w32]
 
+-- | Computes the hash of a given file.
+-- This function loops over the handle, running in constant memory.
+--
+-- /Since: 4.7.0.0/
+getFileHash :: FilePath -> IO Fingerprint
+getFileHash path = withBinaryFile path ReadMode $ \h -> do
+  allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
+    c_MD5Init pctxt
+
+    processChunks h (\buf size -> c_MD5Update pctxt buf (fromIntegral size))
+
+    allocaBytes 16 $ \pdigest -> do
+      c_MD5Final pdigest pctxt
+      peek (castPtr pdigest :: Ptr Fingerprint)
+
+  where
+    _BUFSIZE = 4096
+
+    -- | Loop over _BUFSIZE sized chunks read from the handle,
+    -- passing the callback a block of bytes and its size.
+    processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
+    processChunks h f = allocaBytes _BUFSIZE $ \arrPtr ->
+
+      let loop = do
+            count <- hGetBuf h arrPtr _BUFSIZE
+            eof <- hIsEOF h
+            when (count /= _BUFSIZE && not eof) $ error $
+              "GHC.Fingerprint.getFileHash: only read " ++ show count ++ " bytes"
+
+            f arrPtr count
+
+            when (not eof) loop
+
+      in loop
+
 data MD5Context
 
-foreign import ccall unsafe "MD5Init"
+foreign import ccall unsafe "__hsbase_MD5Init"
    c_MD5Init   :: Ptr MD5Context -> IO ()
-foreign import ccall unsafe "MD5Update"
+foreign import ccall unsafe "__hsbase_MD5Update"
    c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
-foreign import ccall unsafe "MD5Final"
+foreign import ccall unsafe "__hsbase_MD5Final"
    c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()
-