add a UUIDDesc type containing a ByteString

Groundwork for handling uuid.log using ByteString

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

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

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]
 

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

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)

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

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
 			)

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

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

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

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

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.

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

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

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 =

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

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

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]

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

Remote.hs

@@ -1,10 +1,12 @@
 {- git-annex remotes
  -
- - Copyright 2011-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  -
  - 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

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