module Git.Tree.Working where
import Control.Applicative
import Control.Concurrent.Async.Lifted
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Control
import qualified Data.ByteString as B (readFile)
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldl')
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.Maybe
import Data.Tagged
import Data.Time
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Git hiding (Options)
import Prelude hiding (log)
import System.FilePath.Posix
import System.Posix.Files
data FileEntry m = FileEntry
{ fileModTime :: UTCTime
, fileBlobOid :: BlobOid m
, fileBlobKind :: BlobKind
, fileChecksum :: BlobOid m
}
type FileTree m = HashMap TreeFilePath (FileEntry m)
readFileTree :: (MonadBaseControl IO m, MonadIO m, MonadGit r m)
=> RefName
-> FilePath
-> Bool
-> m (FileTree r)
readFileTree ref wdir getHash = do
h <- resolveReference ref
case h of
Nothing -> pure Map.empty
Just h' -> do
tr <- lookupTree . commitTree =<< lookupCommit (Tagged h')
readFileTree' tr wdir getHash
readFileTree' :: (MonadBaseControl IO m, MonadIO m, MonadGit r m)
=> Tree r -> FilePath -> Bool
-> m (FileTree r)
readFileTree' tr wdir getHash = do
blobs <- treeBlobEntries tr
stats <- mapConcurrently go blobs
return $ foldl' (\m (!fp,!fent) -> maybe m (flip (Map.insert fp) m) fent)
Map.empty stats
where
go (!fp,!oid,!kind) = do
fent <- readModTime wdir getHash (B8.unpack fp) oid kind
fent `seq` return (fp,fent)
readModTime :: (MonadIO m, MonadGit r m)
=> FilePath
-> Bool
-> FilePath
-> BlobOid r
-> BlobKind
-> m (Maybe (FileEntry r))
readModTime wdir getHash fp oid kind = do
let path = wdir </> fp
estatus <- liftIO $ try $ getSymbolicLinkStatus path
case (estatus :: Either SomeException FileStatus) of
Right status | isRegularFile status ->
Just <$> (FileEntry
<$> pure (posixSecondsToUTCTime
(realToFrac (modificationTime status)))
<*> pure oid
<*> pure kind
<*> if getHash
then hashContents . BlobString
=<< liftIO (B.readFile path)
else return oid)
_ -> return Nothing