From 304f4c34068e774c852685cc38f77d6a0d645a85 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Wed, 17 Jun 2020 17:33:53 +0100
Subject: [PATCH] Tidy up wrapper logging

---
 exe/Main.hs    |  1 +
 exe/Wrapper.hs | 78 ++++++++++++++++----------------------------------
 2 files changed, 26 insertions(+), 53 deletions(-)

diff --git a/exe/Main.hs b/exe/Main.hs
index 1bca8cb6a2..b88b0d1d60 100644
--- a/exe/Main.hs
+++ b/exe/Main.hs
@@ -184,6 +184,7 @@ main = do
         hPutStrLn stderr "Starting (haskell-language-server)LSP server..."
         hPutStrLn stderr $ "  with arguments: " <> show args
         hPutStrLn stderr $ "  with plugins: " <> show (Map.keys $ ipMap idePlugins')
+        hPutStrLn stderr $ "  in directory: " <> dir
         hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
         runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps -> do
             t <- t
diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs
index 3dad06ea95..91be5666b1 100644
--- a/exe/Wrapper.hs
+++ b/exe/Wrapper.hs
@@ -1,32 +1,22 @@
-{-# LANGUAGE CPP             #-}
 {-# LANGUAGE RecordWildCards #-}
 -- | This module is based on the hie-wrapper.sh script in
 -- https://github.com/alanz/vscode-hie-server
 module Main where
 
-#if __GLASGOW_HASKELL__ < 804
-import           Data.Semigroup
-#endif
-
 import Arguments
--- import Control.Concurrent.Extra
 import Control.Monad.Extra
-import           Data.Foldable
-import           Data.List
--- import Data.List.Extra
--- import qualified Data.Text as T
--- import qualified Data.Text.IO as T
--- import Development.IDE.Types.Logger
+import Data.Foldable
+import Data.List
 import HIE.Bios
-import           Ide.Cradle (findLocalCradle)
-import           Ide.Logger (logm)
-import           Ide.Version
-import           System.Directory
-import           System.Environment
+import HIE.Bios.Types
+import Ide.Cradle (findLocalCradle)
+import Ide.Version
+import System.Directory
+import System.Environment
 import System.Exit
 import System.IO
-import           System.Info
-import           System.Process
+import System.Info
+import System.Process
 
 -- ---------------------------------------------------------------------
 
@@ -40,40 +30,25 @@ main = do
 
   -- Get the cabal directory from the cradle
   cradle <- findLocalCradle d
-  let dir = cradleRootDir cradle
-  setCurrentDirectory dir
-
-  ghcVersion <- getProjectGhcVersion cradle
-
-  when argsProjectGhcVersion $ putStrLn ghcVersion >> exitSuccess
-
-  if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
-  else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
+  setCurrentDirectory $ cradleRootDir cradle
 
-  -- lock to avoid overlapping output on stdout
-  -- lock <- newLock
-  -- let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $
-  --         T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg
+  when argsProjectGhcVersion $ getProjectGhcVersion cradle >>= putStrLn >> exitSuccess
+  when argsVersion $ ghcideVersion >>= putStrLn >> exitSuccess
 
   whenJust argsCwd setCurrentDirectory
 
-  -- let mLogFileName = optLogFile opts
-
-  --     logLevel = if optDebugOn opts
-  --                  then L.DEBUG
-  --                  else L.INFO
-
-  -- Core.setupLogger mLogFileName ["hie"] logLevel
-
   progName <- getProgName
-  logm $  "run entered for haskell-language-server-wrapper(" ++ progName ++ ") "
-            ++ hlsVersion
-  logm $ "Current directory:" ++ d
-  logm $ "Operating system:" ++ os
+  hPutStrLn stderr $ "Run entered for haskell-language-server-wrapper(" ++ progName ++ ") "
+                     ++ hlsVersion
+  hPutStrLn stderr $ "Current directory: " ++ d
+  hPutStrLn stderr $ "Operating system: " ++ os
   args <- getArgs
-  logm $ "args:" ++ show args
-  logm $ "Cradle directory:" ++ dir
-  logm $ "Project GHC version:" ++ ghcVersion
+  hPutStrLn stderr $ "Arguments: " ++ show args
+  hPutStrLn stderr $ "Cradle directory: " ++ cradleRootDir cradle
+  hPutStrLn stderr $ "Cradle type: " ++ show (actionName (cradleOptsProg cradle))
+  hPutStrLn stderr $ "Consulting the cradle to get project GHC version..."
+  ghcVersion <- getProjectGhcVersion cradle
+  hPutStrLn stderr $ "Project GHC version: " ++ ghcVersion
 
   let
     hlsBin = "haskell-language-server-" ++ ghcVersion
@@ -84,17 +59,14 @@ main = do
     candidates' = [hlsBin, backupHlsBin, "haskell-language-server"]
     candidates = map (++ exeExtension) candidates'
 
-  logm $ "haskell-language-server exe candidates :" ++ show candidates
+  hPutStrLn stderr $ "haskell-language-server exe candidates: " ++ show candidates
 
   mexes <- traverse findExecutable candidates
 
   case asum mexes of
-    Nothing -> logm $ "cannot find any haskell-language-server exe, looked for:" ++ intercalate ", " candidates
+    Nothing -> hPutStrLn stderr $ "Cannot find any haskell-language-server exe, looked for: " ++ intercalate ", " candidates
     Just e -> do
-      logm $ "found haskell-language-server exe at:" ++ e
-      logm $ "args:" ++ show args
-      logm "launching ....\n\n\n"
+      hPutStrLn stderr $ "Launching haskell-language-server exe at:" ++ e
       callProcess e args
-      logm "done"
 
 -- ---------------------------------------------------------------------