Process replacements according to AST depth (fixes #1431)

This commit is contained in:
Vidar Holen 2019-01-08 17:22:39 -08:00
parent 394f4d6505
commit 434b904746
7 changed files with 382 additions and 84 deletions

View File

@ -49,9 +49,10 @@ library
build-depends:
semigroups
build-depends:
aeson,
array,
-- GHC 7.6.3 (base 4.6.0.1) is buggy (#1131, #1119) in optimized mode.
-- Just disable that version entirely to fail fast.
aeson,
base > 4.6.0.1 && < 5,
bytestring,
containers >= 0.5,
@ -91,6 +92,7 @@ executable shellcheck
semigroups
build-depends:
aeson,
array,
base >= 4 && < 5,
bytestring,
deepseq >= 1.4.0.0,
@ -107,6 +109,7 @@ test-suite test-shellcheck
type: exitcode-stdio-1.0
build-depends:
aeson,
array,
base >= 4 && < 5,
bytestring,
deepseq >= 1.4.0.0,

View File

@ -250,11 +250,14 @@ replaceStart id params n r =
new_end = start {
posColumn = posColumn start + n
}
depth = length $ getPath (parentMap params) (T_EOF id)
in
newReplacement {
repStartPos = start,
repEndPos = new_end,
repString = r
repString = r,
repPrecedence = depth,
repInsertionPoint = InsertAfter
}
replaceEnd id params n r =
let tp = tokenPositions params
@ -265,11 +268,14 @@ replaceEnd id params n r =
new_end = end {
posColumn = posColumn end
}
depth = length $ getPath (parentMap params) (T_EOF id)
in
newReplacement {
repStartPos = new_start,
repEndPos = new_end,
repString = r
repString = r,
repPrecedence = depth,
repInsertionPoint = InsertBefore
}
surroundWidth id params s = fixWith [replaceStart id params 0 s, replaceEnd id params 0 s]
fixWith fixes = newFix { fixReplacements = fixes }
@ -1676,9 +1682,8 @@ checkSpacefulness params t =
"This default assignment may cause DoS due to globbing. Quote it."
else
makeCommentWithFix InfoC (getId token) 2086
"Double quote to prevent globbing and word splitting." (surroundWidth (getId token) params "\"")
-- makeComment InfoC (getId token) 2086
-- "Double quote to prevent globbing and word splitting."
"Double quote to prevent globbing and word splitting."
(surroundWidth (getId token) params "\"")
writeF _ _ name (DataString SourceExternal) = setSpaces name True >> return []
writeF _ _ name (DataString SourceInteger) = setSpaces name False >> return []

View File

@ -1,8 +1,33 @@
module ShellCheck.Fixer (applyFix , replaceMultiLines, Ranged(..)) where
{-
Copyright 2018-2019 Vidar Holen, Ng Zhi An
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE TemplateHaskell #-}
module ShellCheck.Fixer (applyFix, mapPositions, Ranged(..), runTests) where
import ShellCheck.Interface
import Control.Monad.State
import Data.Array
import Data.List
import Data.Semigroup
import GHC.Exts (sortWith)
import Test.QuickCheck
-- The Ranged class is used for types that has a start and end position.
class Ranged a where
@ -19,6 +44,27 @@ class Ranged a where
-- Set a new start and end position on a Ranged
setRange :: (Position, Position) -> a -> a
-- Tests auto-verify that overlap commutes
assertOverlap x y = overlap x y && overlap y x
assertNoOverlap x y = not (overlap x y) && not (overlap y x)
prop_overlap_contiguous = assertNoOverlap
(tFromStart 10 12 "foo" 1)
(tFromStart 12 14 "bar" 2)
prop_overlap_adjacent_zerowidth = assertNoOverlap
(tFromStart 3 3 "foo" 1)
(tFromStart 3 3 "bar" 2)
prop_overlap_enclosed = assertOverlap
(tFromStart 3 5 "foo" 1)
(tFromStart 1 10 "bar" 2)
prop_overlap_partial = assertOverlap
(tFromStart 1 5 "foo" 1)
(tFromStart 3 7 "bar" 2)
instance Ranged PositionedComment where
start = pcStartPos
end = pcEndPos
@ -35,44 +81,60 @@ instance Ranged Replacement where
repEndPos = e
}
instance Ranged a => Ranged [a] where
start [] = newPosition
start xs = (minimum . map start) xs
end [] = newPosition
end xs = (maximum . map end) xs
setRange (s, e) rs = map (setRange (s, e)) rs
instance Ranged Fix where
start = start . fixReplacements
end = end . fixReplacements
setRange (s, e) f = f {
fixReplacements = setRange (s, e) (fixReplacements f)
}
-- The Monoid instance for Fix merges replacements that do not overlap.
-- The Monoid instance for Fix merges fixes that do not conflict.
-- TODO: Make an efficient 'mconcat'
instance Monoid Fix where
mempty = newFix
mappend = (<>)
instance Semigroup Fix where
f1 <> f2 = if overlap f1 f2 then f1 else newFix {
f1 <> f2 =
-- FIXME: This might need to also discard adjacent zero-width ranges for
-- when two fixes change the same AST node, e.g. `foo` -> "$(foo)"
if or [ r2 `overlap` r1 | r1 <- fixReplacements f1, r2 <- fixReplacements f2 ]
then f1
else newFix {
fixReplacements = fixReplacements f1 ++ fixReplacements f2
}
}
mapPositions :: (Position -> Position) -> Fix -> Fix
mapPositions f = adjustFix
where
adjustReplacement rep =
rep {
repStartPos = f $ repStartPos rep,
repEndPos = f $ repEndPos rep
}
adjustFix fix =
fix {
fixReplacements = map adjustReplacement $ fixReplacements fix
}
multiToSingleLine :: [Fix] -> Array Int String -> ([Fix], String)
multiToSingleLine fixes lines =
(map (mapPositions adjust) fixes, unlines $ elems lines)
where
-- A prefix sum tree from line number to column shift.
-- FIXME: The tree will be totally unbalanced.
shiftTree :: PSTree Int
shiftTree =
foldl (\t (n,s) -> addPSValue (n+1) (length s + 1) t) newPSTree $
assocs lines
singleString = unlines $ elems lines
adjust pos =
pos {
posLine = 1,
posColumn = (posColumn pos) +
(fromIntegral $ getPrefixSum (fromIntegral $ posLine pos) shiftTree)
}
-- Apply a fix and return resulting lines.
-- The number of lines can increase or decrease with no obvious mapping back, so
-- the function does not return an array.
applyFix :: Fix -> Array Int String -> [String]
applyFix fix fileLines =
-- apply replacements in sorted order by end position
let sorted = (removeOverlap . reverse . sort) (fixReplacements fix) in
applyReplacement sorted fileLines
where
applyReplacement [] s = s
applyReplacement (rep:xs) s = applyReplacement xs $ replaceMultiLines rep s
-- prereq: list is already sorted by start position
removeOverlap [] = []
removeOverlap (x:xs) = checkoverlap x xs
checkoverlap x [] = x:[]
checkoverlap x (y:ys) =
if overlap x y then x:(removeOverlap ys) else x:y:(removeOverlap ys)
let (adjustedFixes, singleLine) = multiToSingleLine [fix] fileLines
in lines . runFixer $ applyFixes2 adjustedFixes singleLine
-- A replacement that spans multiple line is applied by:
-- 1. merging the affected lines into a single string using `unlines`
@ -111,14 +173,13 @@ replaceMultiLines rep fileLines = -- this can replace doReplace
in
xs ++ replacedLines ++ zs
-- FIXME: Work correctly with tabs
-- start and end comes from pos, which is 1 based
-- doReplace 0 0 "1234" "A" -> "A1234" -- technically not valid
-- doReplace 1 1 "1234" "A" -> "A1234"
-- doReplace 1 2 "1234" "A" -> "A234"
-- doReplace 3 3 "1234" "A" -> "12A34"
-- doReplace 4 4 "1234" "A" -> "123A4"
-- doReplace 5 5 "1234" "A" -> "1234A"
prop_doReplace1 = doReplace 0 0 "1234" "A" == "A1234" -- technically not valid
prop_doReplace2 = doReplace 1 1 "1234" "A" == "A1234"
prop_doReplace3 = doReplace 1 2 "1234" "A" == "A234"
prop_doReplace4 = doReplace 3 3 "1234" "A" == "12A34"
prop_doReplace5 = doReplace 4 4 "1234" "A" == "123A4"
prop_doReplace6 = doReplace 5 5 "1234" "A" == "1234A"
doReplace start end o r =
let si = fromIntegral (start-1)
ei = fromIntegral (end-1)
@ -126,3 +187,207 @@ doReplace start end o r =
(y, z) = splitAt (ei - si) xs
in
x ++ r ++ z
-- Fail if the 'expected' string is not result when applying 'fixes' to 'original'.
testFixes :: String -> String -> [Fix] -> Bool
testFixes expected original fixes =
actual == expected
where
actual = runFixer (applyFixes2 fixes original)
-- A Fixer allows doing repeated modifications of a string where each
-- replacement automatically accounts for shifts from previous ones.
type Fixer a = State (PSTree Int) a
-- Apply a single replacement using its indices into the original string.
-- It does not handle multiple lines, all line indices must be 1.
applyReplacement2 :: Replacement -> String -> Fixer String
applyReplacement2 rep string = do
tree <- get
let transform pos = pos + getPrefixSum pos tree
let originalPos = (repStartPos rep, repEndPos rep)
(oldStart, oldEnd) = tmap (fromInteger . posColumn) originalPos
(newStart, newEnd) = tmap transform (oldStart, oldEnd)
let (l1, l2) = tmap posLine originalPos in
when (l1 /= 1 || l2 /= 1) $
error "ShellCheck internal error, please report: bad cross-line fix"
let replacer = repString rep
let shift = (length replacer) - (oldEnd - oldStart)
let insertionPoint =
case repInsertionPoint rep of
InsertBefore -> oldStart
InsertAfter -> oldEnd+1
put $ addPSValue insertionPoint shift tree
return $ doReplace newStart newEnd string replacer
where
tmap f (a,b) = (f a, f b)
-- Apply a list of Replacements in the correct order
applyReplacements2 :: [Replacement] -> String -> Fixer String
applyReplacements2 reps str =
foldM (flip applyReplacement2) str $
reverse $ sortWith repPrecedence reps
-- Apply all fixes with replacements in the correct order
applyFixes2 :: [Fix] -> String -> Fixer String
applyFixes2 fixes = applyReplacements2 (concatMap fixReplacements fixes)
-- Get the final value of a Fixer.
runFixer :: Fixer a -> a
runFixer f = evalState f newPSTree
-- A Prefix Sum Tree that lets you look up the sum of values at and below an index.
-- It's implemented essentially as a Fenwick tree without the bit-based balancing.
-- The last Num is the sum of the left branch plus current element.
data PSTree n = PSBranch n (PSTree n) (PSTree n) n | PSLeaf
deriving (Show)
newPSTree :: Num n => PSTree n
newPSTree = PSLeaf
-- Get the sum of values whose keys are <= 'target'
getPrefixSum :: (Ord n, Num n) => n -> PSTree n -> n
getPrefixSum = f 0
where
f sum _ PSLeaf = sum
f sum target (PSBranch pivot left right cumulative) =
case () of
_ | target < pivot -> f sum target left
_ | target > pivot -> f (sum+cumulative) target right
_ -> sum+cumulative
-- Add a value to the Prefix Sum tree at the given index.
-- Values accumulate: addPSValue 42 2 . addPSValue 42 3 == addPSValue 42 5
addPSValue :: (Ord n, Num n) => n -> n -> PSTree n -> PSTree n
addPSValue key value tree = if value == 0 then tree else f tree
where
f PSLeaf = PSBranch key PSLeaf PSLeaf value
f (PSBranch pivot left right sum) =
case () of
_ | key < pivot -> PSBranch pivot (f left) right (sum + value)
_ | key > pivot -> PSBranch pivot left (f right) sum
_ -> PSBranch pivot left right (sum + value)
prop_pstreeSumsCorrectly kvs targets =
let
-- Trivial O(n * m) implementation
dumbPrefixSums :: [(Int, Int)] -> [Int] -> [Int]
dumbPrefixSums kvs targets =
let prefixSum target = sum . map snd . filter (\(k,v) -> k <= target) $ kvs
in map prefixSum targets
-- PSTree O(n * log m) implementation
smartPrefixSums :: [(Int, Int)] -> [Int] -> [Int]
smartPrefixSums kvs targets =
let tree = foldl (\tree (pos, shift) -> addPSValue pos shift tree) PSLeaf kvs
in map (\x -> getPrefixSum x tree) targets
in smartPrefixSums kvs targets == dumbPrefixSums kvs targets
-- Semi-convenient functions for constructing tests.
testFix :: [Replacement] -> Fix
testFix list = newFix {
fixReplacements = list
}
tFromStart :: Int -> Int -> String -> Int -> Replacement
tFromStart start end repl order =
newReplacement {
repStartPos = newPosition {
posLine = 1,
posColumn = fromIntegral start
},
repEndPos = newPosition {
posLine = 1,
posColumn = fromIntegral end
},
repString = repl,
repPrecedence = order,
repInsertionPoint = InsertAfter
}
tFromEnd start end repl order =
(tFromStart start end repl order) {
repInsertionPoint = InsertBefore
}
prop_simpleFix1 = testFixes "hello world" "hell world" [
testFix [
tFromEnd 5 5 "o" 1
]]
prop_anchorsLeft = testFixes "-->foobar<--" "--><--" [
testFix [
tFromStart 4 4 "foo" 1,
tFromStart 4 4 "bar" 2
]]
prop_anchorsRight = testFixes "-->foobar<--" "--><--" [
testFix [
tFromEnd 4 4 "bar" 1,
tFromEnd 4 4 "foo" 2
]]
prop_anchorsBoth1 = testFixes "-->foobar<--" "--><--" [
testFix [
tFromStart 4 4 "bar" 2,
tFromEnd 4 4 "foo" 1
]]
prop_anchorsBoth2 = testFixes "-->foobar<--" "--><--" [
testFix [
tFromEnd 4 4 "foo" 2,
tFromStart 4 4 "bar" 1
]]
prop_composeFixes1 = testFixes "cd \"$1\" || exit" "cd $1" [
testFix [
tFromStart 4 4 "\"" 10,
tFromEnd 6 6 "\"" 10
],
testFix [
tFromEnd 6 6 " || exit" 5
]]
prop_composeFixes2 = testFixes "$(\"$1\")" "`$1`" [
testFix [
tFromStart 1 2 "$(" 5,
tFromEnd 4 5 ")" 5
],
testFix [
tFromStart 2 2 "\"" 10,
tFromEnd 4 4 "\"" 10
]]
prop_composeFixes3 = testFixes "(x)[x]" "xx" [
testFix [
tFromStart 1 1 "(" 4,
tFromEnd 2 2 ")" 3,
tFromStart 2 2 "[" 2,
tFromEnd 3 3 "]" 1
]]
prop_composeFixes4 = testFixes "(x)[x]" "xx" [
testFix [
tFromStart 1 1 "(" 4,
tFromStart 2 2 "[" 3,
tFromEnd 2 2 ")" 2,
tFromEnd 3 3 "]" 1
]]
prop_composeFixes5 = testFixes "\"$(x)\"" "`x`" [
testFix [
tFromStart 1 2 "$(" 2,
tFromEnd 3 4 ")" 2,
tFromStart 1 1 "\"" 1,
tFromEnd 4 4 "\"" 1
]]
return []
runTests = $quickCheckAll

View File

@ -22,6 +22,7 @@ module ShellCheck.Formatter.Format where
import ShellCheck.Data
import ShellCheck.Interface
import ShellCheck.Fixer
import Data.Array
-- A formatter that carries along an arbitrary piece of data
data Formatter = Formatter {
@ -51,11 +52,12 @@ severityText pc =
makeNonVirtual comments contents =
map fix comments
where
ls = lines contents
fix c = realign c ls
list = lines contents
arr = listArray (1, length list) list
fix c = realign c arr
-- Realign a Ranged from a tabstop of 8 to 1
realign :: Ranged a => a -> [String] -> a
realign :: Ranged a => a -> Array Int String -> a
realign range ls =
let startColumn = realignColumn lineNo colNo range
endColumn = realignColumn endLineNo endColNo range
@ -65,7 +67,7 @@ realign range ls =
where
realignColumn lineNo colNo c =
if lineNo c > 0 && lineNo c <= fromIntegral (length ls)
then real (ls !! fromIntegral (lineNo c - 1)) 0 0 (colNo c)
then real (ls ! fromIntegral (lineNo c)) 0 0 (colNo c)
else colNo c
real _ r v target | target <= v = r
-- hit this case at the end of line, and if we don't hit the target

View File

@ -24,6 +24,7 @@ import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Control.Monad
import Data.Array
import Data.Foldable
import Data.Ord
import Data.IORef
@ -37,6 +38,8 @@ wikiLink = "https://www.shellcheck.net/wiki/"
-- An arbitrary Ord thing to order warnings
type Ranking = (Char, Severity, Integer)
-- Ansi coloring function
type ColorFunc = (String -> String -> String)
format :: FormatterOptions -> IO Formatter
format options = do
@ -119,59 +122,66 @@ outputForFile color sys comments = do
let fileName = sourceFile (head comments)
result <- (siReadFile sys) fileName
let contents = either (const "") id result
let fileLines = lines contents
let lineCount = fromIntegral $ length fileLines
let fileLinesList = lines contents
let lineCount = length fileLinesList
let fileLines = listArray (1, lineCount) fileLinesList
let groups = groupWith lineNo comments
mapM_ (\commentsForLine -> do
let lineNum = lineNo (head commentsForLine)
let lineNum = fromIntegral $ lineNo (head commentsForLine)
let line = if lineNum < 1 || lineNum > lineCount
then ""
else fileLines !! fromIntegral (lineNum - 1)
else fileLines ! fromIntegral lineNum
putStrLn ""
putStrLn $ color "message" $
"In " ++ fileName ++" line " ++ show lineNum ++ ":"
putStrLn (color "source" line)
mapM_ (\c -> putStrLn (color (severityText c) $ cuteIndent c)) commentsForLine
putStrLn ""
showFixedString color comments lineNum fileLines
showFixedString color commentsForLine (fromIntegral lineNum) fileLines
) groups
hasApplicableFix lineNum comment = fromMaybe False $ do
replacements <- fixReplacements <$> pcFix comment
guard $ all (\c -> onSameLine (repStartPos c) && onSameLine (repEndPos c)) replacements
return True
-- Pick out only the lines necessary to show a fix in action
sliceFile :: Fix -> Array Int String -> (Fix, Array Int String)
sliceFile fix lines =
(mapPositions adjust fix, sliceLines lines)
where
onSameLine pos = posLine pos == lineNum
(minLine, maxLine) =
foldl (\(mm, mx) pos -> ((min mm $ fromIntegral $ posLine pos), (max mx $ fromIntegral $ posLine pos)))
(maxBound, minBound) $
concatMap (\x -> [repStartPos x, repEndPos x]) $ fixReplacements fix
sliceLines :: Array Int String -> Array Int String
sliceLines = ixmap (1, maxLine - minLine + 1) (\x -> x + minLine - 1)
adjust pos =
pos {
posLine = posLine pos - (fromIntegral minLine) + 1
}
-- FIXME: Work correctly with multiple replacements
showFixedString :: ColorFunc -> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString color comments lineNum fileLines =
let line = fileLines !! fromIntegral (lineNum - 1) in
-- need to check overlaps
case filter (hasApplicableFix lineNum) comments of
let line = fileLines ! fromIntegral lineNum in
case mapMaybe pcFix comments of
[] -> return ()
-- all the fixes are single-line only, but there could be multiple
-- fixes for that single line. We can fold the fixes (which removes
-- overlaps), and apply it as a single fix with multiple replacements.
applicableComments -> do
let mergedFix = (realignFix . fold . catMaybes . (map pcFix)) applicableComments
fixes -> do
-- Folding automatically removes overlap
let mergedFix = realignFix $ fold fixes
-- We show the complete, associated fixes, whether or not it includes this and/or unrelated lines.
let (excerptFix, excerpt) = sliceFile mergedFix fileLines
-- in the spirit of error prone
putStrLn $ color "message" "Did you mean: "
putStrLn $ unlines $ fixedString mergedFix fileLines
putStrLn $ unlines $ fixedString excerptFix excerpt
where
-- FIXME: This should be handled by Fixer
realignFix f = f { fixReplacements = map fix (fixReplacements f) }
fix r = realign r fileLines
fixedString :: Fix -> [String] -> [String]
fixedString :: Fix -> Array Int String -> [String]
fixedString fix fileLines =
case (fixReplacements fix) of
[] -> []
reps ->
-- applyReplacement returns the full update file, we really only care about the changed lines
-- so we calculate overlapping lines using replacements
drop start $ take end $ applyFix fix fileLines
where
start = (fromIntegral $ minimum $ map (posLine . repStartPos) reps) - 1
end = fromIntegral $ maximum $ map (posLine . repEndPos) reps
applyFix fix fileLines
cuteIndent :: PositionedComment -> String
cuteIndent comment =
@ -187,6 +197,7 @@ cuteIndent comment =
code num = "SC" ++ show num
getColorFunc :: ColorOption -> IO ColorFunc
getColorFunc colorOption = do
term <- hIsTerminalDevice stdout
let windows = "mingw" `isPrefixOf` os

View File

@ -52,7 +52,8 @@ module ShellCheck.Interface
, newComment
, Fix(fixReplacements)
, newFix
, Replacement(repStartPos, repEndPos, repString)
, InsertionPoint(InsertBefore, InsertAfter)
, Replacement(repStartPos, repEndPos, repString, repPrecedence, repInsertionPoint)
, newReplacement
) where
@ -209,16 +210,25 @@ newComment = Comment {
data Replacement = Replacement {
repStartPos :: Position,
repEndPos :: Position,
repString :: String
repString :: String,
-- Order in which the replacements should happen: highest precedence first.
repPrecedence :: Int,
-- Whether to insert immediately before or immediately after the specified region.
repInsertionPoint :: InsertionPoint
} deriving (Show, Eq, Generic, NFData)
data InsertionPoint = InsertBefore | InsertAfter
deriving (Show, Eq, Generic, NFData)
instance Ord Replacement where
compare r1 r2 = (repStartPos r1) `compare` (repStartPos r2)
newReplacement = Replacement {
repStartPos = newPosition,
repEndPos = newPosition,
repString = ""
repString = "",
repPrecedence = 1,
repInsertionPoint = InsertAfter
}
data Fix = Fix {

View File

@ -2,22 +2,24 @@ module Main where
import Control.Monad
import System.Exit
import qualified ShellCheck.Checker
import qualified ShellCheck.Analytics
import qualified ShellCheck.AnalyzerLib
import qualified ShellCheck.Parser
import qualified ShellCheck.Checker
import qualified ShellCheck.Checks.Commands
import qualified ShellCheck.Checks.ShellSupport
import qualified ShellCheck.Fixer
import qualified ShellCheck.Parser
main = do
putStrLn "Running ShellCheck tests..."
results <- sequence [
ShellCheck.Checker.runTests,
ShellCheck.Checks.Commands.runTests,
ShellCheck.Checks.ShellSupport.runTests,
ShellCheck.Analytics.runTests,
ShellCheck.AnalyzerLib.runTests,
ShellCheck.Parser.runTests
ShellCheck.Analytics.runTests
,ShellCheck.AnalyzerLib.runTests
,ShellCheck.Checker.runTests
,ShellCheck.Checks.Commands.runTests
,ShellCheck.Checks.ShellSupport.runTests
,ShellCheck.Fixer.runTests
,ShellCheck.Parser.runTests
]
if and results
then exitSuccess