From 172e8cfa202974d7e30a23c5114cd426eeae794d Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Fri, 24 Jan 2020 16:12:21 -0500 Subject: [PATCH 1/7] Ormolu range format --- src/Haskell/Ide/Engine/Plugin/Ormolu.hs | 102 +++++++++++++++++------- 1 file changed, 72 insertions(+), 30 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index b23109ed9..3483db2db 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs @@ -1,22 +1,29 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE TypeApplications #-} {-# 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 Ormolu +import Haskell.Ide.Engine.PluginUtils +import HIE.Bios.Types #endif ormoluDescriptor :: PluginId -> PluginDescriptor @@ -34,24 +41,59 @@ 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 opts' = + 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) + + case typ of + FormatText -> ret (fullRange contents) <$> fmt contents + 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. + pragmas = (takeWhile ("{-#" `T.isPrefixOf`) $ T.lines contents) <> [""] + unStrip ws new = + T.init $ T.unlines $ map (ws `T.append`) $ drop (length pragmas) $ 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 + ) + ) + (\(ws, striped) -> + ret (lineRange r) + <$> (fmap (unStrip ws) <$> fmt (T.unlines pragmas <> striped)) + ) + 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 From 4bb37bf711597ad26eac6a84412bf798e2199616 Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Sat, 25 Jan 2020 21:37:15 -0500 Subject: [PATCH 2/7] Fix Ormolu range format edge cases --- src/Haskell/Ide/Engine/Plugin/Ormolu.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index 3483db2db..0e429c956 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs @@ -62,10 +62,23 @@ provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do 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. - pragmas = (takeWhile ("{-#" `T.isPrefixOf`) $ T.lines contents) <> [""] + -- 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 = - T.init $ T.unlines $ map (ws `T.append`) $ drop (length pragmas) $ T.lines new + fixLine + $ T.unlines + $ map (ws `T.append`) + $ drop (length pragmas) + $ T.lines new mStrip = case txt of (l : _) -> let ws = fst $ T.span isSpace l From 6153a5a276dd7e06cab1ecbecee3c8bca00aae16 Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Sat, 25 Jan 2020 22:04:58 -0500 Subject: [PATCH 3/7] Move BlockArguments pragma --- src/Haskell/Ide/Engine/Plugin/Ormolu.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index 0e429c956..10a68ba1b 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} @@ -42,6 +41,7 @@ ormoluDescriptor plId = PluginDescriptor provider :: FormattingProvider #if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE BlockArguments #-} provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do opts <- lookupComponentOptions fp let opts' = From 16a807cefba8d570ab7a51752082f1d5bcc6b227 Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Sat, 25 Jan 2020 22:13:38 -0500 Subject: [PATCH 4/7] Fix pre 8.6 build --- src/Haskell/Ide/Engine/Plugin/Ormolu.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index 10a68ba1b..b15c6944f 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs @@ -108,5 +108,5 @@ provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do exop s = "-X" `isPrefixOf` s || "-fplugin=" `isPrefixOf` s || "-pgmF=" `isPrefixOf` s #else - provider _ _ _ _ = return $ IdeResultOk [] -- NOP formatter +provider _ _ _ _ = return $ IdeResultOk [] -- NOP formatter #endif From 4084859bdaa687ed93263f0c2183b4d683ff5535 Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Sun, 26 Jan 2020 15:29:58 -0500 Subject: [PATCH 5/7] Get file pragmas from DynFlags --- src/Haskell/Ide/Engine/Plugin/Ormolu.hs | 68 ++++++++++++------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index b15c6944f..f8137d77a 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/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) From 4a13f8778e4f422ad46a936f80debd52b129c332 Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Mon, 27 Jan 2020 18:47:59 -0500 Subject: [PATCH 6/7] Remove block arguments --- src/Haskell/Ide/Engine/Plugin/Ormolu.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index f8137d77a..1aac1a661 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs @@ -45,7 +45,6 @@ ormoluDescriptor plId = PluginDescriptor provider :: FormattingProvider #if __GLASGOW_HASKELL__ >= 806 -{-# LANGUAGE BlockArguments #-} provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do opts <- lookupComponentOptions fp let cradleOpts = From 02cef7f2b161adcf0bef111dd507aa7d45c93a9e Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Tue, 28 Jan 2020 13:43:14 -0500 Subject: [PATCH 7/7] Fix Ormolu removing preceding empty line --- src/Haskell/Ide/Engine/Plugin/Ormolu.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs index 1aac1a661..fa00aa410 100644 --- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs +++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs @@ -79,9 +79,12 @@ provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do txt = T.lines $ extractRange r contents lineRange (Range (Position sl _) (Position el _)) = Range (Position sl 0) $ Position el $ T.length $ last txt - fixLine t = if T.all isSpace $ last txt then t else T.init t + 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 = - fixLine $ T.unlines $ map (ws `T.append`) $ T.lines new + fixE $ T.unlines $ map (ws `T.append`) $ fixS $ T.lines new mStrip = case txt of (l : _) -> let ws = fst $ T.span isSpace l