wip

hbs2-git3/app/GitRemoteHelper.hs

@@ -141,12 +141,17 @@ 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_ False = none
+    setupTrace_ _ = do
+      --
+      none
 
       origStderr <- liftIO $ dup stdError
       (readEnd, writeEnd) <- liftIO createPipe
@@ -162,8 +167,6 @@ main =  flip runContT pure do
       lift $ void $ installHandler sigPIPE Ignore Nothing
 
       ready_ <- newEmptyTMVarIO
-  cp_ <- newTVarIO Nothing
-  refz <- newTVarIO mempty
 
       -- doesPathExist
 
@@ -226,7 +229,18 @@ 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
+  hSetBuffering stdin  LineBuffering
+  hSetBuffering stdout LineBuffering
+
+  cp <- newTVarIO Nothing
+  refz <- newTVarIO mempty
+
+  setupTrace cp refz
 
   setupLogger