git push --force fix and HBS2TRACE env. supported for debug

hbs2-git3/app/GitRemoteHelper.hs

@@ -130,7 +130,7 @@ localDict DeferredOps{..} = makeDict @C do
     splitPushArgs :: forall m . MonadIO m => (Maybe GitRef -> GitRef -> m ()) -> [Syntax C] -> m ()
     splitPushArgs action = \case
       [ StringLike params ] -> do
-        case Text.splitOn ":" (fromString params) of
+        case Text.splitOn ":" (Text.dropWhile (=='+') (fromString params)) of
           [ b ] -> action Nothing (fromString (Text.unpack b))
           [ a, b ] -> action (Just (fromString (Text.unpack a))) (fromString (Text.unpack b))
           _  -> throwIO (BadFormException @C nil)
@@ -141,12 +141,19 @@ runTop :: (ParseSExp what, MonadUnliftIO m) => Dict C m -> what -> m ()
 runTop dict s = parseTop s & either (const none) (void . run dict)
 
 
-{- HLINT ignore "Functor law" -}
+-- setupTrace :: ContT r IO ()
-main :: IO ()
+setupTrace :: Foldable t => TVar (Maybe (Text, Integer)) -> TVar (t a) -> ContT r IO ()
-main =  flip runContT pure do
+setupTrace cp_ refz = do
-  hSetBuffering stdin  LineBuffering
+  traceMode <- isJust <$> liftIO (lookupEnv "HBS2TRACE")
-  hSetBuffering stdout LineBuffering
+  setupTrace_ traceMode
 
+  where
+    setupTrace_ True = do
+     setLogging @DEBUG debugPrefix
+
+    setupTrace_ _ = do
+      --
+      none
 
       origStderr <- liftIO $ dup stdError
       (readEnd, writeEnd) <- liftIO createPipe
@@ -162,8 +169,6 @@ main =  flip runContT pure do
       lift $ void $ installHandler sigPIPE Ignore Nothing
 
       ready_ <- newEmptyTMVarIO
-  cp_ <- newTVarIO Nothing
-  refz <- newTVarIO mempty
 
       -- doesPathExist
 
@@ -226,10 +231,25 @@ main =  flip runContT pure do
 
         hFlush origHandle
 
-  atomically $ takeTMVar ready_
+      void $ atomically $ takeTMVar ready_
+
+{- HLINT ignore "Functor law" -}
+main :: IO ()
+main =  flip runContT pure do
+
+  ContT $ bracket none $ const do
+    flushLoggers
+
+  hSetBuffering stdin  LineBuffering
+  hSetBuffering stdout LineBuffering
+
+  cp <- newTVarIO Nothing
+  refz <- newTVarIO mempty
 
   setupLogger
 
+  setupTrace cp refz
+
   setStatusOn
 
   env <- nullGit3Env
@@ -247,6 +267,8 @@ main =  flip runContT pure do
 
     cli <- parseCLI
 
+    -- debug $ "CLI:" <+> pretty cli
+
     url <- case cli of
       [ ListVal [_, RepoURL x ] ] -> do
         notice $ "git remote ref set:" <+> green (pretty (AsBase58 x)) <> line