haskell/ghcide
1
1
Fork 0
mirror of https://github.com/haskell/ghcide.git synced 2024-12-03 05:23:25 +03:00
Code Issues Projects Releases Wiki Activity

Support more kinds of literals in hover (#339)

Browse Source 
* Support more kinds of literals in hover

* Fix for HLint

* Fix for GHC 8.8

* Fix for 8.4

* Fix 8.4 + suggestions by @cocreature

* More fixes for 8.4

* Deal with type sigs in all GHC versions

* Additional case for 8.4

* Separate isLit and isChildLit

Co-authored-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>
This commit is contained in:
Alejandro Serrano 2020-01-27 15:12:09 +01:00 committed by Moritz Kiefer
parent ae5c6d34d4
commit ea50c27fad
2 changed files with 35 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
src/Development/IDE/Spans/Calculate.hs
View File

@ -158,8 +158,7 @@ getTypeLHsExpr tms e = do
Nothing -> return Nothing
where
getSpanSource :: HsExpr GhcTc -> SpanSource
getSpanSource (HsLit U lit) = Lit (showGhc lit)
getSpanSource (HsOverLit U lit) = Lit (showGhc lit)
getSpanSource xpr | isLit xpr = Lit (showGhc xpr)
getSpanSource (HsVar U (L _ i)) = Named (getName i)
getSpanSource (HsConLikeOut U (RealDataCon dc)) = Named (dataConName dc)
getSpanSource RecordCon {rcon_con_name} = Named (getName rcon_con_name)
@ -167,6 +166,36 @@ getTypeLHsExpr tms e = do
getSpanSource (HsPar U xpr) = getSpanSource (unLoc xpr)
getSpanSource _ = NoSource
isLit :: HsExpr GhcTc -> Bool
isLit (HsLit U _) = True
isLit (HsOverLit U _) = True
isLit (ExplicitTuple U args _) = all (isTupLit . unLoc) args
#if MIN_GHC_API_VERSION(8,6,0)
isLit (ExplicitSum U _ _ xpr) = isLitChild (unLoc xpr)
isLit (ExplicitList U _ xprs) = all (isLitChild . unLoc) xprs
#else
isLit (ExplicitSum _ _ xpr _) = isLitChild (unLoc xpr)
isLit (ExplicitList _ _ xprs) = all (isLitChild . unLoc) xprs
#endif
isLit _ = False
isTupLit (Present U xpr) = isLitChild (unLoc xpr)
isTupLit _ = False
-- We need special treatment for children so things like [(1)] are still treated
-- as a list literal while not treating (1) as a literal.
isLitChild (HsWrap U _ xpr) = isLitChild xpr
isLitChild (HsPar U xpr) = isLitChild (unLoc xpr)
#if MIN_GHC_API_VERSION(8,8,0)
isLitChild (ExprWithTySig U xpr _) = isLitChild (unLoc xpr)
#elif MIN_GHC_API_VERSION(8,6,0)
isLitChild (ExprWithTySig U xpr) = isLitChild (unLoc xpr)
#else
isLitChild (ExprWithTySigOut xpr _) = isLitChild (unLoc xpr)
isLitChild (ExprWithTySig xpr _) = isLitChild (unLoc xpr)
#endif
isLitChild e = isLit e
-- | Get the name and type of a pattern.
getTypeLPat :: (GhcMonad m)
=> [TypecheckedModule]

8
test/exe/Main.hs
View File

@ -1209,8 +1209,8 @@ findDefinitionAndHoverTests = let
tvrL40 = Position 40 37 ; kindV = [ExpectHoverText [":: * -> *\n"]]
intL41 = Position 41 20 ; litI = [ExpectHoverText ["7518"]]
chrL36 = Position 37 24 ; litC = [ExpectHoverText ["'f'"]]
txtL8 = Position 8 14 ; litT = [ExpectHoverText ["\"dfgv\""]]
lstL43 = Position 43 12 ; litL = [ExpectHoverText ["[ 8391 :: Int, 6268 ]"]]
txtL8 = Position 8 14 ; litT = [ExpectHoverText ["\"dfgy\""]]
lstL43 = Position 43 12 ; litL = [ExpectHoverText ["[8391 :: Int, 6268]"]]
outL45 = Position 45 3 ; outSig = [ExpectHoverText ["outer", "Bool"], mkR 46 0 46 5]
innL48 = Position 48 5 ; innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7]
in
@ -1246,8 +1246,8 @@ findDefinitionAndHoverTests = let
, test no broken tvrL40 kindV "kind of (* -> *) type variable #273"
, test no yes intL41 litI "literal Int in hover info #274"
, test no yes chrL36 litC "literal Char in hover info #274"
, test no broken txtL8 litT "literal Text in hover info #274"
, test no broken lstL43 litL "literal List in hover info #274"
, test no yes txtL8 litT "literal Text in hover info #274"
, test no yes lstL43 litL "literal List in hover info #274"
, test no yes docL41 constr "type constraint in hover info #283"
, test broken broken outL45 outSig "top-level signature #310"
, test broken broken innL48 innSig "inner signature #310"