fixed git push --force

This commit is contained in:
Dmitry Zuykov 2025-05-17 13:19:30 +03:00
parent 5d546075aa
commit afa1350cd0
1 changed files with 8 additions and 2 deletions

View File

@ -130,7 +130,7 @@ localDict DeferredOps{..} = makeDict @C do
splitPushArgs :: forall m . MonadIO m => (Maybe GitRef -> GitRef -> m ()) -> [Syntax C] -> m () splitPushArgs :: forall m . MonadIO m => (Maybe GitRef -> GitRef -> m ()) -> [Syntax C] -> m ()
splitPushArgs action = \case splitPushArgs action = \case
[ StringLike params ] -> do [ StringLike params ] -> do
case Text.splitOn ":" (fromString params) of case Text.splitOn ":" (Text.dropWhile (=='+') (fromString params)) of
[ b ] -> action Nothing (fromString (Text.unpack b)) [ b ] -> action Nothing (fromString (Text.unpack b))
[ a, b ] -> action (Just (fromString (Text.unpack a))) (fromString (Text.unpack b)) [ a, b ] -> action (Just (fromString (Text.unpack a))) (fromString (Text.unpack b))
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -236,6 +236,10 @@ setupTrace cp_ refz = do
{- HLINT ignore "Functor law" -} {- HLINT ignore "Functor law" -}
main :: IO () main :: IO ()
main = flip runContT pure do main = flip runContT pure do
ContT $ bracket none $ const do
flushLoggers
hSetBuffering stdin LineBuffering hSetBuffering stdin LineBuffering
hSetBuffering stdout LineBuffering hSetBuffering stdout LineBuffering
@ -263,7 +267,9 @@ main = flip runContT pure do
cli <- parseCLI cli <- parseCLI
debug $ "CLI:" <+> pretty cli liftIO $ IO.hPrint stderr $ pretty cli
-- debug $ "CLI:" <+> pretty cli
url <- case cli of url <- case cli of
[ ListVal [_, RepoURL x ] ] -> do [ ListVal [_, RepoURL x ] ] -> do