{-
    Copyright 2012-2020 Vidar Holen

    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 #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
module ShellCheck.Checks.ShellSupport (checker , ShellCheck.Checks.ShellSupport.runTests) where

import ShellCheck.AST
import ShellCheck.ASTLib
import ShellCheck.AnalyzerLib
import ShellCheck.Interface
import ShellCheck.Prelude
import ShellCheck.Regex

import Control.Monad
import Control.Monad.RWS
import Data.Char
import Data.Functor.Identity
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set
import Test.QuickCheck.All (forAllProperties)
import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)

data ForShell = ForShell [Shell] (Token -> Analysis)

getChecker :: Parameters -> [ForShell] -> Checker
getChecker Parameters
params [ForShell]
list = Checker {
        perScript :: Root -> Analysis
perScript = Root -> Analysis
forall {b}. b -> Analysis
nullCheck,
        perToken :: Token -> Analysis
perToken = ((Token -> Analysis) -> (Token -> Analysis) -> Token -> Analysis)
-> (Token -> Analysis) -> [Token -> Analysis] -> Token -> Analysis
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Token -> Analysis) -> (Token -> Analysis) -> Token -> Analysis
forall a. (a -> Analysis) -> (a -> Analysis) -> a -> Analysis
composeAnalyzers Token -> Analysis
forall {b}. b -> Analysis
nullCheck ([Token -> Analysis] -> Token -> Analysis)
-> [Token -> Analysis] -> Token -> Analysis
forall a b. (a -> b) -> a -> b
$ (ForShell -> Maybe (Token -> Analysis))
-> [ForShell] -> [Token -> Analysis]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ForShell -> Maybe (Token -> Analysis)
forall {m :: * -> *}.
(Monad m, Alternative m) =>
ForShell -> m (Token -> Analysis)
include [ForShell]
list
    }
  where
    shell :: Shell
shell = Parameters -> Shell
shellType Parameters
params
    include :: ForShell -> m (Token -> Analysis)
include (ForShell [Shell]
list Token -> Analysis
a) = do
        Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Shell
shell Shell -> [Shell] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Shell]
list
        (Token -> Analysis) -> m (Token -> Analysis)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Token -> Analysis
a

checker :: Parameters -> Checker
checker Parameters
params = Parameters -> [ForShell] -> Checker
getChecker Parameters
params [ForShell]
checks

checks :: [ForShell]
checks = [
    ForShell
checkForDecimals
    ,ForShell
checkBashisms
    ,ForShell
checkEchoSed
    ,ForShell
checkBraceExpansionVars
    ,ForShell
checkMultiDimensionalArrays
    ,ForShell
checkPS1Assignments
    ,ForShell
checkMultipleBangs
    ,ForShell
checkBangAfterPipe
    ]

testChecker :: ForShell -> Checker
testChecker (ForShell [Shell]
_ Token -> Analysis
t) =
    Checker {
        perScript :: Root -> Analysis
perScript = Root -> Analysis
forall {b}. b -> Analysis
nullCheck,
        perToken :: Token -> Analysis
perToken = Token -> Analysis
t
    }
verify :: ForShell -> String -> Bool
verify ForShell
c String
s = Checker -> String -> Maybe Bool
producesComments (ForShell -> Checker
testChecker ForShell
c) String
s Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
verifyNot :: ForShell -> String -> Bool
verifyNot ForShell
c String
s = Checker -> String -> Maybe Bool
producesComments (ForShell -> Checker
testChecker ForShell
c) String
s Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False

prop_checkForDecimals1 :: Bool
prop_checkForDecimals1 = ForShell -> String -> Bool
verify ForShell
checkForDecimals String
"((3.14*c))"
prop_checkForDecimals2 :: Bool
prop_checkForDecimals2 = ForShell -> String -> Bool
verify ForShell
checkForDecimals String
"foo[1.2]=bar"
prop_checkForDecimals3 :: Bool
prop_checkForDecimals3 = ForShell -> String -> Bool
verifyNot ForShell
checkForDecimals String
"declare -A foo; foo[1.2]=bar"
checkForDecimals :: ForShell
checkForDecimals = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Sh, Shell
Dash, Shell
BusyboxSh, Shell
Bash] Token -> Analysis
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
f
  where
    f :: Token -> m ()
f t :: Token
t@(TA_Expansion Id
id [Token]
_) = Maybe (m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (m ()) -> m ()) -> Maybe (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Char
first:String
rest <- Token -> Maybe String
getLiteralString Token
t
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isDigit Char
first Bool -> Bool -> Bool
&& Char
'.' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
rest
        m () -> Maybe (m ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m () -> Maybe (m ())) -> m () -> Maybe (m ())
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
err Id
id Code
2079 String
"(( )) doesn't support decimals. Use bc or awk."
    f Token
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


prop_checkBashisms :: Bool
prop_checkBashisms = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"while read a; do :; done < <(a)"
prop_checkBashisms2 :: Bool
prop_checkBashisms2 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"[ foo -nt bar ]"
prop_checkBashisms3 :: Bool
prop_checkBashisms3 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo $((i++))"
prop_checkBashisms4 :: Bool
prop_checkBashisms4 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"rm !(*.hs)"
prop_checkBashisms5 :: Bool
prop_checkBashisms5 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"source file"
prop_checkBashisms6 :: Bool
prop_checkBashisms6 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"[ \"$a\" == 42 ]"
prop_checkBashisms6b :: Bool
prop_checkBashisms6b = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"test \"$a\" == 42"
prop_checkBashisms6c :: Bool
prop_checkBashisms6c = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"[ foo =~ bar ]"
prop_checkBashisms6d :: Bool
prop_checkBashisms6d = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"test foo =~ bar"
prop_checkBashisms7 :: Bool
prop_checkBashisms7 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo ${var[1]}"
prop_checkBashisms8 :: Bool
prop_checkBashisms8 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo ${!var[@]}"
prop_checkBashisms9 :: Bool
prop_checkBashisms9 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo ${!var*}"
prop_checkBashisms10 :: Bool
prop_checkBashisms10 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo ${var:4:12}"
prop_checkBashisms11 :: Bool
prop_checkBashisms11 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"echo ${var:-4}"
prop_checkBashisms12 :: Bool
prop_checkBashisms12 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo ${var//foo/bar}"
prop_checkBashisms13 :: Bool
prop_checkBashisms13 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"exec -c env"
prop_checkBashisms14 :: Bool
prop_checkBashisms14 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo -n \"Foo: \""
prop_checkBashisms15 :: Bool
prop_checkBashisms15 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"let n++"
prop_checkBashisms16 :: Bool
prop_checkBashisms16 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo $RANDOM"
prop_checkBashisms17 :: Bool
prop_checkBashisms17 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo $((RANDOM%6+1))"
prop_checkBashisms18 :: Bool
prop_checkBashisms18 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"foo &> /dev/null"
prop_checkBashisms19 :: Bool
prop_checkBashisms19 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"foo > file*.txt"
prop_checkBashisms20 :: Bool
prop_checkBashisms20 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"read -ra foo"
prop_checkBashisms21 :: Bool
prop_checkBashisms21 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"[ -a foo ]"
prop_checkBashisms21b :: Bool
prop_checkBashisms21b = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"test -a foo"
prop_checkBashisms22 :: Bool
prop_checkBashisms22 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"[ foo -a bar ]"
prop_checkBashisms23 :: Bool
prop_checkBashisms23 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"trap mything ERR INT"
prop_checkBashisms24 :: Bool
prop_checkBashisms24 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"trap mything INT TERM"
prop_checkBashisms25 :: Bool
prop_checkBashisms25 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"cat < /dev/tcp/host/123"
prop_checkBashisms26 :: Bool
prop_checkBashisms26 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"trap mything ERR SIGTERM"
prop_checkBashisms27 :: Bool
prop_checkBashisms27 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo *[^0-9]*"
prop_checkBashisms28 :: Bool
prop_checkBashisms28 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"exec {n}>&2"
prop_checkBashisms29 :: Bool
prop_checkBashisms29 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo ${!var}"
prop_checkBashisms30 :: Bool
prop_checkBashisms30 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"printf -v '%s' \"$1\""
prop_checkBashisms31 :: Bool
prop_checkBashisms31 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"printf '%q' \"$1\""
prop_checkBashisms32 :: Bool
prop_checkBashisms32 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\n[ foo -nt bar ]"
prop_checkBashisms33 :: Bool
prop_checkBashisms33 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho -n foo"
prop_checkBashisms34 :: Bool
prop_checkBashisms34 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\necho -n foo"
prop_checkBashisms35 :: Bool
prop_checkBashisms35 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\nlocal foo"
prop_checkBashisms36 :: Bool
prop_checkBashisms36 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\nread -p foo -r bar"
prop_checkBashisms37 :: Bool
prop_checkBashisms37 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"HOSTNAME=foo; echo $HOSTNAME"
prop_checkBashisms38 :: Bool
prop_checkBashisms38 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"RANDOM=9; echo $RANDOM"
prop_checkBashisms39 :: Bool
prop_checkBashisms39 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"foo-bar() { true; }"
prop_checkBashisms40 :: Bool
prop_checkBashisms40 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo $(<file)"
prop_checkBashisms41 :: Bool
prop_checkBashisms41 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"echo `<file`"
prop_checkBashisms42 :: Bool
prop_checkBashisms42 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"trap foo int"
prop_checkBashisms43 :: Bool
prop_checkBashisms43 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"trap foo sigint"
prop_checkBashisms44 :: Bool
prop_checkBashisms44 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\ntrap foo int"
prop_checkBashisms45 :: Bool
prop_checkBashisms45 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\ntrap foo INT"
prop_checkBashisms46 :: Bool
prop_checkBashisms46 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/dash\ntrap foo SIGINT"
prop_checkBashisms47 :: Bool
prop_checkBashisms47 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/dash\necho foo 42>/dev/null"
prop_checkBashisms48 :: Bool
prop_checkBashisms48 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\necho $LINENO"
prop_checkBashisms49 :: Bool
prop_checkBashisms49 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/dash\necho $MACHTYPE"
prop_checkBashisms50 :: Bool
prop_checkBashisms50 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\ncmd >& file"
prop_checkBashisms51 :: Bool
prop_checkBashisms51 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\ncmd 2>&1"
prop_checkBashisms52 :: Bool
prop_checkBashisms52 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\ncmd >&2"
prop_checkBashisms52b :: Bool
prop_checkBashisms52b = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\ncmd >& $var"
prop_checkBashisms52c :: Bool
prop_checkBashisms52c = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\ncmd >& $dir/$var"
prop_checkBashisms53 :: Bool
prop_checkBashisms53 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nprintf -- -f\n"
prop_checkBashisms54 :: Bool
prop_checkBashisms54 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nfoo+=bar"
prop_checkBashisms55 :: Bool
prop_checkBashisms55 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho ${@%foo}"
prop_checkBashisms56 :: Bool
prop_checkBashisms56 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\necho ${##}"
prop_checkBashisms57 :: Bool
prop_checkBashisms57 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\nulimit -c 0"
prop_checkBashisms58 :: Bool
prop_checkBashisms58 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nulimit -c 0"
prop_checkBashisms59 :: Bool
prop_checkBashisms59 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\njobs -s"
prop_checkBashisms60 :: Bool
prop_checkBashisms60 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\njobs -p"
prop_checkBashisms61 :: Bool
prop_checkBashisms61 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\njobs -lp"
prop_checkBashisms62 :: Bool
prop_checkBashisms62 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nexport -f foo"
prop_checkBashisms63 :: Bool
prop_checkBashisms63 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nexport -p"
prop_checkBashisms64 :: Bool
prop_checkBashisms64 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nreadonly -a"
prop_checkBashisms65 :: Bool
prop_checkBashisms65 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nreadonly -p"
prop_checkBashisms66 :: Bool
prop_checkBashisms66 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\ncd -P ."
prop_checkBashisms67 :: Bool
prop_checkBashisms67 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\ncd -P -e ."
prop_checkBashisms68 :: Bool
prop_checkBashisms68 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\numask -p"
prop_checkBashisms69 :: Bool
prop_checkBashisms69 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\numask -S"
prop_checkBashisms70 :: Bool
prop_checkBashisms70 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\ntrap -l"
prop_checkBashisms71 :: Bool
prop_checkBashisms71 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\ntype -a ls"
prop_checkBashisms72 :: Bool
prop_checkBashisms72 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\ntype ls"
prop_checkBashisms73 :: Bool
prop_checkBashisms73 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nunset -n namevar"
prop_checkBashisms74 :: Bool
prop_checkBashisms74 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nunset -f namevar"
prop_checkBashisms75 :: Bool
prop_checkBashisms75 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\necho \"-n foo\""
prop_checkBashisms76 :: Bool
prop_checkBashisms76 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\necho \"-ne foo\""
prop_checkBashisms77 :: Bool
prop_checkBashisms77 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\necho -Q foo"
prop_checkBashisms78 :: Bool
prop_checkBashisms78 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho -ne foo"
prop_checkBashisms79 :: Bool
prop_checkBashisms79 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nhash -l"
prop_checkBashisms80 :: Bool
prop_checkBashisms80 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nhash -r"
prop_checkBashisms81 :: Bool
prop_checkBashisms81 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\nhash -v"
prop_checkBashisms82 :: Bool
prop_checkBashisms82 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nset -v +o allexport -o errexit -C"
prop_checkBashisms83 :: Bool
prop_checkBashisms83 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nset --"
prop_checkBashisms84 :: Bool
prop_checkBashisms84 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nset -o pipefail"
prop_checkBashisms85 :: Bool
prop_checkBashisms85 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nset -B"
prop_checkBashisms86 :: Bool
prop_checkBashisms86 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\nset -o emacs"
prop_checkBashisms87 :: Bool
prop_checkBashisms87 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nset -o emacs"
prop_checkBashisms88 :: Bool
prop_checkBashisms88 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nset -- wget -o foo 'https://some.url'"
prop_checkBashisms89 :: Bool
prop_checkBashisms89 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nopts=$-\nset -\"$opts\""
prop_checkBashisms90 :: Bool
prop_checkBashisms90 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\nset -o \"$opt\""
prop_checkBashisms91 :: Bool
prop_checkBashisms91 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\nwait -n"
prop_checkBashisms92 :: Bool
prop_checkBashisms92 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho $((16#FF))"
prop_checkBashisms93 :: Bool
prop_checkBashisms93 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho $(( 10#$(date +%m) ))"
prop_checkBashisms94 :: Bool
prop_checkBashisms94 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\n[ -v var ]"
prop_checkBashisms95 :: Bool
prop_checkBashisms95 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho $_"
prop_checkBashisms96 :: Bool
prop_checkBashisms96 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/dash\necho $_"
prop_checkBashisms97 :: Bool
prop_checkBashisms97 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho ${var,}"
prop_checkBashisms98 :: Bool
prop_checkBashisms98 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\necho ${var^^}"
prop_checkBashisms99 :: Bool
prop_checkBashisms99 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/dash\necho [^f]oo"
prop_checkBashisms100 :: Bool
prop_checkBashisms100 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"read -r"
prop_checkBashisms101 :: Bool
prop_checkBashisms101 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"read"
prop_checkBashisms102 :: Bool
prop_checkBashisms102 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"read -r foo"
prop_checkBashisms103 :: Bool
prop_checkBashisms103 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"read foo"
prop_checkBashisms104 :: Bool
prop_checkBashisms104 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"read ''"
prop_checkBashisms105 :: Bool
prop_checkBashisms105 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\nset -o pipefail"
prop_checkBashisms106 :: Bool
prop_checkBashisms106 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\nx=x\n[[ \"$x\" = \"$x\" ]]"
prop_checkBashisms107 :: Bool
prop_checkBashisms107 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\nx=x\n[ \"$x\" == \"$x\" ]"
prop_checkBashisms108 :: Bool
prop_checkBashisms108 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\necho magic &> /dev/null"
prop_checkBashisms109 :: Bool
prop_checkBashisms109 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\ntrap stop EXIT SIGTERM"
prop_checkBashisms110 :: Bool
prop_checkBashisms110 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\nsource /dev/null"
prop_checkBashisms111 :: Bool
prop_checkBashisms111 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/dash\nx='test'\n${x:0:3}" -- SC3057
prop_checkBashisms112 :: Bool
prop_checkBashisms112 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\nx='test'\n${x:0:3}" -- SC3057
prop_checkBashisms113 :: Bool
prop_checkBashisms113 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/dash\nx='test'\n${x/st/xt}" -- SC3060
prop_checkBashisms114 :: Bool
prop_checkBashisms114 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/busybox sh\nx='test'\n${x/st/xt}" -- SC3060
prop_checkBashisms115 :: Bool
prop_checkBashisms115 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/busybox sh\nx='test'\n${!x}" -- SC3053
prop_checkBashisms116 :: Bool
prop_checkBashisms116 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/busybox sh\nx='test'\n${x[1]}" -- SC3054
prop_checkBashisms117 :: Bool
prop_checkBashisms117 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/busybox sh\nx='test'\n${!x[@]}" -- SC3055
prop_checkBashisms118 :: Bool
prop_checkBashisms118 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/busybox sh\nxyz=1\n${!x*}" -- SC3056
prop_checkBashisms119 :: Bool
prop_checkBashisms119 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/busybox sh\nx='test'\n${x^^[t]}" -- SC3059
prop_checkBashisms120 :: Bool
prop_checkBashisms120 = ForShell -> String -> Bool
verify ForShell
checkBashisms String
"#!/bin/sh\n[ x == y ]"
prop_checkBashisms121 :: Bool
prop_checkBashisms121 = ForShell -> String -> Bool
verifyNot ForShell
checkBashisms String
"#!/bin/sh\n# shellcheck shell=busybox\n[ x == y ]"
checkBashisms :: ForShell
checkBashisms = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Sh, Shell
Dash, Shell
BusyboxSh] ((Token -> Analysis) -> ForShell)
-> (Token -> Analysis) -> ForShell
forall a b. (a -> b) -> a -> b
$ \Token
t -> do
    Parameters
params <- RWST Parameters [TokenComment] Cache Identity Parameters
forall r (m :: * -> *). MonadReader r m => m r
ask
    Parameters -> Token -> Analysis
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Parameters -> Token -> m ()
kludge Parameters
params Token
t
 where
  -- This code was copy-pasted from Analytics where params was a variable
  kludge :: Parameters -> Token -> m ()
kludge Parameters
params = Token -> m ()
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
bashism
   where
    isBusyboxSh :: Bool
isBusyboxSh = Parameters -> Shell
shellType Parameters
params Shell -> Shell -> Bool
forall a. Eq a => a -> a -> Bool
== Shell
BusyboxSh
    isDash :: Bool
isDash = Parameters -> Shell
shellType Parameters
params Shell -> Shell -> Bool
forall a. Eq a => a -> a -> Bool
== Shell
Dash Bool -> Bool -> Bool
|| Bool
isBusyboxSh
    warnMsg :: Id -> Code -> String -> m ()
warnMsg Id
id Code
code String
s =
        if Bool
isDash
        then Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
err  Id
id Code
code (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"In dash, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not supported."
        else Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warn Id
id Code
code (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"In POSIX sh, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" undefined."
    asStr :: Token -> Maybe String
asStr = Token -> Maybe String
getLiteralString

    bashism :: Token -> m ()
bashism (T_ProcSub Id
id String
_ [Token]
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3001 String
"process substitution is"
    bashism (T_Extglob Id
id String
_ [Token]
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3002 String
"extglob is"
    bashism (T_DollarSingleQuoted Id
id String
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3003 String
"$'..' is"
    bashism (T_DollarDoubleQuoted Id
id [Token]
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3004 String
"$\"..\" is"
    bashism (T_ForArithmetic Id
id Token
_ Token
_ Token
_ [Token]
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3005 String
"arithmetic for loops are"
    bashism (T_Arithmetic Id
id Token
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3006 String
"standalone ((..)) is"
    bashism (T_DollarBracket Id
id Token
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3007 String
"$[..] in place of $((..)) is"
    bashism (T_SelectIn Id
id String
_ [Token]
_ [Token]
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3008 String
"select loops are"
    bashism (T_BraceExpansion Id
id [Token]
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3009 String
"brace expansion is"
    bashism (T_Condition Id
id ConditionType
DoubleBracket Token
_) =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBusyboxSh (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3010 String
"[[ ]] is"
    bashism (T_HereString Id
id Token
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3011 String
"here-strings are"
    bashism (TC_Binary Id
id ConditionType
SingleBracket String
op Token
_ Token
_)
        | String
op String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"<", String
">", String
"\\<", String
"\\>", String
"<=", String
">=", String
"\\<=", String
"\\>="] =
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isDash (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3012 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"lexicographical " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
    bashism (T_SimpleCommand Id
id [Token]
_ [Token -> Maybe String
asStr -> Just String
"test", Token
lhs, Token -> Maybe String
asStr -> Just String
op, Token
rhs])
        | String
op String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"<", String
">", String
"\\<", String
"\\>", String
"<=", String
">=", String
"\\<=", String
"\\>="] =
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isDash (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3012 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"lexicographical " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
    bashism (TC_Binary Id
id ConditionType
SingleBracket String
op Token
_ Token
_)
        | String
op String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"-ot", String
"-nt", String
"-ef" ] =
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isDash (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3013 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
    bashism (T_SimpleCommand Id
id [Token]
_ [Token -> Maybe String
asStr -> Just String
"test", Token
lhs, Token -> Maybe String
asStr -> Just String
op, Token
rhs])
        | String
op String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"-ot", String
"-nt", String
"-ef" ] =
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isDash (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3013 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
    bashism (TC_Binary Id
id ConditionType
SingleBracket String
"==" Token
_ Token
_) =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBusyboxSh (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3014 String
"== in place of = is"
    bashism (T_SimpleCommand Id
id [Token]
_ [Token -> Maybe String
asStr -> Just String
"test", Token
lhs, Token -> Maybe String
asStr -> Just String
"==", Token
rhs]) =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBusyboxSh (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3014 String
"== in place of = is"
    bashism (TC_Binary Id
id ConditionType
SingleBracket String
"=~" Token
_ Token
_) =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3015 String
"=~ regex matching is"
    bashism (T_SimpleCommand Id
id [Token]
_ [Token -> Maybe String
asStr -> Just String
"test", Token
lhs, Token -> Maybe String
asStr -> Just String
"=~", Token
rhs]) =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3015 String
"=~ regex matching is"
    bashism (TC_Unary Id
id ConditionType
SingleBracket String
"-v" Token
_) =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3016 String
"unary -v (in place of [ -n \"${var+x}\" ]) is"
    bashism (T_SimpleCommand Id
id [Token]
_ [Token -> Maybe String
asStr -> Just String
"test", Token -> Maybe String
asStr -> Just String
"-v", Token
_]) =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3016 String
"unary -v (in place of [ -n \"${var+x}\" ]) is"
    bashism (TC_Unary Id
id ConditionType
_ String
"-a" Token
_) =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3017 String
"unary -a in place of -e is"
    bashism (T_SimpleCommand Id
id [Token]
_ [Token -> Maybe String
asStr -> Just String
"test", Token -> Maybe String
asStr -> Just String
"-a", Token
_]) =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3017 String
"unary -a in place of -e is"
    bashism (TA_Unary Id
id String
op Token
_)
        | String
op String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"|++", String
"|--", String
"++|", String
"--|"] =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3018 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|') String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
    bashism (TA_Binary Id
id String
"**" Token
_ Token
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3019 String
"exponentials are"
    bashism (T_FdRedirect Id
id String
"&" (T_IoFile Id
_ (T_Greater Id
_) Token
_)) =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBusyboxSh (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3020 String
"&> is"
    bashism (T_FdRedirect Id
id String
"" (T_IoFile Id
_ (T_GREATAND Id
_) Token
file)) =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Token -> String
onlyLiteralString Token
file) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3021 String
">& filename (as opposed to >& fd) is"
    bashism (T_FdRedirect Id
id (Char
'{':String
_) Token
_) = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3022 String
"named file descriptors are"
    bashism (T_FdRedirect Id
id String
num Token
_)
        | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
num Bool -> Bool -> Bool
&& String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3023 String
"FDs outside 0-9 are"
    bashism (T_Assignment Id
id AssignmentMode
Append String
_ [Token]
_ Token
_) =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3024 String
"+= is"
    bashism (T_IoFile Id
id Token
_ Token
word) | Bool
isNetworked =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3025 String
"/dev/{tcp,udp} is"
        where
            file :: String
file = Token -> String
onlyLiteralString Token
word
            isNetworked :: Bool
isNetworked = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
file) [String
"/dev/tcp", String
"/dev/udp"]
    bashism (T_Glob Id
id String
str) | String
"[^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
str =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3026 String
"^ in place of ! in glob bracket expressions is"

    bashism t :: Token
t@(TA_Variable Id
id String
str [Token]
_) | String -> Bool
isBashVariable String
str =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3028 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"

    bashism t :: Token
t@(T_DollarBraced Id
id Bool
_ Token
token) = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBusyboxSh (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ((Regex, Code, String) -> m ()) -> [(Regex, Code, String)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Regex, Code, String) -> m ()
forall {f :: * -> *}.
MonadWriter [TokenComment] f =>
(Regex, Code, String) -> f ()
check [(Regex, Code, String)]
simpleExpansions
        ((Regex, Code, String) -> m ()) -> [(Regex, Code, String)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Regex, Code, String) -> m ()
forall {f :: * -> *}.
MonadWriter [TokenComment] f =>
(Regex, Code, String) -> f ()
check [(Regex, Code, String)]
advancedExpansions
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
isBashVariable String
var) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3028 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
      where
        str :: String
str = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Token -> [String]
oversimplify Token
token
        var :: String
var = String -> String
getBracedReference String
str
        check :: (Regex, Code, String) -> f ()
check (Regex
regex, Code
code, String
feature) =
            Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex Regex
regex String
str) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> f ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
code String
feature

    bashism t :: Token
t@(T_Pipe Id
id String
"|&") =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3029 String
"|& in place of 2>&1 | is"
    bashism (T_Array Id
id [Token]
_) =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3030 String
"arrays are"
    bashism (T_IoFile Id
id Token
_ Token
t) | Token -> Bool
isGlob Token
t =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3031 String
"redirecting to/from globs is"
    bashism (T_CoProc Id
id Maybe String
_ Token
_) =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3032 String
"coproc is"

    bashism (T_Function Id
id FunctionKeyword
_ FunctionParentheses
_ String
str Token
_) | Bool -> Bool
not (String -> Bool
isVariableName String
str) =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3033 String
"naming functions outside [a-zA-Z_][a-zA-Z0-9_]* is"

    bashism (T_DollarExpansion Id
id [Token
x]) | Token -> Bool
isOnlyRedirection Token
x =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3034 String
"$(<file) to read files is"
    bashism (T_Backticked Id
id [Token
x]) | Token -> Bool
isOnlyRedirection Token
x =
        Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3035 String
"`<file` to read files is"

    bashism t :: Token
t@(T_SimpleCommand Id
_ [Token]
_ (Token
cmd:Token
arg:[Token]
_))
        | Token
t Token -> String -> Bool
`isCommand` String
"echo" Bool -> Bool -> Bool
&& String
argString String -> Regex -> Bool
`matches` Regex
flagRegex =
            if Bool
isDash
            then
                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
argString String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-n") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                    Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
arg) Code
3036 String
"echo flags besides -n"
            else
                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
arg) Code
3037 String
"echo flags are"
      where
          argString :: String
argString = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Token -> [String]
oversimplify Token
arg
          flagRegex :: Regex
flagRegex = String -> Regex
mkRegex String
"^-[eEsn]+$"

    bashism t :: Token
t@(T_SimpleCommand Id
_ [Token]
_ (Token
cmd:Token
arg:[Token]
_))
        | Token -> Maybe String
getLiteralString Token
cmd Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"exec" Bool -> Bool -> Bool
&& String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Token -> [String]
oversimplify Token
arg) =
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
arg) Code
3038 String
"exec flags are"
    bashism t :: Token
t@(T_SimpleCommand Id
id [Token]
_ [Token]
_)
        | Token
t Token -> String -> Bool
`isCommand` String
"let" = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3039 String
"'let' is"
    bashism t :: Token
t@(T_SimpleCommand Id
_ [Token]
_ (Token
cmd:[Token]
args))
        | Token
t Token -> String -> Bool
`isCommand` String
"set" = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isDash (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            [(Id, String)] -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
[(Id, String)] -> m ()
checkOptions ([(Id, String)] -> m ()) -> [(Id, String)] -> m ()
forall a b. (a -> b) -> a -> b
$ [Token] -> [(Id, String)]
getLiteralArgs [Token]
args
      where
        -- Get the literal options from a list of arguments,
        -- up until the first non-literal one
        getLiteralArgs :: [Token] -> [(Id, String)]
        getLiteralArgs :: [Token] -> [(Id, String)]
getLiteralArgs = (Token -> [(Id, String)] -> [(Id, String)])
-> [(Id, String)] -> [Token] -> [(Id, String)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Token -> [(Id, String)] -> [(Id, String)]
go []
          where
            go :: Token -> [(Id, String)] -> [(Id, String)]
go Token
first [(Id, String)]
rest = case Token -> Maybe String
getLiteralString Token
first of
                Just String
str -> (Token -> Id
getId Token
first, String
str) (Id, String) -> [(Id, String)] -> [(Id, String)]
forall a. a -> [a] -> [a]
: [(Id, String)]
rest
                Maybe String
Nothing -> []

        -- Check a flag-option pair (such as -o errexit)
        checkOptions :: [(Id, String)] -> m ()
checkOptions (flag :: (Id, String)
flag@(Id
fid,String
flag') : opt :: (Id, String)
opt@(Id
oid,String
opt') : [(Id, String)]
rest)
            | String
flag' String -> Regex -> Bool
`matches` Regex
oFlagRegex = do
                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
opt' String -> Set String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set String
longOptions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                  Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
oid Code
3040 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"set option " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
opt' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is"
                [(Id, String)] -> m ()
checkFlags ((Id, String)
flag(Id, String) -> [(Id, String)] -> [(Id, String)]
forall a. a -> [a] -> [a]
:[(Id, String)]
rest)
            | Bool
otherwise = [(Id, String)] -> m ()
checkFlags ((Id, String)
flag(Id, String) -> [(Id, String)] -> [(Id, String)]
forall a. a -> [a] -> [a]
:(Id, String)
opt(Id, String) -> [(Id, String)] -> [(Id, String)]
forall a. a -> [a] -> [a]
:[(Id, String)]
rest)
        checkOptions ((Id, String)
flag:[(Id, String)]
rest) = [(Id, String)] -> m ()
checkFlags ((Id, String)
flag(Id, String) -> [(Id, String)] -> [(Id, String)]
forall a. a -> [a] -> [a]
:[(Id, String)]
rest)
        checkOptions [(Id, String)]
_           = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        -- Check that each option in a sequence of flags
        -- (such as -aveo) is valid
        checkFlags :: [(Id, String)] -> m ()
checkFlags (flag :: (Id, String)
flag@(Id
fid, String
flag'):[(Id, String)]
rest)
            | String -> Bool
startsOption String
flag' = do
                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
flag' String -> Regex -> Bool
`matches` Regex
validFlagsRegex) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                  String -> (Char -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
flag') ((Char -> m ()) -> m ()) -> (Char -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Char
letter ->
                    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
letter Char -> Set Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Char
optionsSet) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                      Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
fid Code
3041 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"set flag " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
letterChar -> String -> String
forall a. a -> [a] -> [a]
:String
" is")
                [(Id, String)] -> m ()
checkOptions [(Id, String)]
rest
            | String -> Bool
beginsWithDoubleDash String
flag' = do
                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
fid Code
3042 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"set flag " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
flag' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is"
                [(Id, String)] -> m ()
checkOptions [(Id, String)]
rest
            -- Either a word that doesn't start with a dash, or simply '--',
            -- so stop checking.
            | Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        checkFlags [] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        options :: String
options              = String
"abCefhmnuvxo"
        optionsSet :: Set Char
optionsSet           = String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList String
options
        startsOption :: String -> Bool
startsOption         = (String -> Regex -> Bool
`matches` String -> Regex
mkRegex String
"^(\\+|-[^-])")
        oFlagRegex :: Regex
oFlagRegex           = String -> Regex
mkRegex (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^[-+][" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
options String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]*o$"
        validFlagsRegex :: Regex
validFlagsRegex      = String -> Regex
mkRegex (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^[-+]([" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
options String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]+o?|o)$"
        beginsWithDoubleDash :: String -> Bool
beginsWithDoubleDash = (String -> Regex -> Bool
`matches` String -> Regex
mkRegex String
"^--.+$")
        longOptions :: Set String
longOptions          = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList
            [ String
"allexport", String
"errexit", String
"ignoreeof", String
"monitor", String
"noclobber"
            , String
"noexec", String
"noglob", String
"nolog", String
"notify" , String
"nounset", String
"verbose"
            , String
"vi", String
"xtrace" ]

    bashism t :: Token
t@(T_SimpleCommand Id
id [Token]
_ (Token
cmd:[Token]
rest)) =
        let name :: String
name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getCommandName Token
t
            flags :: [(Token, String)]
flags = Token -> [(Token, String)]
getLeadingFlags Token
t
        in do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"local" Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDash) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                -- This is so commonly accepted that we'll make it a special case
                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3043 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"'local' is"
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
unsupportedCommands) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3044 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is"
            Maybe (m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (m ()) -> m ()) -> Maybe (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
                Maybe [String]
allowed' <- String -> Map String (Maybe [String]) -> Maybe (Maybe [String])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String (Maybe [String])
allowedFlags
                [String]
allowed <- Maybe [String]
allowed'
                (Token
word, String
flag) <- ((Token, String) -> Bool)
-> [(Token, String)] -> Maybe (Token, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
                    (\(Token, String)
x -> (Bool -> Bool
not (Bool -> Bool)
-> ((Token, String) -> Bool) -> (Token, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> ((Token, String) -> String) -> (Token, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token, String) -> String
forall a b. (a, b) -> b
snd ((Token, String) -> Bool) -> (Token, String) -> Bool
forall a b. (a -> b) -> a -> b
$ (Token, String)
x) Bool -> Bool -> Bool
&& (Token, String) -> String
forall a b. (a, b) -> b
snd (Token, String)
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
allowed) [(Token, String)]
flags
                m () -> Maybe (m ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m () -> Maybe (m ()))
-> (String -> m ()) -> String -> Maybe (m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
word) Code
3045 (String -> Maybe (m ())) -> String -> Maybe (m ())
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"

            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"source" Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isBusyboxSh) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3046 String
"'source' in place of '.' is"
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"trap") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                let
                    check :: Token -> m ()
check Token
token = Maybe (m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (m ()) -> m ()) -> Maybe (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
                        String
str <- Token -> Maybe String
getLiteralString Token
token
                        let upper :: String
upper = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
str
                        m () -> Maybe (m ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m () -> Maybe (m ())) -> m () -> Maybe (m ())
forall a b. (a -> b) -> a -> b
$ do
                            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
upper String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"ERR", String
"DEBUG", String
"RETURN"]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
token) Code
3047 (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"trapping " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
                            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isBusyboxSh Bool -> Bool -> Bool
&& String
"SIG" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
upper) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
token) Code
3048
                                    String
"prefixing signal names with 'SIG' is"
                            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isDash Bool -> Bool -> Bool
&& String
upper String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
str) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
token) Code
3049
                                    String
"using lower/mixed case for signal names is"
                in
                    (Token -> m ()) -> [Token] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Token -> m ()
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
check (Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
drop Int
1 [Token]
rest)

            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"printf") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (m ()) -> m ()) -> Maybe (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
                Token
format <- [Token]
rest [Token] -> Int -> Maybe Token
forall {a}. [a] -> Int -> Maybe a
!!! Int
0  -- flags are covered by allowedFlags
                let literal :: String
literal = Token -> String
onlyLiteralString Token
format
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String
"%q" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
literal
                m () -> Maybe (m ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m () -> Maybe (m ())) -> m () -> Maybe (m ())
forall a b. (a -> b) -> a -> b
$ Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
format) Code
3050 String
"printf %q is"

            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"read" Bool -> Bool -> Bool
&& (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isFlag [Token]
rest) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg (Token -> Id
getId Token
cmd) Code
3061 String
"read without a variable is"
      where
        unsupportedCommands :: [String]
unsupportedCommands = [
            String
"let", String
"caller", String
"builtin", String
"complete", String
"compgen", String
"declare", String
"dirs", String
"disown",
            String
"enable", String
"mapfile", String
"readarray", String
"pushd", String
"popd", String
"shopt", String
"suspend",
            String
"typeset"
            ]
        allowedFlags :: Map String (Maybe [String])
allowedFlags = [(String, Maybe [String])] -> Map String (Maybe [String])
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
            (String
"cd", [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"L", String
"P"]),
            (String
"exec", [String] -> Maybe [String]
forall a. a -> Maybe a
Just []),
            (String
"export", [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"p"]),
            (String
"hash", [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ if Bool
isDash then [String
"r", String
"v"] else [String
"r"]),
            (String
"jobs", [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"l", String
"p"]),
            (String
"printf", [String] -> Maybe [String]
forall a. a -> Maybe a
Just []),
            (String
"read", [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ if Bool
isDash then [String
"r", String
"p"] else [String
"r"]),
            (String
"readonly", [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"p"]),
            (String
"trap", [String] -> Maybe [String]
forall a. a -> Maybe a
Just []),
            (String
"type", [String] -> Maybe [String]
forall a. a -> Maybe a
Just []),
            (String
"ulimit", if Bool
isDash then Maybe [String]
forall a. Maybe a
Nothing else [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"f"]),
            (String
"umask", [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"S"]),
            (String
"unset", [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"f", String
"v"]),
            (String
"wait", [String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
            ]
    bashism t :: Token
t@(T_SourceCommand Id
id Token
src Token
_)
      | Token -> Maybe String
getCommandName Token
src Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"source" =
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBusyboxSh (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3051 String
"'source' in place of '.' is"
    bashism (TA_Expansion Id
_ (T_Literal Id
id String
str : [Token]
_))
        | String
str String -> Regex -> Bool
`matches` Regex
radix = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warnMsg Id
id Code
3052 String
"arithmetic base conversion is"
      where
        radix :: Regex
radix = String -> Regex
mkRegex String
"^[0-9]+#"
    bashism Token
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    varChars :: String
varChars=String
"_0-9a-zA-Z"
    advancedExpansions :: [(Regex, Code, String)]
advancedExpansions = let re :: String -> Regex
re = String -> Regex
mkRegex in [
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^![" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
varChars String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]", Code
3053, String
"indirect expansion is"),
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
varChars String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]+\\[.*\\]$", Code
3054, String
"array references are"),
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^![" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
varChars String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]+\\[[*@]]$", Code
3055, String
"array key expansion is"),
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^![" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
varChars String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]+[*@]$", Code
3056, String
"name matching prefixes are"),
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
varChars String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*@]+(\\[.*\\])?[,^]", Code
3059, String
"case modification is")
        ]
    simpleExpansions :: [(Regex, Code, String)]
simpleExpansions = let re :: String -> Regex
re = String -> Regex
mkRegex in [
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
varChars String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*@]+:[^-=?+]", Code
3057, String
"string indexing is"),
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^([*@][%#]|#[@*])", Code
3058, String
"string operations on $@/$* are"),
        (String -> Regex
re (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
varChars String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*@]+(\\[.*\\])?/", Code
3060, String
"string replacement is")
        ]
    bashVars :: [String]
bashVars = [
        -- This list deliberately excludes $BASH_VERSION as it's often used
        -- for shell identification.
        String
"OSTYPE", String
"MACHTYPE", String
"HOSTTYPE", String
"HOSTNAME",
        String
"DIRSTACK", String
"EUID", String
"UID", String
"SHLVL", String
"PIPESTATUS", String
"SHELLOPTS",
        String
"_", String
"BASHOPTS", String
"BASHPID", String
"BASH_ALIASES", String
"BASH_ARGC",
        String
"BASH_ARGV", String
"BASH_ARGV0", String
"BASH_CMDS", String
"BASH_COMMAND",
        String
"BASH_EXECUTION_STRING", String
"BASH_LINENO", String
"BASH_REMATCH", String
"BASH_SOURCE",
        String
"BASH_SUBSHELL", String
"BASH_VERSINFO", String
"EPOCHREALTIME", String
"EPOCHSECONDS",
        String
"FUNCNAME", String
"GROUPS", String
"MACHTYPE", String
"MAPFILE"
        ]
    bashDynamicVars :: [String]
bashDynamicVars = [ String
"RANDOM", String
"SECONDS" ]
    dashVars :: [String]
dashVars = [ String
"_" ]
    isBashVariable :: String -> Bool
isBashVariable String
var =
        (String
var String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
bashDynamicVars
            Bool -> Bool -> Bool
|| String
var String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
bashVars Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
isAssigned String
var))
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
isDash Bool -> Bool -> Bool
&& String
var String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
dashVars)
    isAssigned :: String -> Bool
isAssigned String
var = (StackData -> Bool) -> [StackData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StackData -> Bool
f (Parameters -> [StackData]
variableFlow Parameters
params)
      where
        f :: StackData -> Bool
f StackData
x = case StackData
x of
                Assignment (Token
_, Token
_, String
name, DataType
_) -> String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
var
                StackData
_ -> Bool
False

prop_checkEchoSed1 :: Bool
prop_checkEchoSed1 = ForShell -> String -> Bool
verify ForShell
checkEchoSed String
"FOO=$(echo \"$cow\" | sed 's/foo/bar/g')"
prop_checkEchoSed1b :: Bool
prop_checkEchoSed1b = ForShell -> String -> Bool
verify ForShell
checkEchoSed String
"FOO=$(sed 's/foo/bar/g' <<< \"$cow\")"
prop_checkEchoSed2 :: Bool
prop_checkEchoSed2 = ForShell -> String -> Bool
verify ForShell
checkEchoSed String
"rm $(echo $cow | sed -e 's,foo,bar,')"
prop_checkEchoSed2b :: Bool
prop_checkEchoSed2b = ForShell -> String -> Bool
verify ForShell
checkEchoSed String
"rm $(sed -e 's,foo,bar,' <<< $cow)"
checkEchoSed :: ForShell
checkEchoSed = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Bash, Shell
Ksh] Token -> Analysis
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
f
  where
    f :: Token -> f ()
f (T_Redirecting Id
id [Token]
lefts Token
r) =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
redirectHereString [Token]
lefts) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
            Id -> [String] -> f ()
forall {f :: * -> *}.
MonadWriter [TokenComment] f =>
Id -> [String] -> f ()
checkSed Id
id [String]
rcmd
      where
        redirectHereString :: Token -> Bool
        redirectHereString :: Token -> Bool
redirectHereString Token
t = case Token
t of
            (T_FdRedirect Id
_ String
_ T_HereString{}) -> Bool
True
            Token
_                                 -> Bool
False
        rcmd :: [String]
rcmd = Token -> [String]
oversimplify Token
r

    f (T_Pipeline Id
id [Token]
_ [Token
a, Token
b]) =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
acmd [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"echo", String
"${VAR}"]) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
            Id -> [String] -> f ()
forall {f :: * -> *}.
MonadWriter [TokenComment] f =>
Id -> [String] -> f ()
checkSed Id
id [String]
bcmd
      where
        acmd :: [String]
acmd = Token -> [String]
oversimplify Token
a
        bcmd :: [String]
bcmd = Token -> [String]
oversimplify Token
b

    f Token
_ = () -> f ()
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    checkSed :: Id -> [String] -> f ()
checkSed Id
id [String
"sed", String
v]       = Id -> String -> f ()
forall {f :: * -> *}.
MonadWriter [TokenComment] f =>
Id -> String -> f ()
checkIn Id
id String
v
    checkSed Id
id [String
"sed", String
"-e", String
v] = Id -> String -> f ()
forall {f :: * -> *}.
MonadWriter [TokenComment] f =>
Id -> String -> f ()
checkIn Id
id String
v
    checkSed Id
_ [String]
_                 = () -> f ()
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- This should have used backreferences, but TDFA doesn't support them
    sedRe :: Regex
sedRe = String -> Regex
mkRegex String
"^s(.)([^\n]*)g?$"
    isSimpleSed :: String -> Bool
isSimpleSed String
s = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
        [Char
h:String
_,String
rest] <- Regex -> String -> Maybe [String]
matchRegex Regex
sedRe String
s
        let delimiters :: String
delimiters = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
h) String
rest
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
delimiters Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
    checkIn :: Id -> String -> f ()
checkIn Id
id String
s =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
isSimpleSed String
s) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
            Id -> Code -> String -> f ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
style Id
id Code
2001 String
"See if you can use ${variable//search/replace} instead."


prop_checkBraceExpansionVars1 :: Bool
prop_checkBraceExpansionVars1 = ForShell -> String -> Bool
verify ForShell
checkBraceExpansionVars String
"echo {1..$n}"
prop_checkBraceExpansionVars2 :: Bool
prop_checkBraceExpansionVars2 = ForShell -> String -> Bool
verifyNot ForShell
checkBraceExpansionVars String
"echo {1,3,$n}"
prop_checkBraceExpansionVars3 :: Bool
prop_checkBraceExpansionVars3 = ForShell -> String -> Bool
verify ForShell
checkBraceExpansionVars String
"eval echo DSC{0001..$n}.jpg"
prop_checkBraceExpansionVars4 :: Bool
prop_checkBraceExpansionVars4 = ForShell -> String -> Bool
verify ForShell
checkBraceExpansionVars String
"echo {$i..100}"
checkBraceExpansionVars :: ForShell
checkBraceExpansionVars = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Bash] Token -> Analysis
forall {m :: * -> *}.
(MonadReader Parameters m, MonadWriter [TokenComment] m) =>
Token -> m ()
f
  where
    f :: Token -> m ()
f t :: Token
t@(T_BraceExpansion Id
id [Token]
list) = (Token -> m ()) -> [Token] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Token -> m ()
forall {m :: * -> *}.
(MonadReader Parameters m, MonadWriter [TokenComment] m) =>
Token -> m ()
check [Token]
list
      where
        check :: Token -> f ()
check Token
element =
            Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Token -> String
toString Token
element) [String
"$..", String
"..$"]) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ do
                Bool
c <- Token -> f Bool
forall {m :: * -> *}. MonadReader Parameters m => Token -> m Bool
isEvaled Token
element
                if Bool
c
                    then Id -> Code -> String -> f ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
style Id
id Code
2175 String
"Quote this invalid brace expansion since it should be passed literally to eval."
                    else Id -> Code -> String -> f ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warn Id
id Code
2051 String
"Bash doesn't support variables in brace range expansions."
    f Token
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    literalExt :: Token -> m String
literalExt Token
t =
        case Token
t of
            T_DollarBraced {} -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"$"
            T_DollarExpansion {} -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"$"
            T_DollarArithmetic {} -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"$"
            Token
_ -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-"
    toString :: Token -> String
toString Token
t = Identity String -> String
forall a. Identity a -> a
runIdentity (Identity String -> String) -> Identity String -> String
forall a b. (a -> b) -> a -> b
$ (Token -> Identity String) -> Token -> Identity String
forall (m :: * -> *).
Monad m =>
(Token -> m String) -> Token -> m String
getLiteralStringExt Token -> Identity String
forall {m :: * -> *}. Monad m => Token -> m String
literalExt Token
t
    isEvaled :: Token -> m Bool
isEvaled Token
t = do
        Maybe Token
cmd <- Token -> m (Maybe Token)
forall {m :: * -> *}.
MonadReader Parameters m =>
Token -> m (Maybe Token)
getClosestCommandM Token
t
        Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> (Token -> Bool) -> Maybe Token -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Token -> String -> Bool
`isUnqualifiedCommand` String
"eval") Maybe Token
cmd


prop_checkMultiDimensionalArrays1 :: Bool
prop_checkMultiDimensionalArrays1 = ForShell -> String -> Bool
verify ForShell
checkMultiDimensionalArrays String
"foo[a][b]=3"
prop_checkMultiDimensionalArrays2 :: Bool
prop_checkMultiDimensionalArrays2 = ForShell -> String -> Bool
verifyNot ForShell
checkMultiDimensionalArrays String
"foo[a]=3"
prop_checkMultiDimensionalArrays3 :: Bool
prop_checkMultiDimensionalArrays3 = ForShell -> String -> Bool
verify ForShell
checkMultiDimensionalArrays String
"foo=( [a][b]=c )"
prop_checkMultiDimensionalArrays4 :: Bool
prop_checkMultiDimensionalArrays4 = ForShell -> String -> Bool
verifyNot ForShell
checkMultiDimensionalArrays String
"foo=( [a]=c )"
prop_checkMultiDimensionalArrays5 :: Bool
prop_checkMultiDimensionalArrays5 = ForShell -> String -> Bool
verify ForShell
checkMultiDimensionalArrays String
"echo ${foo[bar][baz]}"
prop_checkMultiDimensionalArrays6 :: Bool
prop_checkMultiDimensionalArrays6 = ForShell -> String -> Bool
verifyNot ForShell
checkMultiDimensionalArrays String
"echo ${foo[bar]}"
checkMultiDimensionalArrays :: ForShell
checkMultiDimensionalArrays = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Bash] Token -> Analysis
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
f
  where
    f :: Token -> m ()
f Token
token =
        case Token
token of
            T_Assignment Id
_ AssignmentMode
_ String
name (Token
first:Token
second:[Token]
_) Token
_ -> Token -> m ()
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
about Token
second
            T_IndexedElement Id
_ (Token
first:Token
second:[Token]
_) Token
_ -> Token -> m ()
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
about Token
second
            T_DollarBraced Id
_ Bool
_ Token
l ->
                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Token -> Bool
isMultiDim Token
l) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Token -> m ()
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
about Token
token
            Token
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    about :: Token -> m ()
about Token
t = Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
warn (Token -> Id
getId Token
t) Code
2180 String
"Bash does not support multidimensional arrays. Use 1D or associative arrays."

    re :: Regex
re = String -> Regex
mkRegex String
"^\\[.*\\]\\[.*\\]"  -- Fixme, this matches ${foo:- [][]} and such as well
    isMultiDim :: Token -> Bool
isMultiDim Token
l = String -> String
getBracedModifier ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Token -> [String]
oversimplify Token
l) String -> Regex -> Bool
`matches` Regex
re

prop_checkPS11 :: Bool
prop_checkPS11 = ForShell -> String -> Bool
verify ForShell
checkPS1Assignments String
"PS1='\\033[1;35m\\$ '"
prop_checkPS11a :: Bool
prop_checkPS11a = ForShell -> String -> Bool
verify ForShell
checkPS1Assignments String
"export PS1='\\033[1;35m\\$ '"
prop_checkPSf2 :: Bool
prop_checkPSf2 = ForShell -> String -> Bool
verify ForShell
checkPS1Assignments String
"PS1='\\h \\e[0m\\$ '"
prop_checkPS13 :: Bool
prop_checkPS13 = ForShell -> String -> Bool
verify ForShell
checkPS1Assignments String
"PS1=$'\\x1b[c '"
prop_checkPS14 :: Bool
prop_checkPS14 = ForShell -> String -> Bool
verify ForShell
checkPS1Assignments String
"PS1=$'\\e[3m; '"
prop_checkPS14a :: Bool
prop_checkPS14a = ForShell -> String -> Bool
verify ForShell
checkPS1Assignments String
"export PS1=$'\\e[3m; '"
prop_checkPS15 :: Bool
prop_checkPS15 = ForShell -> String -> Bool
verifyNot ForShell
checkPS1Assignments String
"PS1='\\[\\033[1;35m\\]\\$ '"
prop_checkPS16 :: Bool
prop_checkPS16 = ForShell -> String -> Bool
verifyNot ForShell
checkPS1Assignments String
"PS1='\\[\\e1m\\e[1m\\]\\$ '"
prop_checkPS17 :: Bool
prop_checkPS17 = ForShell -> String -> Bool
verifyNot ForShell
checkPS1Assignments String
"PS1='e033x1B'"
prop_checkPS18 :: Bool
prop_checkPS18 = ForShell -> String -> Bool
verifyNot ForShell
checkPS1Assignments String
"PS1='\\[\\e\\]'"
checkPS1Assignments :: ForShell
checkPS1Assignments = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Bash] Token -> Analysis
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
f
  where
    f :: Token -> f ()
f Token
token = case Token
token of
        (T_Assignment Id
_ AssignmentMode
_ String
"PS1" [Token]
_ Token
word) -> Token -> f ()
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
warnFor Token
word
        Token
_ -> () -> f ()
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    warnFor :: Token -> f ()
warnFor Token
word =
        let contents :: String
contents = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Token -> [String]
oversimplify Token
word in
            Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
containsUnescaped String
contents) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
                Id -> Code -> String -> f ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
info (Token -> Id
getId Token
word) Code
2025 String
"Make sure all escape sequences are enclosed in \\[..\\] to prevent line wrapping issues"
    containsUnescaped :: String -> Bool
containsUnescaped String
s =
        let unenclosed :: String
unenclosed = Regex -> String -> String -> String
subRegex Regex
enclosedRegex String
s String
"" in
           Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex Regex
escapeRegex String
unenclosed
    enclosedRegex :: Regex
enclosedRegex = String -> Regex
mkRegex String
"\\\\\\[.*\\\\\\]" -- FIXME: shouldn't be eager
    escapeRegex :: Regex
escapeRegex = String -> Regex
mkRegex String
"\\\\x1[Bb]|\\\\e|\x1B|\\\\033"


prop_checkMultipleBangs1 :: Bool
prop_checkMultipleBangs1 = ForShell -> String -> Bool
verify ForShell
checkMultipleBangs String
"! ! true"
prop_checkMultipleBangs2 :: Bool
prop_checkMultipleBangs2 = ForShell -> String -> Bool
verifyNot ForShell
checkMultipleBangs String
"! true"
checkMultipleBangs :: ForShell
checkMultipleBangs = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Dash, Shell
BusyboxSh, Shell
Sh] Token -> Analysis
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
f
  where
    f :: Token -> m ()
f Token
token = case Token
token of
        T_Banged Id
id (T_Banged Id
_ Token
_) ->
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
err Id
id Code
2325 String
"Multiple ! in front of pipelines are a bash/ksh extension. Use only 0 or 1."
        Token
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


prop_checkBangAfterPipe1 :: Bool
prop_checkBangAfterPipe1 = ForShell -> String -> Bool
verify ForShell
checkBangAfterPipe String
"true | ! true"
prop_checkBangAfterPipe2 :: Bool
prop_checkBangAfterPipe2 = ForShell -> String -> Bool
verifyNot ForShell
checkBangAfterPipe String
"true | ( ! true )"
prop_checkBangAfterPipe3 :: Bool
prop_checkBangAfterPipe3 = ForShell -> String -> Bool
verifyNot ForShell
checkBangAfterPipe String
"! ! true | true"
checkBangAfterPipe :: ForShell
checkBangAfterPipe = [Shell] -> (Token -> Analysis) -> ForShell
ForShell [Shell
Dash, Shell
BusyboxSh, Shell
Sh, Shell
Bash] Token -> Analysis
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
f
  where
    f :: Token -> m ()
f Token
token = case Token
token of
        T_Pipeline Id
_ [Token]
_ [Token]
cmds -> (Token -> m ()) -> [Token] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Token -> m ()
forall {m :: * -> *}. MonadWriter [TokenComment] m => Token -> m ()
check [Token]
cmds
        Token
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    check :: Token -> m ()
check Token
token = case Token
token of
        T_Banged Id
id Token
_ ->
            Id -> Code -> String -> m ()
forall {m :: * -> *}.
MonadWriter [TokenComment] m =>
Id -> Code -> String -> m ()
err Id
id Code
2326 String
"! is not allowed in the middle of pipelines. Use command group as in cmd | { ! cmd; } if necessary."
        Token
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

return []
runTests :: IO Bool
runTests =  $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])