add web special remote

Generalized LocationLog to PresenceLog, and use a presence log to record
urls for the web special remote.
This commit is contained in:
Joey Hess 2011-07-01 15:24:07 -04:00
parent ceb887d826
commit cdbcd6f495
17 changed files with 272 additions and 139 deletions

View file

@ -5,11 +5,6 @@
-
- Repositories record their UUID and the date when they --get or --drop
- a value.
-
- A line of the log will look like: "date N UUID"
- Where N=1 when the repo has the file, and 0 otherwise.
- (After the UUID can optionally come a white space and other data,
- for future expansion.)
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
@ -25,61 +20,16 @@ module LocationLog (
loggedKeys
) where
import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import System.FilePath
import qualified Data.Map as Map
import Control.Monad (when)
import Data.Maybe
import Control.Monad.State (liftIO)
import qualified Git
import qualified Branch
import UUID
import Types
import Locations
data LogLine = LogLine {
date :: POSIXTime,
status :: LogStatus,
uuid :: UUID
} deriving (Eq)
data LogStatus = ValuePresent | ValueMissing | Undefined
deriving (Eq)
instance Show LogStatus where
show ValuePresent = "1"
show ValueMissing = "0"
show Undefined = "undefined"
instance Read LogStatus where
readsPrec _ "1" = [(ValuePresent, "")]
readsPrec _ "0" = [(ValueMissing, "")]
readsPrec _ _ = [(Undefined, "")]
instance Show LogLine where
show (LogLine d s u) = unwords [show d, show s, u]
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 maybe bad good pdate
else bad
where
w = words string
s = read $ w !! 1
u = w !! 2
pdate :: Maybe UTCTime
pdate = parseTime defaultTimeLocale "%s%Qs" $ head w
good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s u
bad = ret $ LogLine 0 Undefined ""
ret v = [(v, "")]
import PresenceLog
{- Log a change in the presence of a key's value in a repository. -}
logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex ()
@ -92,59 +42,10 @@ logChange repo key u s = do
ls <- readLog f
writeLog f (compactLog $ line:ls)
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
readLog :: FilePath -> Annex [LogLine]
readLog file = return . parseLog =<< Branch.get file
parseLog :: String -> [LogLine]
parseLog s = filter parsable $ map read $ lines s
where
-- some lines may be unparseable, avoid them
parsable l = status l /= Undefined
{- Stores a set of lines in a log file -}
writeLog :: FilePath -> [LogLine] -> Annex ()
writeLog file ls = Branch.change file (unlines $ map show ls)
{- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> UUID -> Annex LogLine
logNow s u = do
now <- liftIO $ getPOSIXTime
return $ LogLine now s u
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. -}
keyLocations :: Key -> Annex [UUID]
keyLocations key = do
ls <- readLog $ logFile key
return $ map uuid $ filterPresent ls
{- Filters the list of LogLines to find ones where the value
- is (or should still be) present. -}
filterPresent :: [LogLine] -> [LogLine]
filterPresent ls = filter (\l -> ValuePresent == status l) $ compactLog ls
type LogMap = Map.Map UUID LogLine
{- Compacts a set of logs, returning a subset that contains the current
- status. -}
compactLog :: [LogLine] -> [LogLine]
compactLog ls = compactLog' Map.empty ls
compactLog' :: LogMap -> [LogLine] -> [LogLine]
compactLog' m [] = Map.elems m
compactLog' m (l:ls) = compactLog' (mapLog m 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 :: LogMap -> LogLine -> LogMap
mapLog m l =
if better
then Map.insert u l m
else m
where
better = maybe True (\l' -> date l' <= date l) $ Map.lookup u m
u = uuid l
keyLocations key = currentLog $ logFile key
{- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -}