mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
Don't report nonsense file names (#718)
* Don't report nonsense file names * add and fix -Wincomplete-uni-patterns
This commit is contained in:
wz1000
GitHub
parent
cb2fd665f2
commit
e837b2d0c5
@ -196,7 +196,7 @@ library
|
||||
other-modules:
|
||||
Development.IDE.GHC.HieAst
|
||||
Development.IDE.GHC.HieBin
|
||||
ghc-options: -Wall -Wno-name-shadowing
|
||||
ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns
|
||||
-- This is needed to prevent a GHC crash when building
|
||||
-- Development.IDE.Session with stack on 8.10.1 on Windows
|
||||
if (impl(ghc > 8.9) && os(windows))
|
||||
@ -255,6 +255,7 @@ executable ghcide
|
||||
ghc-options:
|
||||
-threaded
|
||||
-Wall
|
||||
-Wincomplete-uni-patterns
|
||||
-Wno-name-shadowing
|
||||
-- allow user RTS overrides
|
||||
-rtsopts
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
|
||||
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
||||
|
||||
{-
|
||||
Forked from GHC v8.10.1 to work around the readFile side effect in mkHiefile
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
|
||||
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
||||
{-
|
||||
Forked from GHC v8.8.1 to work around the readFile side effect in mkHiefile
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
|
||||
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
||||
{-
|
||||
Forked from GHC v8.8.1 to work around the readFile side effect in mkHiefile
|
||||
|
||||
|
||||
@ -108,8 +108,8 @@ diagsFromCPPLogs filename logs =
|
||||
-- informational log messages and attaches them to the initial log message.
|
||||
go :: [CPPDiag] -> [CPPLog] -> [CPPDiag]
|
||||
go acc [] = reverse $ map (\d -> d {cdMessage = reverse $ cdMessage d}) acc
|
||||
go acc (CPPLog sev span@(RealSrcSpan _) msg : logs) =
|
||||
let diag = CPPDiag (srcSpanToRange span) (toDSeverity sev) [msg]
|
||||
go acc (CPPLog sev (RealSrcSpan span) msg : logs) =
|
||||
let diag = CPPDiag (realSrcSpanToRange span) (toDSeverity sev) [msg]
|
||||
in go (diag : acc) logs
|
||||
go (diag : diags) (CPPLog _sev (UnhelpfulSpan _) msg : logs) =
|
||||
go (diag {cdMessage = msg : cdMessage diag} : diags) logs
|
||||
|
||||
@ -463,7 +463,7 @@ reportImportCyclesRule =
|
||||
| f `elem` fs = Just (imp, fs)
|
||||
cycleErrorInFile _ _ = Nothing
|
||||
toDiag imp mods = (fp , ShowDiag , ) $ Diagnostic
|
||||
{ _range = (_range :: Location -> Range) loc
|
||||
{ _range = rng
|
||||
, _severity = Just DsError
|
||||
, _source = Just "Import cycle detection"
|
||||
, _message = "Cyclic module dependency between " <> showCycle mods
|
||||
@ -471,8 +471,8 @@ reportImportCyclesRule =
|
||||
, _relatedInformation = Nothing
|
||||
, _tags = Nothing
|
||||
}
|
||||
where loc = srcSpanToLocation (getLoc imp)
|
||||
fp = toNormalizedFilePath' $ srcSpanToFilename (getLoc imp)
|
||||
where rng = fromMaybe noRange $ srcSpanToRange (getLoc imp)
|
||||
fp = toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename (getLoc imp)
|
||||
getModuleName file = do
|
||||
ms <- use_ GetModSummaryWithoutTimestamps file
|
||||
pure (moduleNameString . moduleName . ms_mod $ ms)
|
||||
|
||||
@ -13,6 +13,7 @@ module Development.IDE.GHC.Error
|
||||
-- * utilities working with spans
|
||||
, srcSpanToLocation
|
||||
, srcSpanToRange
|
||||
, realSrcSpanToRange
|
||||
, srcSpanToFilename
|
||||
, zeroSpan
|
||||
, realSpan
|
||||
@ -25,6 +26,7 @@ module Development.IDE.GHC.Error
|
||||
|
||||
import Development.IDE.Types.Diagnostics as D
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.GHC.Orphans()
|
||||
import qualified FastString as FS
|
||||
@ -41,9 +43,9 @@ import Exception (ExceptionMonad)
|
||||
|
||||
|
||||
diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
|
||||
diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ srcSpanToFilename loc,ShowDiag,)
|
||||
diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc,ShowDiag,)
|
||||
Diagnostic
|
||||
{ _range = srcSpanToRange loc
|
||||
{ _range = fromMaybe noRange $ srcSpanToRange loc
|
||||
, _severity = Just sev
|
||||
, _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
|
||||
, _message = msg
|
||||
@ -64,9 +66,9 @@ diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
|
||||
diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList
|
||||
|
||||
-- | Convert a GHC SrcSpan to a DAML compiler Range
|
||||
srcSpanToRange :: SrcSpan -> Range
|
||||
srcSpanToRange (UnhelpfulSpan _) = noRange
|
||||
srcSpanToRange (RealSrcSpan real) = realSrcSpanToRange real
|
||||
srcSpanToRange :: SrcSpan -> Maybe Range
|
||||
srcSpanToRange (UnhelpfulSpan _) = Nothing
|
||||
srcSpanToRange (RealSrcSpan real) = Just $ realSrcSpanToRange real
|
||||
|
||||
realSrcSpanToRange :: RealSrcSpan -> Range
|
||||
realSrcSpanToRange real =
|
||||
@ -75,18 +77,21 @@ realSrcSpanToRange real =
|
||||
|
||||
-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
|
||||
-- FIXME This may not be an _absolute_ file name, needs fixing.
|
||||
srcSpanToFilename :: SrcSpan -> FilePath
|
||||
srcSpanToFilename (UnhelpfulSpan fs) = FS.unpackFS fs
|
||||
srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
|
||||
srcSpanToFilename :: SrcSpan -> Maybe FilePath
|
||||
srcSpanToFilename (UnhelpfulSpan _) = Nothing
|
||||
srcSpanToFilename (RealSrcSpan real) = Just $ FS.unpackFS $ srcSpanFile real
|
||||
|
||||
srcSpanToLocation :: SrcSpan -> Location
|
||||
srcSpanToLocation src =
|
||||
srcSpanToLocation :: SrcSpan -> Maybe Location
|
||||
srcSpanToLocation src = do
|
||||
fs <- srcSpanToFilename src
|
||||
rng <- srcSpanToRange src
|
||||
-- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
|
||||
Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ srcSpanToFilename src) (srcSpanToRange src)
|
||||
pure $ Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' fs) rng
|
||||
|
||||
isInsideSrcSpan :: Position -> SrcSpan -> Bool
|
||||
p `isInsideSrcSpan` r = sp <= p && p <= ep
|
||||
where Range sp ep = srcSpanToRange r
|
||||
p `isInsideSrcSpan` r = case srcSpanToRange r of
|
||||
Just (Range sp ep) -> sp <= p && p <= ep
|
||||
_ -> False
|
||||
|
||||
-- | Convert a GHC severity to a DAML compiler Severity. Severities below
|
||||
-- "Warning" level are dropped (returning Nothing).
|
||||
|
||||
@ -22,7 +22,7 @@ import qualified Data.Text as T
|
||||
import Development.IDE.Core.Rules
|
||||
import Development.IDE.Core.Shake
|
||||
import Development.IDE.GHC.Compat
|
||||
import Development.IDE.GHC.Error ( srcSpanToRange )
|
||||
import Development.IDE.GHC.Error ( realSrcSpanToRange )
|
||||
import Development.IDE.LSP.Server
|
||||
import Development.IDE.Types.Location
|
||||
import Outputable ( Outputable
|
||||
@ -46,12 +46,14 @@ moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentI
|
||||
Just ParsedModule { pm_parsed_source = L _ltop HsModule { hsmodName, hsmodDecls, hsmodImports } }
|
||||
-> let
|
||||
declSymbols = mapMaybe documentSymbolForDecl hsmodDecls
|
||||
moduleSymbol = hsmodName <&> \(L l m) ->
|
||||
(defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = pprText m
|
||||
, _kind = SkFile
|
||||
, _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
|
||||
}
|
||||
moduleSymbol = hsmodName >>= \case
|
||||
(L (RealSrcSpan l) m) -> Just $
|
||||
(defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = pprText m
|
||||
, _kind = SkFile
|
||||
, _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
|
||||
}
|
||||
_ -> Nothing
|
||||
importSymbols = maybe [] pure $
|
||||
documentSymbolForImportSummary
|
||||
(mapMaybe documentSymbolForImport hsmodImports)
|
||||
@ -68,7 +70,7 @@ moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentI
|
||||
Nothing -> pure $ Right $ DSDocumentSymbols (List [])
|
||||
|
||||
documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol
|
||||
documentSymbolForDecl (L l (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName n
|
||||
<> (case pprText fdTyVars of
|
||||
@ -78,7 +80,7 @@ documentSymbolForDecl (L l (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _
|
||||
, _detail = Just $ pprText fdInfo
|
||||
, _kind = SkClass
|
||||
}
|
||||
documentSymbolForDecl (L l (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName name
|
||||
<> (case pprText tcdTyVars of
|
||||
@ -92,13 +94,13 @@ documentSymbolForDecl (L l (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdT
|
||||
[ (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName n
|
||||
, _kind = SkMethod
|
||||
, _selectionRange = srcSpanToRange l'
|
||||
, _selectionRange = realSrcSpanToRange l'
|
||||
}
|
||||
| L l (ClassOpSig False names _) <- tcdSigs
|
||||
, L l' n <- names
|
||||
| L (RealSrcSpan l) (ClassOpSig False names _) <- tcdSigs
|
||||
, L (RealSrcSpan l') n <- names
|
||||
]
|
||||
}
|
||||
documentSymbolForDecl (L l (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName name
|
||||
, _kind = SkStruct
|
||||
@ -107,11 +109,11 @@ documentSymbolForDecl (L l (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn =
|
||||
[ (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName n
|
||||
, _kind = SkConstructor
|
||||
, _selectionRange = srcSpanToRange l'
|
||||
, _selectionRange = realSrcSpanToRange l'
|
||||
, _children = conArgRecordFields (getConArgs x)
|
||||
}
|
||||
| L l x <- dd_cons
|
||||
, L l' n <- getConNames x
|
||||
| L (RealSrcSpan l ) x <- dd_cons
|
||||
, L (RealSrcSpan l') n <- getConNames x
|
||||
]
|
||||
}
|
||||
where
|
||||
@ -122,48 +124,48 @@ documentSymbolForDecl (L l (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn =
|
||||
, _kind = SkField
|
||||
}
|
||||
| L _ cdf <- lcdfs
|
||||
, L l n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf
|
||||
, L (RealSrcSpan l) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf
|
||||
]
|
||||
conArgRecordFields _ = Nothing
|
||||
documentSymbolForDecl (L l (TyClD SynDecl { tcdLName = L l' n })) = Just
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (TyClD SynDecl { tcdLName = L (RealSrcSpan l') n })) = Just
|
||||
(defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n
|
||||
, _kind = SkTypeParameter
|
||||
, _selectionRange = srcSpanToRange l'
|
||||
, _selectionRange = realSrcSpanToRange l'
|
||||
}
|
||||
documentSymbolForDecl (L l (InstD ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (InstD ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty
|
||||
, _kind = SkInterface
|
||||
}
|
||||
documentSymbolForDecl (L l (InstD DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (InstD DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
|
||||
(map pprText feqn_pats)
|
||||
, _kind = SkInterface
|
||||
}
|
||||
documentSymbolForDecl (L l (InstD TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (InstD TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
|
||||
(map pprText feqn_pats)
|
||||
, _kind = SkInterface
|
||||
}
|
||||
documentSymbolForDecl (L l (DerivD DerivDecl { deriv_type })) =
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (DerivD DerivDecl { deriv_type })) =
|
||||
gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) ->
|
||||
(defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs)
|
||||
name
|
||||
, _kind = SkInterface
|
||||
}
|
||||
documentSymbolForDecl (L l (ValD FunBind{fun_id = L _ name})) = Just
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (ValD FunBind{fun_id = L _ name})) = Just
|
||||
(defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = showRdrName name
|
||||
, _kind = SkFunction
|
||||
}
|
||||
documentSymbolForDecl (L l (ValD PatBind{pat_lhs})) = Just
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (ValD PatBind{pat_lhs})) = Just
|
||||
(defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = pprText pat_lhs
|
||||
, _kind = SkFunction
|
||||
}
|
||||
|
||||
documentSymbolForDecl (L l (ForD x)) = Just
|
||||
documentSymbolForDecl (L (RealSrcSpan l) (ForD x)) = Just
|
||||
(defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = case x of
|
||||
ForeignImport{} -> name
|
||||
@ -203,7 +205,7 @@ documentSymbolForImportSummary importSymbols =
|
||||
}
|
||||
|
||||
documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol
|
||||
documentSymbolForImport (L l ImportDecl { ideclName, ideclQualified }) = Just
|
||||
documentSymbolForImport (L (RealSrcSpan l) ImportDecl { ideclName, ideclQualified }) = Just
|
||||
(defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name = "import " <> pprText ideclName
|
||||
, _kind = SkModule
|
||||
@ -213,18 +215,16 @@ documentSymbolForImport (L l ImportDecl { ideclName, ideclQualified }) = Just
|
||||
, _detail = if ideclQualified then Just "qualified" else Nothing
|
||||
#endif
|
||||
}
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
documentSymbolForImport (L _ XImportDecl {}) = Nothing
|
||||
#endif
|
||||
documentSymbolForImport _ = Nothing
|
||||
|
||||
defDocumentSymbol :: SrcSpan -> DocumentSymbol
|
||||
defDocumentSymbol :: RealSrcSpan -> DocumentSymbol
|
||||
defDocumentSymbol l = DocumentSymbol { .. } where
|
||||
_detail = Nothing
|
||||
_deprecated = Nothing
|
||||
_name = ""
|
||||
_kind = SkUnknown 0
|
||||
_range = srcSpanToRange l
|
||||
_selectionRange = srcSpanToRange l
|
||||
_range = realSrcSpanToRange l
|
||||
_selectionRange = realSrcSpanToRange l
|
||||
_children = Nothing
|
||||
|
||||
showRdrName :: RdrName -> Text
|
||||
|
||||
@ -163,7 +163,7 @@ suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(
|
||||
suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmodImports}} contents Diagnostic{_range=_range,..}
|
||||
-- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant
|
||||
| Just [_, bindings] <- matchRegex _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
|
||||
, Just (L _ impDecl) <- find (\(L l _) -> srcSpanToRange l == _range ) hsmodImports
|
||||
, Just (L _ impDecl) <- find (\(L l _) -> srcSpanToRange l == Just _range ) hsmodImports
|
||||
, Just c <- contents
|
||||
, ranges <- map (rangesForBinding impDecl . T.unpack) (T.splitOn ", " bindings)
|
||||
, ranges' <- extendAllToIncludeCommaIfPossible (indexedByPosition $ T.unpack c) (concat ranges)
|
||||
@ -192,17 +192,17 @@ suggestDeleteUnusedBinding
|
||||
where
|
||||
relatedRanges indexedContent name =
|
||||
concatMap (findRelatedSpans indexedContent name) hsmodDecls
|
||||
toRange = srcSpanToRange
|
||||
toRange = realSrcSpanToRange
|
||||
extendForSpaces = extendToIncludePreviousNewlineIfPossible
|
||||
|
||||
findRelatedSpans :: PositionIndexedString -> String -> Located (HsDecl GhcPs) -> [Range]
|
||||
findRelatedSpans
|
||||
indexedContent
|
||||
name
|
||||
(L l (ValD (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) =
|
||||
(L (RealSrcSpan l) (ValD (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) =
|
||||
case lname of
|
||||
(L nLoc _name) | isTheBinding nLoc ->
|
||||
let findSig (L l (SigD sig)) = findRelatedSigSpan indexedContent name l sig
|
||||
let findSig (L (RealSrcSpan l) (SigD sig)) = findRelatedSigSpan indexedContent name l sig
|
||||
findSig _ = []
|
||||
in
|
||||
[extendForSpaces indexedContent $ toRange l]
|
||||
@ -220,13 +220,13 @@ suggestDeleteUnusedBinding
|
||||
} = Just (lname, matches)
|
||||
extractNameAndMatchesFromFunBind _ = Nothing
|
||||
|
||||
findRelatedSigSpan :: PositionIndexedString -> String -> SrcSpan -> Sig GhcPs -> [Range]
|
||||
findRelatedSigSpan :: PositionIndexedString -> String -> RealSrcSpan -> Sig GhcPs -> [Range]
|
||||
findRelatedSigSpan indexedContent name l sig =
|
||||
let maybeSpan = findRelatedSigSpan1 name sig
|
||||
in case maybeSpan of
|
||||
Nothing -> []
|
||||
Just (_span, True) -> pure $ extendForSpaces indexedContent $ toRange l -- a :: Int
|
||||
Just (span, False) -> pure $ toRange span -- a, b :: Int, a is unused
|
||||
Just (RealSrcSpan span, False) -> pure $ toRange span -- a, b :: Int, a is unused
|
||||
_ -> []
|
||||
|
||||
-- Second of the tuple means there is only one match
|
||||
findRelatedSigSpan1 :: String -> Sig GhcPs -> Maybe (SrcSpan, Bool)
|
||||
@ -278,16 +278,17 @@ suggestDeleteUnusedBinding
|
||||
indexedContent
|
||||
name
|
||||
lsigs
|
||||
(L l (extractNameAndMatchesFromFunBind -> Just (lname, matches))) =
|
||||
(L (RealSrcSpan l) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) =
|
||||
if isTheBinding (getLoc lname)
|
||||
then
|
||||
let findSig (L l sig) = findRelatedSigSpan indexedContent name l sig
|
||||
let findSig (L (RealSrcSpan l) sig) = findRelatedSigSpan indexedContent name l sig
|
||||
findSig _ = []
|
||||
in [extendForSpaces indexedContent $ toRange l] ++ concatMap findSig lsigs
|
||||
else concatMap (findRelatedSpanForMatch indexedContent name) matches
|
||||
findRelatedSpanForHsBind _ _ _ _ = []
|
||||
|
||||
isTheBinding :: SrcSpan -> Bool
|
||||
isTheBinding span = srcSpanToRange span == _range
|
||||
isTheBinding span = srcSpanToRange span == Just _range
|
||||
|
||||
isSameName :: IdP GhcPs -> String -> Bool
|
||||
isSameName x name = showSDocUnsafe (ppr x) == name
|
||||
@ -306,10 +307,10 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
|
||||
<|> matchRegex _message ".*Defined but not used: data constructor ‘([^ ]+)’"
|
||||
, Just (exportType, _) <- find (matchWithDiagnostic _range . snd)
|
||||
. mapMaybe
|
||||
(\(L l b) -> if isTopLevel $ srcSpanToRange l
|
||||
(\(L l b) -> if maybe False isTopLevel $ srcSpanToRange l
|
||||
then exportsAs b else Nothing)
|
||||
$ hsmodDecls
|
||||
, Just pos <- _end . getLocatedRange <$> hsmodExports
|
||||
, Just pos <- fmap _end . getLocatedRange =<< hsmodExports
|
||||
, Just needComma <- needsComma source <$> hsmodExports
|
||||
, let exportName = (if needComma then "," else "") <> printExport exportType name
|
||||
insertPos = pos {_character = pred $ _character pos}
|
||||
@ -319,18 +320,21 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
|
||||
-- we get the last export and the closing bracket and check for comma in that range
|
||||
needsComma :: T.Text -> Located [LIE GhcPs] -> Bool
|
||||
needsComma _ (L _ []) = False
|
||||
needsComma source x@(L _ exports) =
|
||||
let closeParan = _end $ getLocatedRange x
|
||||
lastExport = _end . getLocatedRange $ last exports
|
||||
in not $ T.isInfixOf "," $ textInRange (Range lastExport closeParan) source
|
||||
needsComma source (L (RealSrcSpan l) exports) =
|
||||
let closeParan = _end $ realSrcSpanToRange l
|
||||
lastExport = fmap _end . getLocatedRange $ last exports
|
||||
in case lastExport of
|
||||
Just lastExport -> not $ T.isInfixOf "," $ textInRange (Range lastExport closeParan) source
|
||||
_ -> False
|
||||
needsComma _ _ = False
|
||||
|
||||
getLocatedRange :: Located a -> Range
|
||||
getLocatedRange :: Located a -> Maybe Range
|
||||
getLocatedRange = srcSpanToRange . getLoc
|
||||
|
||||
matchWithDiagnostic :: Range -> Located (IdP GhcPs) -> Bool
|
||||
matchWithDiagnostic Range{_start=l,_end=r} x =
|
||||
let loc = _start . getLocatedRange $ x
|
||||
in loc >= l && loc <= r
|
||||
let loc = fmap _start . getLocatedRange $ x
|
||||
in loc >= Just l && loc <= Just r
|
||||
|
||||
printExport :: ExportsAs -> T.Text -> T.Text
|
||||
printExport ExportName x = x
|
||||
@ -436,8 +440,8 @@ suggestNewDefinition ideOptions parsedModule contents Diagnostic{_message, _rang
|
||||
newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text -> [(T.Text, [TextEdit])]
|
||||
newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ
|
||||
| Range _ lastLineP : _ <-
|
||||
[ srcSpanToRange l
|
||||
| (L l _) <- hsmodDecls
|
||||
[ realSrcSpanToRange sp
|
||||
| (L l@(RealSrcSpan sp) _) <- hsmodDecls
|
||||
, _start `isInsideSrcSpan` l]
|
||||
, nextLineP <- Position{ _line = _line lastLineP + 1, _character = 0}
|
||||
= [ ("Define " <> sig
|
||||
@ -551,7 +555,7 @@ suggestExtendImport (Just dflags) contents Diagnostic{_range=_range,..}
|
||||
, Just c <- contents
|
||||
, POk _ (L _ name) <- runParser dflags (T.unpack binding) parseIdentifier
|
||||
= let range = case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of
|
||||
[s] -> let x = srcSpanToRange s
|
||||
[s] -> let x = realSrcSpanToRange s
|
||||
in x{_end = (_end x){_character = succ (_character (_end x))}}
|
||||
_ -> error "bug in srcspan parser"
|
||||
importLine = textInRange range c
|
||||
@ -968,7 +972,7 @@ textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
|
||||
-- | Returns the ranges for a binding in an import declaration
|
||||
rangesForBinding :: ImportDecl GhcPs -> String -> [Range]
|
||||
rangesForBinding ImportDecl{ideclHiding = Just (False, L _ lies)} b =
|
||||
concatMap (map srcSpanToRange . rangesForBinding' b') lies
|
||||
concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies
|
||||
where
|
||||
b' = wrapOperatorInParens (unqualify b)
|
||||
|
||||
|
||||
@ -107,7 +107,7 @@ extendToIncludeCommaIfPossible indexedString range
|
||||
-- a, |b|, c ===> a, |b, |c
|
||||
[ range { _end = end' }
|
||||
| (_, ',') : rest <- [after']
|
||||
, let (end', _) : _ = dropWhile (isSpace . snd) rest
|
||||
, (end', _) : _ <- pure $ dropWhile (isSpace . snd) rest
|
||||
]
|
||||
| otherwise
|
||||
= [range]
|
||||
|
||||
@ -15,6 +15,7 @@ import Data.Generics
|
||||
import Data.List.Extra as List hiding (stripPrefix)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import qualified Data.Maybe as UnsafeMaybe (fromJust)
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Fuzzy as Fuzzy
|
||||
|
||||
@ -233,7 +234,7 @@ cacheDataProducer packageState tm deps = do
|
||||
dflags = hsc_dflags packageState
|
||||
curMod = ms_mod $ pm_mod_summary parsedMod
|
||||
curModName = moduleName curMod
|
||||
Just (_,limports,_,_) = tm_renamed_source tm
|
||||
(_,limports,_,_) = UnsafeMaybe.fromJust $ tm_renamed_source tm -- safe because we always save the typechecked source
|
||||
|
||||
iDeclToModName :: ImportDecl name -> ModuleName
|
||||
iDeclToModName = unLoc . ideclName
|
||||
|
||||
@ -171,7 +171,7 @@ querySpanInfoAt :: forall m
|
||||
-> [SpanInfo]
|
||||
-> MaybeT m [Location]
|
||||
querySpanInfoAt getSpan _ideOptions pos =
|
||||
lift . fmap (map srcSpanToLocation) . mapMaybeM getSpan . spansAtPoint pos
|
||||
lift . fmap (mapMaybe srcSpanToLocation) . mapMaybeM getSpan . spansAtPoint pos
|
||||
|
||||
-- | Given a 'Name' attempt to find the location where it is defined.
|
||||
nameToLocation :: Monad f => (Module -> MaybeT f (HieFile, String)) -> Name -> f (Maybe SrcSpan)
|
||||
|
||||
@ -75,25 +75,25 @@ showPosition :: Position -> String
|
||||
showPosition Position{..} = show (_line + 1) ++ ":" ++ show (_character + 1)
|
||||
|
||||
-- | Parser for the GHC output format
|
||||
readSrcSpan :: ReadS SrcSpan
|
||||
readSrcSpan :: ReadS RealSrcSpan
|
||||
readSrcSpan = readP_to_S (singleLineSrcSpanP <|> multiLineSrcSpanP)
|
||||
where
|
||||
singleLineSrcSpanP, multiLineSrcSpanP :: ReadP SrcSpan
|
||||
singleLineSrcSpanP, multiLineSrcSpanP :: ReadP RealSrcSpan
|
||||
singleLineSrcSpanP = do
|
||||
fp <- filePathP
|
||||
l <- readS_to_P reads <* char ':'
|
||||
c0 <- readS_to_P reads
|
||||
c1 <- (char '-' *> readS_to_P reads) <|> pure c0
|
||||
let from = mkSrcLoc fp l c0
|
||||
to = mkSrcLoc fp l c1
|
||||
return $ mkSrcSpan from to
|
||||
let from = mkRealSrcLoc fp l c0
|
||||
to = mkRealSrcLoc fp l c1
|
||||
return $ mkRealSrcSpan from to
|
||||
|
||||
multiLineSrcSpanP = do
|
||||
fp <- filePathP
|
||||
s <- parensP (srcLocP fp)
|
||||
void $ char '-'
|
||||
e <- parensP (srcLocP fp)
|
||||
return $ mkSrcSpan s e
|
||||
return $ mkRealSrcSpan s e
|
||||
|
||||
parensP :: ReadP a -> ReadP a
|
||||
parensP = between (char '(') (char ')')
|
||||
@ -101,12 +101,12 @@ readSrcSpan = readP_to_S (singleLineSrcSpanP <|> multiLineSrcSpanP)
|
||||
filePathP :: ReadP FastString
|
||||
filePathP = fromString <$> (readFilePath <* char ':') <|> pure ""
|
||||
|
||||
srcLocP :: FastString -> ReadP SrcLoc
|
||||
srcLocP :: FastString -> ReadP RealSrcLoc
|
||||
srcLocP fp = do
|
||||
l <- readS_to_P reads
|
||||
void $ char ','
|
||||
c <- readS_to_P reads
|
||||
return $ mkSrcLoc fp l c
|
||||
return $ mkRealSrcLoc fp l c
|
||||
|
||||
readFilePath :: ReadP FilePath
|
||||
readFilePath = some ReadP.get
|
||||
|
||||
Loading…
Reference in New Issue
Block a user