From 3a38253a1fcd83c83b05fbfbf132d1ead842b0a7 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Sun, 15 Dec 2019 19:40:17 +0000
Subject: [PATCH] Add ability to override some config via env vars

---
 src/Language/Haskell/LSP/Test.hs         | 14 +++++++++++++-
 src/Language/Haskell/LSP/Test/Session.hs |  8 ++++++--
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 1a3b2e2..03e2a1a 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -110,6 +110,7 @@ import Language.Haskell.LSP.Test.Exceptions
 import Language.Haskell.LSP.Test.Parsing
 import Language.Haskell.LSP.Test.Session
 import Language.Haskell.LSP.Test.Server
+import System.Environment
 import System.IO
 import System.Directory
 import System.FilePath
@@ -137,10 +138,12 @@ runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
-runSessionWithConfig config serverExe caps rootDir session = do
+runSessionWithConfig config' serverExe caps rootDir session = do
   pid <- getCurrentProcessID
   absRootDir <- canonicalizePath rootDir
 
+  config <- envOverrideConfig config'
+
   let initializeParams = InitializeParams (Just pid)
                                           (Just $ T.pack absRootDir)
                                           (Just $ filePathToUri absRootDir)
@@ -185,6 +188,15 @@ runSessionWithConfig config serverExe caps rootDir session = do
       (RspShutdown _) -> return ()
       _               -> listenServer serverOut context
 
+  -- | Check environment variables to override the config
+  envOverrideConfig :: SessionConfig -> IO SessionConfig
+  envOverrideConfig cfg = do
+    logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
+    logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
+    return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
+    where checkEnv :: String -> IO (Maybe Bool)
+          checkEnv s = fmap (const True) <$> lookupEnv s
+
 -- | The current text contents of a document.
 documentContents :: TextDocumentIdentifier -> Session T.Text
 documentContents doc = do
diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 3426bcc..21c0086 100644
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -91,8 +91,12 @@ instance MonadFail Session where
 -- | Stuff you can configure for a 'Session'.
 data SessionConfig = SessionConfig
   { messageTimeout :: Int  -- ^ Maximum time to wait for a message in seconds, defaults to 60.
-  , logStdErr      :: Bool -- ^ Redirect the server's stderr to this stdout, defaults to False.
-  , logMessages    :: Bool -- ^ Trace the messages sent and received to stdout, defaults to False.
+  , logStdErr      :: Bool
+  -- ^ Redirect the server's stderr to this stdout, defaults to False.
+  -- Can be overriden with @LSP_TEST_LOG_STDERR@.
+  , logMessages    :: Bool
+  -- ^ Trace the messages sent and received to stdout, defaults to False.
+  -- Can be overriden with the environment variable @LSP_TEST_LOG_MESSAGES@.
   , logColor       :: Bool -- ^ Add ANSI color to the logged messages, defaults to True.
   , lspConfig      :: Maybe Value -- ^ The initial LSP config as JSON value, defaults to Nothing.
   -- ^ Whether or not to ignore 'ShowMessageNotification' and 'LogMessageNotification', defaults to False.
-- 
2.30.2