add a UUIDDesc type containing a ByteString
Groundwork for handling uuid.log using ByteString
This commit is contained in:
parent
b781fbcccf
commit
894716512d
21 changed files with 94 additions and 74 deletions
|
@ -29,5 +29,5 @@ start _ = giveup "Specify a repository and a description."
|
|||
|
||||
perform :: UUID -> String -> CommandPerform
|
||||
perform u description = do
|
||||
describeUUID u description
|
||||
describeUUID u (toUUIDDesc description)
|
||||
next $ return True
|
||||
|
|
|
@ -100,7 +100,9 @@ cleanupSpecialRemote u c = do
|
|||
unknownNameError :: String -> Annex a
|
||||
unknownNameError prefix = do
|
||||
m <- Annex.SpecialRemote.specialRemoteMap
|
||||
descm <- M.unionWith Remote.addName <$> uuidMap <*> pure m
|
||||
descm <- M.unionWith Remote.addName
|
||||
<$> uuidDescMap
|
||||
<*> pure (M.map toUUIDDesc m)
|
||||
specialmsg <- if M.null m
|
||||
then pure "(No special remotes are currently known; perhaps use initremote instead?)"
|
||||
else Remote.prettyPrintUUIDsDescs
|
||||
|
|
|
@ -51,11 +51,11 @@ seek o = do
|
|||
expire <- parseExpire (expireParams o)
|
||||
actlog <- lastActivities (activityOption o)
|
||||
u <- getUUID
|
||||
us <- filter (/= u) . M.keys <$> uuidMap
|
||||
descs <- uuidMap
|
||||
us <- filter (/= u) . M.keys <$> uuidDescMap
|
||||
descs <- uuidDescMap
|
||||
commandActions $ map (start expire (noActOption o) actlog descs) us
|
||||
|
||||
start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandStart
|
||||
start :: Expire -> Bool -> Log Activity -> UUIDDescMap -> UUID -> CommandStart
|
||||
start (Expire expire) noact actlog descs u =
|
||||
case lastact of
|
||||
Just ent | notexpired ent -> checktrust (== DeadTrusted) $ do
|
||||
|
@ -75,7 +75,7 @@ start (Expire expire) noact actlog descs u =
|
|||
d <- liftIO $ durationSince $ posixSecondsToUTCTime c
|
||||
return $ "last active: " ++ fromDuration d ++ " ago"
|
||||
_ -> return "no activity"
|
||||
desc = fromUUID u ++ " " ++ fromMaybe "" (M.lookup u descs)
|
||||
desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
|
||||
notexpired ent = case ent of
|
||||
Unknown -> False
|
||||
VectorClock c -> case lookupexpire of
|
||||
|
|
|
@ -326,7 +326,7 @@ repository_mode = simpleStat "repository mode" $ lift $
|
|||
repo_list :: TrustLevel -> Stat
|
||||
repo_list level = stat n $ nojson $ lift $ do
|
||||
us <- filter (/= NoUUID) . M.keys
|
||||
<$> (M.union <$> uuidMap <*> remoteMap Remote.name)
|
||||
<$> (M.union <$> (M.map fromUUIDDesc <$> uuidDescMap) <*> remoteMap Remote.name)
|
||||
rs <- fst <$> trustPartition level us
|
||||
countRepoList (length rs)
|
||||
-- This also handles json display.
|
||||
|
|
|
@ -59,6 +59,6 @@ perform t name c = do
|
|||
|
||||
cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup
|
||||
cleanup u name c = do
|
||||
describeUUID u name
|
||||
describeUUID u (toUUIDDesc name)
|
||||
Logs.Remote.configSet u c
|
||||
return True
|
||||
|
|
|
@ -61,10 +61,10 @@ getList o
|
|||
let l = (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts
|
||||
return $ filter (\(_, _, t) -> t /= DeadTrusted) l
|
||||
getAllUUIDs = do
|
||||
rs <- M.toList <$> uuidMap
|
||||
rs3 <- forM rs $ \(u, n) -> (,,)
|
||||
rs <- M.toList <$> uuidDescMap
|
||||
rs3 <- forM rs $ \(u, d) -> (,,)
|
||||
<$> pure u
|
||||
<*> pure n
|
||||
<*> pure (fromUUIDDesc d)
|
||||
<*> lookupTrust u
|
||||
return $ sortBy (comparing snd3) $
|
||||
filter (\t -> thd3 t /= DeadTrusted) rs3
|
||||
|
|
|
@ -150,13 +150,13 @@ showLog outputter cs = forM_ cs $ \c -> do
|
|||
sequence_ $ compareChanges (outputter keyname)
|
||||
[(changetime c, new, old)]
|
||||
|
||||
mkOutputter :: M.Map UUID String -> TimeZone -> LogOptions -> FilePath -> Outputter
|
||||
mkOutputter :: UUIDDescMap -> TimeZone -> LogOptions -> FilePath -> Outputter
|
||||
mkOutputter m zone o file
|
||||
| rawDateOption o = normalOutput lookupdescription file show
|
||||
| gourceOption o = gourceOutput lookupdescription file
|
||||
| otherwise = normalOutput lookupdescription file (showTimeStamp zone)
|
||||
where
|
||||
lookupdescription u = fromMaybe (fromUUID u) $ M.lookup u m
|
||||
lookupdescription u = maybe (fromUUID u) (fromUUIDDesc) (M.lookup u m)
|
||||
|
||||
normalOutput :: (UUID -> String) -> FilePath -> (POSIXTime -> String) -> Outputter
|
||||
normalOutput lookupdescription file formattime logchange ts us =
|
||||
|
|
|
@ -43,7 +43,7 @@ start :: CommandStart
|
|||
start = do
|
||||
rs <- combineSame <$> (spider =<< gitRepo)
|
||||
|
||||
umap <- uuidMap
|
||||
umap <- uuidDescMap
|
||||
trustmap <- trustMapLoad
|
||||
|
||||
file <- (</>) <$> fromRepo gitAnnexDir <*> pure "map.dot"
|
||||
|
@ -79,7 +79,7 @@ runViewer file ((c, ps):rest) = ifM (liftIO $ inPath c)
|
|||
- the repositories first, followed by uuids that were not matched
|
||||
- to a repository.
|
||||
-}
|
||||
drawMap :: [RepoRemotes] -> TrustMap -> M.Map UUID String -> String
|
||||
drawMap :: [RepoRemotes] -> TrustMap -> UUIDDescMap -> String
|
||||
drawMap rs trustmap umap = Dot.graph $ repos ++ others
|
||||
where
|
||||
repos = map (node umap (map fst rs) trustmap) rs
|
||||
|
@ -88,7 +88,9 @@ drawMap rs trustmap umap = Dot.graph $ repos ++ others
|
|||
filter (\u -> M.lookup u trustmap /= Just DeadTrusted) $
|
||||
filter (`notElem` ruuids) (M.keys umap)
|
||||
uuidnode u = trustDecorate trustmap u $
|
||||
Dot.graphNode (fromUUID u) $ M.findWithDefault "" u umap
|
||||
Dot.graphNode
|
||||
(fromUUID u)
|
||||
(fromUUIDDesc $ M.findWithDefault mempty u umap)
|
||||
|
||||
hostname :: Git.Repo -> String
|
||||
hostname r
|
||||
|
@ -100,10 +102,10 @@ basehostname r = fromMaybe "" $ headMaybe $ splitc '.' $ hostname r
|
|||
|
||||
{- A name to display for a repo. Uses the name from uuid.log if available,
|
||||
- or the remote name if not. -}
|
||||
repoName :: M.Map UUID String -> Git.Repo -> String
|
||||
repoName :: UUIDDescMap -> Git.Repo -> String
|
||||
repoName umap r
|
||||
| repouuid == NoUUID = fallback
|
||||
| otherwise = M.findWithDefault fallback repouuid umap
|
||||
| otherwise = maybe fallback fromUUIDDesc $ M.lookup repouuid umap
|
||||
where
|
||||
repouuid = getUncachedUUID r
|
||||
fallback = fromMaybe "unknown" $ Git.remoteName r
|
||||
|
@ -116,7 +118,7 @@ nodeId r =
|
|||
u@(UUID _) -> fromUUID u
|
||||
|
||||
{- A node representing a repo. -}
|
||||
node :: M.Map UUID String -> [Git.Repo] -> TrustMap -> RepoRemotes -> String
|
||||
node :: UUIDDescMap -> [Git.Repo] -> TrustMap -> RepoRemotes -> String
|
||||
node umap fullinfo trustmap (r, rs) = unlines $ n:edges
|
||||
where
|
||||
n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $
|
||||
|
@ -125,7 +127,7 @@ node umap fullinfo trustmap (r, rs) = unlines $ n:edges
|
|||
edges = map (edge umap fullinfo r) rs
|
||||
|
||||
{- An edge between two repos. The second repo is a remote of the first. -}
|
||||
edge :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> Git.Repo -> String
|
||||
edge :: UUIDDescMap -> [Git.Repo] -> Git.Repo -> Git.Repo -> String
|
||||
edge umap fullinfo from to =
|
||||
Dot.graphEdge (nodeId from) (nodeId fullto) edgename
|
||||
where
|
||||
|
|
|
@ -296,8 +296,8 @@ commit o = stopUnless shouldcommit $ next $ next $ do
|
|||
commitMsg :: Annex String
|
||||
commitMsg = do
|
||||
u <- getUUID
|
||||
m <- uuidMap
|
||||
return $ "git-annex in " ++ fromMaybe "unknown" (M.lookup u m)
|
||||
m <- uuidDescMap
|
||||
return $ "git-annex in " ++ maybe "unknown" fromUUIDDesc (M.lookup u m)
|
||||
|
||||
commitStaged :: Git.Branch.CommitMode -> String -> Annex Bool
|
||||
commitStaged commitmode commitmessage = do
|
||||
|
|
|
@ -129,7 +129,7 @@ diffCfg curcfg newcfg = Cfg
|
|||
diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
|
||||
(f newcfg) (f curcfg)
|
||||
|
||||
genCfg :: Cfg -> M.Map UUID String -> String
|
||||
genCfg :: Cfg -> UUIDDescMap -> String
|
||||
genCfg cfg descs = unlines $ intercalate [""]
|
||||
[ intro
|
||||
, trust
|
||||
|
@ -223,7 +223,7 @@ genCfg cfg descs = unlines $ intercalate [""]
|
|||
gline g val = [ unwords ["config", g, "=", val] ]
|
||||
|
||||
line setting u val =
|
||||
[ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")"
|
||||
[ com $ "(for " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs)) ++ ")"
|
||||
, unwords [setting, fromUUID u, "=", val]
|
||||
]
|
||||
|
||||
|
@ -235,7 +235,7 @@ genCfg cfg descs = unlines $ intercalate [""]
|
|||
, line' "numcopies" (show . fromNumCopies <$> cfgNumCopies cfg)
|
||||
]
|
||||
|
||||
settings :: Ord v => Cfg -> M.Map UUID String -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String]
|
||||
settings :: Ord v => Cfg -> UUIDDescMap -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String]
|
||||
settings cfg descs = settings' cfg (M.keysSet descs)
|
||||
|
||||
settings' :: (Ord v, Ord f) => Cfg -> S.Set f -> (Cfg -> M.Map f v) -> [String] -> ((v, f) -> [String]) -> (f -> [String]) -> [String]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue