git-annex/LocationLog.hs

163 lines
4.5 KiB
Haskell
Raw Normal View History

2010-10-09 23:22:40 +00:00
{- git-annex location log
-
2010-10-13 00:04:36 +00:00
- git-annex keeps track of on which repository it last saw a value.
2010-10-09 23:22:40 +00:00
- 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
2010-10-13 00:04:36 +00:00
- repositories have the value.
2010-10-09 23:22:40 +00:00
-
2010-10-13 00:04:36 +00:00
- Location tracking information is stored in `.git-annex/key.log`.
2010-10-12 22:06:34 +00:00
- Repositories record their UUID and the date when they --get or --drop
2010-10-13 00:04:36 +00:00
- a value.
2010-10-09 23:22:40 +00:00
-
2010-10-12 22:06:34 +00:00
- A line of the log will look like: "date N UUID"
2010-10-10 02:29:16 +00:00
- Where N=1 when the repo has the file, and 0 otherwise.
2010-10-10 16:31:14 +00:00
-
- Git is configured to use a union merge for this file,
- so the lines may be in arbitrary order, but it will never conflict.
2010-10-27 20:53:54 +00:00
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
2010-10-09 23:22:40 +00:00
-}
2010-10-11 21:52:46 +00:00
module LocationLog (
2010-10-12 22:25:41 +00:00
LogStatus(..),
logChange,
2010-11-15 17:00:43 +00:00
keyLocations
2010-10-11 21:52:46 +00:00
) where
2010-10-09 23:22:40 +00:00
import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
2010-10-10 16:31:14 +00:00
import qualified Data.Map as Map
2010-10-10 03:35:05 +00:00
import System.Directory
import System.Posix.Process
2010-10-16 20:20:49 +00:00
2010-10-14 06:36:41 +00:00
import qualified GitRepo as Git
2010-10-10 02:46:35 +00:00
import Utility
2010-10-12 22:06:34 +00:00
import UUID
2010-10-14 07:18:11 +00:00
import Types
import Locations
2010-10-09 23:22:40 +00:00
data LogLine = LogLine {
date :: POSIXTime,
status :: LogStatus,
2010-10-12 22:06:34 +00:00
uuid :: UUID
} deriving (Eq)
2010-10-13 00:04:36 +00:00
data LogStatus = ValuePresent | ValueMissing | Undefined
2010-10-10 02:29:16 +00:00
deriving (Eq)
instance Show LogStatus where
2010-10-13 00:04:36 +00:00
show ValuePresent = "1"
show ValueMissing = "0"
2010-10-10 02:29:16 +00:00
show Undefined = "undefined"
instance Read LogStatus where
2010-10-13 00:04:36 +00:00
readsPrec _ "1" = [(ValuePresent, "")]
readsPrec _ "0" = [(ValueMissing, "")]
2010-10-10 02:29:16 +00:00
readsPrec _ _ = [(Undefined, "")]
2010-10-09 23:22:40 +00:00
instance Show LogLine where
2010-10-31 19:50:07 +00:00
show (LogLine d s u) = unwords [show d, show s, u]
2010-10-09 23:22:40 +00:00
instance Read LogLine where
2010-10-10 02:29:16 +00:00
-- 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 =
2010-10-13 00:04:36 +00:00
if (length w == 3)
then case (pdate) of
Just v -> good v
2010-10-31 19:50:07 +00:00
Nothing -> bad
else bad
2010-10-09 23:22:40 +00:00
where
w = words string
2010-10-31 19:50:07 +00:00
s = read $ w !! 1
u = w !! 2
pdate = (parseTime defaultTimeLocale "%s%Qs" $ w !! 0) :: Maybe UTCTime
2010-10-31 19:50:07 +00:00
good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s u
bad = ret $ LogLine (0) Undefined ""
ret v = [(v, "")]
2010-10-09 23:22:40 +00:00
2010-10-26 20:15:29 +00:00
{- Log a change in the presence of a key's value in a repository,
- and returns the filename of the logfile. -}
logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO (FilePath)
2010-10-31 19:50:07 +00:00
logChange repo key u s = do
line <- logNow s u
2010-10-13 00:04:36 +00:00
ls <- readLog logfile
2010-10-31 19:50:07 +00:00
writeLog logfile (compactLog $ line:ls)
2010-10-26 20:15:29 +00:00
return logfile
2010-10-12 22:25:41 +00:00
where
2010-10-13 00:04:36 +00:00
logfile = logFile repo key
2010-10-12 22:25:41 +00:00
2010-10-10 03:35:05 +00:00
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
2010-10-10 16:41:20 +00:00
readLog :: FilePath -> IO [LogLine]
2010-10-09 23:22:40 +00:00
readLog file = do
2010-10-10 03:35:05 +00:00
exists <- doesFileExist file
if exists
then do
s <- readFile file
2010-10-10 03:35:05 +00:00
-- filter out any unparsable lines
return $ filter (\l -> (status l) /= Undefined )
$ map read $ lines s
else do
return []
2010-10-09 23:22:40 +00:00
2010-10-10 16:31:14 +00:00
{- Writes a set of lines to a log file -}
2010-10-10 16:41:20 +00:00
writeLog :: FilePath -> [LogLine] -> IO ()
2010-10-31 19:50:07 +00:00
writeLog file ls = do
pid <- getProcessID
let tmpfile = file ++ ".tmp" ++ show pid
2010-10-10 16:31:14 +00:00
createDirectoryIfMissing True (parentDir file)
2010-10-31 19:50:07 +00:00
writeFile tmpfile $ unlines $ map show ls
renameFile tmpfile file
2010-10-10 16:31:14 +00:00
2010-10-10 02:46:35 +00:00
{- Generates a new LogLine with the current date. -}
2010-10-12 22:25:41 +00:00
logNow :: LogStatus -> UUID -> IO LogLine
2010-10-31 19:50:07 +00:00
logNow s u = do
now <- getPOSIXTime
2010-10-31 19:50:07 +00:00
return $ LogLine now s u
2010-10-10 02:14:13 +00:00
2010-10-13 00:04:36 +00:00
{- Returns the filename of the log file for a given key. -}
2010-10-14 06:36:41 +00:00
logFile :: Git.Repo -> Key -> String
2010-10-13 00:04:36 +00:00
logFile repo key =
2010-10-14 06:36:41 +00:00
(gitStateDir repo) ++ (Git.relative repo (keyFile key)) ++ ".log"
2010-10-10 02:46:35 +00:00
2010-10-12 22:25:41 +00:00
{- Returns a list of repository UUIDs that, according to the log, have
2010-10-13 00:04:36 +00:00
- the value of a key. -}
2010-10-14 06:36:41 +00:00
keyLocations :: Git.Repo -> Key -> IO [UUID]
2010-10-13 00:04:36 +00:00
keyLocations thisrepo key = do
2010-10-31 19:50:07 +00:00
ls <- readLog $ logFile thisrepo key
return $ map uuid $ filterPresent ls
2010-10-10 02:46:35 +00:00
2010-10-13 00:04:36 +00:00
{- Filters the list of LogLines to find ones where the value
2010-10-10 02:46:35 +00:00
- is (or should still be) present. -}
filterPresent :: [LogLine] -> [LogLine]
2010-10-31 19:50:07 +00:00
filterPresent ls = filter (\l -> ValuePresent == status l) $ compactLog ls
type LogMap = Map.Map UUID LogLine
2010-10-10 16:31:14 +00:00
{- Compacts a set of logs, returning a subset that contains the current
- status. -}
compactLog :: [LogLine] -> [LogLine]
2010-10-31 19:50:07 +00:00
compactLog ls = compactLog' Map.empty ls
compactLog' :: LogMap -> [LogLine] -> [LogLine]
compactLog' m [] = Map.elems m
compactLog' m (l:ls) = compactLog' (mapLog m l) ls
2010-10-10 16:31:14 +00:00
{- 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 -}
2010-10-31 19:50:07 +00:00
mapLog :: LogMap -> LogLine -> LogMap
mapLog m l =
2010-10-10 16:31:14 +00:00
if (better)
2010-10-31 19:50:07 +00:00
then Map.insert u l m
else m
2010-10-10 16:31:14 +00:00
where
2010-10-31 19:50:07 +00:00
better = case Map.lookup u m of
Just l' -> (date l' <= date l)
2010-10-10 16:31:14 +00:00
Nothing -> True
2010-10-31 19:50:07 +00:00
u = uuid l