From 13aca91231c07a63f9baeb2e8b5081ad6b27f993 Mon Sep 17 00:00:00 2001
From: Chris Smith <cdsmith@gmail.com>
Date: Sat, 11 Sep 2021 19:33:27 -0400
Subject: [PATCH] Add a warning when the installed HLS and GHC versions are not
 compatible.

This is triggered when:

1. The user has just set either the GHC or HLS version.
2. There is an HLS version set (so some GHC version is compatible).
3. There is a GHC version.
4. The HLS version doesn't support that GHC version.

Fixes #234
---
 lib/GHCup.hs | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/lib/GHCup.hs b/lib/GHCup.hs
index 3a6f315..1ecb395 100644
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@@ -868,6 +868,10 @@ setGHC ver sghc = do
   -- create symlink for share dir
   when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
 
+  case sghc of
+    SetGHCOnly -> lift $ warnAboutHlsCompatibility
+    _          -> return ()
+
   pure ver
 
  where
@@ -978,6 +982,8 @@ setHLS ver = do
 
   lift $ createLink destL wrapper
 
+  lift $ warnAboutHlsCompatibility
+
   pure ()
 
 
@@ -1010,6 +1016,29 @@ setStack ver = do
   pure ()
 
 
+-- | Warn if there's an installed HLS that's not compatible with the installed
+-- GHC version.
+warnAboutHlsCompatibility :: ( MonadReader env m
+                             , HasDirs env
+                             , HasLog env
+                             , MonadThrow m
+                             , MonadCatch m
+                             , MonadIO m
+                             )
+                          => m ()
+warnAboutHlsCompatibility = do
+  supportedGHC <- hlsGHCVersions
+  currentGHC   <- fmap _tvVersion <$> ghcSet Nothing
+
+  case currentGHC of
+    Just v | not (null supportedGHC) && v `notElem` supportedGHC -> do
+      logWarn $ "The current GHC version is not compatible with the "
+        <> "current version of Haskell Language Server."
+      logWarn $ "Haskell IDE support may not work correctly until this is "
+        <> "fixed."
+      logWarn $ "Install a different HLS version, or run `ghcup list` to see "
+        <> "supported GHC versions."
+    _ -> return ()
 
     ------------------
     --[ List tools ]--