diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 3002e3e..b2e227c 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1336,7 +1336,10 @@ prop_checkBackticks1 = verify checkBackticks "echo `foo`" prop_checkBackticks2 = verifyNot checkBackticks "echo $(foo)" prop_checkBackticks3 = verifyNot checkBackticks "echo `#inlined comment` foo" checkBackticks _ (T_Backticked id list) | not (null list) = - style id 2006 "Use $(...) notation instead of legacy backticked `...`." + addComment $ + makeCommentWithFix StyleC id 2006 "Use $(...) notation instead of legacy backticked `...`." + ((replaceStart 1 "$(") ++ (replaceEnd 1 ")")) + -- style id 2006 "Use $(...) notation instead of legacy backticked `...`." checkBackticks _ _ = return () prop_checkIndirectExpansion1 = verify checkIndirectExpansion "${foo$n}" @@ -1640,8 +1643,10 @@ checkSpacefulness params t = makeComment InfoC (getId token) 2223 "This default assignment may cause DoS due to globbing. Quote it." else - makeComment InfoC (getId token) 2086 - "Double quote to prevent globbing and word splitting." + makeCommentWithFix InfoC (getId token) 2086 + "Double quote to prevent globbing and word splitting." (surroundWith "\"") + -- makeComment InfoC (getId token) 2086 + -- "Double quote to prevent globbing and word splitting." writeF _ _ name (DataString SourceExternal) = setSpaces name True >> return [] writeF _ _ name (DataString SourceInteger) = setSpaces name False >> return [] @@ -2538,7 +2543,9 @@ checkUncheckedCdPushdPopd params root = && not (isSafeDir t) && not (name t `elem` ["pushd", "popd"] && ("n" `elem` map snd (getAllFlags t))) && not (isCondition $ getPath (parentMap params) t)) $ - warn (getId t) 2164 "Use 'cd ... || exit' or 'cd ... || return' in case cd fails." + -- warn (getId t) 2164 "Use 'cd ... || exit' or 'cd ... || return' in case cd fails." + warnWithFix (getId t) 2164 "Use 'cd ... || exit' or 'cd ... || return' in case cd fails." + (replaceEnd 0 " || exit") checkElement _ = return () name t = fromMaybe "" $ getCommandName t isSafeDir t = case oversimplify t of @@ -2695,7 +2702,7 @@ checkArrayAssignmentIndices params root = T_Literal id str -> [(id,str)] _ -> [] guard $ '=' `elem` str - return $ warn id 2191 "The = here is literal. To assign by index, use ( [index]=value ) with no spaces. To keep as literal, quote it." + return $ warnWithFix id 2191 "The = here is literal. To assign by index, use ( [index]=value ) with no spaces. To keep as literal, quote it." (surroundWith "\"") in if null literalEquals && isAssociative then warn (getId t) 2190 "Elements in associative arrays need index, e.g. array=( [index]=value ) ." diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index de3498d..4bf68e7 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -150,6 +150,19 @@ err id code str = addComment $ makeComment ErrorC id code str info id code str = addComment $ makeComment InfoC id code str style id code str = addComment $ makeComment StyleC id code str +warnWithFix id code str fix = addComment $ + let comment = makeComment WarningC id code str in + comment { + tcFix = Just fix + } + +makeCommentWithFix :: Severity -> Id -> Code -> String -> Fix -> TokenComment +makeCommentWithFix severity id code str fix = + let comment = makeComment severity id code str in + comment { + tcFix = Just fix + } + makeParameters spec = let params = Parameters { rootNode = root, diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index ac58876..b9e7927 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -42,7 +42,8 @@ tokenToPosition startMap t = fromMaybe fail $ do return $ newPositionedComment { pcStartPos = fst span, pcEndPos = snd span, - pcComment = tcComment t + pcComment = tcComment t, + pcFix = tcFix t } where fail = error "Internal shellcheck error: id doesn't exist. Please report!" diff --git a/src/ShellCheck/Formatter/TTY.hs b/src/ShellCheck/Formatter/TTY.hs index dd0e0da..dc3f32e 100644 --- a/src/ShellCheck/Formatter/TTY.hs +++ b/src/ShellCheck/Formatter/TTY.hs @@ -129,8 +129,47 @@ outputForFile color sys comments = do putStrLn (color "source" line) mapM_ (\c -> putStrLn (color (severityText c) $ cuteIndent c)) x putStrLn "" + mapM_ (\c -> putStrLn "Did you mean:" >> putStrLn (fixedString c line)) x ) groups +-- need to do something smart about sorting by end index +fixedString :: PositionedComment -> String -> String +fixedString comment line = + case (pcFix comment) of + Nothing -> "" + Just rs -> + apply_replacement rs line 0 + where + apply_replacement [] s _ = s + apply_replacement ((Start n r):xs) s offset = + let start = (posColumn . pcStartPos) comment + end = start + n + z = do_replace start end s r + len_r = (fromIntegral . length) r in + apply_replacement xs z (offset + (end - start) + len_r) + apply_replacement ((End n r):xs) s offset = + -- tricky math because column is 1 based + let end = (posColumn . pcEndPos) comment + 1 + start = end - n + z = do_replace start end s r + len_r = (fromIntegral . length) r in + apply_replacement xs z (offset + (end - start) + len_r) + +-- start and end comes from pos, which is 1 based +-- do_replace 0 0 "1234" "A" -> "A1234" -- technically not valid +-- do_replace 1 1 "1234" "A" -> "A1234" +-- do_replace 1 2 "1234" "A" -> "A234" +-- do_replace 3 3 "1234" "A" -> "12A34" +-- do_replace 4 4 "1234" "A" -> "123A4" +-- do_replace 5 5 "1234" "A" -> "1234A" +do_replace start end o r = + let si = fromIntegral (start-1) + ei = fromIntegral (end-1) + (x, xs) = splitAt si o + (y, z) = splitAt (ei - si) xs + in + x ++ r ++ z + cuteIndent :: PositionedComment -> String cuteIndent comment = replicate (fromIntegral $ colNo comment - 1) ' ' ++ diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index f20874f..69d452d 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -34,9 +34,9 @@ module ShellCheck.Interface , Severity(ErrorC, WarningC, InfoC, StyleC) , Position(posFile, posLine, posColumn) , Comment(cSeverity, cCode, cMessage) - , PositionedComment(pcStartPos , pcEndPos , pcComment) + , PositionedComment(pcStartPos , pcEndPos , pcComment, pcFix) , ColorOption(ColorAuto, ColorAlways, ColorNever) - , TokenComment(tcId, tcComment) + , TokenComment(tcId, tcComment, tcFix) , emptyCheckResult , newParseResult , newAnalysisSpec @@ -49,10 +49,16 @@ module ShellCheck.Interface , emptyCheckSpec , newPositionedComment , newComment + , Fix + , Replacement(Start, End) + , surroundWith + , replaceStart + , replaceEnd ) where import ShellCheck.AST import Control.Monad.Identity +import Data.Monoid import qualified Data.Map as Map @@ -190,27 +196,50 @@ newComment = Comment { cMessage = "" } +-- only support single line for now +data Replacement = + Start Integer String + | End Integer String + deriving (Show, Eq) + +type Fix = [Replacement] + +surroundWith s = + (replaceStart 0 s) ++ (replaceEnd 0 s) + +-- replace first n chars +replaceStart n r = + [ Start n r ] + +-- replace last n chars +replaceEnd n r = + [ End n r ] + data PositionedComment = PositionedComment { pcStartPos :: Position, pcEndPos :: Position, - pcComment :: Comment + pcComment :: Comment, + pcFix :: Maybe Fix } deriving (Show, Eq) newPositionedComment :: PositionedComment newPositionedComment = PositionedComment { pcStartPos = newPosition, pcEndPos = newPosition, - pcComment = newComment + pcComment = newComment, + pcFix = Nothing } data TokenComment = TokenComment { tcId :: Id, - tcComment :: Comment + tcComment :: Comment, + tcFix :: Maybe Fix } deriving (Show, Eq) newTokenComment = TokenComment { tcId = Id 0, - tcComment = newComment + tcComment = newComment, + tcFix = Nothing } data ColorOption =