support boolean git configs that are represented by the name of the setting with no value

Eg"core.bare" is the same as "core.bare = true".

Note that git treats "core.bare =" the same as "core.bare = false", so the
code had to become more complicated in order to treat the absense of a
value differently than an empty value. Ugh.

CHANGELOG

@@ -7,6 +7,8 @@ git-annex (8.20200331) UNRELEASED; urgency=medium
   * Various speed improvements gained by using ByteStrings for git refs and
     shas.
   * Fix a potential failure to parse git config.
+  * Support boolean git configs that are represented by the name of the
+    setting with no value, eg "core.bare" is the same as "core.bare = true".
 
  -- Joey Hess <id@joeyh.name>  Mon, 30 Mar 2020 15:58:34 -0400
 

Command/Config.hs

@@ -69,8 +69,9 @@ seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction
 seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $
 	startingCustomOutput (ActionItemOther Nothing) $ do
 		getGlobalConfig ck >>= \case
-			Nothing -> return ()
 			Just (ConfigValue v) -> liftIO $ S8.putStrLn v
+			Just NoConfigValue -> return ()
+			Nothing -> return ()
 		next $ return True
 
 checkIsGlobalConfig :: ConfigKey -> Annex a -> Annex a

Git/Config.hs

@@ -135,6 +135,7 @@ updateLocation' r l = do
 			top <- absPath $ fromRawFilePath (gitdir l)
 			let p = absPathFrom top (fromRawFilePath d)
 			return $ l { worktree = Just (toRawFilePath p) }
+		Just NoConfigValue -> return l
 	return $ r { location = l' }
 
 data ConfigStyle = ConfigList | ConfigNullList
@@ -152,8 +153,12 @@ parse s st
 	eq = fromIntegral (ord '=')
 
 	sep c = M.fromListWith (++)
-		. map (\(k,v) -> (ConfigKey k, [ConfigValue (S.drop 1 v)])) 
+		. map (\(k,v) -> (ConfigKey k, [mkval v])) 
 		. map (S.break (== c))
+	
+	mkval v 
+		| S.null v = NoConfigValue
+		| otherwise = ConfigValue (S.drop 1 v)
 
 {- Checks if a string from git config is a true/false value. -}
 isTrueFalse :: String -> Maybe Bool
@@ -166,6 +171,7 @@ isTrueFalse' (ConfigValue s)
 	| otherwise = Nothing
   where
 	s' = S8.map toLower s
+isTrueFalse' NoConfigValue = Just True
 
 boolConfig :: Bool -> String
 boolConfig True = "true"

Git/ConfigTypes.hs

@@ -23,7 +23,6 @@ data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
 getSharedRepository :: Repo -> SharedRepository
 getSharedRepository r =
 	case Git.Config.getMaybe "core.sharedrepository" r of
-		Nothing -> UnShared
 		Just (ConfigValue v) -> case S8.map toLower v of
 			"1" -> GroupShared
 			"2" -> AllShared
@@ -33,6 +32,8 @@ getSharedRepository r =
 			"world" -> AllShared
 			"everybody" -> AllShared
 			_ -> maybe UnShared UmaskShared (readish (decodeBS' v))
+		Just NoConfigValue -> UnShared
+		Nothing -> UnShared
 
 data DenyCurrentBranch = UpdateInstead | RefusePush | WarnPush | IgnorePush
 	deriving (Eq)
@@ -45,4 +46,5 @@ getDenyCurrentBranch r =
 			"warn" -> WarnPush
 			"ignore" -> IgnorePush
 			_ -> RefusePush
+		Just NoConfigValue -> RefusePush
 		Nothing -> RefusePush

Git/GCrypt.hs

@@ -98,6 +98,7 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
 	defaultkey = "gcrypt.participants"
 	parse (Just (ConfigValue "simple")) = []
 	parse (Just (ConfigValue b)) = words (decodeBS' b)
+	parse (Just NoConfigValue) = []
 	parse Nothing = []
 
 remoteParticipantConfigKey :: RemoteName -> ConfigKey

Git/Types.hs

@@ -1,12 +1,11 @@
 {- git data types
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Git.Types where
 
@@ -18,6 +17,8 @@ import qualified Data.ByteString as S
 import System.Posix.Types
 import Utility.SafeCommand
 import Utility.FileSystemEncoding
+import qualified Data.Semigroup as Sem
+import Prelude
 
 {- Support repositories on local disk, and repositories accessed via an URL.
  -
@@ -54,8 +55,20 @@ data Repo = Repo
 newtype ConfigKey = ConfigKey S.ByteString
 	deriving (Ord, Eq)
 
-newtype ConfigValue = ConfigValue S.ByteString
-	deriving (Ord, Eq, Semigroup, Monoid)
+data ConfigValue
+	= ConfigValue S.ByteString
+	| NoConfigValue
+	-- ^ git treats a setting with no value as different than a setting
+	-- with an empty value
+	deriving (Ord, Eq)
+
+instance Sem.Semigroup ConfigValue where
+	ConfigValue a <> ConfigValue b = ConfigValue (a <> b)
+	a <> NoConfigValue = a
+	NoConfigValue <> b = b
+
+instance Monoid ConfigValue where
+	mempty = ConfigValue mempty
 
 instance Default ConfigValue where
 	def = ConfigValue mempty
@@ -68,6 +81,7 @@ instance Show ConfigKey where
 
 fromConfigValue :: ConfigValue -> String
 fromConfigValue (ConfigValue s) = decodeBS' s
+fromConfigValue NoConfigValue = mempty
 
 instance Show ConfigValue where
 	show = fromConfigValue

Logs/Config.hs

@@ -55,6 +55,7 @@ buildGlobalConfig = buildMapLog configkeybuilder valuebuilder
   where
 	configkeybuilder (ConfigKey k) = byteString k
 	valuebuilder (ConfigValue v) = byteString v
+	valuebuilder NoConfigValue = mempty
 
 parseGlobalConfig :: L.ByteString -> MapLog ConfigKey ConfigValue
 parseGlobalConfig = parseMapLog configkeyparser valueparser

Types/UUID.hs

@@ -58,6 +58,7 @@ instance FromUUID ConfigValue where
 
 instance ToUUID ConfigValue where
 	toUUID (ConfigValue v) = toUUID v
+	toUUID NoConfigValue = NoUUID
 
 -- There is no matching FromUUID U.UUID because a git-annex UUID may
 -- be NoUUID or perhaps contain something not allowed in a canonical UUID.