record annexed files in log
This commit is contained in:
parent
b882fe8410
commit
3b89924f53
2 changed files with 25 additions and 8 deletions
1
Annex.hs
1
Annex.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue