2016-03-14 19:54:46 +00:00
|
|
|
{- git hash-object interface, with handle automatically stored in the Annex monad
|
|
|
|
-
|
|
|
|
- Copyright 2016 Joey Hess <id@joeyh.name>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Annex.HashObject (
|
|
|
|
hashFile,
|
|
|
|
hashBlob,
|
|
|
|
hashObjectHandle,
|
|
|
|
hashObjectStop,
|
|
|
|
) where
|
|
|
|
|
|
|
|
import Annex.Common
|
|
|
|
import qualified Git.HashObject
|
|
|
|
import qualified Annex
|
|
|
|
import Git.Types
|
|
|
|
|
|
|
|
hashObjectHandle :: Annex Git.HashObject.HashObjectHandle
|
|
|
|
hashObjectHandle = maybe startup return =<< Annex.getState Annex.hashobjecthandle
|
|
|
|
where
|
|
|
|
startup = do
|
2016-03-14 19:58:46 +00:00
|
|
|
h <- inRepo $ Git.HashObject.hashObjectStart
|
2016-03-14 19:54:46 +00:00
|
|
|
Annex.changeState $ \s -> s { Annex.hashobjecthandle = Just h }
|
|
|
|
return h
|
|
|
|
|
|
|
|
hashObjectStop :: Annex ()
|
2016-03-14 19:58:46 +00:00
|
|
|
hashObjectStop = maybe noop stop =<< Annex.getState Annex.hashobjecthandle
|
2016-03-14 19:54:46 +00:00
|
|
|
where
|
|
|
|
stop h = do
|
2016-03-14 19:58:46 +00:00
|
|
|
liftIO $ Git.HashObject.hashObjectStop h
|
2016-03-14 19:54:46 +00:00
|
|
|
Annex.changeState $ \s -> s { Annex.hashobjecthandle = Nothing }
|
2016-03-14 19:58:46 +00:00
|
|
|
return ()
|
2016-03-14 19:54:46 +00:00
|
|
|
|
|
|
|
hashFile :: FilePath -> Annex Sha
|
|
|
|
hashFile f = do
|
|
|
|
h <- hashObjectHandle
|
2016-03-14 19:58:46 +00:00
|
|
|
liftIO $ Git.HashObject.hashFile h f
|
2016-03-14 19:54:46 +00:00
|
|
|
|
|
|
|
{- Note that the content will be written to a temp file.
|
|
|
|
- So it may be faster to use Git.HashObject.hashObject for large
|
|
|
|
- blob contents. -}
|
2019-01-03 17:19:59 +00:00
|
|
|
hashBlob :: Git.HashObject.HashableBlob b => b -> Annex Sha
|
2016-03-14 19:54:46 +00:00
|
|
|
hashBlob content = do
|
|
|
|
h <- hashObjectHandle
|
2016-03-14 19:58:46 +00:00
|
|
|
liftIO $ Git.HashObject.hashBlob h content
|