diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index b23109ed9..fa00aa410 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs @@ -2,21 +2,31 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -module Haskell.Ide.Engine.Plugin.Ormolu ( ormoluDescriptor ) where +module Haskell.Ide.Engine.Plugin.Ormolu + ( ormoluDescriptor + ) +where -import Haskell.Ide.Engine.MonadTypes +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.List -import Data.Maybe -import qualified Data.Text as T -import Ormolu -import Haskell.Ide.Engine.PluginUtils -import HIE.Bios.Types +import Control.Exception +import Control.Monad +import Control.Monad.IO.Class ( liftIO + , MonadIO(..) + ) +import Data.Aeson ( Value(Null) ) +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 @@ -34,24 +44,71 @@ ormoluDescriptor plId = PluginDescriptor provider :: FormattingProvider -provider _contents _uri _typ _opts = #if __GLASGOW_HASKELL__ >= 806 - case _typ of - FormatRange _ -> return $ IdeResultFail (IdeError PluginError (T.pack "Selection formatting for Ormolu is not currently supported.") Null) - FormatText -> pluginGetFile _contents _uri $ \file -> do - 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 (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 +provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do + opts <- lookupComponentOptions fp + let cradleOpts = + map DynOption + $ filter exop + $ join + $ maybeToList + $ componentOptions + <$> opts + + 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 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 + hIsSpace (h : _) = T.all isSpace h + hIsSpace _ = True + fixS t = if hIsSpace txt && (not $ hIsSpace t) then "" : t else t + fixE t = if T.all isSpace $ last txt then t else T.init t + unStrip ws new = + fixE $ T.unlines $ map (ws `T.append`) $ fixS $ 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 + err = return $ IdeResultFail + (IdeError + PluginError + (T.pack + "You must format a whole block of code. Ormolu does not support arbitrary ranges." + ) + Null + ) + 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) + ret r (Right new) = IdeResultOk [TextEdit r new] + + exop s = + "-X" `isPrefixOf` s || "-fplugin=" `isPrefixOf` s || "-pgmF=" `isPrefixOf` s #else - return $ IdeResultOk [] -- NOP formatter +provider _ _ _ _ = return $ IdeResultOk [] -- NOP formatter #endif