Merge pull request #1589 from Avi-D-coder/ormolu-opts

Pass Ormolu cradle flags & default-extensions

Author: Avi-D-coder

cabal.project

@@ -16,5 +16,4 @@ constraints:
 
 write-ghc-environment-files: never
 
-index-state: 2020-01-21T18:23:31Z
-allow-newer: ormolu:optparse-applicative
+index-state: 2020-01-24T16:47:33Z

haskell-ide-engine.cabal

@@ -104,7 +104,7 @@ library
                      , unliftio
                      , hlint >= 2.2.8
   if impl(ghc >= 8.6)
-     build-depends: ormolu
+     build-depends: ormolu >= 0.0.3.1
 
   ghc-options:         -Wall -Wredundant-constraints
   if flag(pedantic)

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

@@ -99,24 +99,49 @@ data LookupCradleResult = ReuseCradle | LoadCradle CachedCradle | NewCradle File
 -- via 'setCurrentCradle' before the Cradle can be cached via 'cacheCradle'.
 lookupCradle :: FilePath -> GhcModuleCache -> LookupCradleResult
 lookupCradle fp gmc =
-  case currentCradle gmc of
-    Just (dirs, _c) | (any (\d -> d `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
+  lookupInCache fp gmc (const $ const ReuseCradle) LoadCradle $ NewCradle fp
+
+-- | Find the cradle wide 'ComponentOptions' that apply to a 'FilePath'
+lookupComponentOptions
+  :: HasGhcModuleCache m => FilePath -> m (Maybe BIOS.ComponentOptions)
+lookupComponentOptions fp = do
+  gmc <- getModuleCache
+  return $ lookupInCache fp gmc (const Just) (Just . compOpts) Nothing
+
+lookupInCache
+  :: FilePath
+  -> GhcModuleCache
+  -- | Called when file is in the current cradle
+  -> (BIOS.Cradle -> BIOS.ComponentOptions -> a)
+  -- | Called when file is a member of a cached cradle
+  -> (CachedCradle -> a)
+  -- | Default value to return if a cradle is not found
+  -> a
+  -> a
+lookupInCache fp gmc cur cached def = case currentCradle gmc of
+  Just (dirs, c, co) | any (`isPrefixOf` fp) dirs -> cur c co
+  _ -> case T.match (cradleCache gmc) (B.pack fp) of
+    Just (_k, c, _suf) -> cached c
+    Nothing            -> def
+
+-- | A 'Cradle', it's 'HscEnv' and 'ComponentOptions'
+data CachedCradle = CachedCradle
+  { ccradle :: BIOS.Cradle
+  , hscEnv :: HscEnv
+  , compOpts :: 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
+              -- ^ map from FilePath to cradle and it's config.
+              -- May not include currentCradle
   , uriCaches  :: !UriCaches
-  , currentCradle :: Maybe ([FilePath], BIOS.Cradle)
-              -- ^ The current cradle and which FilePath's it is
-              -- responsible for
+  , currentCradle :: Maybe ([FilePath], BIOS.Cradle, BIOS.ComponentOptions)
+              -- ^ The current cradle, it's config,
+              -- and which FilePath's it is responsible for.
   } deriving (Show)
 
 -- ---------------------------------------------------------------------

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

@@ -48,6 +48,7 @@ import           System.Directory
 
 
 import qualified GHC
+import qualified GhcMake as GHC
 import qualified HscMain as GHC
 import qualified HIE.Bios as Bios
 import qualified HIE.Bios.Ghc.Api as Bios
@@ -131,13 +132,13 @@ 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 co)) _def action = do
   -- Reloading a cradle happens on component switch
   logm $ "Switch to cradle: " ++ show crd
   -- Cache the existing cradle
   maybe (return ()) cacheCradle =<< (currentCradle <$> getModuleCache)
   GHC.setSession env
-  setCurrentCradle crd
+  setCurrentCradle crd co
   IdeResultOk <$> action
 
 loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
@@ -166,7 +167,7 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
   initialiseCradle :: (MonadIde m, HasGhcModuleCache m, GHC.GhcMonad m)
                   => Bios.Cradle -> (Progress -> IO ()) -> m (IdeResult a)
   initialiseCradle cradle f = do
-    res <- Bios.initializeFlagsWithCradleWithMessage (Just (toMessager f)) fp cradle
+    res <- initializeFlagsWithCradleWithMessage (Just (toMessager f)) fp cradle
     case res of
       Bios.CradleNone ->
         -- Note: The action is not run if we are in the none cradle, we
@@ -194,7 +195,7 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
             , ideMessage = Text.unwords  (take 2 msgTxt)
             , ideInfo    = Aeson.Null
             }
-      Bios.CradleSuccess init_session -> do
+      Bios.CradleSuccess (init_session, copts) -> do
         -- Note that init_session contains a Hook to 'f'.
         -- So, it can still provide Progress Reports.
         -- Therefore, invocation of 'init_session' must happen
@@ -225,37 +226,58 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
             -- be that slow, even though the cradle isn't cached because the
             -- `.hi` files will be saved.
           Right Bios.Succeeded -> do
-            setCurrentCradle cradle
+            setCurrentCradle cradle copts
             logm "Cradle set succesfully"
             IdeResultOk <$> action
 
           Right Bios.Failed -> do
-            setCurrentCradle cradle
+            setCurrentCradle cradle copts
             logm "Cradle did not load succesfully"
             IdeResultOk <$> action
 
+-- TODO remove after hie-bios update
+initializeFlagsWithCradleWithMessage ::
+  GHC.GhcMonad m
+  => Maybe GHC.Messager
+  -> FilePath -- ^ The file we are loading the 'Cradle' because of
+  -> Bios.Cradle -- ^ The cradle we want to load
+  -> m (Bios.CradleLoadResult (m GHC.SuccessFlag, Bios.ComponentOptions)) -- ^ Whether we actually loaded the cradle or not.
+initializeFlagsWithCradleWithMessage msg fp cradle =
+    fmap (initSessionWithMessage msg) <$> liftIO (Bios.getCompilerOptions fp cradle)
+
+initSessionWithMessage :: (GHC.GhcMonad m)
+            => Maybe GHC.Messager
+            -> Bios.ComponentOptions
+            -> (m GHC.SuccessFlag, Bios.ComponentOptions)
+initSessionWithMessage msg copts = (do
+    targets <- Bios.initSession copts
+    GHC.setTargets targets
+    -- Get the module graph using the function `getModuleGraph`
+    mod_graph <- GHC.depanal [] True
+    GHC.load' GHC.LoadAllTargets msg mod_graph, copts)
+
 -- | Sets the current cradle for caching.
 -- Retrieves the current GHC Module Graph, to find all modules
 -- that belong to this cradle.
 -- If the cradle does not load any module, it is responsible for an empty
 -- list of Modules.
-setCurrentCradle :: (HasGhcModuleCache m, GHC.GhcMonad m) => Bios.Cradle -> m ()
-setCurrentCradle cradle = do
+setCurrentCradle :: (HasGhcModuleCache m, GHC.GhcMonad m) => Bios.Cradle -> Bios.ComponentOptions -> m ()
+setCurrentCradle cradle co = do
     mg <- GHC.getModuleGraph
     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, co) })
 
 -- | 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, 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) })
 

src/Haskell/Ide/Engine/Plugin/Ormolu.hs

@@ -8,15 +8,15 @@ import Haskell.Ide.Engine.MonadTypes
 
 #if __GLASGOW_HASKELL__ >= 806
 import Control.Exception
+import Control.Monad
 import Control.Monad.IO.Class ( liftIO , MonadIO(..) )
 import Data.Aeson ( Value ( Null ) )
-import Data.Text
+import Data.List
+import Data.Maybe
+import qualified Data.Text as T
 import Ormolu
-#if __GLASGOW_HASKELL__ < 808
-import Ormolu.Config (defaultConfig)
-import Ormolu.Exception (OrmoluException)
-#endif
 import Haskell.Ide.Engine.PluginUtils
+import HIE.Bios.Types
 #endif
 
 ormoluDescriptor :: PluginId -> PluginDescriptor
@@ -37,12 +37,21 @@ provider :: FormattingProvider
 provider _contents _uri _typ _opts =
 #if __GLASGOW_HASKELL__ >= 806
   case _typ of
-    FormatRange _ -> return $ IdeResultFail (IdeError PluginError (pack "Selection formatting for Ormolu is not currently supported.") Null)
+    FormatRange _ -> return $ IdeResultFail (IdeError PluginError (T.pack "Selection formatting for Ormolu is not currently supported.") Null)
     FormatText -> pluginGetFile _contents _uri $ \file -> do
-        result <- liftIO $ try @OrmoluException (ormolu defaultConfig file (unpack _contents))
+        opts <- lookupComponentOptions file
+        let opts' = map DynOption $ filter exop $ join $ maybeToList $ componentOptions <$> opts
+            conf  = Config opts' False False True False
+        result <- liftIO $ try @OrmoluException (ormolu conf file (T.unpack _contents))
+
         case result of
-          Left  err -> return $ IdeResultFail (IdeError PluginError (pack $  "ormoluCmd: " ++ show err) Null)
+          Left  err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "ormoluCmd: " ++ show err) Null)
           Right new -> return $ IdeResultOk [TextEdit (fullRange _contents) new]
+  where
+    exop s =
+      "-X" `isPrefixOf` s
+      || "-fplugin=" `isPrefixOf` s
+      || "-pgmF=" `isPrefixOf` s
 #else
   return $ IdeResultOk [] -- NOP formatter
 #endif

stack-8.6.4.yaml

@@ -29,7 +29,7 @@ extra-deps:
 - monad-dijkstra-0.1.1.2@rev:1
 - monad-memo-0.4.1
 - multistate-0.8.0.1
-- ormolu-0.0.3.0
+- ormolu-0.0.3.1
 - parser-combinators-1.2.1
 - rope-utf16-splay-0.3.1.0
 - syz-0.2.0.0

stack-8.6.5.yaml

@@ -27,7 +27,7 @@ extra-deps:
 - hsimport-0.11.0
 - lsp-test-0.10.0.0
 - monad-dijkstra-0.1.1.2@rev:1
-- ormolu-0.0.3.0
+- ormolu-0.0.3.1
 - parser-combinators-1.2.1
 - syz-0.2.0.0
 - temporary-1.2.1.1

stack-8.8.1.yaml

@@ -22,8 +22,7 @@ extra-deps:
 - hsimport-0.11.0
 - ilist-0.3.1.0
 - monad-dijkstra-0.1.1.2
-- optparse-applicative-0.15.1.0
-- ormolu-0.0.3.0
+- ormolu-0.0.3.1
 - semigroups-0.18.5
 - temporary-1.2.1.1
 
@@ -33,8 +32,7 @@ flags:
   hie-plugin-api:
     pedantic: true
 
-# Required to build ormolu with optparse-applicative-0.15.1.0
-allow-newer: true
+# allow-newer: true
 
 nix:
   packages: [ icu libcxx zlib ]

stack.yaml

@@ -29,7 +29,7 @@ extra-deps:
 - lsp-test-0.10.0.0
 - monad-dijkstra-0.1.1.2@rev:1
 - parser-combinators-1.2.1
-- ormolu-0.0.3.0
+- ormolu-0.0.3.1
 - syz-0.2.0.0
 - temporary-1.2.1.1
 - unix-compat-0.5.2