Merge remote-tracking branch 'origin/master' into ghc-9.0.1-with-lsp-1.2

Author: anka-213

exe/Wrapper.hs

@@ -8,9 +8,8 @@ import           Data.Default
 import           Data.Foldable
 import           Data.List
 import           Data.Void
-import           Development.IDE.Session (findCradle)
-import           HIE.Bios                hiding (findCradle)
-import           HIE.Bios.Environment
+import qualified Development.IDE.Session as Session
+import qualified HIE.Bios.Environment    as HieBios
 import           HIE.Bios.Types
 import           Ide.Arguments
 import           Ide.Version
@@ -44,6 +43,9 @@ main = do
       VersionMode PrintNumericVersion ->
           putStrLn haskellLanguageServerNumericVersion
 
+      BiosMode PrintCradleType ->
+          print =<< findProjectCradle
+
       _ -> launchHaskellLanguageServer args
 
 launchHaskellLanguageServer :: Arguments -> IO ()
@@ -53,9 +55,11 @@ launchHaskellLanguageServer parsedArgs = do
     _                          -> pure ()
 
   d <- getCurrentDirectory
+  
+  -- search for the project cradle type
+  cradle <- findProjectCradle
 
-  -- Get the cabal directory from the cradle
-  cradle <- findLocalCradle (d </> "a")
+  -- Get the root directory from the cradle
   setCurrentDirectory $ cradleRootDir cradle
 
   case parsedArgs of
@@ -114,7 +118,7 @@ getRuntimeGhcVersion' cradle = do
     Direct  -> checkToolExists "ghc"
     _       -> pure ()
 
-  ghcVersionRes <- getRuntimeGhcVersion cradle
+  ghcVersionRes <- HieBios.getRuntimeGhcVersion cradle
   case ghcVersionRes of
     CradleSuccess ver -> do
       return ver
@@ -129,23 +133,16 @@ getRuntimeGhcVersion' cradle = do
           die $ "Cradle requires " ++ exe ++ " but couldn't find it" ++ "\n"
            ++ show cradle
 
--- | Find the cradle that the given File belongs to.
---
--- First looks for a "hie.yaml" file in the directory of the file
--- or one of its parents. If this file is found, the cradle
--- is read from the config. If this config does not comply to the "hie.yaml"
--- specification, an error is raised.
---
--- If no "hie.yaml" can be found, the implicit config is used.
--- The implicit config uses different heuristics to determine the type
--- of the project that may or may not be accurate.
-findLocalCradle :: FilePath -> IO (Cradle Void)
-findLocalCradle fp = do
-  cradleConf <- findCradle def fp
-  crdl       <- case cradleConf of
-    Just yaml -> do
-      hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\""
-      loadCradle yaml
-    Nothing -> loadImplicitCradle fp
-  hPutStrLn stderr $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl
-  return crdl
+findProjectCradle :: IO (Cradle Void)
+findProjectCradle = do
+  d <- getCurrentDirectory
+
+  let initialFp = (d </> "a")
+  hieYaml <- Session.findCradle def initialFp
+
+  -- Some log messages
+  case hieYaml of
+    Just yaml -> hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ initialFp ++ "\""
+    Nothing -> hPutStrLn stderr "No 'hie.yaml' found. Try to discover the project type!"
+
+  Session.loadCradle def hieYaml d

ghcide/ghcide.cabal

@@ -14,7 +14,7 @@ description:
 homepage:           https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme
 bug-reports:        https://github.com/haskell/haskell-language-server/issues
 tested-with:        GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4 || == 8.10.2 || == 8.10.3 || == 8.10.4 || == 9.0.1
-extra-source-files: include/ghc-api-version.h README.md CHANGELOG.md
+extra-source-files: README.md CHANGELOG.md
                     test/data/**/*.project
                     test/data/**/*.cabal
                     test/data/**/*.yaml
@@ -334,9 +334,9 @@ test-suite ghcide-tests
         extra,
         filepath,
         --------------------------------------------------------------
-        -- The MIN_GHC_API_VERSION macro relies on MIN_VERSION pragmas
+        -- The MIN_VERSION_ghc macro relies on MIN_VERSION pragmas
         -- which require depending on ghc. So the tests need to depend
-        -- on ghc if they need to use MIN_GHC_API_VERSION. Maybe a
+        -- on ghc if they need to use MIN_VERSION_ghc. Maybe a
         -- better solution can be found, but this is a quick solution
         -- which works for now.
         ghc,

ghcide/include/ghc-api-version.h

@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP          #-}
 {-# LANGUAGE TypeFamilies #-}
-#include "ghc-api-version.h"
 
 {-|
 The logic for setting up a ghcide session by tapping into hie-bios.
@@ -48,6 +47,7 @@ import           Development.IDE.GHC.Compat           hiding (Target,
                                                        TargetFile, TargetModule)
 import qualified Development.IDE.GHC.Compat           as GHC
 import           Development.IDE.GHC.Util
+import           Development.IDE.Graph                (Action)
 import           Development.IDE.Session.VersionCheck
 import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Types.Exports
@@ -56,7 +56,6 @@ import           Development.IDE.Types.HscEnvEq       (HscEnvEq, newHscEnvEq,
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Logger
 import           Development.IDE.Types.Options
-import           Development.IDE.Graph                    (Action)
 import           GHC.Check
 import qualified HIE.Bios                             as HieBios
 import           HIE.Bios.Environment                 hiding (getCacheDir)
@@ -84,12 +83,10 @@ import           Control.Concurrent.STM               (atomically)
 import           Control.Concurrent.STM.TQueue
 import qualified Data.HashSet                         as Set
 import           Database.SQLite.Simple
-import           HIE.Bios.Cradle                      (yamlConfig)
+import           GHC.LanguageExtensions               (Extension (EmptyCase))
 import           HieDb.Create
 import           HieDb.Types
 import           HieDb.Utils
-import           Maybes                               (MaybeT (runMaybeT))
-import           GHC.LanguageExtensions               (Extension(EmptyCase))
 
 -- | Bump this version number when making changes to the format of the data stored in hiedb
 hiedbDataVersion :: String
@@ -99,15 +96,18 @@ data CacheDirs = CacheDirs
   { hiCacheDir, hieCacheDir, oCacheDir :: Maybe FilePath}
 
 data SessionLoadingOptions = SessionLoadingOptions
-  { findCradle          :: FilePath -> IO (Maybe FilePath)
-  , loadCradle          :: FilePath -> IO (HieBios.Cradle Void)
+  { findCradle             :: FilePath -> IO (Maybe FilePath)
+  -- | Load the cradle with an optional 'hie.yaml' location.
+  -- If a 'hie.yaml' is given, use it to load the cradle.
+  -- Otherwise, use the provided project root directory to determine the cradle type.
+  , loadCradle             :: Maybe FilePath -> FilePath -> IO (HieBios.Cradle Void)
   -- | Given the project name and a set of command line flags,
   --   return the path for storing generated GHC artifacts,
   --   or 'Nothing' to respect the cradle setting
-  , getCacheDirs        :: String -> [String] -> IO CacheDirs
+  , getCacheDirs           :: String -> [String] -> IO CacheDirs
   -- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
-  , getInitialGhcLibDir :: IO (Maybe LibDir)
-  , fakeUid             :: GHC.InstalledUnitId
+  , getInitialGhcLibDir    :: IO (Maybe LibDir)
+  , fakeUid                :: GHC.InstalledUnitId
     -- ^ unit id used to tag the internal component built by ghcide
     --   To reuse external interface files the unit ids must match,
     --   thus make sure to build them with `--this-unit-id` set to the
@@ -117,17 +117,39 @@ data SessionLoadingOptions = SessionLoadingOptions
 instance Default SessionLoadingOptions where
     def = SessionLoadingOptions
         {findCradle = HieBios.findCradle
-        ,loadCradle = HieBios.loadCradle
+        ,loadCradle = loadWithImplicitCradle
         ,getCacheDirs = getCacheDirsDefault
         ,getInitialGhcLibDir = getInitialGhcLibDirDefault
         ,fakeUid = GHC.toInstalledUnitId (GHC.stringToUnit "main")
         }
 
+-- | Find the cradle for a given 'hie.yaml' configuration.
+--
+-- If a 'hie.yaml' is given, the cradle is read from the config.
+--  If this config does not comply to the "hie.yaml"
+-- specification, an error is raised.
+--
+-- If no location for "hie.yaml" is provided, the implicit config is used
+-- using the provided root directory for discovering the project.
+-- The implicit config uses different heuristics to determine the type
+-- of the project that may or may not be accurate.
+loadWithImplicitCradle :: Maybe FilePath
+                          -- ^ Optional 'hie.yaml' location. Will be used if given.
+                          -> FilePath
+                          -- ^ Root directory of the project. Required as a fallback
+                          -- if no 'hie.yaml' location is given.
+                          -> IO (HieBios.Cradle Void)
+loadWithImplicitCradle mHieYaml rootDir = do
+  crdl       <- case mHieYaml of
+    Just yaml -> HieBios.loadCradle yaml
+    Nothing   -> loadImplicitHieCradle $ addTrailingPathSeparator rootDir
+  return crdl
+
 getInitialGhcLibDirDefault :: IO (Maybe LibDir)
 getInitialGhcLibDirDefault = do
   dir <- IO.getCurrentDirectory
-  hieYaml <- runMaybeT $ yamlConfig dir
-  cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) HieBios.loadCradle hieYaml
+  hieYaml <- findCradle def dir
+  cradle <- loadCradle def hieYaml dir
   hPutStrLn stderr $ "setInitialDynFlags cradle: " ++ show cradle
   libDirRes <- getRuntimeGhcLibDir cradle
   case libDirRes of
@@ -399,7 +421,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
            when (isNothing hieYaml) $
              logWarning logger $ implicitCradleWarning lfp
 
-           cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
+           cradle <- loadCradle hieYaml dir
 
            when optTesting $ mRunLspT lspEnv $
             sendNotification (SCustomMethod "ghcide/cradle/loaded") (toJSON cfp)

ghcide/session-loader/Development/IDE/Session.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE CPP        #-}
 {-# LANGUAGE GADTs      #-}
 {-# LANGUAGE RankNTypes #-}
-#include "ghc-api-version.h"
 
 -- | Based on https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/API.
 --   Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values.

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

@@ -5,7 +5,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE TypeFamilies          #-}
-#include "ghc-api-version.h"
 
 -- | A Shake implementation of the compiler service, built
 --   using the "Shaker" abstraction layer for in-memory use.

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

@@ -1,6 +1,5 @@
 {-# LANGUAGE NoApplicativeDo #-}
 {-# LANGUAGE CPP #-}
-#include "ghc-api-version.h"
 module Development.IDE.Core.Tracing
     ( otTracedHandler
     , otTracedAction
@@ -96,7 +95,7 @@ otTracedAction key file success act
             return res)
   | otherwise = act
 
-#if MIN_GHC_API_VERSION(8,8,0)
+#if MIN_VERSION_ghc(8,8,0)
 otTracedProvider :: MonadUnliftIO m => PluginId -> ByteString -> m a -> m a
 #else
 otTracedProvider :: MonadUnliftIO m => PluginId -> String -> m a -> m a

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

@@ -12,7 +12,6 @@
 {-# LANGUAGE NamedFieldPuns           #-}
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-#include "ghc-api-version.h"
 
 -----------------------------------------------------------------------------
 --

ghcide/src/Development/IDE/GHC/CPP.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE PatternSynonyms   #-}
 {-# OPTIONS -Wno-dodgy-imports -Wno-incomplete-uni-patterns #-}
 {-# OPTIONS -Wno-missing-signatures #-} -- TODO: Remove!
-#include "ghc-api-version.h"
 
 -- | Attempt at hiding the GHC version differences we can.
 module Development.IDE.GHC.Compat(

ghcide/src/Development/IDE/GHC/Compat.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
-#include "ghc-api-version.h"
 
 -- | Orphan instances for GHC.
 --   Note that the 'NFData' instances may not be law abiding.

ghcide/src/Development/IDE/GHC/Orphans.hs

@@ -2,7 +2,6 @@
 -- SPDX-License-Identifier: Apache-2.0
 
 {-# LANGUAGE CPP #-}
-#include "ghc-api-version.h"
 
 module Development.IDE.Import.FindImports
   ( locateModule

ghcide/src/Development/IDE/Import/FindImports.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE RankNTypes            #-}
-#include "ghc-api-version.h"
 
 module Development.IDE.LSP.Outline
   ( moduleOutline

ghcide/src/Development/IDE/LSP/Outline.hs

@@ -3,7 +3,6 @@
 
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-#include "ghc-api-version.h"
 
 -- | Go to the definition of a variable.
 

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP          #-}
 {-# LANGUAGE RankNTypes   #-}
 {-# LANGUAGE TypeFamilies #-}
-#include "ghc-api-version.h"
 
 module Development.IDE.Plugin.Completions
     ( descriptor

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE GADTs      #-}
 {-# LANGUAGE MultiWayIf #-}
 
-#include "ghc-api-version.h"
 
 -- Mostly taken from "haskell-ide-engine"
 module Development.IDE.Plugin.Completions.Logic (

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -3,7 +3,6 @@
 
 {-# LANGUAGE CPP   #-}
 {-# LANGUAGE GADTs #-}
-#include "ghc-api-version.h"
 
 -- | Gives information about symbols at a given point in DAML files.
 -- These are all pure functions that should execute quickly.

ghcide/src/Development/IDE/Spans/AtPoint.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveAnyClass     #-}
 {-# LANGUAGE DerivingStrategies #-}
-#include "ghc-api-version.h"
 
 module Development.IDE.Spans.Common (
   showGhc

ghcide/src/Development/IDE/Spans/Common.hs

@@ -3,7 +3,6 @@
 -- SPDX-License-Identifier: Apache-2.0
 
 {-# LANGUAGE CPP        #-}
-#include "ghc-api-version.h"
 
 module Development.IDE.Spans.Documentation (
     getDocumentation

ghcide/src/Development/IDE/Spans/Documentation.hs

@@ -11,7 +11,6 @@
 {-# LANGUAGE PolyKinds             #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-}
-#include "ghc-api-version.h"
 
 module Main (main) where
 

ghcide/test/exe/Main.hs

@@ -18,7 +18,6 @@ tested-with:        GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4
 extra-source-files:
   README.md
   ChangeLog.md
-  include/ghc-api-version.h
   test/testdata/**/*.project
   test/testdata/**/*.cabal
   test/testdata/**/*.yaml
@@ -475,7 +474,8 @@ test-suite func-test
 test-suite wrapper-test
   type:               exitcode-stdio-1.0
   build-tool-depends:
-    haskell-language-server:haskell-language-server-wrapper -any
+    haskell-language-server:haskell-language-server-wrapper -any,
+    haskell-language-server:haskell-language-server -any
 
   default-language:   Haskell2010
   build-depends: