newtype Group to ByteString

This may speed up queries for things in groups, due to Eq and Ord being faster.

Assistant/WebApp/Configurators/Edit.hs

@@ -45,6 +45,7 @@ import Assistant.Ssh
 import Config
 import Config.GitConfig
 import Config.DynamicConfig
+import Types.Group
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -71,7 +72,7 @@ getRepoConfig uuid mremote = do
 	groups <- lookupGroups uuid
 	remoteconfig <- M.lookup uuid <$> readRemoteLog
 	let (repogroup, associateddirectory) = case getStandardGroup groups of
-		Nothing -> (RepoGroupCustom $ unwords $ S.toList groups, Nothing)
+		Nothing -> (RepoGroupCustom $ unwords $ map fromGroup $ S.toList groups, Nothing)
 		Just g -> (RepoGroupStandard g, associatedDirectory remoteconfig g)
 	
 	description <- fmap (T.pack . fromUUIDDesc) . M.lookup uuid <$> uuidDescMap
@@ -127,7 +128,7 @@ setRepoConfig uuid mremote oldc newc = do
 	when groupChanged $ do
 		liftAnnex $ case repoGroup newc of
 			RepoGroupStandard g -> setStandardGroup uuid g
-			RepoGroupCustom s -> groupSet uuid $ S.fromList $ words s
+			RepoGroupCustom s -> groupSet uuid $ S.fromList $ map toGroup $ words s
 		{- Enabling syncing will cause a scan,
 		 - so avoid queueing a duplicate scan. -}
 		when (repoSyncable newc && not syncableChanged) $ liftAssistant $

Command/Group.hs

@@ -26,11 +26,13 @@ start (name:g:[]) = do
 	allowMessages
 	showStart' "group" (Just name)
 	u <- Remote.nameToUUID name
-	next $ setGroup u g
+	next $ setGroup u (toGroup g)
 start (name:[]) = do
 	u <- Remote.nameToUUID name
-	liftIO . putStrLn . unwords . S.toList =<< lookupGroups u
+	liftIO . putStrLn . unwords . map fmt . S.toList =<< lookupGroups u
 	stop
+  where
+	fmt (Group g) = decodeBS g
 start _ = giveup "Specify a repository and a group."
 
 setGroup :: UUID -> Group -> CommandPerform

Command/GroupWanted.hs

@@ -10,6 +10,7 @@ module Command.GroupWanted where
 import Command
 import Logs.PreferredContent
 import Command.Wanted (performGet, performSet)
+import Types.Group
 
 cmd :: Command
 cmd = noMessages $ command "groupwanted" SectionSetup 
@@ -21,9 +22,9 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start (g:[]) = next $ performGet groupPreferredContentMapRaw g
+start (g:[]) = next $ performGet groupPreferredContentMapRaw (toGroup g)
 start (g:expr:[]) = do
 	allowMessages
 	showStart' "groupwanted" (Just g)
-	next $ performSet groupPreferredContentSet expr g
+	next $ performSet groupPreferredContentSet expr (toGroup g)
 start _ = giveup "Specify a group."

Command/Ungroup.hs

@@ -25,7 +25,7 @@ start :: [String] -> CommandStart
 start (name:g:[]) = do
 	showStart' "ungroup" (Just name)
 	u <- Remote.nameToUUID name
-	next $ perform u g
+	next $ perform u (toGroup g)
 start _ = giveup "Specify a repository and a group."
 
 perform :: UUID -> Group -> CommandPerform

Command/Vicfg.hs

@@ -167,10 +167,10 @@ genCfg cfg descs = unlines $ intercalate [""]
 		, com $ "(Standard groups: " ++ grouplist ++ ")"
 		, com "(Separate group names with spaces)"
 		]
-		(\(s, u) -> line "group" u $ unwords $ S.toList s)
+		(\(s, u) -> line "group" u $ unwords $ map fromGroup $ S.toList s)
 		(\u -> lcom $ line "group" u "")
 	  where
-		grouplist = unwords $ map fromStandardGroup [minBound..]
+		grouplist = unwords $ map (fromGroup . fromStandardGroup) [minBound..]
 
 	preferredcontent = settings cfg descs cfgPreferredContentMap
 		[ com "Repository preferred contents"
@@ -191,7 +191,7 @@ genCfg cfg descs = unlines $ intercalate [""]
 		(\(s, g) -> gline g s)
 		(\g -> gline g "")
 	  where
-		gline g val = [ unwords ["groupwanted", g, "=", val] ]
+		gline g val = [ unwords ["groupwanted", fromGroup g, "=", val] ]
 		allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg)
 		stdgroups = S.fromList $ map fromStandardGroup [minBound..maxBound]
 
@@ -204,7 +204,7 @@ genCfg cfg descs = unlines $ intercalate [""]
 	  where
 		gline g = com $ unwords
 			[ "standard"
-			, fromStandardGroup g, "=", standardPreferredContent g
+			, fromGroup (fromStandardGroup g), "=", standardPreferredContent g
 			]
 	
 	schedule = settings cfg descs cfgScheduleMap
@@ -282,7 +282,7 @@ parseCfg defcfg = go [] defcfg . lines
 				let m = M.insert u (Down t) (cfgTrustMap cfg)
 				in Right $ cfg { cfgTrustMap = m }
 		| setting == "group" =
-			let m = M.insert u (S.fromList $ words val) (cfgGroupMap cfg)
+			let m = M.insert u (S.fromList $ map toGroup $ words val) (cfgGroupMap cfg)
 			in Right $ cfg { cfgGroupMap = m }
 		| setting == "wanted" = 
 			case checkPreferredContentExpression val of
@@ -300,7 +300,7 @@ parseCfg defcfg = go [] defcfg . lines
 			case checkPreferredContentExpression val of
 				Just e -> Left e
 				Nothing ->
-					let m = M.insert f val (cfgGroupPreferredContentMap cfg)
+					let m = M.insert (toGroup f) val (cfgGroupPreferredContentMap cfg)
 					in Right $ cfg { cfgGroupPreferredContentMap = m }
 		| setting == "schedule" = case parseScheduledActivities val of
 			Left e -> Left e

Limit.hs

@@ -169,7 +169,7 @@ limitCopies want = case splitc ':' want of
 	-- level, it's parsed as a trust level, not as a group.
 	[v, n] -> case parsetrustspec v of
 		Just checker -> go n $ checktrust checker
-		Nothing -> go n $ checkgroup v
+		Nothing -> go n $ checkgroup (toGroup v)
 	[n] -> go n $ const $ return True
 	_ -> Left "bad value for copies"
   where
@@ -237,7 +237,7 @@ addInAllGroup groupname = addLimit $ limitInAllGroup groupMap groupname
 limitInAllGroup :: Annex GroupMap -> MkLimit Annex
 limitInAllGroup getgroupmap groupname = Right $ \notpresent mi -> do
 	m <- getgroupmap
-	let want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
+	let want = fromMaybe S.empty $ M.lookup (toGroup groupname) $ uuidsByGroup m
 	if S.null want
 		then return True
 		-- optimisation: Check if a wanted uuid is notpresent.

Logs/Group.hs

@@ -16,6 +16,7 @@ module Logs.Group (
 	inUnwantedGroup
 ) where
 
+import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.ByteString.Builder
@@ -38,9 +39,7 @@ groupChange uuid@(UUID _) modifier = do
 	curr <- lookupGroups uuid
 	c <- liftIO currentVectorClock
 	Annex.Branch.change groupLog $
-		buildLog buildGroup .
+		buildLog buildGroup . changeLog c uuid (modifier curr) . parseGroup
-			changeLog c uuid (modifier curr) .
-				parseLog (Just . S.fromList . words) . decodeBL
 	
 	-- The changed group invalidates the preferred content cache.
 	Annex.changeState $ \s -> s
@@ -54,7 +53,10 @@ buildGroup = go . S.toList
   where
 	go [] = mempty
 	go (g:gs) = bld g <> mconcat [ charUtf8 ' ' <> bld g' | g' <- gs ]
-	bld = byteString . encodeBS
+	bld (Group g) = byteString g
+
+parseGroup :: L.ByteString -> Log (S.Set Group)
+parseGroup = parseLog (Just . S.fromList . map toGroup . words) . decodeBL
 
 groupSet :: UUID -> S.Set Group -> Annex ()
 groupSet u g = groupChange u (const g)
@@ -66,9 +68,7 @@ groupMap = maybe groupMapLoad return =<< Annex.getState Annex.groupmap
 {- Loads the map, updating the cache. -}
 groupMapLoad :: Annex GroupMap
 groupMapLoad = do
-	m <- makeGroupMap . simpleMap .
+	m <- makeGroupMap . simpleMap . parseGroup <$> Annex.Branch.get groupLog
-		parseLog (Just . S.fromList . words) . decodeBL <$>
-			Annex.Branch.get groupLog
 	Annex.changeState $ \s -> s { Annex.groupmap = Just m }
 	return m
 

Logs/PreferredContent/Raw.hs

@@ -17,6 +17,7 @@ import Types.StandardGroups
 import Types.Group
 
 import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as L
 import Data.ByteString.Builder
 
 {- Changes the preferred content configuration of a remote. -}
@@ -46,13 +47,16 @@ groupPreferredContentSet g val = do
 	Annex.Branch.change groupPreferredContentLog $
 		buildGroupPreferredContent
 		. changeMapLog c g val 
-		. parseMapLog Just Just . decodeBL
+		. parseGroupPreferredContent
 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
 
+parseGroupPreferredContent :: L.ByteString -> MapLog Group String
+parseGroupPreferredContent = parseMapLog (Just . toGroup) Just . decodeBL
+
 buildGroupPreferredContent :: MapLog Group PreferredContentExpression -> Builder
 buildGroupPreferredContent = buildMapLog buildgroup buildexpr
   where
-	buildgroup = byteString . encodeBS
+	buildgroup (Group g) = byteString g
 	buildexpr = byteString . encodeBS
 
 preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
@@ -64,5 +68,5 @@ requiredContentMapRaw = simpleMap . parseLog Just . decodeBL
 	<$> Annex.Branch.get requiredContentLog
 
 groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression)
-groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just . decodeBL
+groupPreferredContentMapRaw = simpleMap . parseGroupPreferredContent
 	<$> Annex.Branch.get groupPreferredContentLog

Types/Group.hs

@@ -1,22 +1,33 @@
 {- git-annex repo groups
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012, 2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Types.Group (
-	Group,
+	Group(..),
+	fromGroup,
+	toGroup,
 	GroupMap(..),
 	emptyGroupMap
 ) where
 
 import Types.UUID
+import Utility.FileSystemEncoding
 
 import qualified Data.Map as M
 import qualified Data.Set as S
+import qualified Data.ByteString as S
 
-type Group = String
+newtype Group = Group S.ByteString
+	deriving (Eq, Ord)
+
+fromGroup :: Group -> String
+fromGroup (Group g) = decodeBS g
+
+toGroup :: String -> Group
+toGroup = Group . encodeBS
 
 data GroupMap = GroupMap
 	{ groupsByUUID :: M.Map UUID (S.Set Group)

Types/StandardGroups.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Types.StandardGroups where
 
 import Types.Remote (RemoteConfig)
@@ -29,28 +31,28 @@ data StandardGroup
 	deriving (Eq, Ord, Enum, Bounded, Show)
 
 fromStandardGroup :: StandardGroup -> Group
-fromStandardGroup ClientGroup = "client"
+fromStandardGroup ClientGroup = Group "client"
-fromStandardGroup TransferGroup = "transfer"
+fromStandardGroup TransferGroup = Group "transfer"
-fromStandardGroup BackupGroup = "backup"
+fromStandardGroup BackupGroup = Group "backup"
-fromStandardGroup IncrementalBackupGroup = "incrementalbackup"
+fromStandardGroup IncrementalBackupGroup = Group "incrementalbackup"
-fromStandardGroup SmallArchiveGroup = "smallarchive"
+fromStandardGroup SmallArchiveGroup = Group "smallarchive"
-fromStandardGroup FullArchiveGroup = "archive"
+fromStandardGroup FullArchiveGroup = Group "archive"
-fromStandardGroup SourceGroup = "source"
+fromStandardGroup SourceGroup = Group "source"
-fromStandardGroup ManualGroup = "manual"
+fromStandardGroup ManualGroup = Group "manual"
-fromStandardGroup PublicGroup = "public"
+fromStandardGroup PublicGroup = Group "public"
-fromStandardGroup UnwantedGroup = "unwanted"
+fromStandardGroup UnwantedGroup = Group "unwanted"
 
 toStandardGroup :: Group -> Maybe StandardGroup
-toStandardGroup "client" = Just ClientGroup
+toStandardGroup (Group "client") = Just ClientGroup
-toStandardGroup "transfer" = Just TransferGroup
+toStandardGroup (Group "transfer") = Just TransferGroup
-toStandardGroup "backup" = Just BackupGroup
+toStandardGroup (Group "backup") = Just BackupGroup
-toStandardGroup "incrementalbackup" = Just IncrementalBackupGroup
+toStandardGroup (Group "incrementalbackup") = Just IncrementalBackupGroup
-toStandardGroup "smallarchive" = Just SmallArchiveGroup
+toStandardGroup (Group "smallarchive") = Just SmallArchiveGroup
-toStandardGroup "archive" = Just FullArchiveGroup
+toStandardGroup (Group "archive") = Just FullArchiveGroup
-toStandardGroup "source" = Just SourceGroup
+toStandardGroup (Group "source") = Just SourceGroup
-toStandardGroup "manual" = Just ManualGroup
+toStandardGroup (Group "manual") = Just ManualGroup
-toStandardGroup "public" = Just PublicGroup
+toStandardGroup (Group "public") = Just PublicGroup
-toStandardGroup "unwanted" = Just UnwantedGroup
+toStandardGroup (Group "unwanted") = Just UnwantedGroup
 toStandardGroup _ = Nothing
 
 descStandardGroup :: StandardGroup -> String