diff --git a/Annex.hs b/Annex.hs index e1406d2419..0a0368d361 100644 --- a/Annex.hs +++ b/Annex.hs @@ -122,7 +122,7 @@ data AnnexState = AnnexState , globalnumcopies :: Maybe NumCopies , forcenumcopies :: Maybe NumCopies , limit :: ExpandableMatcher Annex - , uuidmap :: Maybe UUIDMap + , uuiddescmap :: Maybe UUIDDescMap , preferredcontentmap :: Maybe (FileMatcherMap Annex) , requiredcontentmap :: Maybe (FileMatcherMap Annex) , forcetrust :: TrustMap @@ -181,7 +181,7 @@ newState c r = do , globalnumcopies = Nothing , forcenumcopies = Nothing , limit = BuildingMatcher [] - , uuidmap = Nothing + , uuiddescmap = Nothing , preferredcontentmap = Nothing , requiredcontentmap = Nothing , forcetrust = M.empty diff --git a/Annex/Difference.hs b/Annex/Difference.hs index 23448192a8..1d9d0c9969 100644 --- a/Annex/Difference.hs +++ b/Annex/Difference.hs @@ -41,7 +41,7 @@ setDifferences = do warning "Cannot change tunable parameters in already initialized repository." return oldds , if otherds == mempty - then ifM (any (/= u) . M.keys <$> uuidMap) + then ifM (any (/= u) . M.keys <$> uuidDescMap) ( do warning "Cannot change tunable parameters in a clone of an existing repository." return mempty diff --git a/Annex/Init.hs b/Annex/Init.hs index 5b2b811de6..1b0d312fac 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -45,6 +45,7 @@ import Annex.InodeSentinal import Upgrade import Annex.Perms import Utility.UserInfo +import Utility.FileSystemEncoding #ifndef mingw32_HOST_OS import Utility.FileMode import System.Posix.User @@ -68,14 +69,14 @@ checkCanInitialize (AutoInit False) a = fromRepo Git.repoWorkTree >>= \case giveup "Not initialized." ) -genDescription :: Maybe String -> Annex String -genDescription (Just d) = return d +genDescription :: Maybe String -> Annex UUIDDesc +genDescription (Just d) = return $ UUIDDesc $ encodeBS d genDescription Nothing = do reldir <- liftIO . relHome =<< liftIO . absPath =<< fromRepo Git.repoPath hostname <- fromMaybe "" <$> liftIO getHostname let at = if null hostname then "" else "@" v <- liftIO myUserName - return $ concat $ case v of + return $ UUIDDesc $ encodeBS $ concat $ case v of Right username -> [username, at, hostname, ":", reldir] Left _ -> [hostname, ":", reldir] diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 43b046bc97..7571f0c9ef 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -106,8 +106,8 @@ setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) = do (c', u) <- R.setup remotetype ss mu mcreds weakc dummycfg configSet u c' when setdesc $ - whenM (isNothing . M.lookup u <$> uuidMap) $ - describeUUID u name + whenM (isNothing . M.lookup u <$> uuidDescMap) $ + describeUUID u (toUUIDDesc name) return name {- Returns the name of the git remote it created. If there's already a diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs index d63faff5e9..8fd9469625 100644 --- a/Assistant/Threads/ConfigMonitor.hs +++ b/Assistant/Threads/ConfigMonitor.hs @@ -57,7 +57,7 @@ type Configs = S.Set (FilePath, Sha) {- All git-annex's config files, and actions to run when they change. -} configFilesActions :: [(FilePath, Assistant ())] configFilesActions = - [ (uuidLog, void $ liftAnnex uuidMapLoad) + [ (uuidLog, void $ liftAnnex uuidDescMapLoad) , (remoteLog, void $ liftAnnex remoteListRefresh) , (trustLog, void $ liftAnnex trustMapLoad) , (groupLog, void $ liftAnnex groupMapLoad) diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index fe30d1b340..b302d1efea 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -66,7 +66,7 @@ getRepoConfig :: UUID -> Maybe Remote -> Annex RepoConfig getRepoConfig uuid mremote = do -- Ensure we're editing current data by discarding caches. void groupMapLoad - void uuidMapLoad + void uuidDescMapLoad groups <- lookupGroups uuid remoteconfig <- M.lookup uuid <$> readRemoteLog @@ -74,7 +74,7 @@ getRepoConfig uuid mremote = do Nothing -> (RepoGroupCustom $ unwords $ S.toList groups, Nothing) Just g -> (RepoGroupStandard g, associatedDirectory remoteconfig g) - description <- fmap T.pack . M.lookup uuid <$> uuidMap + description <- fmap (T.pack . fromUUIDDesc) . M.lookup uuid <$> uuidDescMap syncable <- case mremote of Just r -> liftIO $ getDynamicConfig $ remoteAnnexSync $ Remote.gitconfig r @@ -90,8 +90,8 @@ getRepoConfig uuid mremote = do setRepoConfig :: UUID -> Maybe Remote -> RepoConfig -> RepoConfig -> Handler () setRepoConfig uuid mremote oldc newc = do when descriptionChanged $ liftAnnex $ do - maybe noop (describeUUID uuid . T.unpack) (repoDescription newc) - void uuidMapLoad + maybe noop (describeUUID uuid . toUUIDDesc . T.unpack) (repoDescription newc) + void uuidDescMapLoad when nameChanged $ do liftAnnex $ do name <- uniqueRemoteName (legalName newc) 0 <$> Annex.getGitRemotes diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index b0ea9833f0..bdc576e051 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -289,7 +289,7 @@ getConfirmAddDriveR drive = ifM (liftIO $ probeRepoExists dir) askcombine = page "Combine repositories?" (Just Configuration) $ $(widgetFile "configurators/adddrive/combine") isknownuuid driveuuid = - ifM (M.member driveuuid <$> liftAnnex uuidMap) + ifM (M.member driveuuid <$> liftAnnex uuidDescMap) ( knownrepo , askcombine ) diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 8bf92e550f..87129757ef 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -418,7 +418,7 @@ getLogin sshinput = geti inputUsername ++ "@" ++ geti inputHostname getConfirmSshR :: SshData -> UUID -> Handler Html getConfirmSshR sshdata u | u == NoUUID = handlenew - | otherwise = handleexisting =<< (M.lookup u <$> liftAnnex uuidMap) + | otherwise = handleexisting =<< (M.lookup u <$> liftAnnex uuidDescMap) where handlenew = sshConfigurator $ do cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig diff --git a/Command/Describe.hs b/Command/Describe.hs index eb87db968b..390be84395 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -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 diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index e114707e2f..ab5692e1ad 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -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 diff --git a/Command/Expire.hs b/Command/Expire.hs index 1329171c80..a72c5fef92 100644 --- a/Command/Expire.hs +++ b/Command/Expire.hs @@ -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 diff --git a/Command/Info.hs b/Command/Info.hs index e4b61c4bec..73c6efdbba 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -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. diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index f781416810..0f9ec41357 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -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 diff --git a/Command/List.hs b/Command/List.hs index ef95310450..ba2fc50d93 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -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 diff --git a/Command/Log.hs b/Command/Log.hs index f5d14bd03a..6369fb61df 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -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 = diff --git a/Command/Map.hs b/Command/Map.hs index 6889f44f22..94ef89f35e 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -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 diff --git a/Command/Sync.hs b/Command/Sync.hs index 0ed42b436b..f223afac18 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -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 diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 9889b1c53e..c144b3a482 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -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] diff --git a/Logs/UUID.hs b/Logs/UUID.hs index d3b1e64095..367551ac94 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -1,10 +1,4 @@ -{- git-annex uuids - - - - Each git repository used by git-annex has an annex.uuid setting that - - uniquely identifies that repository. - - - - UUIDs of remotes are cached in git config, using keys named - - remote..annex-uuid +{- git-annex uuid log - - uuid.log stores a list of known uuids, and their descriptions. - @@ -16,8 +10,8 @@ module Logs.UUID ( uuidLog, describeUUID, - uuidMap, - uuidMapLoad + uuidDescMap, + uuidDescMapLoad ) where import Types.UUID @@ -28,15 +22,16 @@ import qualified Annex.Branch import Logs import Logs.UUIDBased import qualified Annex.UUID +import Utility.FileSystemEncoding import qualified Data.Map.Strict as M {- Records a description for a uuid in the log. -} -describeUUID :: UUID -> String -> Annex () +describeUUID :: UUID -> UUIDDesc -> Annex () describeUUID uuid desc = do c <- liftIO currentVectorClock Annex.Branch.change uuidLog $ - showLog id . changeLog c uuid desc . fixBadUUID . parseLog Just + showLog id . changeLog c uuid (fromUUIDDesc desc) . fixBadUUID . parseLog Just {- Temporarily here to fix badly formatted uuid logs generated by - versions 3.20111105 and 3.20111025. @@ -68,19 +63,20 @@ fixBadUUID = M.fromList . map fixup . M.toList isuuid s = length s == 36 && length (splitc '-' s) == 5 {- The map is cached for speed. -} -uuidMap :: Annex UUIDMap -uuidMap = maybe uuidMapLoad return =<< Annex.getState Annex.uuidmap +uuidDescMap :: Annex UUIDDescMap +uuidDescMap = maybe uuidDescMapLoad return =<< Annex.getState Annex.uuiddescmap {- Read the uuidLog into a simple Map. - - The UUID of the current repository is included explicitly, since - - it may not have been described and so otherwise would not appear. -} -uuidMapLoad :: Annex UUIDMap -uuidMapLoad = do - m <- (simpleMap . parseLog Just) <$> Annex.Branch.get uuidLog + - it may not have been described and otherwise would not appear. -} +uuidDescMapLoad :: Annex UUIDDescMap +uuidDescMapLoad = do + m <- (simpleMap . parseLog (Just . UUIDDesc . encodeBS)) + <$> Annex.Branch.get uuidLog u <- Annex.UUID.getUUID - let m' = M.insertWith preferold u "" m - Annex.changeState $ \s -> s { Annex.uuidmap = Just m' } + let m' = M.insertWith preferold u mempty m + Annex.changeState $ \s -> s { Annex.uuiddescmap = Just m' } return m' where preferold = flip const diff --git a/Remote.hs b/Remote.hs index e992da84bc..49f000c6b8 100644 --- a/Remote.hs +++ b/Remote.hs @@ -1,10 +1,12 @@ {- git-annex remotes - - - Copyright 2011-2018 Joey Hess + - Copyright 2011-2019 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Remote ( Remote, uuid, @@ -57,6 +59,7 @@ module Remote ( ) where import Data.Ord +import Data.String import qualified Data.Map as M import qualified Data.Vector as V @@ -73,6 +76,7 @@ import Config import Config.DynamicConfig import Git.Types (RemoteName) import Utility.Aeson +import Utility.FileSystemEncoding {- Map from UUIDs of Remotes to a calculated value. -} remoteMap :: (Remote -> v) -> Annex (M.Map UUID v) @@ -92,13 +96,16 @@ remoteMap' mkv mkk = M.fromList . catMaybes <$> (mapM mk =<< remoteList) {- Map of UUIDs of repositories and their descriptions. - The names of Remotes are added to suppliment any description that has - been set for a repository. -} -uuidDescriptions :: Annex (M.Map UUID String) -uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap name +uuidDescriptions :: Annex UUIDDescMap +uuidDescriptions = M.unionWith addName + <$> uuidDescMap + <*> remoteMap (UUIDDesc . encodeBS . name) -addName :: String -> RemoteName -> String +{- Add a remote name to its description. -} +addName :: (IsString t, Monoid t, Eq t) => t -> t -> t addName desc n - | desc == n || null desc = "[" ++ n ++ "]" - | otherwise = desc ++ " [" ++ n ++ "]" + | desc == n || desc == mempty = "[" <> n <> "]" + | otherwise = desc <> " [" <> n <> "]" byUUID :: UUID -> Annex (Maybe Remote) byUUID u = headMaybe . filter matching <$> remoteList @@ -170,8 +177,9 @@ nameToUUID' n = byName' n >>= go NoUUID -> Left $ noRemoteUUIDMsg r u -> Right u go (Left e) = do - m <- uuidMap - return $ case M.keys (M.filter (== n) m) of + m <- uuidDescMap + let descn = UUIDDesc (encodeBS n) + return $ case M.keys (M.filter (== descn) m) of [u] -> Right u [] -> let u = toUUID n in case M.keys (M.filterWithKey (\k _ -> k == u) m) of @@ -189,7 +197,7 @@ prettyPrintUUIDs header uuids = do descm <- uuidDescriptions prettyPrintUUIDsDescs header descm uuids -prettyPrintUUIDsDescs :: String -> M.Map UUID RemoteName -> [UUID] -> Annex String +prettyPrintUUIDsDescs :: String -> UUIDDescMap -> [UUID] -> Annex String prettyPrintUUIDsDescs header descm uuids = prettyPrintUUIDsWith Nothing header descm (const Nothing) @@ -200,7 +208,7 @@ prettyPrintUUIDsWith :: ToJSON' v => Maybe String -> String - -> M.Map UUID RemoteName + -> UUIDDescMap -> (v -> Maybe String) -> [(UUID, Maybe v)] -> Annex String @@ -209,7 +217,7 @@ prettyPrintUUIDsWith optfield header descm showval uuidvals = do maybeShowJSON $ JSONChunk [(header, V.fromList $ map (jsonify hereu) uuidvals)] return $ unwords $ map (\u -> "\t" ++ prettify hereu u ++ "\n") uuidvals where - finddescription u = M.findWithDefault "" u descm + finddescription u = fromUUIDDesc $ M.findWithDefault mempty u descm prettify hereu (u, optval) | not (null d) = addoptval $ fromUUID u ++ " -- " ++ d | otherwise = addoptval $ fromUUID u @@ -237,9 +245,9 @@ prettyListUUIDs :: [UUID] -> Annex [String] prettyListUUIDs uuids = do hereu <- getUUID m <- uuidDescriptions - return $ map (prettify m hereu) uuids + return $ map (fromUUIDDesc . prettify m hereu) uuids where - finddescription m u = M.findWithDefault "" u m + finddescription m u = M.findWithDefault mempty u m prettify m hereu u | u == hereu = addName n "here" | otherwise = n diff --git a/Types/UUID.hs b/Types/UUID.hs index 5efc26dd0b..443cbb1e57 100644 --- a/Types/UUID.hs +++ b/Types/UUID.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-} module Types.UUID where @@ -13,6 +13,7 @@ import qualified Data.ByteString as B import qualified Data.Map as M import qualified Data.UUID as U import Data.Maybe +import Data.String import Utility.FileSystemEncoding import qualified Utility.SimpleProtocol as Proto @@ -56,7 +57,17 @@ instance ToUUID U.UUID where isUUID :: String -> Bool isUUID = isJust . U.fromString -type UUIDMap = M.Map UUID String +-- A description of a UUID. +newtype UUIDDesc = UUIDDesc B.ByteString + deriving (Eq, Monoid, Semigroup, IsString) + +fromUUIDDesc :: UUIDDesc -> String +fromUUIDDesc (UUIDDesc d) = decodeBS d + +toUUIDDesc :: String -> UUIDDesc +toUUIDDesc = UUIDDesc . encodeBS + +type UUIDDescMap = M.Map UUID UUIDDesc instance Proto.Serializable UUID where serialize = fromUUID