Skip to content

Commit 9cf7d5b

Browse files
isovectorwz1000
isovector
authored and
wz1000
committed
Add refinery
[WIP] Add Skeleton for Tactic Plugin Local bindings [WIP] Add more to the code action provider more cases for bindings is it a hole? Beginning of tactics machinery tactics machinery split out tactics machinery; finish porting tactics Haddock for tactics machinery Use a map for hypothesis Better types on LocalBindings render the result of running a tactic Hypothesis from bindings Sort types mostSpecificSpan Render Actually add the tactic plugin :) [WIP] Do stuff slightly better span better sorting for specific spans Fix size [WIP] It does the thing!! Multiple tactic actions Parenthesize if necessary [WIP] Home on the 'Range' destruct and homo fix naming and parens Cleanup Plugin Tactic context dependent destruct and homo Generalized interface More composable Remove TacticVariety Haddock Describe spooky monoidal behavior Only look at actual holes Auto if possible debugging Maybe grafting works now Transformation works; tree doesnt Remove debugging Proper indentation and parenthesizing Less fancy parenthesizing Don't crash if we can't lookup things Holes must start with an underscore Haddock pass Module restructuring Fix the cabal file Intros, and disable some of the unpolished tactics Disable autoIfPossible Fix stack.yaml Respond to simple PR comments. Get a proper dflags WIP on a better bindings interface Simplify dflags lookup and expose titles Tactic tests Add a few more tests Cleanup imports Haddock the tests Rebase on ghcide HEAD (haskell#378) * Rebase on top of ghcide HEAD * use Development.IDE to trim imports * Fix Eval plugin to use GhcSessionDeps Use stale data in explicit imports lens (haskell#383) This prevents the lenses from disappearing while editing, which causes lots of unpleasant jumping Create hls-plugin-api and move plugins to exe Keep current version Add hls-plugin-api component to cradle Move exe modules to main library Format .cabal files with `cabal-fmt --ident 2` Restore ghcide ref Fix cradles Move tactic plugin Almost there! Get the tests running again Empty commit for CI Add refinery to stack more stack woes Duplicate NoExt and less dependency on ghc Cradle is necessary bump ghcide submodule (haskell#396) * Bump ghcide submodule * Update stack descriptors Co-authored-by: Pepe Iborra <[email protected]> Update ghcide Compute an interval map of what's in scope Fix 'binding'
1 parent 34eff96 commit 9cf7d5b

File tree

21 files changed

+1146
-15
lines changed

21 files changed

+1146
-15
lines changed

‎exe/Main.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import Ide.Plugin.ImportLens as ImportLens
2020
import Ide.Plugin.Ormolu as Ormolu
2121
import Ide.Plugin.StylishHaskell as StylishHaskell
2222
import Ide.Plugin.Retrie as Retrie
23+
import Ide.Plugin.Tactic as Tactic
2324
#if AGPL
2425
import Ide.Plugin.Brittany as Brittany
2526
#endif
@@ -45,6 +46,9 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
4546
, Pragmas.descriptor "pragmas"
4647
, Floskell.descriptor "floskell"
4748
, Fourmolu.descriptor "fourmolu"
49+
, Tactic.descriptor "tactic"
50+
-- , genericDescriptor "generic"
51+
-- , ghcmodDescriptor "ghcmod"
4852
, Ormolu.descriptor "ormolu"
4953
, StylishHaskell.descriptor "stylish-haskell"
5054
, Retrie.descriptor "retrie"

‎haskell-language-server.cabal‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -112,6 +112,7 @@ executable haskell-language-server
112112
, deepseq
113113
, floskell ^>=0.10
114114
, fourmolu ^>=0.1
115+
, fingertree
115116
, ghc
116117
, ghc-boot-th
117118
, ghcide >=0.1
@@ -123,10 +124,21 @@ executable haskell-language-server
123124
, ormolu ^>=0.1.2
124125
, regex-tdfa
125126
, retrie >=0.1.1.0
127+
, hslogger
128+
, optparse-applicative
129+
, haskell-lsp ^>=0.22
130+
, hls-plugin-api
131+
, lens
132+
, mtl
133+
, ormolu ^>=0.1.2
134+
, regex-tdfa
135+
, retrie >=0.1.1.0
126136
, safe-exceptions
127137
, shake >=0.17.5
128138
, stylish-haskell ^>=0.11
129139
, temporary
140+
, text
141+
, syb
130142
, time
131143
, transformers
132144
, unordered-containers

‎plugins/default/src/Ide/LocalBindings.hs‎

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
{-# LANGUAGE DerivingStrategies #-}
2+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+
{-# LANGUAGE LambdaCase #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
6+
module Ide.LocalBindings
7+
( Bindings
8+
, getLocalScope
9+
, mostSpecificSpan
10+
, holify
11+
, bindings
12+
) where
13+
14+
import Data.Function
15+
import Data.Generics
16+
import Data.IntervalMap.FingerTree (IntervalMap, Interval (..))
17+
import qualified Data.IntervalMap.FingerTree as IM
18+
import Data.List
19+
import qualified Data.Map as M
20+
import Data.Maybe
21+
import Data.Ord
22+
import Data.Set (Set)
23+
import qualified Data.Set as S
24+
import Development.IDE.GHC.Compat (GhcTc, RefMap, identType, identInfo, noExt, getScopeFromContext, Scope(..))
25+
import HsExpr
26+
import Id
27+
import OccName
28+
import SrcLoc
29+
30+
------------------------------------------------------------------------------
31+
-- | Turn a 'RealSrcSpan' into an 'Interval'.
32+
realSrcSpanToInterval :: RealSrcSpan -> Interval RealSrcLoc
33+
realSrcSpanToInterval rss =
34+
Interval
35+
(realSrcSpanStart rss)
36+
(realSrcSpanEnd rss)
37+
38+
39+
------------------------------------------------------------------------------
40+
-- | Compute which identifiers are in scpoe at every point in the AST. Use
41+
-- 'getLocalScope' to find the results.
42+
bindings :: RefMap -> Bindings
43+
bindings refmap = Bindings $ foldr (uncurry IM.insert) mempty $ do
44+
(ident, refs) <- M.toList refmap
45+
Right name <- pure ident
46+
(ref_span, ident_details) <- refs
47+
Just ty <- pure $ identType ident_details
48+
info <- S.toList $ identInfo ident_details
49+
Just scopes <- pure $ getScopeFromContext info
50+
scope <- scopes >>= \case
51+
ModuleScope -> pure $
52+
let file = srcSpanFile ref_span
53+
in Interval
54+
(mkRealSrcLoc file minBound minBound)
55+
(mkRealSrcLoc file maxBound maxBound)
56+
LocalScope scope -> pure $ realSrcSpanToInterval scope
57+
NoScope -> []
58+
pure ( scope
59+
, S.singleton $ mkVanillaGlobal name ty
60+
)
61+
62+
------------------------------------------------------------------------------
63+
-- | The available bindings at every point in a Haskell tree.
64+
newtype Bindings = Bindings
65+
{ getBindings :: IntervalMap RealSrcLoc (Set Id)
66+
} deriving newtype (Eq, Ord, Semigroup, Monoid)
67+
68+
69+
------------------------------------------------------------------------------
70+
-- | Given a 'Bindings' get every identifier in scope at the given
71+
-- 'RealSrcSpan',
72+
getLocalScope :: Bindings -> RealSrcSpan -> Set Id
73+
getLocalScope bs rss
74+
= foldMap snd
75+
$ IM.dominators (realSrcSpanToInterval rss)
76+
$ getBindings bs
77+
78+
79+
------------------------------------------------------------------------------
80+
-- | How many lines and columns does a SrcSpan span?
81+
srcSpanSize :: SrcSpan -> (Int, Int)
82+
srcSpanSize (UnhelpfulSpan _) = maxBound
83+
srcSpanSize (RealSrcSpan span) =
84+
( srcSpanEndLine span - srcSpanStartLine span
85+
, srcSpanEndCol span - srcSpanStartCol span
86+
)
87+
88+
89+
------------------------------------------------------------------------------
90+
-- | Given a SrcSpan, find the smallest LHsExpr that entirely contains that
91+
-- span. Useful for determining what node in the tree your cursor is hovering over.
92+
mostSpecificSpan :: (Data a, Typeable pass) => SrcSpan -> a -> Maybe (LHsExpr pass)
93+
mostSpecificSpan span z
94+
= listToMaybe
95+
$ sortBy (comparing srcSpanSize `on` getLoc)
96+
$ everything (<>) (mkQ mempty $ \case
97+
l@(L span' _) | span `isSubspanOf` span' -> [l]
98+
_ -> [])
99+
$ z
100+
101+
102+
------------------------------------------------------------------------------
103+
-- | Convert an HsVar back into an HsUnboundVar if it isn't actually in scope.
104+
-- TODO(sandy): this will throw away the type >:(
105+
holify :: Bindings -> LHsExpr GhcTc -> LHsExpr GhcTc
106+
holify bs v@(L s@(RealSrcSpan span) (HsVar _ (L _ var))) =
107+
let occ = occName var
108+
binds = getLocalScope bs span
109+
in -- Make sure the binding is not in scope and that it begins with an
110+
-- underscore
111+
case not (S.member var binds) && take 1 (occNameString occ) == "_" of
112+
True -> L s $ HsUnboundVar noExt $ TrueExprHole occ
113+
False -> v
114+
holify _ v = v
115+

0 commit comments

Comments
 (0)