on multi-component help sign in
505 lines 23 kB history raw
1-- Copyright (c) 2019 The DAML Authors. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4{-# LANGUAGE DuplicateRecordFields #-}
5{-# LANGUAGE CPP #-}
6#include "ghc-api-version.h"
8-- | Go to the definition of a variable.
9module Development.IDE.Plugin.CodeAction
10 ( setHandlersCodeAction
11 , setHandlersCodeLens
12 ) where
14import Language.Haskell.LSP.Types
15import Control.Monad (join)
16import Development.IDE.GHC.Compat
17import Development.IDE.Core.Rules
18import Development.IDE.Core.RuleTypes
19import Development.IDE.Core.Service
20import Development.IDE.Core.Shake
21import Development.IDE.GHC.Error
22import Development.IDE.LSP.Server
23import Development.IDE.Types.Location
24import Development.IDE.Types.Options
25import qualified Data.HashMap.Strict as Map
26import qualified Data.HashSet as Set
27import qualified Language.Haskell.LSP.Core as LSP
28import Language.Haskell.LSP.VFS
29import Language.Haskell.LSP.Messages
30import qualified Data.Rope.UTF16 as Rope
31import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
32import Control.Monad.Trans.Maybe
33import Data.Char
34import Data.Maybe
35import Data.List.Extra
36import qualified Data.Text as T
37import Text.Regex.TDFA ((=~), (=~~))
38import Text.Regex.TDFA.Text()
39import Outputable (ppr, showSDocUnsafe)
41-- | Generate code actions.
42codeAction
43 :: LSP.LspFuncs ()
44 -> IdeState
45 -> CodeActionParams
46 -> IO (List CAResult)
47codeAction lsp state CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
48 -- disable logging as its quite verbose
49 -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
50 contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
51 let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
52 (ideOptions, parsedModule) <- runAction state $
53 (,) <$> getIdeOptions
54 <*> (getParsedModule . toNormalizedFilePath) `traverse` uriToFilePath uri
55 pure $ List
56 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
57 | x <- xs, (title, tedit) <- suggestAction ideOptions ( join parsedModule ) text x
58 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
59 ]
61-- | Generate code lenses.
62codeLens
63 :: LSP.LspFuncs ()
64 -> IdeState
65 -> CodeLensParams
66 -> IO (List CodeLens)
67codeLens _lsp ideState CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
68 case uriToFilePath' uri of
69 Just (toNormalizedFilePath -> filePath) -> do
70 _ <- runAction ideState $ runMaybeT $ useE TypeCheck filePath
71 diag <- getDiagnostics ideState
72 hDiag <- getHiddenDiagnostics ideState
73 pure $ List
74 [ CodeLens _range (Just (Command title "typesignature.add" (Just $ List [toJSON edit]))) Nothing
75 | (dFile, _, dDiag@Diagnostic{_range=_range@Range{..},..}) <- diag ++ hDiag
76 , dFile == filePath
77 , (title, tedit) <- suggestSignature False dDiag
78 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
79 ]
80 Nothing -> pure $ List []
82-- | Execute the "typesignature.add" command.
83executeAddSignatureCommand
84 :: LSP.LspFuncs ()
85 -> IdeState
86 -> ExecuteCommandParams
87 -> IO (Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
88executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}
89 | _command == "typesignature.add"
90 , Just (List [edit]) <- _arguments
91 , Success wedit <- fromJSON edit
92 = return (Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams wedit))
93 | otherwise
94 = return (Null, Nothing)
96suggestAction :: IdeOptions -> Maybe ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
97suggestAction ideOptions parsedModule text diag = concat
98 [ suggestAddExtension diag
99 , suggestExtendImport text diag
100 , suggestFillHole diag
101 , suggestFillTypeWildcard diag
102 , suggestFixConstructorImport text diag
103 , suggestModuleTypo diag
104 , suggestReplaceIdentifier text diag
105 , suggestSignature True diag
106 ] ++ concat
107 [ suggestNewDefinition ideOptions pm text diag
108 ++ suggestRemoveRedundantImport pm text diag
109 | Just pm <- [parsedModule]]
112suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
113suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmodImports}} contents Diagnostic{_range=_range@Range{..},..}
114-- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant
115 | Just [_, bindings] <- matchRegex _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
116 , Just (L _ impDecl) <- find (\(L l _) -> srcSpanToRange l == _range ) hsmodImports
117 , Just c <- contents
118 , ranges <- map (rangesForBinding impDecl . T.unpack) (T.splitOn ", " bindings)
119 , ranges' <- extendAllToIncludeCommaIfPossible (indexedByPosition $ T.unpack c) (concat ranges)
120 = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )]
122-- File.hs:16:1: warning:
123-- The import of `Data.List' is redundant
124-- except perhaps to import instances from `Data.List'
125-- To import instances alone, use: import Data.List()
126 | _message =~ ("The( qualified)? import of [^ ]* is redundant" :: String)
127 = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]
128 | otherwise = []
130suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
131suggestReplaceIdentifier contents Diagnostic{_range=_range@Range{..},..}
132-- File.hs:52:41: error:
133-- * Variable not in scope:
134-- suggestAcion :: Maybe T.Text -> Range -> Range
135-- * Perhaps you meant ‘suggestAction’ (line 83)
136-- File.hs:94:37: error:
137-- Not in scope: ‘T.isPrfixOf’
138-- Perhaps you meant one of these:
139-- ‘T.isPrefixOf’ (imported from Data.Text),
140-- ‘T.isInfixOf’ (imported from Data.Text),
141-- ‘T.isSuffixOf’ (imported from Data.Text)
142-- Module ‘Data.Text’ does not export ‘isPrfixOf’.
143 | renameSuggestions@(_:_) <- extractRenamableTerms _message
144 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]
145 | otherwise = []
147suggestNewDefinition :: IdeOptions -> ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
148suggestNewDefinition ideOptions parsedModule contents Diagnostic{_message, _range}
149-- * Variable not in scope:
150-- suggestAcion :: Maybe T.Text -> Range -> Range
151 | Just [name, typ] <- matchRegex message "Variable not in scope: ([^ ]+) :: ([^*•]+)"
152 = newDefinitionAction ideOptions parsedModule _range name typ
153 | Just [name, typ] <- matchRegex message "Found hole: _([^ ]+) :: ([^*•]+) Or perhaps"
154 , [(label, newDefinitionEdits)] <- newDefinitionAction ideOptions parsedModule _range name typ
155 = [(label, mkRenameEdit contents _range name : newDefinitionEdits)]
156 | otherwise = []
157 where
158 message = unifySpaces _message
160newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text -> [(T.Text, [TextEdit])]
161newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ
162 | Range _ lastLineP : _ <-
163 [ srcSpanToRange l
164 | (L l _) <- hsmodDecls
165 , _start `isInsideSrcSpan` l]
166 , nextLineP <- Position{ _line = _line lastLineP + 1, _character = 0}
167 = [ ("Define " <> sig
168 , [TextEdit (Range nextLineP nextLineP) (T.unlines ["", sig, name <> " = error \"not implemented\""])]
169 )]
170 | otherwise = []
171 where
172 colon = if optNewColonConvention then " : " else " :: "
173 sig = name <> colon <> T.dropWhileEnd isSpace typ
174 ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls}} = parsedModule
177suggestFillTypeWildcard :: Diagnostic -> [(T.Text, [TextEdit])]
178suggestFillTypeWildcard Diagnostic{_range=_range@Range{..},..}
179-- Foo.hs:3:8: error:
180-- * Found type wildcard `_' standing for `p -> p1 -> p'
182 | "Found type wildcard" `T.isInfixOf` _message
183 , " standing for " `T.isInfixOf` _message
184 , typeSignature <- extractWildCardTypeSignature _message
185 = [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])]
186 | otherwise = []
188suggestAddExtension :: Diagnostic -> [(T.Text, [TextEdit])]
189suggestAddExtension Diagnostic{_range=_range@Range{..},..}
190-- File.hs:22:8: error:
191-- Illegal lambda-case (use -XLambdaCase)
192-- File.hs:22:6: error:
193-- Illegal view pattern: x -> foo
194-- Use ViewPatterns to enable view patterns
195-- File.hs:26:8: error:
196-- Illegal `..' in record pattern
197-- Use RecordWildCards to permit this
198-- File.hs:53:28: error:
199-- Illegal tuple section: use TupleSections
200-- File.hs:238:29: error:
201-- * Can't make a derived instance of `Data FSATrace':
202-- You need DeriveDataTypeable to derive an instance for this class
203-- * In the data declaration for `FSATrace'
204-- C:\Neil\shake\src\Development\Shake\Command.hs:515:31: error:
205-- * Illegal equational constraint a ~ ()
206-- (Use GADTs or TypeFamilies to permit this)
207-- * In the context: a ~ ()
208-- While checking an instance declaration
209-- In the instance declaration for `Unit (m a)'
210 | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
211 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]
212 | otherwise = []
214suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])]
215suggestModuleTypo Diagnostic{_range=_range@Range{..},..}
216-- src/Development/IDE/Core/Compile.hs:58:1: error:
217-- Could not find module ‘Data.Cha’
218-- Perhaps you meant Data.Char (from base-4.12.0.0)
219 | "Could not find module" `T.isInfixOf` _message
220 , "Perhaps you meant" `T.isInfixOf` _message = let
221 findSuggestedModules = map (head . T.words) . drop 2 . T.lines
222 proposeModule mod = ("replace with " <> mod, [TextEdit _range mod])
223 in map proposeModule $ nubOrd $ findSuggestedModules _message
224 | otherwise = []
226suggestFillHole :: Diagnostic -> [(T.Text, [TextEdit])]
227suggestFillHole Diagnostic{_range=_range@Range{..},..}
228-- ...Development/IDE/LSP/CodeAction.hs:103:9: warning:
229-- * Found hole: _ :: Int -> String
230-- * In the expression: _
231-- In the expression: _ a
232-- In an equation for ‘foo’: foo a = _ a
233-- * Relevant bindings include
234-- a :: Int
235-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:5)
236-- foo :: Int -> String
237-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)
238-- Valid hole fits include
239-- foo :: Int -> String
240-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)
241-- show :: forall a. Show a => a -> String
242-- with show @Int
243-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37
244-- (and originally defined in ‘GHC.Show’))
245-- mempty :: forall a. Monoid a => a
246-- with mempty @(Int -> String)
247-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37
248-- (and originally defined in ‘GHC.Base’)) (lsp-ui)
250 | topOfHoleFitsMarker `T.isInfixOf` _message = let
251 findSuggestedHoleFits :: T.Text -> [T.Text]
252 findSuggestedHoleFits = extractFitNames . selectLinesWithFits . dropPreceding . T.lines
253 proposeHoleFit name = ("replace hole `" <> holeName <> "` with " <> name, [TextEdit _range name])
254 holeName = T.strip $ last $ T.splitOn ":" $ head . T.splitOn "::" $ head $ filter ("Found hole" `T.isInfixOf`) $ T.lines _message
255 dropPreceding = dropWhile (not . (topOfHoleFitsMarker `T.isInfixOf`))
256 selectLinesWithFits = filter ("::" `T.isInfixOf`)
257 extractFitNames = map (T.strip . head . T.splitOn " :: ")
258 in map proposeHoleFit $ nubOrd $ findSuggestedHoleFits _message
260 | otherwise = []
262suggestExtendImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
263suggestExtendImport contents Diagnostic{_range=_range,..}
264 | Just [binding, mod, srcspan] <-
265 matchRegex _message
266 "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\).$"
267 , Just c <- contents
268 = let range = case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of
269 [s] -> let x = srcSpanToRange s
270 in x{_end = (_end x){_character = succ (_character (_end x))}}
271 _ -> error "bug in srcspan parser"
272 importLine = textInRange range c
273 in [("Add " <> binding <> " to the import list of " <> mod
274 , [TextEdit range (addBindingToImportList binding importLine)])]
275 | otherwise = []
277suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
278suggestFixConstructorImport _ Diagnostic{_range=_range,..}
279 -- ‘Success’ is a data constructor of ‘Result’
280 -- To import it use
281 -- import Data.Aeson.Types( Result( Success ) )
282 -- or
283 -- import Data.Aeson.Types( Result(..) ) (lsp-ui)
284 | Just [constructor, typ] <-
285 matchRegex _message
286 "‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"
287 = let fixedImport = typ <> "(" <> constructor <> ")"
288 in [("Fix import of " <> fixedImport, [TextEdit _range fixedImport])]
289 | otherwise = []
291suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]
292suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}
293 | "Top-level binding with no type signature" `T.isInfixOf` _message = let
294 signature = T.strip $ unifySpaces $ last $ T.splitOn "type signature: " $ filterNewlines _message
295 startOfLine = Position (_line _start) 0
296 beforeLine = Range startOfLine startOfLine
297 title = if isQuickFix then "add signature: " <> signature else signature
298 action = TextEdit beforeLine $ signature <> "\n"
299 in [(title, [action])]
300suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}
301 | "Polymorphic local binding with no type signature" `T.isInfixOf` _message = let
302 signature = removeInitialForAll
303 $ T.takeWhile (\x -> x/='*' && x/='•')
304 $ T.strip $ unifySpaces $ last $ T.splitOn "type signature: " $ filterNewlines _message
305 startOfLine = Position (_line _start) (_character _start)
306 beforeLine = Range startOfLine startOfLine
307 title = if isQuickFix then "add signature: " <> signature else signature
308 action = TextEdit beforeLine $ signature <> "\n" <> T.replicate (_character _start) " "
309 in [(title, [action])]
310 where removeInitialForAll :: T.Text -> T.Text
311 removeInitialForAll (T.breakOnEnd " :: " -> (nm, ty))
312 | "forall" `T.isPrefixOf` ty = nm <> T.drop 2 (snd (T.breakOn "." ty))
313 | otherwise = nm <> ty
314suggestSignature _ _ = []
316topOfHoleFitsMarker :: T.Text
317topOfHoleFitsMarker =
318#if MIN_GHC_API_VERSION(8,6,0)
319 "Valid hole fits include"
320#else
321 "Valid substitutions include"
322#endif
324mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
325mkRenameEdit contents range name =
326 if fromMaybe False maybeIsInfixFunction
327 then TextEdit range ("`" <> name <> "`")
328 else TextEdit range name
329 where
330 maybeIsInfixFunction = do
331 curr <- textInRange range <$> contents
332 pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr
334extractWildCardTypeSignature :: T.Text -> T.Text
335extractWildCardTypeSignature =
336 -- inferring when parens are actually needed around the type signature would
337 -- require understanding both the precedence of the context of the _ and of
338 -- the signature itself. Inserting them unconditionally is ugly but safe.
339 ("(" `T.append`) . (`T.append` ")") .
340 T.takeWhile (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') .
341 snd . T.breakOnEnd "standing for "
343extractRenamableTerms :: T.Text -> [T.Text]
344extractRenamableTerms msg
345 -- Account for both "Variable not in scope" and "Not in scope"
346 | "ot in scope:" `T.isInfixOf` msg = extractSuggestions msg
347 | otherwise = []
348 where
349 extractSuggestions = map getEnclosed
350 . concatMap singleSuggestions
351 . filter isKnownSymbol
352 . T.lines
353 singleSuggestions = T.splitOn "), " -- Each suggestion is comma delimited
354 isKnownSymbol t = " (imported from" `T.isInfixOf` t || " (line " `T.isInfixOf` t
355 getEnclosed = T.dropWhile (== '‘')
356 . T.dropWhileEnd (== '’')
357 . T.dropAround (\c -> c /= '‘' && c /= '’')
359-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace
360-- between the end of the range and the next newline), extend the range to take up the whole line.
361extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range
362extendToWholeLineIfPossible contents range@Range{..} =
363 let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . splitTextAtPosition _end) contents
364 extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line
365 in if extend then Range _start (Position (_line _end + 1) 0) else range
367-- | All the GHC extensions
368ghcExtensions :: Set.HashSet T.Text
369ghcExtensions = Set.fromList $ map (T.pack . show) ghcEnumerateExtensions
371splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text)
372splitTextAtPosition (Position row col) x
373 | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x
374 , (preCol, postCol) <- T.splitAt col mid
375 = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)
376 | otherwise = (x, T.empty)
378-- | Returns [start .. end[
379textInRange :: Range -> T.Text -> T.Text
380textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
381 case compare startRow endRow of
382 LT ->
383 let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine
384 (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of
385 [] -> ("", [])
386 firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween)
387 maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines
388 in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine)
389 EQ ->
390 let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine)
391 in T.take (endCol - startCol) (T.drop startCol line)
392 GT -> ""
393 where
394 linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)
396-- | Returns the ranges for a binding in an import declaration
397rangesForBinding :: ImportDecl GhcPs -> String -> [Range]
398rangesForBinding ImportDecl{ideclHiding = Just (False, L _ lies)} b =
399 concatMap (map srcSpanToRange . rangesForBinding' b') lies
400 where
401 b' = wrapOperatorInParens (unqualify b)
403 wrapOperatorInParens x = if isAlpha (head x) then x else "(" <> x <> ")"
405 unqualify x = snd $ breakOnEnd "." x
407rangesForBinding _ _ = []
409rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]
410rangesForBinding' b (L l x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l]
411rangesForBinding' b (L l x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l]
412rangesForBinding' b (L l x@IEThingAll{}) | showSDocUnsafe (ppr x) == b = [l]
413rangesForBinding' b (L l (IEThingWith thing _ inners labels))
414 | showSDocUnsafe (ppr thing) == b = [l]
415 | otherwise =
416 [ l' | L l' x <- inners, showSDocUnsafe (ppr x) == b] ++
417 [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b]
418rangesForBinding' _ _ = []
420-- | Extends an import list with a new binding.
421-- Assumes an import statement of the form:
422-- import (qualified) A (..) ..
423-- Places the new binding first, preserving whitespace.
424-- Copes with multi-line import lists
425addBindingToImportList :: T.Text -> T.Text -> T.Text
426addBindingToImportList binding importLine = case T.breakOn "(" importLine of
427 (pre, T.uncons -> Just (_, rest)) ->
428 case T.uncons (T.dropWhile isSpace rest) of
429 Just (')', _) -> T.concat [pre, "(", binding, rest]
430 _ -> T.concat [pre, "(", binding, ", ", rest]
431 _ ->
432 error
433 $ "importLine does not have the expected structure: "
434 <> T.unpack importLine
436-- | Returns Just (the submatches) for the first capture, or Nothing.
437matchRegex :: T.Text -> T.Text -> Maybe [T.Text]
438matchRegex message regex = case unifySpaces message =~~ regex of
439 Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings
440 Nothing -> Nothing
442setHandlersCodeAction :: PartialHandlers
443setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
444 LSP.codeActionHandler = withResponse RspCodeAction codeAction
445 }
447setHandlersCodeLens :: PartialHandlers
448setHandlersCodeLens = PartialHandlers $ \WithMessage{..} x -> return x{
449 LSP.codeLensHandler = withResponse RspCodeLens codeLens,
450 LSP.executeCommandHandler = withResponseAndRequest RspExecuteCommand ReqApplyWorkspaceEdit executeAddSignatureCommand
451 }
453filterNewlines :: T.Text -> T.Text
454filterNewlines = T.concat . T.lines
456unifySpaces :: T.Text -> T.Text
457unifySpaces = T.unwords . T.words
459--------------------------------------------------------------------------------
461type PositionIndexedString = [(Position, Char)]
463indexedByPosition :: String -> PositionIndexedString
464indexedByPosition = unfoldr f . (Position 0 0,) where
465 f (_, []) = Nothing
466 f (p@(Position l _), '\n' : rest) = Just ((p,'\n'), (Position (l+1) 0, rest))
467 f (p@(Position l c), x : rest) = Just ((p, x), (Position l (c+1), rest))
469-- | Returns a tuple (before, contents, after)
470unconsRange :: Range -> PositionIndexedString -> (PositionIndexedString, PositionIndexedString, PositionIndexedString)
471unconsRange Range {..} indexedString = (before, mid, after)
472 where
473 (before, rest) = span ((/= _start) . fst) indexedString
474 (mid, after) = span ((/= _end) . fst) rest
476stripRange :: Range -> PositionIndexedString -> PositionIndexedString
477stripRange r s = case unconsRange r s of
478 (b, _, a) -> b ++ a
480extendAllToIncludeCommaIfPossible :: PositionIndexedString -> [Range] -> [Range]
481extendAllToIncludeCommaIfPossible _ [] = []
482extendAllToIncludeCommaIfPossible indexedString (r : rr) = r' : extendAllToIncludeCommaIfPossible indexedString' rr
483 where
484 r' = case extendToIncludeCommaIfPossible indexedString r of
485 [] -> r
486 r' : _ -> r'
487 indexedString' = stripRange r' indexedString
489-- | Returns a sorted list of ranges with extended selections includindg preceding or trailing commas
490extendToIncludeCommaIfPossible :: PositionIndexedString -> Range -> [Range]
491extendToIncludeCommaIfPossible indexedString range =
492 -- a, |b|, c ===> a|, b|, c
493 [ range{_start = start'}
494 | (start', ',') : _ <- [before']
495 ]
496 ++
497 -- a, |b|, c ===> a, |b, |c
498 [ range{_end = end'}
499 | (_, ',') : rest <- [after']
500 , let (end', _) : _ = dropWhile (isSpace . snd) rest
501 ]
502 where
503 (before, _, after) = unconsRange range indexedString
504 after' = dropWhile (isSpace . snd) after
505 before' = dropWhile (isSpace . snd) (reverse before)