hls-splice-plugin 1.0.0.4 → 1.0.0.5
raw patch · 3 files changed
+36/−41 lines, 3 filesdep ~ghcide
Dependency ranges changed: ghcide
Files
- hls-splice-plugin.cabal +2/−2
- src/Ide/Plugin/Splice.hs +27/−36
- test/Main.hs +7/−3
hls-splice-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-splice-plugin-version: 1.0.0.4+version: 1.0.0.5 synopsis: HLS Plugin to expand TemplateHaskell Splices and QuasiQuotes @@ -38,7 +38,7 @@ , foldl , ghc , ghc-exactprint- , ghcide >=1.2 && <1.5+ , ghcide >=1.2 && <1.6 , hls-plugin-api >=1.1 && <1.3 , lens , lsp
src/Ide/Plugin/Splice.hs view
@@ -23,6 +23,7 @@ import Control.Applicative (Alternative ((<|>))) import Control.Arrow+import Control.Exception import qualified Control.Foldl as L import Control.Lens (Identity (..), ix, view, (%~), (<&>), (^.))@@ -43,12 +44,10 @@ mapMaybe) import qualified Data.Text as T import Development.IDE-import Development.IDE.GHC.Compat hiding (getLoc)+import Development.IDE.GHC.Compat as Compat hiding (getLoc)+import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.ExactPrint-import Exception import GHC.Exts-import GhcMonad-import GhcPlugins hiding (Var, getLoc, (<>)) import Ide.Plugin.Splice.Types import Ide.Types import Language.Haskell.GHC.ExactPrint (setPrecedingLines,@@ -57,8 +56,6 @@ import Language.LSP.Types import Language.LSP.Types.Capabilities import qualified Language.LSP.Types.Lens as J-import RnSplice-import TcRnMonad descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId =@@ -146,7 +143,7 @@ dflags clientCapabilities uri- (graft (RealSrcSpan spliceSpan) expanded)+ (graft (RealSrcSpan spliceSpan Nothing) expanded) ps maybe (throwE "No splice information found") (either throwE pure) $ case spliceContext of@@ -162,7 +159,7 @@ dflags clientCapabilities uri- (graftDecls (RealSrcSpan spliceSpan) expanded)+ (graftDecls (RealSrcSpan spliceSpan Nothing) expanded) ps <&> -- FIXME: Why ghc-exactprint sweeps preceeding comments?@@ -195,7 +192,7 @@ where range = realSrcSpanToRange spliceSpan- srcSpan = RealSrcSpan spliceSpan+ srcSpan = RealSrcSpan spliceSpan Nothing setupHscEnv@@ -211,33 +208,27 @@ let ps = annotateParsedSource pm hscEnv0 = hscEnvWithImportPaths hscEnvEq modSum = pm_mod_summary pm- df' <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum- let hscEnv = hscEnv0 { hsc_dflags = df' }- pure (ps, hscEnv, df')+ hscEnv <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum+ pure (ps, hscEnv, hsc_dflags hscEnv) -setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags+setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv setupDynFlagsForGHCiLike env dflags = do- let dflags3 =- dflags- { hscTarget = HscInterpreted- , ghcMode = CompManager- , ghcLink = LinkInMemory- }+ let dflags3 = setInterpreterLinkerOptions dflags platform = targetPlatform dflags3- dflags3a = updateWays $ dflags3 {ways = interpWays}+ dflags3a = setWays hostFullWays dflags3 dflags3b = foldl gopt_set dflags3a $- concatMap (wayGeneralFlags platform) interpWays+ concatMap (wayGeneralFlags platform) hostFullWays dflags3c = foldl gopt_unset dflags3b $- concatMap (wayUnsetGeneralFlags platform) interpWays+ concatMap (wayUnsetGeneralFlags platform) hostFullWays dflags4 = dflags3c `gopt_set` Opt_ImplicitImportQualified `gopt_set` Opt_IgnoreOptimChanges `gopt_set` Opt_IgnoreHpcChanges `gopt_unset` Opt_DiagnosticsShowCaret- initializePlugins env dflags4+ initializePlugins (hscSetFlags dflags4 env) adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit adjustToRange uri ran (WorkspaceEdit mhult mlt x) =@@ -335,26 +326,26 @@ case classifyAST spliceContext of IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $ flip (transformM dflags clientCapabilities uri) ps $- graftDeclsWithM (RealSrcSpan srcSpan) $ \case+ graftDeclsWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do eExpr <- eitherM (fail . show) pure $ lift ( lift $- gtry @_ @SomeException $+ Util.try @_ @SomeException $ (fst <$> rnTopSpliceDecls spl) ) pure $ Just eExpr _ -> pure Nothing OneToOneAST astP -> flip (transformM dflags clientCapabilities uri) ps $- graftWithM (RealSrcSpan srcSpan) $ \case+ graftWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (matchSplice astP -> Just spl)) -> do eExpr <- eitherM (fail . show) pure $ lift ( lift $- gtry @_ @SomeException $+ Util.try @_ @SomeException $ (fst <$> expandSplice astP spl) ) Just <$> either (pure . L _spn) (unRenamedE dflags) eExpr@@ -428,8 +419,8 @@ mkQ Continue ( \case- (L l@(RealSrcSpan spLoc) expr :: LHsExpr GhcPs)- | RealSrcSpan spn `isSubspanOf` l ->+ (L l@(RealSrcSpan spLoc _) expr :: LHsExpr GhcPs)+ | RealSrcSpan spn Nothing `isSubspanOf` l -> case expr of HsSpliceE {} -> Here (spLoc, Expr) _ -> Continue@@ -437,25 +428,25 @@ ) `extQ` \case #if __GLASGOW_HASKELL__ == 808- (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc) pat :: Located (Pat GhcPs))+ (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc _) pat :: Located (Pat GhcPs)) #else- (L l@(RealSrcSpan spLoc) pat :: LPat GhcPs)+ (L l@(RealSrcSpan spLoc _) pat :: LPat GhcPs) #endif- | RealSrcSpan spn `isSubspanOf` l ->+ | RealSrcSpan spn Nothing `isSubspanOf` l -> case pat of SplicePat{} -> Here (spLoc, Pat) _ -> Continue _ -> Stop `extQ` \case- (L l@(RealSrcSpan spLoc) ty :: LHsType GhcPs)- | RealSrcSpan spn `isSubspanOf` l ->+ (L l@(RealSrcSpan spLoc _) ty :: LHsType GhcPs)+ | RealSrcSpan spn Nothing `isSubspanOf` l -> case ty of HsSpliceTy {} -> Here (spLoc, HsType) _ -> Continue _ -> Stop `extQ` \case- (L l@(RealSrcSpan spLoc) decl :: LHsDecl GhcPs)- | RealSrcSpan spn `isSubspanOf` l ->+ (L l@(RealSrcSpan spLoc _) decl :: LHsDecl GhcPs)+ | RealSrcSpan spn Nothing `isSubspanOf` l -> case decl of SpliceD {} -> Here (spLoc, HsDecl) _ -> Continue
test/Main.hs view
@@ -64,7 +64,9 @@ goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree goldenTest fp tc line col = goldenWithHaskellDoc splicePlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do- _ <- waitForDiagnostics+ -- wait for the entire build to finish, so that code actions that+ -- use stale data will get uptodate stuff+ void waitForBuildQueue actions <- getCodeActions doc $ pointRange line col case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of Just (InR CodeAction {_command = Just c}) -> do@@ -83,12 +85,14 @@ { _start = Position 0 0 , _end = Position (length lns + 1) 1 }- waitForProgressDone -- cradle- waitForProgressDone+ waitForAllProgressDone -- cradle+ waitForAllProgressDone alt <- liftIO $ T.readFile (fp <.> "error.hs") void $ applyEdit doc $ TextEdit theRange alt changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt] void waitForDiagnostics+ -- wait for the entire build to finish+ void waitForBuildQueue actions <- getCodeActions doc $ pointRange line col case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of Just (InR CodeAction {_command = Just c}) -> do