{- git-annex location log - - git-annex keeps track of on which repository it last saw a file's content. - This can be useful when using it for archiving with offline storage. - When you indicate you --want a file, git-annex will tell you which - repositories have the file's content. - - Location tracking information is stored in `.git-annex/filename.log`. - Repositories record their UUID and the date when they --get or --drop - a file's content. - - A line of the log will look like: "date N UUID" - Where N=1 when the repo has the file, and 0 otherwise. - - Git is configured to use a union merge for this file, - so the lines may be in arbitrary order, but it will never conflict. -} module LocationLog ( ) where import Data.Time.Clock.POSIX import Data.Time import System.Locale import qualified Data.Map as Map import System.IO import System.Directory import Data.Char import GitRepo import Utility import UUID import Locations data LogLine = LogLine { date :: POSIXTime, status :: LogStatus, uuid :: UUID } deriving (Eq) data LogStatus = FilePresent | FileMissing | Undefined deriving (Eq) instance Show LogStatus where show FilePresent = "1" show FileMissing = "0" show Undefined = "undefined" instance Read LogStatus where readsPrec _ "1" = [(FilePresent, "")] readsPrec _ "0" = [(FileMissing, "")] readsPrec _ _ = [(Undefined, "")] instance Show LogLine where show (LogLine date status uuid) = unwords [(show date), (show status), uuid] instance Read LogLine where -- This parser is robust in that even unparsable log lines are -- read without an exception being thrown. -- Such lines have a status of Undefined. readsPrec _ string = if (length w >= 3) then case (pdate) of Just v -> good v Nothing -> undefined else undefined where w = words string date = w !! 0 status = read $ w !! 1 uuid = unwords $ drop 2 w pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status uuid undefined = ret $ LogLine (0) Undefined "" ret v = [(v, "")] {- Reads a log file. - Note that the LogLines returned may be in any order. -} readLog :: FilePath -> IO [LogLine] readLog file = do exists <- doesFileExist file if exists then do s <- withFileLocked file ReadMode $ \h -> hGetContentsStrict h -- filter out any unparsable lines return $ filter (\l -> (status l) /= Undefined ) $ map read $ lines s else do return [] {- Adds a LogLine to a log file -} appendLog :: FilePath -> LogLine -> IO () appendLog file line = do createDirectoryIfMissing True (parentDir file) withFileLocked file AppendMode $ \h -> hPutStrLn h $ show line -- TODO git add log {- Writes a set of lines to a log file -} writeLog :: FilePath -> [LogLine] -> IO () writeLog file lines = do createDirectoryIfMissing True (parentDir file) withFileLocked file WriteMode $ \h -> hPutStr h $ unlines $ map show lines {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> IO LogLine logNow status uuid = do now <- getPOSIXTime return $ LogLine now status uuid {- Returns the filename of the log file for a given annexed file. -} logFile :: GitRepo -> FilePath -> IO String logFile repo annexedFile = do return $ (gitStateDir repo) ++ (gitRelative repo annexedFile) ++ ".log" {- Returns a list of repositories that, according to the log, have - the content of a file -} fileLocations :: GitRepo -> FilePath -> IO [String] fileLocations thisrepo file = do log <- logFile thisrepo file lines <- readLog log return $ map uuid (filterPresent lines) {- Filters the list of LogLines to find ones where the file - is (or should still be) present. -} filterPresent :: [LogLine] -> [LogLine] filterPresent lines = filter (\l -> FilePresent == status l) $ compactLog lines {- Compacts a set of logs, returning a subset that contains the current - status. -} compactLog :: [LogLine] -> [LogLine] compactLog lines = compactLog' Map.empty lines compactLog' map [] = Map.elems map compactLog' map (l:ls) = compactLog' (mapLog map l) ls {- Inserts a log into a map of logs, if the log has better (ie, newer) - information about a repo than the other logs in the map -} mapLog map log = if (better) then Map.insert (uuid log) log map else map where better = case (Map.lookup (uuid log) map) of Just l -> (date l <= date log) Nothing -> True