mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

bugfixes

Browse source 
getRemoteConfigPassedThrough was never returning anything, Typeable
prevented the type checker from noticing a dumb mistake.

parseRemoteConfig was not adding Accepted values as PassedThrough
This commit is contained in:
Joey Hess 2020-01-17 17:09:56 -04:00
parent 99cb3e75f1
commit 8b9b90c74a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 7 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Annex/SpecialRemote/Config.hs
View file

@ -172,7 +172,7 @@ getRemoteConfigValue f m = case M.lookup f m of
{- Gets all fields that remoteConfigRestPassthrough matched. -} {- Gets all fields that remoteConfigRestPassthrough matched. -}
getRemoteConfigPassedThrough :: ParsedRemoteConfig -> M.Map RemoteConfigField String getRemoteConfigPassedThrough :: ParsedRemoteConfig -> M.Map RemoteConfigField String
getRemoteConfigPassedThrough = M.mapMaybe $ \v -> getRemoteConfigPassedThrough = M.mapMaybe $ \(RemoteConfigValue v) ->
case cast v of case cast v of
Just (PassedThrough s) -> Just s Just (PassedThrough s) -> Just s
Nothing -> Nothing Nothing -> Nothing
@ -181,15 +181,16 @@ newtype PassedThrough = PassedThrough String
parseRemoteConfig :: RemoteConfig -> RemoteConfigParser -> Either String ParsedRemoteConfig parseRemoteConfig :: RemoteConfig -> RemoteConfigParser -> Either String ParsedRemoteConfig
parseRemoteConfig c rpc = parseRemoteConfig c rpc =
go [] (M.filterWithKey notaccepted c) (remoteConfigFieldParsers rpc ++ commonFieldParsers) go [] c (remoteConfigFieldParsers rpc ++ commonFieldParsers)
where where
go l c' [] = go l c' [] =
let (passover, leftovers) = partition let (passover, leftovers) = partition
(remoteConfigRestPassthrough rpc . fst) (remoteConfigRestPassthrough rpc . fst)
(M.toList c') (M.toList c')
in if not (null leftovers) leftovers' = filter (notaccepted . fst) leftovers
in if not (null leftovers')
then Left $ "Unexpected parameters: " ++ then Left $ "Unexpected parameters: " ++
unwords (map (fromProposedAccepted . fst) leftovers) unwords (map (fromProposedAccepted . fst) leftovers')
else Right $ M.fromList $ else Right $ M.fromList $
l ++ map (uncurry passthrough) passover l ++ map (uncurry passthrough) passover
go l c' ((f, p):rest) = do go l c' ((f, p):rest) = do
@ -200,8 +201,8 @@ parseRemoteConfig c rpc =
passthrough f v = (f, RemoteConfigValue (PassedThrough (fromProposedAccepted v))) passthrough f v = (f, RemoteConfigValue (PassedThrough (fromProposedAccepted v)))
notaccepted (Proposed _) _ = True notaccepted (Proposed _) = True
notaccepted (Accepted _) _ = False notaccepted (Accepted _) = False
optionalStringParser :: RemoteConfigField -> RemoteConfigFieldParser optionalStringParser :: RemoteConfigField -> RemoteConfigFieldParser
optionalStringParser f = (f, p) optionalStringParser f = (f, p)