Warn if TH and Mac and static binary

Author: pepeiborra

docs/troubleshooting.md

@@ -36,15 +36,15 @@ An usual symptom is the presence of errors containing `unknown symbol` and it is
 
 The workaround is to use a version of haskell-language-server compiled from source with the ghc option `-dynamic` enabled. See more details [here](https://github.com/haskell/haskell-language-server/issues/1160#issuecomment-756566273).
 
-### Problems with Template Haskell
+### Support for Template Haskell
 
-Due to how Template Haskell code is evaluated at compile time and some limitations in the interaction between HLS and GHC, the loading of modules using TH can be problematic.
+Template Haskell should work fine in Linux with the distributed binaries
 
-The errors thrown are usually related to linking and usually make HLS crash: `Segmentation fault`, `GHC runtime linker: fatal error`, etc
+Usage of Template Haskell in Mac Os requires a dynamically linked binary of HLS or risk encountering linker errors and/or segmentation faults.
 
-A workaround which has helped in some cases is to compile HLS from source with the ghc option `-dynamic` enabled, as in the previous issue.
+The best and currently only way to obtain a dynamically linked HLS binary is to build it locally. With cabal install this can be done as follows:
 
-We have a [dedicated label](https://github.com/haskell/haskell-language-server/issues?q=is%3Aissue+is%3Aopen+label%3A%22type%3A+template+haskell+related%22) in the issue tracker and an [general issue](https://github.com/haskell/haskell-language-server/issues/1431) tracking support for TH.
+    cabal install haskell-language-server --enable-executable-dynamic
 
 ## Troubleshooting the server
 

ghcide/src/Development/IDE/Core/Rules.hs

@@ -136,7 +136,7 @@ import qualified GHC.LanguageExtensions                       as LangExt
 import qualified HieDb
 import           Ide.Plugin.Config
 import qualified Language.LSP.Server                          as LSP
-import           Language.LSP.Types                           (SMethod (SCustomMethod))
+import           Language.LSP.Types                           (SMethod (SCustomMethod, SWindowShowMessage), ShowMessageParams (ShowMessageParams), MessageType (MtInfo))
 import           Language.LSP.VFS
 import           System.Directory                             (makeAbsolute)
 import           Data.Default                                 (def, Default)
@@ -149,6 +149,14 @@ import           Ide.PluginUtils                              (configForPlugin)
 import           Ide.Types                                    (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser),
                                                                PluginId)
 import Control.Concurrent.STM.Stats (atomically)
+import Language.LSP.Server (LspT)
+import System.Environment (getExecutablePath)
+import System.Process.Extra (readProcessWithExitCode)
+import Text.Read (readMaybe)
+import System.Info.Extra (isMac)
+
+templateHaskellInstructions :: T.Text
+templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#support-for-template-haskell"
 
 -- | This is useful for rules to convert rules that can only produce errors or
 -- a result into the more general IdeResult type that supports producing
@@ -820,8 +828,34 @@ isHiFileStableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsHiFileStable f -
       summarize SourceUnmodified          = BS.singleton 2
       summarize SourceUnmodifiedAndStable = BS.singleton 3
 
+displayTHWarning :: LspT c IO ()
+displayTHWarning
+  | isMac = do
+    isDynamicBinary <- lift $ do
+        exe <- getExecutablePath
+        (_, out, _) <- readProcessWithExitCode exe ["+RTS", "--info"] ""
+        return $ fromMaybe False $ do
+            fields <- readMaybe out
+            rtsWay <- lookup ("RTS way" :: String) fields
+            return $ "dyn" `isInfixOf` rtsWay
+    unless isDynamicBinary $
+      LSP.sendNotification SWindowShowMessage $
+        ShowMessageParams MtInfo $ T.unwords
+          [ "This HLS binary does not support Template Haskell."
+          , "Follow the [instructions](" <> templateHaskellInstructions <> ")"
+          , "to build an HLS binary with support for Template Haskell."
+          ]
+  | otherwise = return ()
+
+newtype DisplayTHWarning = DisplayTHWarning (IO ())
+instance IsIdeGlobal DisplayTHWarning
+
 getModSummaryRule :: Rules ()
 getModSummaryRule = do
+    env <- lspEnv <$> getShakeExtrasRules
+    displayItOnce <- liftIO $ once $ LSP.runLspT (fromJust env) displayTHWarning
+    addIdeGlobal (DisplayTHWarning displayItOnce)
+
     defineEarlyCutoff $ Rule $ \GetModSummary f -> do
         session' <- hscEnv <$> use_ GhcSession f
         modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal
@@ -832,6 +866,10 @@ getModSummaryRule = do
                 getModSummaryFromImports session fp modTime (textToStringBuffer <$> mFileContent)
         case modS of
             Right res -> do
+                -- Check for Template Haskell
+                when (uses_th_qq $ msrModSummary res) $ do
+                    DisplayTHWarning act <- getIdeGlobalAction
+                    liftIO act
                 bufFingerPrint <- liftIO $
                     fingerprintFromStringBuffer $ fromJust $ ms_hspp_buf $ msrModSummary res
                 let fingerPrint = Util.fingerprintFingerprints
@@ -1027,9 +1065,6 @@ needsCompilationRule file = do
 
   pure (Just $ encodeLinkableType res, Just res)
   where
-    uses_th_qq (ms_hspp_opts -> dflags) =
-      xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
-
     computeLinkableType :: ModSummary -> [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
     computeLinkableType this deps xs
       | Just ObjectLinkable `elem` xs     = Just ObjectLinkable -- If any dependent needs object code, so do we
@@ -1039,6 +1074,10 @@ needsCompilationRule file = do
       where
         this_type = computeLinkableTypeForDynFlags (ms_hspp_opts this)
 
+uses_th_qq :: ModSummary -> Bool
+uses_th_qq (ms_hspp_opts -> dflags) =
+      xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
+
 -- | How should we compile this module?
 -- (assuming we do in fact need to compile it).
 -- Depends on whether it uses unboxed tuples or sums