Merge pull request #246 from pepeiborra/ormolu

Ormolu flags

Author: fendor

haskell-language-server.cabal

@@ -71,6 +71,7 @@ library
     , filepath
     , floskell == 0.10.*
     , ghc
+    , ghc-boot-th
     , ghcide >= 0.1
     , gitrev
     , hashable

src/Ide/Plugin/Ormolu.hs

@@ -1,8 +1,7 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeApplications    #-}
 
 module Ide.Plugin.Ormolu
   (
@@ -12,19 +11,27 @@ module Ide.Plugin.Ormolu
 where
 
 import           Control.Exception
-import qualified Data.Text as T
+import qualified Data.Text                         as T
 import           Development.IDE.Core.Rules
+import           Development.IDE.Core.RuleTypes    (GhcSession (GhcSession))
+import           Development.IDE.Core.Shake        (use)
+import           Development.IDE.GHC.Util          (hscEnv)
 import           Development.IDE.Types.Diagnostics as D
 import           Development.IDE.Types.Location
-import qualified DynFlags as D
-import qualified EnumSet  as S
+import qualified DynFlags                          as D
+import qualified EnumSet                           as S
 import           GHC
-import           Ide.Types
-import           Ide.PluginUtils
+import           GHC.LanguageExtensions.Type
+import           GhcPlugins                        (HscEnv (hsc_dflags))
 import           Ide.Plugin.Formatter
+import           Ide.PluginUtils
+import           Ide.Types
+import           Language.Haskell.LSP.Core         (LspFuncs (withIndefiniteProgress),
+                                                    ProgressCancellable (Cancellable))
 import           Language.Haskell.LSP.Types
 import           Ormolu
-import           Text.Regex.TDFA.Text()
+import           System.FilePath                   (takeFileName)
+import           Text.Regex.TDFA.Text              ()
 
 -- ---------------------------------------------------------------------
 
@@ -36,24 +43,24 @@ descriptor plId = (defaultPluginDescriptor plId)
 -- ---------------------------------------------------------------------
 
 provider :: FormattingProvider IO
-provider _lf ideState typ contents fp _ = do
+provider lf ideState typ contents fp _ = withIndefiniteProgress lf title Cancellable $ do
   let
-    fromDyn :: ParsedModule -> IO [DynOption]
-    fromDyn pmod =
+    fromDyn :: DynFlags -> IO [DynOption]
+    fromDyn df =
       let
-        df = ms_hspp_opts $ pm_mod_summary pmod
         pp =
           let p = D.sPgm_F $ D.settings df
           in  if null p then [] else ["-pgmF=" <> p]
         pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df
-        ex = map (("-X" <>) . show) $ S.toList $ D.extensionFlags df
+        ex = map showExtension $ S.toList $ D.extensionFlags df
       in
         return $ map DynOption $ pp <> pm <> ex
 
-  m_parsed <- runAction "Ormolu" ideState $ getParsedModule fp
-  fileOpts <- case m_parsed of
+  ghc <- runAction "Ormolu" ideState $ use GhcSession fp
+  let df = hsc_dflags . hscEnv <$> ghc
+  fileOpts <- case df of
           Nothing -> return []
-          Just pm -> fromDyn pm
+          Just df -> fromDyn df
 
   let
     fullRegion = RegionIndices Nothing Nothing
@@ -71,7 +78,12 @@ provider _lf ideState typ contents fp _ = do
       in
         ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el))
  where
+  title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp)
   ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
   ret (Left err) = Left
     (responseError (T.pack $ "ormoluCmd: " ++ show err) )
   ret (Right new) = Right (makeDiffTextEdit contents new)
+
+showExtension :: Extension -> String
+showExtension Cpp   = "-XCPP"
+showExtension other = "-X" ++ show other