add a UUIDDesc type containing a ByteString

Groundwork for handling uuid.log using ByteString
This commit is contained in:
Joey Hess 2019-01-01 15:39:45 -04:00
parent b781fbcccf
commit 894716512d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
21 changed files with 94 additions and 74 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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.

View file

@ -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

View file

@ -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

View file

@ -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 =

View file

@ -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

View file

@ -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

View file

@ -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]