Skip to content

Commit 1730357

Browse files
fendorfendor
committed
Unify session loading using implicit-hie
Make Wrapper and Session loader use the same logic to avoid loading logic divergence. Cleans up existing usages to use infrastructure in place.
1 parent 54737e9 commit 1730357

File tree

2 files changed

+49
-40
lines changed

2 files changed

+49
-40
lines changed

‎exe/Wrapper.hs‎

Lines changed: 13 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,8 @@ import Control.Monad.Extra
77
import Data.Default
88
import Data.Foldable
99
import Data.List
10-
import Data.Void
11-
import Development.IDE.Session (findCradle)
12-
import HIE.Bios hiding (findCradle)
13-
import HIE.Bios.Environment
10+
import qualified Development.IDE.Session as Session
11+
import qualified HIE.Bios.Environment as HieBios
1412
import HIE.Bios.Types
1513
import Ide.Arguments
1614
import Ide.Version
@@ -54,8 +52,17 @@ launchHaskellLanguageServer parsedArgs = do
5452

5553
d <- getCurrentDirectory
5654

55+
let initialFp = (d </> "a")
5756
-- Get the cabal directory from the cradle
58-
cradle <- findLocalCradle (d </> "a")
57+
hieYaml <- Session.findCradle def initialFp
58+
59+
-- Some log messages
60+
case hieYaml of
61+
Just yaml -> hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ initialFp ++ "\""
62+
Nothing -> hPutStrLn stderr "No 'hie.yaml' found. Try to discover the project type!"
63+
64+
cradle <- Session.loadCradle def hieYaml d
65+
5966
setCurrentDirectory $ cradleRootDir cradle
6067

6168
case parsedArgs of
@@ -114,7 +121,7 @@ getRuntimeGhcVersion' cradle = do
114121
Direct -> checkToolExists "ghc"
115122
_ -> pure ()
116123

117-
ghcVersionRes <- getRuntimeGhcVersion cradle
124+
ghcVersionRes <- HieBios.getRuntimeGhcVersion cradle
118125
case ghcVersionRes of
119126
CradleSuccess ver -> do
120127
return ver
@@ -128,24 +135,3 @@ getRuntimeGhcVersion' cradle = do
128135
Nothing ->
129136
die $ "Cradle requires " ++ exe ++ " but couldn't find it" ++ "\n"
130137
++ show cradle
131-
132-
-- | Find the cradle that the given File belongs to.
133-
--
134-
-- First looks for a "hie.yaml" file in the directory of the file
135-
-- or one of its parents. If this file is found, the cradle
136-
-- is read from the config. If this config does not comply to the "hie.yaml"
137-
-- specification, an error is raised.
138-
--
139-
-- If no "hie.yaml" can be found, the implicit config is used.
140-
-- The implicit config uses different heuristics to determine the type
141-
-- of the project that may or may not be accurate.
142-
findLocalCradle :: FilePath -> IO (Cradle Void)
143-
findLocalCradle fp = do
144-
cradleConf <- findCradle def fp
145-
crdl <- case cradleConf of
146-
Just yaml -> do
147-
hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\""
148-
loadCradle yaml
149-
Nothing -> loadImplicitCradle fp
150-
hPutStrLn stderr $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl
151-
return crdl

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

Lines changed: 36 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ import Development.IDE.GHC.Compat hiding (Target,
4848
TargetFile, TargetModule)
4949
import qualified Development.IDE.GHC.Compat as GHC
5050
import Development.IDE.GHC.Util
51+
import Development.IDE.Graph (Action)
5152
import Development.IDE.Session.VersionCheck
5253
import Development.IDE.Types.Diagnostics
5354
import Development.IDE.Types.Exports
@@ -56,7 +57,6 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq, newHscEnvEq,
5657
import Development.IDE.Types.Location
5758
import Development.IDE.Types.Logger
5859
import Development.IDE.Types.Options
59-
import Development.IDE.Graph (Action)
6060
import GHC.Check
6161
import qualified HIE.Bios as HieBios
6262
import HIE.Bios.Environment hiding (getCacheDir)
@@ -85,12 +85,10 @@ import Control.Concurrent.STM (atomically)
8585
import Control.Concurrent.STM.TQueue
8686
import qualified Data.HashSet as Set
8787
import Database.SQLite.Simple
88-
import HIE.Bios.Cradle (yamlConfig)
88+
import GHC.LanguageExtensions (Extension (EmptyCase))
8989
import HieDb.Create
9090
import HieDb.Types
9191
import HieDb.Utils
92-
import Maybes (MaybeT (runMaybeT))
93-
import GHC.LanguageExtensions (Extension(EmptyCase))
9492

9593
-- | Bump this version number when making changes to the format of the data stored in hiedb
9694
hiedbDataVersion :: String
@@ -100,15 +98,17 @@ data CacheDirs = CacheDirs
10098
{ hiCacheDir, hieCacheDir, oCacheDir :: Maybe FilePath}
10199

102100
data SessionLoadingOptions = SessionLoadingOptions
103-
{ findCradle :: FilePath -> IO (Maybe FilePath)
104-
, loadCradle :: FilePath -> IO (HieBios.Cradle Void)
101+
{ findCradle :: FilePath -> IO (Maybe FilePath)
102+
-- | Load the cradle for give Config. If the config is 'Nothing', use the provided
103+
-- project root directory to determine the 'Cradle' type.
104+
, loadCradle :: Maybe FilePath -> FilePath -> IO (HieBios.Cradle Void)
105105
-- | Given the project name and a set of command line flags,
106106
-- return the path for storing generated GHC artifacts,
107107
-- or 'Nothing' to respect the cradle setting
108-
, getCacheDirs :: String -> [String] -> IO CacheDirs
108+
, getCacheDirs :: String -> [String] -> IO CacheDirs
109109
-- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
110-
, getInitialGhcLibDir :: IO (Maybe LibDir)
111-
, fakeUid :: InstalledUnitId
110+
, getInitialGhcLibDir :: IO (Maybe LibDir)
111+
, fakeUid :: InstalledUnitId
112112
-- ^ unit id used to tag the internal component built by ghcide
113113
-- To reuse external interface files the unit ids must match,
114114
-- thus make sure to build them with `--this-unit-id` set to the
@@ -118,17 +118,40 @@ data SessionLoadingOptions = SessionLoadingOptions
118118
instance Default SessionLoadingOptions where
119119
def = SessionLoadingOptions
120120
{findCradle = HieBios.findCradle
121-
,loadCradle = HieBios.loadCradle
121+
,loadCradle = loadWithImplicitCradle
122122
,getCacheDirs = getCacheDirsDefault
123123
,getInitialGhcLibDir = getInitialGhcLibDirDefault
124124
,fakeUid = toInstalledUnitId (stringToUnitId "main")
125125
}
126126

127+
-- | Find the cradle for a given 'hie.yaml' configuration.
128+
--
129+
-- If a 'hie.yaml' is given, the cradle is read from the config.
130+
-- If this config does not comply to the "hie.yaml"
131+
-- specification, an error is raised.
132+
--
133+
-- If no location for "hie.yaml" is provided, the implicit config is used
134+
-- using the provided root directory for discovering the project.
135+
-- The implicit config uses different heuristics to determine the type
136+
-- of the project that may or may not be accurate.
137+
loadWithImplicitCradle :: Maybe FilePath
138+
-- ^ Optional 'hie.yaml' location. Will be used if given.
139+
-> FilePath
140+
-- ^ Root directory of the project. Required as a fallback
141+
-- if no 'hie.yaml' location is given.
142+
-> IO (HieBios.Cradle Void)
143+
loadWithImplicitCradle mHieYaml rootDir = do
144+
crdl <- case mHieYaml of
145+
Just yaml -> do
146+
HieBios.loadCradle yaml
147+
Nothing -> loadImplicitHieCradle $ addTrailingPathSeparator rootDir
148+
return crdl
149+
127150
getInitialGhcLibDirDefault :: IO (Maybe LibDir)
128151
getInitialGhcLibDirDefault = do
129152
dir <- IO.getCurrentDirectory
130-
hieYaml <- runMaybeT $ yamlConfig dir
131-
cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) HieBios.loadCradle hieYaml
153+
hieYaml <- findCradle def dir
154+
cradle <- loadCradle def hieYaml dir
132155
hPutStrLn stderr $ "setInitialDynFlags cradle: " ++ show cradle
133156
libDirRes <- getRuntimeGhcLibDir cradle
134157
case libDirRes of
@@ -400,7 +423,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
400423
when (isNothing hieYaml) $
401424
logWarning logger $ implicitCradleWarning lfp
402425

403-
cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
426+
cradle <- loadCradle hieYaml dir
404427

405428
when optTesting $ mRunLspT lspEnv $
406429
sendNotification (SCustomMethod "ghcide/cradle/loaded") (toJSON cfp)

0 commit comments

Comments
 (0)