all commands building except for assistant
also, changed ConfigValue to a newtype, and moved it into Git.Config.
This commit is contained in:
parent
718fa83da6
commit
c20f4704a7
40 changed files with 187 additions and 174 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
21
Git/Types.hs
21
Git/Types.hs
|
@ -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. -}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue