Skip to content

Commit 2979131

Browse files
ozkutukozkutuk
committed
Move common pragma logic to same file
1 parent f8e2549 commit 2979131

File tree

4 files changed

+33
-49
lines changed

4 files changed

+33
-49
lines changed

‎ghcide/src/Development/IDE/Spans/Pragmas.hs

Lines changed: 22 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -6,19 +6,24 @@ module Development.IDE.Spans.Pragmas
66
( NextPragmaInfo(..)
77
, LineSplitTextEdits(..)
88
, getNextPragmaInfo
9-
, insertNewPragma ) where
9+
, insertNewPragma
10+
, getFirstPragma ) where
1011

1112
import Data.Bits (Bits (setBit))
1213
import Data.Function ((&))
1314
import qualified Data.List as List
1415
import qualified Data.Maybe as Maybe
1516
import Data.Text (Text, pack)
1617
import qualified Data.Text as Text
17-
import Development.IDE (srcSpanToRange)
18+
import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, runAction, useWithStale, GhcSession (..), getFileContents, hscEnv)
1819
import Development.IDE.GHC.Compat
1920
import Development.IDE.GHC.Compat.Util
20-
import GHC.LanguageExtensions.Type (Extension)
2121
import qualified Language.LSP.Types as LSP
22+
import Control.Monad.IO.Class (MonadIO (..))
23+
import Control.Monad.Trans.Except (ExceptT)
24+
import Ide.Types (PluginId(..))
25+
import qualified Data.Text as T
26+
import Ide.PluginUtils (handleMaybeM)
2227

2328
getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo
2429
getNextPragmaInfo dynFlags sourceText =
@@ -31,13 +36,25 @@ getNextPragmaInfo dynFlags sourceText =
3136
| otherwise
3237
-> NextPragmaInfo 0 Nothing
3338

39+
showExtension :: Extension -> Text
40+
showExtension RecordPuns = "NamedFieldPuns"
41+
showExtension ext = pack (show ext)
42+
3443
insertNewPragma :: NextPragmaInfo -> Extension -> LSP.TextEdit
35-
insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins { LSP._newText = "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n" } :: LSP.TextEdit
36-
insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit pragmaInsertRange $ "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n"
44+
insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins { LSP._newText = "{-# LANGUAGE " <> showExtension newPragma <> " #-}\n" } :: LSP.TextEdit
45+
insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit pragmaInsertRange $ "{-# LANGUAGE " <> showExtension newPragma <> " #-}\n"
3746
where
3847
pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0
3948
pragmaInsertRange = LSP.Range pragmaInsertPosition pragmaInsertPosition
4049

50+
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
51+
getFirstPragma (PluginId pId) state nfp = handleMaybeM "Could not get NextPragmaInfo" $ do
52+
ghcSession <- liftIO $ runAction (T.unpack pId <> ".GhcSession") state $ useWithStale GhcSession nfp
53+
(_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
54+
case ghcSession of
55+
Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
56+
Nothing -> pure Nothing
57+
4158
-- Pre-declaration comments parser -----------------------------------------------------
4259

4360
-- | Each mode represents the "strongest" thing we've seen so far.

‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs

Lines changed: 1 addition & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE TypeFamilies #-}
44
{-# LANGUAGE TypeOperators #-}
5-
{-# LANGUAGE ViewPatterns #-}
65
module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where
76

87
import Control.Lens ((^.))
@@ -21,6 +20,7 @@ import Development.IDE.GHC.Compat hiding (getSrcSpan)
2120
import Development.IDE.GHC.Compat.Util (toList)
2221
import Development.IDE.Graph.Classes (Hashable, NFData, rnf)
2322
import Development.IDE.Spans.Pragmas (NextPragmaInfo,
23+
getFirstPragma,
2424
getNextPragmaInfo,
2525
insertNewPragma)
2626
import Development.IDE.Types.Logger as Logger
@@ -141,14 +141,6 @@ contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSr
141141
isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
142142
p `isInsideRealSrcSpan` r = let (Range sp ep) = realSrcSpanToRange r in sp <= p && p <= ep
143143

144-
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
145-
getFirstPragma (PluginId pId) state nfp = handleMaybeM "Could not get NextPragmaInfo" $ do
146-
ghcSession <- liftIO $ runAction (unpack pId <> ".GhcSession") state $ useWithStale GhcSession nfp
147-
(_, fileContents) <- liftIO $ runAction (unpack pId <> ".GetFileContents") state $ getFileContents nfp
148-
case ghcSession of
149-
Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
150-
Nothing -> pure Nothing
151-
152144
requestLiterals :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult
153145
requestLiterals (PluginId pId) state = handleMaybeM "Could not Collect Literals"
154146
. liftIO

‎plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs

Lines changed: 6 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ module Ide.Plugin.ExplicitFields
1111
( descriptor
1212
) where
1313

14-
import Control.Lens ((%~), (^.))
14+
import Control.Lens ((^.))
1515
import Control.Monad.IO.Class (MonadIO, liftIO)
1616
import Control.Monad.Trans.Except (ExceptT)
1717
import Data.Generics (GenericQ, everything, extQ,
@@ -20,22 +20,19 @@ import qualified Data.HashMap.Strict as HashMap
2020
import Data.Maybe (catMaybes, isJust, mapMaybe,
2121
maybeToList)
2222
import Data.Text (Text)
23-
import qualified Data.Text as T
2423
import Development.IDE (IdeState, NormalizedFilePath,
2524
Pretty (..), Range (..),
2625
Recorder (..), Rules,
2726
WithPriority (..),
28-
getFileContents, hscEnv,
2927
srcSpanToRange)
3028
import Development.IDE.Core.Rules (runAction)
31-
import Development.IDE.Core.RuleTypes (GhcSession (..),
32-
TcModuleResult (..),
29+
import Development.IDE.Core.RuleTypes (TcModuleResult (..),
3330
TypeCheck (..))
34-
import Development.IDE.Core.Shake (define, use, useWithStale)
31+
import Development.IDE.Core.Shake (define, use)
3532
import qualified Development.IDE.Core.Shake as Shake
3633
import Development.IDE.GHC.Compat (HasSrcSpan (..),
3734
HsConDetails (RecCon),
38-
HsRecFields (..), HscEnv (..),
35+
HsRecFields (..),
3936
LPat, Outputable, SrcSpan,
4037
pm_mod_summary, unLoc)
4138
import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns),
@@ -50,7 +47,7 @@ import Development.IDE.GHC.Util (printOutputable)
5047
import Development.IDE.Graph (RuleResult)
5148
import Development.IDE.Graph.Classes (Hashable, NFData (rnf))
5249
import Development.IDE.Spans.Pragmas (NextPragmaInfo (..),
53-
getNextPragmaInfo,
50+
getFirstPragma,
5451
insertNewPragma)
5552
import Development.IDE.Types.Logger (cmapWithPrio)
5653
import GHC.Generics (Generic)
@@ -120,9 +117,7 @@ codeActionProvider ideState pId (CodeActionParams _ _ docId range _) = pluginRes
120117
pragmaEdit :: Maybe TextEdit
121118
pragmaEdit = if NamedFieldPuns `elem` exts
122119
then Nothing
123-
else Just $ patchExtName $ insertNewPragma pragma NamedFieldPuns
124-
where
125-
patchExtName = L.newText %~ T.replace "Record" "NamedField"
120+
else Just $ insertNewPragma pragma NamedFieldPuns
126121

127122
mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit
128123
mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing
@@ -255,12 +250,3 @@ collectRecordsInRange range ideState nfp = do
255250
where
256251
inRange :: RenderedRecordInfo -> Bool
257252
inRange (RenderedRecordInfo ss _) = maybe False (subRange range) (srcSpanToRange ss)
258-
259-
-- Copied from hls-alternate-number-format-plugin
260-
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
261-
getFirstPragma (PluginId pId) state nfp = handleMaybeM "Could not get NextPragmaInfo" $ do
262-
ghcSession <- liftIO $ runAction (T.unpack pId <> ".GhcSession") state $ useWithStale GhcSession nfp
263-
(_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
264-
case ghcSession of
265-
Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
266-
Nothing -> pure Nothing

‎plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs

Lines changed: 4 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -21,11 +21,9 @@ import Development.IDE.GHC.Compat
2121
import Control.Monad.Trans.Except (throwE)
2222
import Data.Maybe (mapMaybe)
2323
import Development.IDE.GHC.Compat.Util (toList)
24-
import Development.IDE.Spans.Pragmas (NextPragmaInfo,
25-
getNextPragmaInfo,
24+
import Development.IDE.Spans.Pragmas (getFirstPragma,
2625
insertNewPragma)
2726
import GHC.Generics (Generic)
28-
import GHC.LanguageExtensions.Type (Extension (GADTSyntax, GADTs))
2927
import Ide.Plugin.GHC
3028
import Ide.PluginUtils
3129
import Ide.Types
@@ -52,20 +50,20 @@ toGADTSyntaxCommandId = "GADT.toGADT"
5250

5351
-- | A command replaces H98 data decl with GADT decl in place
5452
toGADTCommand :: PluginId -> CommandFunction IdeState ToGADTParams
55-
toGADTCommand _ state ToGADTParams{..} = pluginResponse $ do
53+
toGADTCommand pId@(PluginId pId') state ToGADTParams{..} = pluginResponse $ do
5654
nfp <- getNormalizedFilePath uri
5755
(decls, exts) <- getInRangeH98DeclsAndExts state range nfp
5856
(L ann decl) <- case decls of
5957
[d] -> pure d
6058
_ -> throwE $ "Expected 1 declaration, but got " <> show (Prelude.length decls)
61-
deps <- liftIO $ runAction "GADT.GhcSessionDeps" state $ use GhcSessionDeps nfp
59+
deps <- liftIO $ runAction (T.unpack pId' <> ".GhcSessionDeps") state $ use GhcSessionDeps nfp
6260
(hsc_dflags . hscEnv -> df) <- liftEither
6361
$ maybeToEither "Get GhcSessionDeps failed" deps
6462
txt <- liftEither $ T.pack <$> (prettyGADTDecl df . h98ToGADTDecl) decl
6563
range <- liftEither
6664
$ maybeToEither "Unable to get data decl range"
6765
$ srcSpanToRange $ locA ann
68-
pragma <- getNextPragma state nfp
66+
pragma <- getFirstPragma pId state nfp
6967
let insertEdit = [insertNewPragma pragma GADTs | all (`notElem` exts) [GADTSyntax, GADTs]]
7068

7169
_ <- lift $ sendRequest
@@ -120,12 +118,3 @@ getInRangeH98DeclsAndExts state range nfp = do
120118
$ filter (inRange range) hsDecls
121119
exts = (toList . extensionFlags . ms_hspp_opts . pm_mod_summary) pm
122120
pure (decls, exts)
123-
124-
-- Copy from hls-alternate-number-format-plugin
125-
getNextPragma :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
126-
getNextPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ do
127-
ghcSession <- liftIO $ runAction "GADT.GhcSession" state $ useWithStale GhcSession nfp
128-
(_, fileContents) <- liftIO $ runAction "GADT.GetFileContents" state $ getFileContents nfp
129-
case ghcSession of
130-
Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
131-
Nothing -> pure Nothing

0 commit comments

Comments
 (0)