From 047d83284e80f2a6a0c41b149a18a31a6c6bfe73 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Tue, 26 May 2020 13:15:51 +0100
Subject: [PATCH 01/13] catch exceptions in plugin Commands
---
src/Ide/Plugin.hs | 11 ++++++++++-
1 file changed, 10 insertions(+), 1 deletion(-)
diff --git a/src/Ide/Plugin.hs b/src/Ide/Plugin.hs
index 0fd249745c..6077c0e91f 100644
--- a/src/Ide/Plugin.hs
+++ b/src/Ide/Plugin.hs
@@ -18,6 +18,7 @@ module Ide.Plugin
, responseError
) where
+import Control.Exception(SomeException, catch)
import Control.Lens ( (^.) )
import Control.Monad
import qualified Data.Aeson as J
@@ -206,7 +207,7 @@ executeCommandHandlers ecs = PartialHandlers $ \WithMessage{..} x -> return x{
-- -> ExecuteCommandParams
-- -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
makeExecuteCommands :: [(PluginId, [PluginCommand])] -> LSP.LspFuncs Config -> ExecuteCommandProvider
-makeExecuteCommands ecs lf ide = do
+makeExecuteCommands ecs lf ide = wrapUnhandledExceptions $ do
let
pluginMap = Map.fromList ecs
parseCmdId :: T.Text -> Maybe (PluginId, CommandId)
@@ -334,6 +335,14 @@ makeExecuteCommands ecs lf ide = do
-- | Runs a plugin command given a PluginId, CommandId and
-- arguments in the form of a JSON object.
+wrapUnhandledExceptions ::
+ (a -> IO (Either ResponseError J.Value, Maybe b)) ->
+ a -> IO (Either ResponseError J.Value, Maybe b)
+wrapUnhandledExceptions action input =
+ catch (action input) $ \(e::SomeException) -> do
+ let resp = ResponseError InternalError (T.pack $ show e) Nothing
+ return (Left resp, Nothing)
+
runPluginCommand :: Map.Map PluginId [PluginCommand]
-> LSP.LspFuncs Config
-> IdeState
From e70d7e8255e2cd26595be0e394affa9b0ea1529f Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 09:05:15 +0100
Subject: [PATCH 02/13] add retrie to shell.nix
---
shell.nix | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/shell.nix b/shell.nix
index c485fe801b..7f0ffcc9be 100644
--- a/shell.nix
+++ b/shell.nix
@@ -17,7 +17,8 @@ let defaultCompiler = "ghc" + lib.replaceStrings ["."] [""] haskellPackages.ghc.
# for all other compilers there is no Nix cache so dont bother building deps with NIx
else haskell.packages.${compiler}.ghcWithPackages (_: []);
- compilerWithPackages = haskellPackagesForProject(p:
+ retrie = with haskell.lib; dontCheck(disableLibraryProfiling(haskellPackages.retrie));
+ compilerWithPackages = haskellPackagesForProject(p:
with p;
[
Diff
@@ -66,6 +67,7 @@ let defaultCompiler = "ghc" + lib.replaceStrings ["."] [""] haskellPackages.ghc.
primes
psqueues
regex-tdfa
+ retrie
rope-utf16-splay
safe-exceptions
shake
From f8f58c90256bb0035b8513e84bbc4dd13d044712 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Wed, 20 May 2020 19:32:35 +0100
Subject: [PATCH 03/13] Initial Retrie plugin
Supports RULES, functions and type synonyms
Future work:
- Handling names properly (when retrie/#10 is fixed)
- Suggestions for pattern synonyms (when retrie/#15 is released)
- Refactorings: rename, extract, move, etc..
- Automatically add imports when unfolding
- Proper support for workspace folders
---
exe/Main.hs | 2 +
haskell-language-server.cabal | 3 +
src/Ide/Plugin/Retrie.hs | 532 ++++++++++++++++++++++++++++++++++
3 files changed, 537 insertions(+)
create mode 100644 src/Ide/Plugin/Retrie.hs
diff --git a/exe/Main.hs b/exe/Main.hs
index 081f261cac..67f35c2a64 100644
--- a/exe/Main.hs
+++ b/exe/Main.hs
@@ -69,6 +69,7 @@ import Ide.Plugin.GhcIde as GhcIde
import Ide.Plugin.Floskell as Floskell
import Ide.Plugin.Ormolu as Ormolu
import Ide.Plugin.StylishHaskell as StylishHaskell
+import Ide.Plugin.Retrie as Retrie
#if AGPL
import Ide.Plugin.Brittany as Brittany
#endif
@@ -105,6 +106,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
-- , ghcmodDescriptor "ghcmod"
, Ormolu.descriptor "ormolu"
, StylishHaskell.descriptor "stylish-haskell"
+ , Retrie.descriptor "retrie"
#if AGPL
, Brittany.descriptor "brittany"
#endif
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
index 120f1dcce2..30a2495db4 100644
--- a/haskell-language-server.cabal
+++ b/haskell-language-server.cabal
@@ -47,6 +47,7 @@ library
Ide.Plugin.GhcIde
Ide.Plugin.Ormolu
Ide.Plugin.Pragmas
+ Ide.Plugin.Retrie
Ide.Plugin.Floskell
Ide.Plugin.Formatter
Ide.Plugin.StylishHaskell
@@ -83,6 +84,8 @@ library
, optparse-simple
, process
, regex-tdfa >= 1.3.1.0
+ , retrie >= 0.1.1.0
+ , safe-exceptions
, shake >= 0.17.5
, stylish-haskell == 0.11.*
, temporary
diff --git a/src/Ide/Plugin/Retrie.hs b/src/Ide/Plugin/Retrie.hs
new file mode 100644
index 0000000000..3ddc981d66
--- /dev/null
+++ b/src/Ide/Plugin/Retrie.hs
@@ -0,0 +1,532 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS -Wno-orphans #-}
+#include "ghc-api-version.h"
+
+module Ide.Plugin.Retrie (descriptor) where
+
+import Control.Exception.Safe (Exception (..), SomeException,
+ catch, throwIO, try)
+import Control.Monad (forM, unless)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Control.Monad.Trans.Class (MonadTrans (lift))
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT,
+ throwE)
+import Data.Aeson (ToJSON (toJSON), Value (Null))
+import Data.Aeson.Types (FromJSON)
+import Data.Bifunctor (Bifunctor (first), second)
+import Data.Coerce
+import Data.Either (partitionEithers)
+import qualified Data.HashMap.Strict as HM
+import Data.IORef.Extra (atomicModifyIORef'_, newIORef,
+ readIORef)
+import Data.List.Extra (nubOrdOn)
+import Data.String (IsString (fromString))
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Typeable (Typeable)
+import Development.IDE.Core.FileStore (getFileContents)
+import Development.IDE.Core.Rules
+import Development.IDE.Core.RuleTypes as Ghcide (GetModIface (..),
+ GetModSummary (..),
+ GhcSessionDeps (..),
+ HiFileResult (..),
+ TypeCheck (..),
+ tmrModule)
+import Development.IDE.Core.Shake (IdeRule,
+ IdeState (shakeExtras),
+ runIdeAction, use,
+ useWithStaleFast, use_)
+import Development.IDE.GHC.Error (isInsideSrcSpan,
+ srcSpanToRange)
+import Development.IDE.GHC.Util (hscEnv, prettyPrint, runGhcEnv)
+import Development.IDE.Types.Location
+import Development.Shake (RuleResult)
+import GHC (GenLocated (L), GhcRn,
+ HsBindLR (FunBind),
+ HsGroup (..),
+ HsValBindsLR (..), HscEnv, IdP,
+ LRuleDecls,
+ ModIface (mi_fixities),
+ ModSummary (ModSummary, ms_hspp_buf, ms_mod),
+ NHsValBindsLR (..),
+ ParsedModule (..),
+ RuleDecl (HsRule),
+ RuleDecls (HsRules),
+ SrcSpan (..),
+ TyClDecl (SynDecl),
+ TyClGroup (..),
+ TypecheckedModule (..), fun_id,
+ moduleNameString, parseModule,
+ rds_rules, srcSpanFile)
+import GHC.Generics (Generic)
+import GhcPlugins (Outputable,
+ SourceText (NoSourceText),
+ isQual, isQual_maybe,
+ nameModule_maybe, nameRdrName,
+ occNameFS, occNameString,
+ rdrNameOcc, unpackFS)
+import Ide.Plugin
+import Ide.Types
+import Language.Haskell.LSP.Core (LspFuncs (..), ProgressCancellable (Cancellable))
+import Language.Haskell.LSP.Messages (FromServerMessage (NotShowMessage))
+import Language.Haskell.LSP.Types as J
+import Retrie.CPP (CPP (NoCPP), parseCPP,
+ printCPP)
+import Retrie.ExactPrint (fix, relativiseApiAnns,
+ transformA, unsafeMkA)
+import Retrie.Fixity (mkFixityEnv)
+import qualified Retrie.GHC as GHC
+import Retrie.Monad (addImports, apply,
+ getGroundTerms, runRetrie)
+import Retrie.Options (defaultOptions, getTargetFiles)
+import qualified Retrie.Options as Retrie
+import Retrie.Replace (Change (..), Replacement (..))
+import Retrie.Rewrites
+import Retrie.SYB (listify)
+import Retrie.Util (Verbosity (Loud))
+import StringBuffer (stringToStringBuffer)
+import System.Directory (makeAbsolute)
+
+descriptor :: PluginId -> PluginDescriptor
+descriptor plId =
+ (defaultPluginDescriptor plId)
+ { pluginCodeActionProvider = Just provider,
+ pluginCommands = [retrieCommand]
+ }
+
+retrieCommandName :: T.Text
+retrieCommandName = "retrieCommand"
+
+retrieCommand :: PluginCommand
+retrieCommand =
+ PluginCommand (coerce retrieCommandName) "run the refactoring" runRetrieCmd
+
+-- | Parameters for the runRetrie PluginCommand.
+data RunRetrieParams = RunRetrieParams
+ { description :: T.Text,
+ -- | rewrites for Retrie
+ rewrites :: [Either ImportSpec RewriteSpec],
+ -- | Originating file
+ originatingFile :: String -- NormalizedFilePath
+ }
+ deriving (Eq, Show, Generic, FromJSON, ToJSON)
+
+runRetrieCmd ::
+ LspFuncs a ->
+ IdeState ->
+ RunRetrieParams ->
+ IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
+runRetrieCmd lsp state RunRetrieParams {..} =
+ withIndefiniteProgress lsp description Cancellable $ do
+ session <-
+ runAction "Retrie.GhcSessionDeps" state $
+ use_ GhcSessionDeps $
+ toNormalizedFilePath originatingFile
+ (errors, edits) <-
+ callRetrie
+ state
+ (hscEnv session)
+ rewrites
+ (toNormalizedFilePath originatingFile)
+ unless (null errors) $
+ sendFunc lsp $
+ NotShowMessage $
+ NotificationMessage "2.0" WindowShowMessage $
+ ShowMessageParams MtWarning $
+ T.unlines $
+ "## Found errors during rewrite:" :
+ ["-" <> T.pack (show e) | e <- errors]
+ return
+ (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams edits))
+
+-------------------------------------------------------------------------------
+
+provider :: CodeActionProvider
+provider _a state plId (TextDocumentIdentifier uri) range ca = response $ do
+ let (J.CodeActionContext _diags _monly) = ca
+ fp <- handleMaybe "uri" $ uriToFilePath' uri
+ let nfp = toNormalizedFilePath' fp
+
+ tm <-
+ handleMaybeM "no typechecked module" $
+ useRule "retrie.typecheckModule" state TypeCheck nfp
+
+ ModSummary {ms_mod} <-
+ handleMaybeM "no mod summary" $
+ useRule "retrie.typecheckModule" state GetModSummary nfp
+
+ -- we use the typechecked source instead of the parsed source
+ -- to be able to extract module names from the Ids,
+ -- so that we can include adding the required imports in the retrie command
+ let TypecheckedModule {tm_renamed_source = Just rn} = tmrModule tm
+ ( HsGroup
+ { hs_valds =
+ XValBindsLR
+ (NValBinds binds _sigs :: NHsValBindsLR GHC.GhcRn),
+ hs_ruleds,
+ hs_tyclds
+ },
+ _,
+ _,
+ _
+ ) = rn
+
+ pos = _start range
+ topLevelBinds =
+ [ decl
+ | (_, bagBinds) <- binds,
+ L _ decl <- GHC.bagToList bagBinds
+ ]
+
+ rewrites =
+ concatMap (suggestBindRewrites fp pos ms_mod) topLevelBinds
+ ++ concatMap (suggestRuleRewrites fp pos ms_mod) hs_ruleds
+ ++ [ r
+ | TyClGroup {group_tyclds} <- hs_tyclds,
+ L _ g <- group_tyclds,
+ r <- suggestTypeRewrites fp pos ms_mod g
+ ]
+
+ commands <- lift $
+ forM rewrites $ \(title, kind, params) -> do
+ c <- mkLspCommand plId (coerce retrieCommandName) title (Just [toJSON params])
+ return $ CodeAction title (Just kind) Nothing Nothing (Just c)
+
+ return $ J.List [CACodeAction c | c <- commands]
+
+suggestBindRewrites ::
+ String ->
+ Position ->
+ GHC.Module ->
+ HsBindLR GhcRn GhcRn ->
+ [(T.Text, CodeActionKind, RunRetrieParams)]
+suggestBindRewrites originatingFile pos ms_mod (FunBind {fun_id = L l' rdrName, fun_matches})
+ | pos `isInsideSrcSpan` l' =
+ let pprName = prettyPrint rdrName
+ pprNameText = T.pack pprName
+ names = listify p fun_matches
+ p name = nameModule_maybe name /= Just ms_mod
+ imports =
+ [ AddImport {..}
+ | name <- names,
+ Just ideclNameString <-
+ [moduleNameString . GHC.moduleName <$> nameModule_maybe name],
+ let ideclSource = False,
+ let r = nameRdrName name,
+ let ideclQualifiedBool = isQual r,
+ let ideclAsString = moduleNameString . fst <$> isQual_maybe r,
+ let ideclThing = Just (IEVar $ occNameString $ rdrNameOcc r)
+ ]
+ in [ let rewrites =
+ [Right $ Unfold (qualify ms_mod pprName)]
+ ++ map Left imports
+ description = "Unfold " <> pprNameText
+ in (description, CodeActionRefactorInline, RunRetrieParams {..}),
+ let rewrites = [Right $ Fold (qualify ms_mod pprName)]
+ description = "Fold " <> pprNameText
+ in (description, CodeActionRefactorExtract, RunRetrieParams {..})
+ ]
+suggestBindRewrites _ _ _ _ = []
+
+-- TODO add imports to the rewrite
+suggestTypeRewrites ::
+ (Outputable (IdP pass)) =>
+ String ->
+ Position ->
+ GHC.Module ->
+ TyClDecl pass ->
+ [(T.Text, CodeActionKind, RunRetrieParams)]
+suggestTypeRewrites originatingFile pos ms_mod (SynDecl {tcdLName = L l rdrName})
+ | pos `isInsideSrcSpan` l =
+ let pprName = prettyPrint rdrName
+ pprNameText = T.pack pprName
+ in [ let rewrites = [Right $ TypeForward (qualify ms_mod pprName)]
+ description = "Unfold " <> pprNameText
+ in (description, CodeActionRefactorInline, RunRetrieParams {..}),
+ let rewrites = [Right $ TypeBackward (qualify ms_mod pprName)]
+ description = "Fold " <> pprNameText
+ in (description, CodeActionRefactorExtract, RunRetrieParams {..})
+ ]
+suggestTypeRewrites _ _ _ _ = []
+
+-- TODO add imports to the rewrite
+suggestRuleRewrites ::
+ FilePath ->
+ Position ->
+ GHC.Module ->
+ LRuleDecls pass ->
+ [(T.Text, CodeActionKind, RunRetrieParams)]
+suggestRuleRewrites originatingFile pos ms_mod (L l (HsRules {rds_rules}))
+ | pos `isInsideSrcSpan` l =
+ concat
+ [ [ let rewrites =
+ [Right $ RuleForward (qualify ms_mod ruleName)]
+ description = "Apply rule " <> T.pack ruleName <> " forward"
+ in ( description,
+ CodeActionRefactor,
+ RunRetrieParams {..}
+ ),
+ let rewrites =
+ [Right $ RuleBackward (qualify ms_mod ruleName)]
+ description = "Apply rule " <> T.pack ruleName <> " backwards"
+ in ( description,
+ CodeActionRefactor,
+ RunRetrieParams {..}
+ )
+ ]
+ | L _ (HsRule _ (L _ (_, rn)) _ _ _ _ _) <- rds_rules,
+ let ruleName = unpackFS rn
+ ]
+suggestRuleRewrites _ _ _ _ = []
+
+qualify :: GHC.Module -> String -> String
+qualify ms_mod x = prettyPrint ms_mod <> "." <> x
+
+-------------------------------------------------------------------------------
+-- Retrie driving code
+
+data CallRetrieError
+ = CallRetrieInternalError String NormalizedFilePath
+ | NoParse NormalizedFilePath
+ | GHCParseError NormalizedFilePath String
+ | NoTypeCheck NormalizedFilePath
+ deriving (Eq, Typeable)
+
+instance Show CallRetrieError where
+ show (CallRetrieInternalError msg f) = msg <> " - " <> fromNormalizedFilePath f
+ show (NoParse f) = "Cannot parse: " <> fromNormalizedFilePath f
+ show (GHCParseError f m) = "Cannot parse " <> fromNormalizedFilePath f <> " : " <> m
+ show (NoTypeCheck f) = "File does not typecheck: " <> fromNormalizedFilePath f
+
+instance Exception CallRetrieError
+
+callRetrie ::
+ IdeState ->
+ HscEnv ->
+ [Either ImportSpec RewriteSpec] ->
+ NormalizedFilePath ->
+ IO ([CallRetrieError], WorkspaceEdit)
+callRetrie state session rewrites origin = do
+ let reuseParsedModule f = do
+ pm <-
+ useOrFail "GetParsedModule" NoParse GetParsedModule f
+ (fixities, pm) <- fixFixities f (fixAnns pm)
+ return (fixities, pm)
+ getCPPmodule t = do
+ nt <- toNormalizedFilePath' <$> makeAbsolute t
+ let getParsedModule f contents = do
+ modSummary <-
+ useOrFail "GetModSummary" (CallRetrieInternalError "file not found") GetModSummary nt
+ let ms' =
+ modSummary
+ { ms_hspp_buf =
+ Just (stringToStringBuffer contents)
+ }
+ (_, parsed) <-
+ runGhcEnv session (parseModule ms')
+ `catch` \e -> throwIO (GHCParseError nt (show @SomeException e))
+ (fixities, parsed) <- fixFixities f (fixAnns parsed)
+ return (fixities, parsed)
+
+ contents <- do
+ (_, mbContentsVFS) <-
+ runAction "Retrie.GetFileContents" state $ getFileContents nt
+ case mbContentsVFS of
+ Just contents -> return contents
+ Nothing -> T.readFile (fromNormalizedFilePath nt)
+ if any (T.isPrefixOf "#if" . T.toLower) (T.lines contents)
+ then do
+ fixitiesRef <- newIORef mempty
+ let parseModule x = do
+ (fix, res) <- getParsedModule nt x
+ atomicModifyIORef'_ fixitiesRef (fix <>)
+ return res
+ res <- parseCPP parseModule contents
+ fixities <- readIORef fixitiesRef
+ return (fixities, res)
+ else do
+ (fixities, pm) <- reuseParsedModule nt
+ return (fixities, NoCPP pm)
+
+ -- TODO cover all workspaceFolders
+ target = "."
+
+ retrieOptions :: Retrie.Options
+ retrieOptions = (defaultOptions target) {Retrie.verbosity = Loud}
+
+ (theImports, theRewrites) = partitionEithers rewrites
+
+ annotatedImports =
+ unsafeMkA (map (GHC.noLoc . toImportDecl) theImports) mempty 0
+
+ (originFixities, originParsedModule) <- reuseParsedModule origin
+ retrie <-
+ (\specs -> apply specs >> addImports annotatedImports)
+ <$> parseRewriteSpecs
+ (\_f -> return $ NoCPP originParsedModule)
+ originFixities
+ theRewrites
+
+ targets <- getTargetFiles retrieOptions (getGroundTerms retrie)
+
+ results <- forM targets $ \t -> runExceptT $ do
+ (fixityEnv, cpp) <- ExceptT $ try $ getCPPmodule t
+ (_user, ast, change@(Change replacements _imports)) <-
+ lift $ runRetrie fixityEnv retrie cpp
+ case ast of
+ _ ->
+ -- NoCPP {} ->
+ return $ asTextEdits change
+ _ -> do
+ -- DEBUG CODE bypass replacements and use the rewritten ast instead
+ -- we would want to do this to capture import edits
+ let new = T.pack $ printCPP replacements ast
+ uri = Uri $ T.pack t
+ change' = [(uri, TextEdit wholeDocument new)]
+ return change'
+
+ let (errors :: [CallRetrieError], replacements) = partitionEithers results
+ editParams :: WorkspaceEdit
+ editParams =
+ WorkspaceEdit (Just $ asEditMap replacements) Nothing
+
+ return (errors, editParams)
+ where
+ useOrFail ::
+ IdeRule r v =>
+ String ->
+ (NormalizedFilePath -> CallRetrieError) ->
+ r ->
+ NormalizedFilePath ->
+ IO (RuleResult r)
+ useOrFail lbl mkException rule f =
+ useRule lbl state rule f >>= maybe (liftIO $ throwIO $ mkException f) return
+ fixityEnvFromModIface modIface =
+ mkFixityEnv
+ [ (fs, (fs, fixity))
+ | (n, fixity) <- mi_fixities modIface,
+ let fs = occNameFS n
+ ]
+ fixFixities f pm = do
+ HiFileResult {hirModIface} <-
+ useOrFail "GetModIface" NoTypeCheck GetModIface f
+ let fixities = fixityEnvFromModIface hirModIface
+ res <- transformA pm (fix fixities)
+ return (fixities, res)
+ fixAnns ParsedModule {..} =
+ let ranns = relativiseApiAnns pm_parsed_source pm_annotations
+ in unsafeMkA pm_parsed_source ranns 0
+
+wholeDocument :: Range
+wholeDocument = Range (Position 0 0) (Position maxBound 0)
+
+asEditMap :: [[(Uri, TextEdit)]] -> WorkspaceEditMap
+asEditMap = coerce . HM.fromListWith (++) . concatMap (map (second pure))
+
+asTextEdits :: Change -> [(Uri, TextEdit)]
+asTextEdits NoChange = []
+asTextEdits (Change reps _imports) =
+ -- TODO retrie does not include import edits in the 'reps' list
+ -- fix this in retrie or work around it here
+ [ (Uri spanLoc, edit)
+ | Replacement {..} <- nubOrdOn replLocation reps,
+ s@(RealSrcSpan rspan) <- [replLocation],
+ let spanLoc = T.pack $ unpackFS $ srcSpanFile rspan,
+ let edit = TextEdit (srcSpanToRange s) (T.pack replReplacement)
+ ]
+
+-------------------------------------------------------------------------------
+-- Rule wrappers
+
+_useRuleBlocking,
+ _useRuleStale,
+ useRule ::
+ (IdeRule k v) =>
+ String ->
+ IdeState ->
+ k ->
+ NormalizedFilePath ->
+ IO (Maybe (RuleResult k))
+_useRuleBlocking label state rule f = runAction label state (use rule f)
+_useRuleStale label state rule f =
+ fmap fst
+ <$> runIdeAction label (shakeExtras state) (useWithStaleFast rule f)
+
+-- | Chosen approach for calling ghcide Shake rules
+useRule label = _useRuleStale ("Retrie." <> label)
+
+-------------------------------------------------------------------------------
+-- Error handling combinators
+
+handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
+handleMaybe msg = maybe (throwE msg) return
+
+handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
+handleMaybeM msg act = maybe (throwE msg) return =<< lift act
+
+response :: ExceptT String IO a -> IO (Either ResponseError a)
+response =
+ fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))
+ . runExceptT
+
+-------------------------------------------------------------------------------
+-- Serialization wrappers and instances
+
+deriving instance Eq RewriteSpec
+
+deriving instance Show RewriteSpec
+
+deriving instance Generic RewriteSpec
+
+deriving instance FromJSON RewriteSpec
+
+deriving instance ToJSON RewriteSpec
+
+data QualName = QualName {qual, name :: String}
+ deriving (Eq, Show, Generic, FromJSON, ToJSON)
+
+data IE name
+ = IEVar name
+ deriving (Eq, Show, Generic, FromJSON, ToJSON)
+
+data ImportSpec = AddImport
+ { ideclNameString :: String,
+ ideclSource :: Bool,
+ ideclQualifiedBool :: Bool,
+ ideclAsString :: Maybe String,
+ ideclThing :: Maybe (IE String)
+ }
+ deriving (Eq, Show, Generic, FromJSON, ToJSON)
+
+toImportDecl :: ImportSpec -> GHC.ImportDecl GHC.GhcPs
+toImportDecl AddImport {..} = GHC.ImportDecl {..}
+ where
+ toMod = GHC.noLoc . GHC.mkModuleName
+ ideclName = toMod ideclNameString
+ ideclPkgQual = Nothing
+ ideclSafe = False
+ ideclImplicit = False
+ ideclHiding = Nothing
+ ideclSourceSrc = NoSourceText
+ ideclExt = GHC.noExtField
+ ideclAs = toMod <$> ideclAsString
+
+#if MIN_GHC_API_VERSION(8,10,0)
+
+ ideclQualified = if ideclQualifiedBool then GHC.QualifiedPre else GHC.NotQualified
+#else
+ ideclQualified = ideclQualifiedBool
+#endif
From 0722bfd90d7c2777fc8a2897c3c0d3e492fb2b3e Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 13:58:05 +0100
Subject: [PATCH 04/13] Add README entry
---
README.md | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/README.md b/README.md
index cf4624f688..fca6598591 100644
--- a/README.md
+++ b/README.md
@@ -71,6 +71,10 @@ This is *very* early stage software.
This will cause compilation errors if a dependency contains invalid Haddock markup, though in a future version of GHC (hopefully 8.12), [these will be demoted to warnings](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2377).
+ - Integration with [retrie](https://hackage.haskell.org/package/retrie)
+
+ 
+
- Many more (TBD)
## Installation
From 5e0e798c2dc4ec10b6b57cec3deb269a90a11a07 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 15:37:14 +0100
Subject: [PATCH 05/13] Fix comment out of place
---
src/Ide/Plugin.hs | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/src/Ide/Plugin.hs b/src/Ide/Plugin.hs
index 6077c0e91f..a9745345a3 100644
--- a/src/Ide/Plugin.hs
+++ b/src/Ide/Plugin.hs
@@ -332,9 +332,6 @@ makeExecuteCommands ecs lf ide = wrapUnhandledExceptions $ do
-}
-- -----------------------------------------------------------
-
--- | Runs a plugin command given a PluginId, CommandId and
--- arguments in the form of a JSON object.
wrapUnhandledExceptions ::
(a -> IO (Either ResponseError J.Value, Maybe b)) ->
a -> IO (Either ResponseError J.Value, Maybe b)
@@ -343,6 +340,9 @@ wrapUnhandledExceptions action input =
let resp = ResponseError InternalError (T.pack $ show e) Nothing
return (Left resp, Nothing)
+
+-- | Runs a plugin command given a PluginId, CommandId and
+-- arguments in the form of a JSON object.
runPluginCommand :: Map.Map PluginId [PluginCommand]
-> LSP.LspFuncs Config
-> IdeState
From 6ff62c4a811e36ab1173dde814bc024e7b6ef9a3 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 15:46:56 +0100
Subject: [PATCH 06/13] Compat with 8.10
---
src/Ide/Plugin/Retrie.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/Ide/Plugin/Retrie.hs b/src/Ide/Plugin/Retrie.hs
index 3ddc981d66..741a615910 100644
--- a/src/Ide/Plugin/Retrie.hs
+++ b/src/Ide/Plugin/Retrie.hs
@@ -59,7 +59,7 @@ import GHC (GenLocated (L), GhcRn,
HsGroup (..),
HsValBindsLR (..), HscEnv, IdP,
LRuleDecls,
- ModIface (mi_fixities),
+ mi_fixities,
ModSummary (ModSummary, ms_hspp_buf, ms_mod),
NHsValBindsLR (..),
ParsedModule (..),
From b8627c2254a67fe21905b449e1ba538578652899 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 15:53:04 +0100
Subject: [PATCH 07/13] Add retrie to all? the stack.yaml descriptors
---
stack-8.10.1.yaml | 3 +++
stack-8.6.4.yaml | 7 +++++++
stack-8.6.5.yaml | 6 +++++-
stack-8.8.2.yaml | 3 +++
stack-8.8.3.yaml | 3 +++
stack-8.8.4.yaml | 3 +++
stack.yaml | 6 +++++-
7 files changed, 29 insertions(+), 2 deletions(-)
diff --git a/stack-8.10.1.yaml b/stack-8.10.1.yaml
index bc51cd64b9..8d62e3c008 100644
--- a/stack-8.10.1.yaml
+++ b/stack-8.10.1.yaml
@@ -19,6 +19,7 @@ extra-deps:
- monad-dijkstra-0.1.1.2
- optics-core-0.3
- ormolu-0.1.2.0
+- retrie-0.1.1.1
- stylish-haskell-0.11.0.0
- semigroups-0.18.5
- temporary-1.2.1.1
@@ -31,6 +32,8 @@ flags:
# but brittany is not usable with ghc-8.10.1
# see https://github.com/lspitzner/brittany/issues/269
agpl: false
+ retrie:
+ BuildExecutable: false
# allow-newer: true
diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml
index 082611ddb4..cbb071ca8f 100644
--- a/stack-8.6.4.yaml
+++ b/stack-8.6.4.yaml
@@ -9,6 +9,8 @@ ghc-options:
extra-deps:
- aeson-1.4.3.0
+- ansi-terminal-0.10.3
+- async-2.2.2
- brittany-0.12.1.1
- butcher-1.3.3.1
- bytestring-trie-0.2.5.0
@@ -46,13 +48,16 @@ extra-deps:
- multistate-0.8.0.1
- ormolu-0.1.2.0
- opentelemetry-0.4.2
+- optparse-applicative-0.15.1.0
- parser-combinators-1.2.1
- regex-base-0.94.0.0
- regex-tdfa-1.3.1.0
+- retrie-0.1.1.1
- rope-utf16-splay-0.3.1.0
- shake-0.19.1
- strict-list-0.1.5
- stylish-haskell-0.11.0.0
+- syb-0.7.1
- syz-0.2.0.0
- tasty-rerun-1.1.17
- temporary-1.2.1.1
@@ -68,6 +73,8 @@ extra-deps:
flags:
haskell-language-server:
pedantic: true
+ retrie:
+ BuildExecutable: false
# allow-newer: true
diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml
index 771d6f3882..fe45cb734a 100644
--- a/stack-8.6.5.yaml
+++ b/stack-8.6.5.yaml
@@ -8,7 +8,7 @@ ghc-options:
"$everything": -haddock
extra-deps:
-- ansi-terminal-0.10.2
+- ansi-terminal-0.10.3
- base-compat-0.11.0
- brittany-0.12.1.1@rev:2
- butcher-1.3.3.1
@@ -20,6 +20,7 @@ extra-deps:
- fuzzy-0.1.0.0
# - ghcide-0.1.0
- ghc-check-0.5.0.1
+- ghc-exactprint-0.6.2
- ghc-lib-parser-8.10.1.20200523
- ghc-lib-parser-ex-8.10.0.4
- haddock-api-2.22.0@rev:1
@@ -41,6 +42,7 @@ extra-deps:
- regex-base-0.94.0.0
- regex-pcre-builtin-0.95.1.1.8.43
- regex-tdfa-1.3.1.0
+- retrie-0.1.1.1
- semialign-1.1
# - github: wz1000/shake
# commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef
@@ -53,6 +55,8 @@ extra-deps:
flags:
haskell-language-server:
pedantic: true
+ retrie:
+ BuildExecutable: false
# allow-newer: true
diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml
index 99e5c20f3b..0d3b2d5ca3 100644
--- a/stack-8.8.2.yaml
+++ b/stack-8.8.2.yaml
@@ -35,6 +35,7 @@ extra-deps:
- monad-dijkstra-0.1.1.2
- opentelemetry-0.4.2
- ormolu-0.1.2.0
+- retrie-0.1.1.1
- semigroups-0.18.5
# - github: wz1000/shake
# commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef
@@ -44,6 +45,8 @@ extra-deps:
flags:
haskell-language-server:
pedantic: true
+ retrie:
+ BuildExecutable: false
# allow-newer: true
diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml
index b972a17e4e..71a81374c1 100644
--- a/stack-8.8.3.yaml
+++ b/stack-8.8.3.yaml
@@ -24,6 +24,7 @@ extra-deps:
- ilist-0.3.1.0
- lsp-test-0.11.0.3
- monad-dijkstra-0.1.1.2
+- retrie-0.1.1.1
- semigroups-0.18.5
# - github: wz1000/shake
# commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef
@@ -32,6 +33,8 @@ extra-deps:
flags:
haskell-language-server:
pedantic: true
+ retrie:
+ BuildExecutable: false
# allow-newer: true
diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml
index 59d3327346..d2f1d8449a 100644
--- a/stack-8.8.4.yaml
+++ b/stack-8.8.4.yaml
@@ -26,6 +26,7 @@ extra-deps:
- ilist-0.3.1.0
- lsp-test-0.11.0.3
- monad-dijkstra-0.1.1.2
+- retrie-0.1.1.1
- semigroups-0.18.5
# - github: wz1000/shake
# commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef
@@ -34,6 +35,8 @@ extra-deps:
flags:
haskell-language-server:
pedantic: true
+ retrie:
+ BuildExecutable: false
# allow-newer: true
diff --git a/stack.yaml b/stack.yaml
index 71c2bd1d51..a3fb790819 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -8,7 +8,7 @@ ghc-options:
"$everything": -haddock
extra-deps:
-- ansi-terminal-0.10.2
+- ansi-terminal-0.10.3
- base-compat-0.11.0
- brittany-0.12.1.1@rev:2
- butcher-1.3.3.1
@@ -20,6 +20,7 @@ extra-deps:
- fuzzy-0.1.0.0
# - ghcide-0.1.0
- ghc-check-0.5.0.1
+- ghc-exactprint-0.6.2
- ghc-lib-parser-8.10.1.20200523
- ghc-lib-parser-ex-8.10.0.4
- haddock-api-2.22.0@rev:1
@@ -41,6 +42,7 @@ extra-deps:
- regex-base-0.94.0.0
- regex-pcre-builtin-0.95.1.1.8.43
- regex-tdfa-1.3.1.0
+- retrie-0.1.1.1
- semialign-1.1
- stylish-haskell-0.11.0.0
- tasty-rerun-1.1.17
@@ -51,6 +53,8 @@ extra-deps:
flags:
haskell-language-server:
pedantic: true
+ retrie:
+ BuildExecutable: false
# allow-newer: true
From 7eb593fa58c7d6622b6a66b420fb6ddb8c1601ea Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 16:18:53 +0100
Subject: [PATCH 08/13] Add ghc-api-version.h from ghcide
---
haskell-language-server.cabal | 3 +++
include/ghc-api-version.h | 10 ++++++++++
2 files changed, 13 insertions(+)
create mode 100644 include/ghc-api-version.h
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
index 30a2495db4..7d598bb0f9 100644
--- a/haskell-language-server.cabal
+++ b/haskell-language-server.cabal
@@ -15,6 +15,7 @@ build-type: Simple
extra-source-files:
README.md
ChangeLog.md
+ include/ghc-api-version.h
flag agpl
Description: Enable AGPL dependencies
@@ -93,6 +94,8 @@ library
, time
, transformers
, unordered-containers
+ include-dirs:
+ include
if os(windows)
build-depends: Win32
else
diff --git a/include/ghc-api-version.h b/include/ghc-api-version.h
new file mode 100644
index 0000000000..11cabb3dc9
--- /dev/null
+++ b/include/ghc-api-version.h
@@ -0,0 +1,10 @@
+#ifndef GHC_API_VERSION_H
+#define GHC_API_VERSION_H
+
+#ifdef GHC_LIB
+#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib(x,y,z)
+#else
+#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc(x,y,z)
+#endif
+
+#endif
From a25b1e3183086496010c534be135ba91c2e297c1 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 16:32:50 +0100
Subject: [PATCH 09/13] drop unused debug code and add TODO for import
replacements
---
src/Ide/Plugin/Retrie.hs | 19 +++----------------
1 file changed, 3 insertions(+), 16 deletions(-)
diff --git a/src/Ide/Plugin/Retrie.hs b/src/Ide/Plugin/Retrie.hs
index 741a615910..32241f5cb1 100644
--- a/src/Ide/Plugin/Retrie.hs
+++ b/src/Ide/Plugin/Retrie.hs
@@ -83,8 +83,7 @@ import Ide.Types
import Language.Haskell.LSP.Core (LspFuncs (..), ProgressCancellable (Cancellable))
import Language.Haskell.LSP.Messages (FromServerMessage (NotShowMessage))
import Language.Haskell.LSP.Types as J
-import Retrie.CPP (CPP (NoCPP), parseCPP,
- printCPP)
+import Retrie.CPP (CPP (NoCPP), parseCPP)
import Retrie.ExactPrint (fix, relativiseApiAnns,
transformA, unsafeMkA)
import Retrie.Fixity (mkFixityEnv)
@@ -384,19 +383,12 @@ callRetrie state session rewrites origin = do
results <- forM targets $ \t -> runExceptT $ do
(fixityEnv, cpp) <- ExceptT $ try $ getCPPmodule t
- (_user, ast, change@(Change replacements _imports)) <-
+ -- TODO add the imports to the resulting edits
+ (_user, ast, change@(Change _replacements _imports)) <-
lift $ runRetrie fixityEnv retrie cpp
case ast of
_ ->
- -- NoCPP {} ->
return $ asTextEdits change
- _ -> do
- -- DEBUG CODE bypass replacements and use the rewritten ast instead
- -- we would want to do this to capture import edits
- let new = T.pack $ printCPP replacements ast
- uri = Uri $ T.pack t
- change' = [(uri, TextEdit wholeDocument new)]
- return change'
let (errors :: [CallRetrieError], replacements) = partitionEithers results
editParams :: WorkspaceEdit
@@ -430,17 +422,12 @@ callRetrie state session rewrites origin = do
let ranns = relativiseApiAnns pm_parsed_source pm_annotations
in unsafeMkA pm_parsed_source ranns 0
-wholeDocument :: Range
-wholeDocument = Range (Position 0 0) (Position maxBound 0)
-
asEditMap :: [[(Uri, TextEdit)]] -> WorkspaceEditMap
asEditMap = coerce . HM.fromListWith (++) . concatMap (map (second pure))
asTextEdits :: Change -> [(Uri, TextEdit)]
asTextEdits NoChange = []
asTextEdits (Change reps _imports) =
- -- TODO retrie does not include import edits in the 'reps' list
- -- fix this in retrie or work around it here
[ (Uri spanLoc, edit)
| Replacement {..} <- nubOrdOn replLocation reps,
s@(RealSrcSpan rspan) <- [replLocation],
From 231bf0c98ac83f099c299954ed0ce6e34abf31e5 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 16:59:18 +0100
Subject: [PATCH 10/13] Compat with 8.6
---
src/Ide/Plugin/Retrie.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/Ide/Plugin/Retrie.hs b/src/Ide/Plugin/Retrie.hs
index 32241f5cb1..57ecfdd8de 100644
--- a/src/Ide/Plugin/Retrie.hs
+++ b/src/Ide/Plugin/Retrie.hs
@@ -286,7 +286,7 @@ suggestRuleRewrites originatingFile pos ms_mod (L l (HsRules {rds_rules}))
RunRetrieParams {..}
)
]
- | L _ (HsRule _ (L _ (_, rn)) _ _ _ _ _) <- rds_rules,
+ | L _ (HsRule {rd_name = (L _ (_, rn))}) <- rds_rules,
let ruleName = unpackFS rn
]
suggestRuleRewrites _ _ _ _ = []
From 4baf2949246c049c70d792a5437bb5c5ecf4e737 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 17:03:46 +0100
Subject: [PATCH 11/13] Rewrite the 8.6.4 stack descriptor on top of the 8.6.5
one
GHC minor versions do not change any APIs, do they?
---
stack-8.6.4.yaml | 50 ++++++++++++++++--------------------------------
1 file changed, 16 insertions(+), 34 deletions(-)
diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml
index cbb071ca8f..307f1a86b9 100644
--- a/stack-8.6.4.yaml
+++ b/stack-8.6.4.yaml
@@ -1,4 +1,5 @@
-resolver: lts-13.19 # Last 8.6.4
+resolver: lts-14.27 # Last 8.6.5
+compiler: ghc-8.6.4
packages:
- .
@@ -8,67 +9,49 @@ ghc-options:
"$everything": -haddock
extra-deps:
-- aeson-1.4.3.0
- ansi-terminal-0.10.3
-- async-2.2.2
-- brittany-0.12.1.1
+- base-compat-0.11.0
+- brittany-0.12.1.1@rev:2
- butcher-1.3.3.1
-- bytestring-trie-0.2.5.0
- Cabal-3.0.2.0
-- cabal-doctest-1.0.8
-- cabal-plan-0.5.0.0
-- constrained-dynamic-0.1.0.0
-- deque-0.4.3
-# - ghcide-0.1.0
+- cabal-plan-0.6.2.0
+- clock-0.7.2
- extra-1.7.3
- floskell-0.10.3
- fuzzy-0.1.0.0
+# - ghcide-0.1.0
- ghc-check-0.5.0.1
-- ghc-exactprint-0.6.2 # for HaRe
+- ghc-exactprint-0.6.2
- ghc-lib-parser-8.10.1.20200523
- ghc-lib-parser-ex-8.10.0.4
-- ghc-paths-0.1.0.12
- haddock-api-2.22.0@rev:1
- haddock-library-1.8.0
-- happy-1.19.12
- haskell-lsp-0.22.0.0
- haskell-lsp-types-0.22.0.0
-- haskell-src-exts-1.21.1
- hie-bios-0.6.1
-- hlint-2.2.8
-- hoogle-5.0.17.11
-- hsimport-0.11.0@rev:2
- HsYAML-0.2.1.0@rev:1
- HsYAML-aeson-0.2.0.0@rev:1
+- indexed-profunctors-0.1
- lens-4.18
- lsp-test-0.11.0.3
-- microlens-th-0.4.2.3@rev:1
- monad-dijkstra-0.1.1.2
-- monad-memo-0.4.1
-- multistate-0.8.0.1
-- ormolu-0.1.2.0
- opentelemetry-0.4.2
+- optics-core-0.2
- optparse-applicative-0.15.1.0
+- ormolu-0.1.2.0
- parser-combinators-1.2.1
- regex-base-0.94.0.0
+- regex-pcre-builtin-0.95.1.1.8.43
- regex-tdfa-1.3.1.0
- retrie-0.1.1.1
-- rope-utf16-splay-0.3.1.0
-- shake-0.19.1
-- strict-list-0.1.5
+- semialign-1.1
+# - github: wz1000/shake
+# commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef
- stylish-haskell-0.11.0.0
-- syb-0.7.1
-- syz-0.2.0.0
- tasty-rerun-1.1.17
- temporary-1.2.1.1
-- th-abstraction-0.3.1.0
- type-equality-1
-- unix-compat-0.5.2
-- unordered-containers-0.2.10.0
-- yaml-0.11.1.2
-# To make build work in windows 7
-- unix-time-0.4.7
-
+- topograph-1
flags:
haskell-language-server:
@@ -76,7 +59,6 @@ flags:
retrie:
BuildExecutable: false
-
# allow-newer: true
nix:
From c00cca01c221f90d663c69742826aaa092a91d75 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 1 Aug 2020 18:12:57 +0100
Subject: [PATCH 12/13] Compat with 8.6.5 (and tighten spans for rule
suggestions)
---
src/Ide/Plugin/Retrie.hs | 13 ++++++++-----
1 file changed, 8 insertions(+), 5 deletions(-)
diff --git a/src/Ide/Plugin/Retrie.hs b/src/Ide/Plugin/Retrie.hs
index 57ecfdd8de..9d50aa2f19 100644
--- a/src/Ide/Plugin/Retrie.hs
+++ b/src/Ide/Plugin/Retrie.hs
@@ -268,8 +268,7 @@ suggestRuleRewrites ::
GHC.Module ->
LRuleDecls pass ->
[(T.Text, CodeActionKind, RunRetrieParams)]
-suggestRuleRewrites originatingFile pos ms_mod (L l (HsRules {rds_rules}))
- | pos `isInsideSrcSpan` l =
+suggestRuleRewrites originatingFile pos ms_mod (L _ (HsRules {rds_rules})) =
concat
[ [ let rewrites =
[Right $ RuleForward (qualify ms_mod ruleName)]
@@ -286,7 +285,13 @@ suggestRuleRewrites originatingFile pos ms_mod (L l (HsRules {rds_rules}))
RunRetrieParams {..}
)
]
- | L _ (HsRule {rd_name = (L _ (_, rn))}) <- rds_rules,
+ | L l r <- rds_rules,
+ pos `isInsideSrcSpan` l,
+#if MIN_GHC_API_VERSION(8,8,0)
+ let HsRule {rd_name = L _ (_, rn)} = r,
+#else
+ let HsRule _ (L _ (_,rn)) _ _ _ _ = r,
+#endif
let ruleName = unpackFS rn
]
suggestRuleRewrites _ _ _ _ = []
@@ -510,9 +515,7 @@ toImportDecl AddImport {..} = GHC.ImportDecl {..}
ideclSourceSrc = NoSourceText
ideclExt = GHC.noExtField
ideclAs = toMod <$> ideclAsString
-
#if MIN_GHC_API_VERSION(8,10,0)
-
ideclQualified = if ideclQualifiedBool then GHC.QualifiedPre else GHC.NotQualified
#else
ideclQualified = ideclQualifiedBool
From 366e8b65d583eefb5e84528b73c0a067a4a3862b Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sun, 2 Aug 2020 08:13:19 +0100
Subject: [PATCH 13/13] Fix imgur link in README
---
README.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/README.md b/README.md
index fca6598591..6f97385d18 100644
--- a/README.md
+++ b/README.md
@@ -73,7 +73,7 @@ This is *very* early stage software.
- Integration with [retrie](https://hackage.haskell.org/package/retrie)
- 
+ 
- Many more (TBD)