Cache CompilerOptions with Cradle

Author: Avi-D-coder

hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs

@@ -4,6 +4,8 @@
 
 module Haskell.Ide.Engine.GhcModuleCache where
 
+import           Control.Monad.IO.Class ( liftIO , MonadIO(..) )
+
 import qualified Data.Map as Map
 import           Data.Dynamic (Dynamic)
 import           Data.Typeable (TypeRep)
@@ -100,21 +102,59 @@ data LookupCradleResult = ReuseCradle | LoadCradle CachedCradle | NewCradle File
 lookupCradle :: FilePath -> GhcModuleCache -> LookupCradleResult
 lookupCradle fp gmc =
   case currentCradle gmc of
-    Just (dirs, _c) | (any (\d -> d `isPrefixOf` fp) dirs) -> ReuseCradle
+    Just (dirs, _c, _) | any (`isPrefixOf` fp) dirs -> ReuseCradle
     _ -> case T.match (cradleCache gmc) (B.pack fp) of
            Just (_k, c, _suf) -> LoadCradle c
            Nothing  -> NewCradle fp
 
-data CachedCradle = CachedCradle BIOS.Cradle HscEnv
+getComponentOptions
+  :: (MonadIO m, HasGhcModuleCache m)
+  => FilePath
+  -> m (Maybe BIOS.ComponentOptions)
+getComponentOptions fp = do
+  mc <- getModuleCache
+  case currentCradle mc of
+    Just (dirs, cradle, co) | any (`isPrefixOf` fp) dirs -> case co of
+      Just _ -> return co
+      _      -> setCo fp cradle setCur
+    _ -> case T.match (cradleCache mc) (B.pack fp) of
+      Just (_, CachedCradle _ _ (Just co), _) -> return $ Just co
+      Just (p, CachedCradle cradle _ Nothing, _) ->
+        setCo (B.unpack p) cradle setCac
+      _ -> return Nothing
+ where
+  setCo fp' cradle mod' = do
+    res <- liftIO $ BIOS.getCompilerOptions fp' cradle
+    case res of
+      BIOS.CradleSuccess opts -> do
+        modifyModuleCache $ mod' opts fp'
+        return $ Just opts
+      _ -> return Nothing
+  setCur opts _ mc'@(GhcModuleCache _ _ (Just (fps, c', _))) =
+    mc' { currentCradle = Just (fps, c', Just opts) }
+  setCur _ _ mc' = mc'
+  setCac opts fp' mc' = mc'
+    { cradleCache = T.adjust (\cc -> cc { mCompOpts = Just opts }) (B.pack fp')
+                      $ cradleCache mc'
+    }
+
+
+
+data CachedCradle = CachedCradle
+  { ccradle :: BIOS.Cradle
+  , hscEnv :: HscEnv
+  , mCompOpts :: Maybe BIOS.ComponentOptions
+  }
 
 instance Show CachedCradle where
-  show (CachedCradle x _) = show x
+  show (CachedCradle x _ _) = show x
 
 data GhcModuleCache = GhcModuleCache
   { cradleCache :: !(T.Trie CachedCradle)
               -- ^ map from FilePath to cradles
+              -- May not include currentCradle
   , uriCaches  :: !UriCaches
-  , currentCradle :: Maybe ([FilePath], BIOS.Cradle)
+  , currentCradle :: Maybe ([FilePath], BIOS.Cradle, Maybe BIOS.ComponentOptions)
               -- ^ The current cradle and which FilePath's it is
               -- responsible for
   } deriving (Show)

hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs

@@ -131,7 +131,7 @@ loadCradle _ _ ReuseCradle _def action = do
   debugm "Reusing cradle"
   IdeResultOk <$> action
 
-loadCradle _ _iniDynFlags (LoadCradle (CachedCradle crd env)) _def action = do
+loadCradle _ _iniDynFlags (LoadCradle (CachedCradle crd env _)) _def action = do
   -- Reloading a cradle happens on component switch
   logm $ "Switch to cradle: " ++ show crd
   -- Cache the existing cradle
@@ -245,17 +245,17 @@ setCurrentCradle cradle = do
     let ps = mapMaybe (GHC.ml_hs_file . GHC.ms_location) (mgModSummaries mg)
     debugm $ "Modules in the cradle: " ++ show ps
     ps' <- liftIO $ mapM canonicalizePath ps
-    modifyCache (\s -> s { currentCradle = Just (ps', cradle) })
+    modifyCache (\s -> s { currentCradle = Just (ps', cradle, Nothing) })
 
 -- | Cache the given Cradle.
 -- Caches the given Cradle together with all Modules this Cradle is responsible
 -- for.
 -- Via 'lookupCradle' it can be checked if a given FilePath is managed by
 -- a any Cradle that has already been loaded.
-cacheCradle :: (HasGhcModuleCache m, GHC.GhcMonad m) => ([FilePath], Bios.Cradle) -> m ()
-cacheCradle (ds, c) = do
+cacheCradle :: (HasGhcModuleCache m, GHC.GhcMonad m) => ([FilePath], Bios.Cradle, Maybe Bios.ComponentOptions) -> m ()
+cacheCradle (ds, c, co) = do
   env <- GHC.getSession
-  let cc = CachedCradle c env
+  let cc = CachedCradle c env co
       new_map = T.fromList (map (, cc) (map B.pack ds))
   modifyCache (\s -> s { cradleCache = T.unionWith (\a _ -> a) new_map (cradleCache s) })