ported almost all remotes, until my brain melted

external is not started yet, and S3 is part way through and not
compiling yet
This commit is contained in:
Joey Hess 2020-01-14 15:41:34 -04:00
parent c498269a88
commit c4ea3ca40a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
13 changed files with 265 additions and 150 deletions

View file

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