@@ -119,6 +119,7 @@ import qualified System.Random as Random
119
119
import System.Random (RandomGen )
120
120
import Text.ParserCombinators.ReadP (readP_to_S )
121
121
122
+ import Data.Tuple (swap )
122
123
import GHC.Data.Bag
123
124
import GHC.Driver.Env (hsc_all_home_unit_ids )
124
125
import GHC.Driver.Errors.Types
@@ -146,7 +147,7 @@ data Log
146
147
| LogSessionLoadingResult ! (Either [CradleError ] (ComponentOptions , FilePath , String ))
147
148
| LogCradle ! (Cradle Void )
148
149
| LogNoneCradleFound FilePath
149
- | LogNoneCradleFounds [ FilePath ]
150
+ | LogNoneCradleFounds ( NE. NonEmpty FilePath )
150
151
| LogNewComponentCache ! (([FileDiagnostic ], Maybe HscEnvEq ), DependencyInfo )
151
152
| LogHieBios HieBios. Log
152
153
| LogSessionLoadingChanged
@@ -648,18 +649,18 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
648
649
649
650
let
650
651
consultCradles [] = return []
651
- consultCradles hyCfpList = do
652
+ consultCradles hyCfpList@ (h : hs) = do
652
653
let lfpLogs = map (makeRelative rootDir . snd ) hyCfpList
653
654
logWith recorder Info $ LogCradlePaths lfpLogs
654
- cradles <- mapM (\ (hieYaml, _) -> loadCradle recorder hieYaml rootDir) hyCfpList
655
+ cradles <- mapM (\ (hieYaml, _) -> do c <- loadCradle recorder hieYaml rootDir; return (c,h)) (h :| hs)
655
656
when optTesting $ mRunLspT lspEnv $ mapM_ (\ (_, cfp) -> sendNotification (SMethod_CustomMethod (Proxy @ " ghcide/cradle/loaded" )) (toJSON cfp)) hyCfpList
656
- let progMsg = " Setting up " <> T. intercalate " ," (T. pack . takeBaseName . cradleRootDir <$> cradles)
657
+ let progMsg = " Setting up " <> T. intercalate " ," (T. pack . takeBaseName . cradleRootDir <$> NE. toList ( fmap fst cradles) )
657
658
<> " (for " <> T. intercalate " ," (T. pack <$> lfpLogs) <> " )"
658
659
eoptsList <- mRunLspTCallback lspEnv (\ act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $
659
660
do old_files <- readIORef cradle_files
660
- res <- cradleToOptsAndLibDirs recorder (sessionLoading clientConfig) ( zip cradles hyCfpList) old_files
661
+ res <- cradleToOptsAndLibDirs recorder (sessionLoading clientConfig) cradles old_files
661
662
return res
662
- mapM (\ (cr, hieYaml, fps, eopts) -> eoptsHscEnv (hieYaml, fps, cr, eopts)) eoptsList
663
+ mapM (\ (cr, hieYaml, fps, eopts) -> eoptsHscEnv (hieYaml, NE. toList fps, cr, eopts)) eoptsList
663
664
664
665
let
665
666
-- | We allow users to specify a loading strategy.
@@ -711,7 +712,6 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
711
712
let cachedMap = Map. fromList cachedResults
712
713
return $ consultMap <> cachedMap
713
714
714
-
715
715
let getOptionsList :: [FilePath ] -> IO (Map. Map FilePath (IdeResult HscEnvEq , [FilePath ]))
716
716
getOptionsList files = do
717
717
let ncfps = toNormalizedFilePath' <$> files
@@ -741,25 +741,20 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
741
741
742
742
743
743
-- how we do batch loading of cradles depends on the the type of cradle we are using
744
- cradleToOptsAndLibDirs :: Recorder (WithPriority Log ) -> SessionLoadingPreferenceConfig -> [(Cradle Void , (Maybe FilePath , FilePath ))] -> [FilePath ]
745
- -> IO [(Cradle Void , Maybe FilePath , [FilePath ], Either [CradleError ] (ComponentOptions , FilePath , String ))]
746
- cradleToOptsAndLibDirs recorder loadConfig [] old_fps = error " cradleToOptsAndLibDirs: empty list of cradles"
747
- cradleToOptsAndLibDirs recorder loadConfig cradleFiles@ (cr: crs) old_fps = do
748
- -- let result :: [([FilePath], CradleLoadResult ComponentOptions)]
749
- results <- HieBios. getCompilerOptionsInBatch (LoadWithContext old_fps) (second snd cr :| map (second snd ) crs)
750
- mapM (\ (fps, crr) -> collectBiosResult'' recorder (getFirstCradle fps cradleFiles) fps crr) results
744
+ cradleToOptsAndLibDirs :: Recorder (WithPriority Log ) -> SessionLoadingPreferenceConfig -> NE. NonEmpty (Cradle Void , (Maybe FilePath , FilePath )) -> [FilePath ]
745
+ -> IO [(Cradle Void , Maybe FilePath , NE. NonEmpty FilePath , Either [CradleError ] (ComponentOptions , FilePath , String ))]
746
+ cradleToOptsAndLibDirs recorder loadConfig cradleFiles old_fps = do
747
+ cradleRes <- HieBios. getCompilerOptionsInBatch loadStyle (second swap <$> cradleFiles)
748
+ mapM (\ (cfps@ ((c,(_,h)):| _), crr) -> collectBiosResult'' recorder (c, h) (fst . snd <$> cfps) crr) cradleRes
751
749
where
752
- getFirstCradle :: [FilePath ] -> [(Cradle Void , (Maybe FilePath , FilePath ))] -> (Cradle Void , Maybe FilePath )
753
- getFirstCradle [] _cradleFiles = error " cradleToOptsAndLibDirs: empty list of cradles"
754
- getFirstCradle (f: _) cradleFiles =
755
- case filter ((== f) . snd . snd ) cradleFiles of
756
- [] -> error " cradleToOptsAndLibDirs: file not found in cradleFiles"
757
- ((cr, (my,_)): _) -> (cr, my)
750
+ loadStyle = case loadConfig of
751
+ PreferSingleComponentLoading -> LoadFile
752
+ PreferMultiComponentLoading -> LoadWithContext old_fps
758
753
collectBiosResult'' recorder (cradle, hieYaml) files cradleRes = do
759
- result <- collectBiosResult' recorder ( cradle, hieYaml) files cradleRes
754
+ result <- collectBiosResult' recorder cradle files cradleRes
760
755
return (cradle, hieYaml, files, result)
761
- collectBiosResult' :: Recorder (WithPriority Log ) -> ( Cradle Void , Maybe FilePath ) -> [ FilePath ] -> CradleLoadResult a2 -> IO (Either [CradleError ] (a2 , FilePath , String ))
762
- collectBiosResult' recorder ( cradle, _) files cradleRes =
756
+ collectBiosResult' :: Recorder (WithPriority Log ) -> Cradle Void -> NE. NonEmpty FilePath -> CradleLoadResult a2 -> IO (Either [CradleError ] (a2 , FilePath , String ))
757
+ collectBiosResult' recorder cradle files cradleRes =
763
758
case cradleRes of
764
759
CradleSuccess r -> do
765
760
-- Now get the GHC lib dir
0 commit comments