Skip to content

Commit f3bd94e

Browse files
wz1000wz1000
authored
Don't report nonsense file names (haskell/ghcide#718)
* Don't report nonsense file names * add and fix -Wincomplete-uni-patterns
1 parent f201cda commit f3bd94e

File tree

13 files changed

+102
-91
lines changed

13 files changed

+102
-91
lines changed

‎ghcide/ghcide.cabal

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -196,7 +196,7 @@ library
196196
other-modules:
197197
Development.IDE.GHC.HieAst
198198
Development.IDE.GHC.HieBin
199-
ghc-options: -Wall -Wno-name-shadowing
199+
ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns
200200
-- This is needed to prevent a GHC crash when building
201201
-- Development.IDE.Session with stack on 8.10.1 on Windows
202202
if (impl(ghc > 8.9) && os(windows))
@@ -255,6 +255,7 @@ executable ghcide
255255
ghc-options:
256256
-threaded
257257
-Wall
258+
-Wincomplete-uni-patterns
258259
-Wno-name-shadowing
259260
-- allow user RTS overrides
260261
-rtsopts

‎ghcide/src/Development/IDE/Core/Preprocessor.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -108,8 +108,8 @@ diagsFromCPPLogs filename logs =
108108
-- informational log messages and attaches them to the initial log message.
109109
go :: [CPPDiag] -> [CPPLog] -> [CPPDiag]
110110
go acc [] = reverse $ map (\d -> d {cdMessage = reverse $ cdMessage d}) acc
111-
go acc (CPPLog sev span@(RealSrcSpan _) msg : logs) =
112-
let diag = CPPDiag (srcSpanToRange span) (toDSeverity sev) [msg]
111+
go acc (CPPLog sev (RealSrcSpan span) msg : logs) =
112+
let diag = CPPDiag (realSrcSpanToRange span) (toDSeverity sev) [msg]
113113
in go (diag : acc) logs
114114
go (diag : diags) (CPPLog _sev (UnhelpfulSpan _) msg : logs) =
115115
go (diag {cdMessage = msg : cdMessage diag} : diags) logs

‎ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -463,16 +463,16 @@ reportImportCyclesRule =
463463
| f `elem` fs = Just (imp, fs)
464464
cycleErrorInFile _ _ = Nothing
465465
toDiag imp mods = (fp , ShowDiag , ) $ Diagnostic
466-
{ _range = (_range :: Location -> Range) loc
466+
{ _range = rng
467467
, _severity = Just DsError
468468
, _source = Just "Import cycle detection"
469469
, _message = "Cyclic module dependency between " <> showCycle mods
470470
, _code = Nothing
471471
, _relatedInformation = Nothing
472472
, _tags = Nothing
473473
}
474-
where loc = srcSpanToLocation (getLoc imp)
475-
fp = toNormalizedFilePath' $ srcSpanToFilename (getLoc imp)
474+
where rng = fromMaybe noRange $ srcSpanToRange (getLoc imp)
475+
fp = toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename (getLoc imp)
476476
getModuleName file = do
477477
ms <- use_ GetModSummaryWithoutTimestamps file
478478
pure (moduleNameString . moduleName . ms_mod $ ms)

‎ghcide/src/Development/IDE/GHC/Error.hs

Lines changed: 19 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ module Development.IDE.GHC.Error
1313
-- * utilities working with spans
1414
, srcSpanToLocation
1515
, srcSpanToRange
16+
, realSrcSpanToRange
1617
, srcSpanToFilename
1718
, zeroSpan
1819
, realSpan
@@ -25,6 +26,7 @@ module Development.IDE.GHC.Error
2526

2627
import Development.IDE.Types.Diagnostics as D
2728
import qualified Data.Text as T
29+
import Data.Maybe
2830
import Development.IDE.Types.Location
2931
import Development.IDE.GHC.Orphans()
3032
import qualified FastString as FS
@@ -41,9 +43,9 @@ import Exception (ExceptionMonad)
4143

4244

4345
diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
44-
diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ srcSpanToFilename loc,ShowDiag,)
46+
diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc,ShowDiag,)
4547
Diagnostic
46-
{ _range = srcSpanToRange loc
48+
{ _range = fromMaybe noRange $ srcSpanToRange loc
4749
, _severity = Just sev
4850
, _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
4951
, _message = msg
@@ -64,9 +66,9 @@ diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
6466
diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList
6567

6668
-- | Convert a GHC SrcSpan to a DAML compiler Range
67-
srcSpanToRange :: SrcSpan -> Range
68-
srcSpanToRange (UnhelpfulSpan _) = noRange
69-
srcSpanToRange (RealSrcSpan real) = realSrcSpanToRange real
69+
srcSpanToRange :: SrcSpan -> Maybe Range
70+
srcSpanToRange (UnhelpfulSpan _) = Nothing
71+
srcSpanToRange (RealSrcSpan real) = Just $ realSrcSpanToRange real
7072

7173
realSrcSpanToRange :: RealSrcSpan -> Range
7274
realSrcSpanToRange real =
@@ -75,18 +77,21 @@ realSrcSpanToRange real =
7577

7678
-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
7779
-- FIXME This may not be an _absolute_ file name, needs fixing.
78-
srcSpanToFilename :: SrcSpan -> FilePath
79-
srcSpanToFilename (UnhelpfulSpan fs) = FS.unpackFS fs
80-
srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
81-
82-
srcSpanToLocation :: SrcSpan -> Location
83-
srcSpanToLocation src =
80+
srcSpanToFilename :: SrcSpan -> Maybe FilePath
81+
srcSpanToFilename (UnhelpfulSpan _) = Nothing
82+
srcSpanToFilename (RealSrcSpan real) = Just $ FS.unpackFS $ srcSpanFile real
83+
84+
srcSpanToLocation :: SrcSpan -> Maybe Location
85+
srcSpanToLocation src = do
86+
fs <- srcSpanToFilename src
87+
rng <- srcSpanToRange src
8488
-- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
85-
Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ srcSpanToFilename src) (srcSpanToRange src)
89+
pure $ Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' fs) rng
8690

8791
isInsideSrcSpan :: Position -> SrcSpan -> Bool
88-
p `isInsideSrcSpan` r = sp <= p && p <= ep
89-
where Range sp ep = srcSpanToRange r
92+
p `isInsideSrcSpan` r = case srcSpanToRange r of
93+
Just (Range sp ep) -> sp <= p && p <= ep
94+
_ -> False
9095

9196
-- | Convert a GHC severity to a DAML compiler Severity. Severities below
9297
-- "Warning" level are dropped (returning Nothing).

‎ghcide/src/Development/IDE/LSP/Outline.hs

Lines changed: 33 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ import qualified Data.Text as T
2222
import Development.IDE.Core.Rules
2323
import Development.IDE.Core.Shake
2424
import Development.IDE.GHC.Compat
25-
import Development.IDE.GHC.Error ( srcSpanToRange )
25+
import Development.IDE.GHC.Error ( realSrcSpanToRange )
2626
import Development.IDE.LSP.Server
2727
import Development.IDE.Types.Location
2828
import Outputable ( Outputable
@@ -46,12 +46,14 @@ moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentI
4646
Just ParsedModule { pm_parsed_source = L _ltop HsModule { hsmodName, hsmodDecls, hsmodImports } }
4747
-> let
4848
declSymbols = mapMaybe documentSymbolForDecl hsmodDecls
49-
moduleSymbol = hsmodName <&> \(L l m) ->
50-
(defDocumentSymbol l :: DocumentSymbol)
51-
{ _name = pprText m
52-
, _kind = SkFile
53-
, _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
54-
}
49+
moduleSymbol = hsmodName >>= \case
50+
(L (RealSrcSpan l) m) -> Just $
51+
(defDocumentSymbol l :: DocumentSymbol)
52+
{ _name = pprText m
53+
, _kind = SkFile
54+
, _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
55+
}
56+
_ -> Nothing
5557
importSymbols = maybe [] pure $
5658
documentSymbolForImportSummary
5759
(mapMaybe documentSymbolForImport hsmodImports)
@@ -68,7 +70,7 @@ moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentI
6870
Nothing -> pure $ Right $ DSDocumentSymbols (List [])
6971

7072
documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol
71-
documentSymbolForDecl (L l (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
73+
documentSymbolForDecl (L (RealSrcSpan l) (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
7274
= Just (defDocumentSymbol l :: DocumentSymbol)
7375
{ _name = showRdrName n
7476
<> (case pprText fdTyVars of
@@ -78,7 +80,7 @@ documentSymbolForDecl (L l (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _
7880
, _detail = Just $ pprText fdInfo
7981
, _kind = SkClass
8082
}
81-
documentSymbolForDecl (L l (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
83+
documentSymbolForDecl (L (RealSrcSpan l) (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
8284
= Just (defDocumentSymbol l :: DocumentSymbol)
8385
{ _name = showRdrName name
8486
<> (case pprText tcdTyVars of
@@ -92,13 +94,13 @@ documentSymbolForDecl (L l (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdT
9294
[ (defDocumentSymbol l :: DocumentSymbol)
9395
{ _name = showRdrName n
9496
, _kind = SkMethod
95-
, _selectionRange = srcSpanToRange l'
97+
, _selectionRange = realSrcSpanToRange l'
9698
}
97-
| L l (ClassOpSig False names _) <- tcdSigs
98-
, L l' n <- names
99+
| L (RealSrcSpan l) (ClassOpSig False names _) <- tcdSigs
100+
, L (RealSrcSpan l') n <- names
99101
]
100102
}
101-
documentSymbolForDecl (L l (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
103+
documentSymbolForDecl (L (RealSrcSpan l) (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
102104
= Just (defDocumentSymbol l :: DocumentSymbol)
103105
{ _name = showRdrName name
104106
, _kind = SkStruct
@@ -107,11 +109,11 @@ documentSymbolForDecl (L l (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn =
107109
[ (defDocumentSymbol l :: DocumentSymbol)
108110
{ _name = showRdrName n
109111
, _kind = SkConstructor
110-
, _selectionRange = srcSpanToRange l'
112+
, _selectionRange = realSrcSpanToRange l'
111113
, _children = conArgRecordFields (getConArgs x)
112114
}
113-
| L l x <- dd_cons
114-
, L l' n <- getConNames x
115+
| L (RealSrcSpan l ) x <- dd_cons
116+
, L (RealSrcSpan l') n <- getConNames x
115117
]
116118
}
117119
where
@@ -122,48 +124,48 @@ documentSymbolForDecl (L l (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn =
122124
, _kind = SkField
123125
}
124126
| L _ cdf <- lcdfs
125-
, L l n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf
127+
, L (RealSrcSpan l) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf
126128
]
127129
conArgRecordFields _ = Nothing
128-
documentSymbolForDecl (L l (TyClD SynDecl { tcdLName = L l' n })) = Just
130+
documentSymbolForDecl (L (RealSrcSpan l) (TyClD SynDecl { tcdLName = L (RealSrcSpan l') n })) = Just
129131
(defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n
130132
, _kind = SkTypeParameter
131-
, _selectionRange = srcSpanToRange l'
133+
, _selectionRange = realSrcSpanToRange l'
132134
}
133-
documentSymbolForDecl (L l (InstD ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
135+
documentSymbolForDecl (L (RealSrcSpan l) (InstD ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
134136
= Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty
135137
, _kind = SkInterface
136138
}
137-
documentSymbolForDecl (L l (InstD DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
139+
documentSymbolForDecl (L (RealSrcSpan l) (InstD DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
138140
= Just (defDocumentSymbol l :: DocumentSymbol)
139141
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
140142
(map pprText feqn_pats)
141143
, _kind = SkInterface
142144
}
143-
documentSymbolForDecl (L l (InstD TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
145+
documentSymbolForDecl (L (RealSrcSpan l) (InstD TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
144146
= Just (defDocumentSymbol l :: DocumentSymbol)
145147
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
146148
(map pprText feqn_pats)
147149
, _kind = SkInterface
148150
}
149-
documentSymbolForDecl (L l (DerivD DerivDecl { deriv_type })) =
151+
documentSymbolForDecl (L (RealSrcSpan l) (DerivD DerivDecl { deriv_type })) =
150152
gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) ->
151153
(defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs)
152154
name
153155
, _kind = SkInterface
154156
}
155-
documentSymbolForDecl (L l (ValD FunBind{fun_id = L _ name})) = Just
157+
documentSymbolForDecl (L (RealSrcSpan l) (ValD FunBind{fun_id = L _ name})) = Just
156158
(defDocumentSymbol l :: DocumentSymbol)
157159
{ _name = showRdrName name
158160
, _kind = SkFunction
159161
}
160-
documentSymbolForDecl (L l (ValD PatBind{pat_lhs})) = Just
162+
documentSymbolForDecl (L (RealSrcSpan l) (ValD PatBind{pat_lhs})) = Just
161163
(defDocumentSymbol l :: DocumentSymbol)
162164
{ _name = pprText pat_lhs
163165
, _kind = SkFunction
164166
}
165167

166-
documentSymbolForDecl (L l (ForD x)) = Just
168+
documentSymbolForDecl (L (RealSrcSpan l) (ForD x)) = Just
167169
(defDocumentSymbol l :: DocumentSymbol)
168170
{ _name = case x of
169171
ForeignImport{} -> name
@@ -203,7 +205,7 @@ documentSymbolForImportSummary importSymbols =
203205
}
204206

205207
documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol
206-
documentSymbolForImport (L l ImportDecl { ideclName, ideclQualified }) = Just
208+
documentSymbolForImport (L (RealSrcSpan l) ImportDecl { ideclName, ideclQualified }) = Just
207209
(defDocumentSymbol l :: DocumentSymbol)
208210
{ _name = "import " <> pprText ideclName
209211
, _kind = SkModule
@@ -213,18 +215,16 @@ documentSymbolForImport (L l ImportDecl { ideclName, ideclQualified }) = Just
213215
, _detail = if ideclQualified then Just "qualified" else Nothing
214216
#endif
215217
}
216-
#if MIN_GHC_API_VERSION(8,6,0)
217-
documentSymbolForImport (L _ XImportDecl {}) = Nothing
218-
#endif
218+
documentSymbolForImport _ = Nothing
219219

220-
defDocumentSymbol :: SrcSpan -> DocumentSymbol
220+
defDocumentSymbol :: RealSrcSpan -> DocumentSymbol
221221
defDocumentSymbol l = DocumentSymbol { .. } where
222222
_detail = Nothing
223223
_deprecated = Nothing
224224
_name = ""
225225
_kind = SkUnknown 0
226-
_range = srcSpanToRange l
227-
_selectionRange = srcSpanToRange l
226+
_range = realSrcSpanToRange l
227+
_selectionRange = realSrcSpanToRange l
228228
_children = Nothing
229229

230230
showRdrName :: RdrName -> Text

0 commit comments

Comments
 (0)