all commands building except for assistant

also, changed ConfigValue to a newtype, and moved it into Git.Config.
This commit is contained in:
Joey Hess 2019-12-05 14:36:43 -04:00
parent 718fa83da6
commit c20f4704a7
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
40 changed files with 187 additions and 174 deletions

View file

@ -46,7 +46,7 @@ fuzzymatches input showchoice choices = fst $ unzip $
-}
prepare :: String -> (c -> String) -> [c] -> Maybe Repo -> IO ()
prepare input showmatch matches r =
case readish . decodeBS' . Git.Config.get "help.autocorrect" "0" =<< r of
case readish . fromConfigValue . Git.Config.get "help.autocorrect" "0" =<< r of
Just n
| n == 0 -> list
| n < 0 -> warn Nothing

View file

@ -21,16 +21,16 @@ import qualified Git.Command
import qualified Git.Construct
import Utility.UserInfo
{- Returns a single git config setting, or a default value if not set. -}
get :: ConfigKey -> S.ByteString -> Repo -> S.ByteString
get key defaultValue repo = M.findWithDefault defaultValue key (config repo)
{- Returns a single git config setting, or a fallback value if not set. -}
get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue
get key fallback repo = M.findWithDefault fallback key (config repo)
{- Returns a list with each line of a multiline config setting. -}
getList :: ConfigKey -> Repo -> [S.ByteString]
{- Returns a list of values. -}
getList :: ConfigKey -> Repo -> [ConfigValue]
getList key repo = M.findWithDefault [] key (fullconfig repo)
{- Returns a single git config setting, if set. -}
getMaybe :: ConfigKey -> Repo -> Maybe S.ByteString
getMaybe :: ConfigKey -> Repo -> Maybe ConfigValue
getMaybe key repo = M.lookup key (config repo)
{- Runs git config and populates a repo with its config.
@ -100,7 +100,7 @@ store s repo = do
{- Stores a single config setting in a Repo, returning the new version of
- the Repo. Config settings can be updated incrementally. -}
store' :: ConfigKey -> S.ByteString -> Repo -> Repo
store' :: ConfigKey -> ConfigValue -> Repo -> Repo
store' k v repo = repo
{ config = M.singleton k v `M.union` config repo
, fullconfig = M.unionWith (++) (M.singleton k [v]) (fullconfig repo)
@ -128,7 +128,7 @@ updateLocation' :: Repo -> RepoLocation -> IO Repo
updateLocation' r l = do
l' <- case getMaybe "core.worktree" r of
Nothing -> return l
Just d -> do
Just (ConfigValue d) -> do
{- core.worktree is relative to the gitdir -}
top <- absPath $ gitdir l
let p = absPathFrom top (fromRawFilePath d)
@ -137,7 +137,7 @@ updateLocation' r l = do
{- Parses git config --list or git config --null --list output into a
- config map. -}
parse :: S.ByteString -> M.Map ConfigKey [S.ByteString]
parse :: S.ByteString -> M.Map ConfigKey [ConfigValue]
parse s
| S.null s = M.empty
-- --list output will have a '=' in the first line
@ -152,15 +152,15 @@ parse s
firstline = S.takeWhile (/= nl) s
sep c = M.fromListWith (++)
. map (\(k,v) -> (ConfigKey k, [S.drop 1 v]))
. map (\(k,v) -> (ConfigKey k, [ConfigValue (S.drop 1 v)]))
. map (S.break (== c))
{- Checks if a string from git config is a true value. -}
isTrue :: String -> Maybe Bool
isTrue = isTrue' . encodeBS'
isTrue = isTrue' . ConfigValue . encodeBS'
isTrue' :: S.ByteString -> Maybe Bool
isTrue' s
isTrue' :: ConfigValue -> Maybe Bool
isTrue' (ConfigValue s)
| s' == "true" = Just True
| s' == "false" = Just False
| otherwise = Nothing

View file

@ -14,6 +14,7 @@ import qualified Data.ByteString.Char8 as S8
import Common
import Git
import Git.Types
import qualified Git.Config
data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
@ -21,23 +22,27 @@ data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
getSharedRepository :: Repo -> SharedRepository
getSharedRepository r =
case S8.map toLower $ Git.Config.get "core.sharedrepository" "" r of
"1" -> GroupShared
"2" -> AllShared
"group" -> GroupShared
"true" -> GroupShared
"all" -> AllShared
"world" -> AllShared
"everybody" -> AllShared
v -> maybe UnShared UmaskShared (readish (decodeBS' v))
case Git.Config.getMaybe "core.sharedrepository" r of
Nothing -> UnShared
Just (ConfigValue v) -> case S8.map toLower v of
"1" -> GroupShared
"2" -> AllShared
"group" -> GroupShared
"true" -> GroupShared
"all" -> AllShared
"world" -> AllShared
"everybody" -> AllShared
_ -> maybe UnShared UmaskShared (readish (decodeBS' v))
data DenyCurrentBranch = UpdateInstead | RefusePush | WarnPush | IgnorePush
deriving (Eq)
getDenyCurrentBranch :: Repo -> DenyCurrentBranch
getDenyCurrentBranch r =
case S8.map toLower $ Git.Config.get "receive.denycurrentbranch" "" r of
"updateinstead" -> UpdateInstead
"warn" -> WarnPush
"ignore" -> IgnorePush
_ -> RefusePush
getDenyCurrentBranch r =
case Git.Config.getMaybe "receive.denycurrentbranch" r of
Just (ConfigValue v) -> case S8.map toLower v of
"updateinstead" -> UpdateInstead
"warn" -> WarnPush
"ignore" -> IgnorePush
_ -> RefusePush
Nothing -> RefusePush

View file

@ -128,7 +128,7 @@ fromRemotes repo = mapM construct remotepairs
filterconfig f = filter f $ M.toList $ config repo
filterkeys f = filterconfig (\(k,_) -> f k)
remotepairs = filterkeys isRemoteKey
construct (k,v) = remoteNamedFromKey k (fromRemoteLocation (decodeBS' v) repo)
construct (k,v) = remoteNamedFromKey k (fromRemoteLocation (fromConfigValue v) repo)
{- Sets the name of a remote when constructing the Repo to represent it. -}
remoteNamed :: String -> IO Repo -> IO Repo

View file

@ -79,9 +79,9 @@ type GCryptId = String
- which is stored in the repository (in encrypted form)
- and cached in a per-remote gcrypt-id configuration setting. -}
remoteRepoId :: Repo -> Maybe RemoteName -> Maybe GCryptId
remoteRepoId r n = decodeBS' <$> getRemoteConfig "gcrypt-id" r n
remoteRepoId r n = fromConfigValue <$> getRemoteConfig "gcrypt-id" r n
getRemoteConfig :: S.ByteString -> Repo -> Maybe RemoteName -> Maybe S.ByteString
getRemoteConfig :: S.ByteString -> Repo -> Maybe RemoteName -> Maybe ConfigValue
getRemoteConfig field repo remotename = do
n <- remotename
Config.getMaybe (remoteConfigKey field n) repo
@ -96,8 +96,8 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
]
where
defaultkey = "gcrypt.participants"
parse (Just "simple") = []
parse (Just b) = words (decodeBS' b)
parse (Just (ConfigValue "simple")) = []
parse (Just (ConfigValue b)) = words (decodeBS' b)
parse Nothing = []
remoteParticipantConfigKey :: RemoteName -> ConfigKey

View file

@ -84,9 +84,9 @@ parseRemoteLocation s repo = ret $ calcloc s
where
replacement = decodeBS' $ S.drop (S.length prefix) $
S.take (S.length bestkey - S.length suffix) bestkey
(ConfigKey bestkey, bestvalue) = maximumBy longestvalue insteadofs
(ConfigKey bestkey, ConfigValue bestvalue) = maximumBy longestvalue insteadofs
longestvalue (_, a) (_, b) = compare b a
insteadofs = filterconfig $ \(ConfigKey k, v) ->
insteadofs = filterconfig $ \(ConfigKey k, ConfigValue v) ->
prefix `S.isPrefixOf` k &&
suffix `S.isSuffixOf` k &&
v `S.isPrefixOf` encodeBS l

View file

@ -6,11 +6,13 @@
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Git.Types where
import Network.URI
import Data.String
import Data.Default
import qualified Data.Map as M
import qualified Data.ByteString as S
import System.Posix.Types
@ -36,9 +38,9 @@ data RepoLocation
data Repo = Repo
{ location :: RepoLocation
, config :: M.Map ConfigKey S.ByteString
, config :: M.Map ConfigKey ConfigValue
-- a given git config key can actually have multiple values
, fullconfig :: M.Map ConfigKey [S.ByteString]
, fullconfig :: M.Map ConfigKey [ConfigValue]
-- remoteName holds the name used for this repo in some other
-- repo's list of remotes, when this repo is such a remote
, remoteName :: Maybe RemoteName
@ -52,15 +54,30 @@ data Repo = Repo
newtype ConfigKey = ConfigKey S.ByteString
deriving (Ord, Eq)
newtype ConfigValue = ConfigValue S.ByteString
deriving (Ord, Eq, Semigroup, Monoid)
instance Default ConfigValue where
def = ConfigValue mempty
fromConfigKey :: ConfigKey -> String
fromConfigKey (ConfigKey s) = decodeBS' s
instance Show ConfigKey where
show = fromConfigKey
fromConfigValue :: ConfigValue -> String
fromConfigValue (ConfigValue s) = decodeBS' s
instance Show ConfigValue where
show = fromConfigValue
instance IsString ConfigKey where
fromString = ConfigKey . encodeBS'
instance IsString ConfigValue where
fromString = ConfigValue . encodeBS'
type RemoteName = String
{- A git ref. Can be a sha1, or a branch or tag name. -}