record annexed files in log

This commit is contained in:
Joey Hess 2010-10-12 18:25:41 -04:00
parent b882fe8410
commit 3b89924f53
2 changed files with 25 additions and 8 deletions

View file

@ -68,6 +68,7 @@ annexFile state file = do
let dest = annexLocation state key let dest = annexLocation state key
createDirectoryIfMissing True (parentDir dest) createDirectoryIfMissing True (parentDir dest)
renameFile file dest renameFile file dest
logChange (repo state) file (getUUID (repo state)) FilePresent
createSymbolicLink dest file createSymbolicLink dest file
gitAdd (repo state) file gitAdd (repo state) file
checkLegal file = do checkLegal file = do

View file

@ -17,6 +17,8 @@
-} -}
module LocationLog ( module LocationLog (
LogStatus(..),
logChange
) where ) where
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
@ -75,6 +77,22 @@ instance Read LogLine where
undefined = ret $ LogLine (0) Undefined "" undefined = ret $ LogLine (0) Undefined ""
ret v = [(v, "")] ret v = [(v, "")]
{- Log a change in the presence of a file in a repository,
- and add the log to git so it will propigate to other repos. -}
logChange :: GitRepo -> FilePath -> UUID -> LogStatus -> IO ()
logChange repo file uuid status = do
log <- logNow status uuid
if (status == FilePresent)
-- file added; just append to log
then appendLog logfile log
-- file removed; compact log
else do
ls <- readLog logfile
writeLog logfile (log:ls)
gitAdd repo logfile
where
logfile = logFile repo file
{- Reads a log file. {- Reads a log file.
- Note that the LogLines returned may be in any order. -} - Note that the LogLines returned may be in any order. -}
readLog :: FilePath -> IO [LogLine] readLog :: FilePath -> IO [LogLine]
@ -106,23 +124,21 @@ writeLog file lines = do
hPutStr h $ unlines $ map show lines hPutStr h $ unlines $ map show lines
{- Generates a new LogLine with the current date. -} {- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> IO LogLine logNow :: LogStatus -> UUID -> IO LogLine
logNow status uuid = do logNow status uuid = do
now <- getPOSIXTime now <- getPOSIXTime
return $ LogLine now status uuid return $ LogLine now status uuid
{- Returns the filename of the log file for a given annexed file. -} {- Returns the filename of the log file for a given annexed file. -}
logFile :: GitRepo -> FilePath -> IO String logFile :: GitRepo -> FilePath -> String
logFile repo annexedFile = do logFile repo annexedFile = (gitStateDir repo) ++
return $ (gitStateDir repo) ++
(gitRelative repo annexedFile) ++ ".log" (gitRelative repo annexedFile) ++ ".log"
{- Returns a list of repositories that, according to the log, have {- Returns a list of repository UUIDs that, according to the log, have
- the content of a file -} - the content of a file -}
fileLocations :: GitRepo -> FilePath -> IO [String] fileLocations :: GitRepo -> FilePath -> IO [UUID]
fileLocations thisrepo file = do fileLocations thisrepo file = do
log <- logFile thisrepo file lines <- readLog $ logFile thisrepo file
lines <- readLog log
return $ map uuid (filterPresent lines) return $ map uuid (filterPresent lines)
{- Filters the list of LogLines to find ones where the file {- Filters the list of LogLines to find ones where the file