Get file pragmas from DynFlags

Author: Avi-D-coder

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

@@ -20,9 +20,13 @@ import Data.Char
 import Data.List
 import Data.Maybe
 import qualified Data.Text as T
+import GHC
 import Ormolu
 import Haskell.Ide.Engine.PluginUtils
+import Haskell.Ide.Engine.Support.HieExtras
 import HIE.Bios.Types
+import qualified DynFlags as D
+import qualified EnumSet as S
 #endif
 
 ormoluDescriptor :: PluginId -> PluginDescriptor
@@ -44,62 +48,58 @@ provider :: FormattingProvider
 {-# LANGUAGE BlockArguments #-}
 provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do
  opts <- lookupComponentOptions fp
- let opts' =
+ let cradleOpts =
  map DynOption
  $ filter exop
  $ join
  $ maybeToList
  $ componentOptions
  <$> opts
- conf = Config opts' False False True False
- fmt :: T.Text -> IdeM (Either OrmoluException T.Text)
- fmt cont = liftIO $ try @OrmoluException (ormolu conf fp $ T.unpack cont)
+
+ fromDyn tcm _ () =
+ let
+ df = getDynFlags tcm
+ 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
+ in
+ return $ map DynOption $ pp <> pm <> ex
+ fileOpts <- ifCachedModuleAndData fp cradleOpts fromDyn
+ let
+ conf o = Config o False False True False
+ fmt :: T.Text -> [DynOption] -> IdeM (Either OrmoluException T.Text)
+ fmt cont o =
+ liftIO $ try @OrmoluException (ormolu (conf o) fp $ T.unpack cont)
 
  case typ of
- FormatText -> ret (fullRange contents) <$> fmt contents
+ FormatText -> ret (fullRange contents) <$> fmt contents cradleOpts
  FormatRange r ->
  let
  txt = T.lines $ extractRange r contents
  lineRange (Range (Position sl _) (Position el _)) =
  Range (Position sl 0) $ Position el $ T.length $ last txt
- -- Pragmas will not be picked up in a non standard location,
- -- or when range starts on a Pragma
- extPragmas = takeWhile ("{-#" `T.isPrefixOf`)
- pragmas =
- let cp = extPragmas $ T.lines contents
- rp = not $ null $ extPragmas txt
- in if null cp || rp
- then []
- -- head txt is safe when extractRange txt is safe
- else cp <> if T.all isSpace $ head txt then [] else [""]
  fixLine t = if T.all isSpace $ last txt then t else T.init t
  unStrip ws new =
- fixLine
- $ T.unlines
- $ map (ws `T.append`)
- $ drop (length pragmas)
- $ T.lines new
+ fixLine $ T.unlines $ map (ws `T.append`) $ T.lines new
  mStrip = case txt of
  (l : _) ->
  let ws = fst $ T.span isSpace l
  in (,) ws . T.unlines <$> traverse (T.stripPrefix ws) txt
  _ -> Nothing
- in
- maybe
- (return $ IdeResultFail
- (IdeError
- PluginError
- (T.pack
- "You must format a whole block of code. Ormolu does not support arbitrary ranges."
- )
- Null
+ err = return $ IdeResultFail
+ (IdeError
+ PluginError
+ (T.pack
+ "You must format a whole block of code. Ormolu does not support arbitrary ranges."
  )
+ Null
  )
- (\(ws, striped) ->
- ret (lineRange r)
- <$> (fmap (unStrip ws) <$> fmt (T.unlines pragmas <> striped))
- )
- mStrip
+ fmt' (ws, striped) =
+ ret (lineRange r) <$> (fmap (unStrip ws) <$> fmt striped fileOpts)
+ in
+ maybe err fmt' mStrip
  where
  ret _ (Left err) = IdeResultFail
  (IdeError PluginError (T.pack $ "ormoluCmd: " ++ show err) Null)