module Hadolint.Shell where

import Control.Monad.Writer (Writer, execWriter, tell)
import Data.Functor.Identity (runIdentity)
import Data.List (isInfixOf)
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import ShellCheck.AST (Id (..), Token (..), pattern T_Pipe, pattern T_SimpleCommand)
import qualified ShellCheck.AST
import qualified ShellCheck.ASTLib
import ShellCheck.Checker (checkScript)
import ShellCheck.Interface
import qualified ShellCheck.Parser

data CmdPart = CmdPart
  { CmdPart -> Text
arg :: Text,
    CmdPart -> Int
partId :: Int
  }
  deriving (CmdPart -> CmdPart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdPart -> CmdPart -> Bool
$c/= :: CmdPart -> CmdPart -> Bool
== :: CmdPart -> CmdPart -> Bool
$c== :: CmdPart -> CmdPart -> Bool
Eq, Int -> CmdPart -> ShowS
[CmdPart] -> ShowS
CmdPart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdPart] -> ShowS
$cshowList :: [CmdPart] -> ShowS
show :: CmdPart -> String
$cshow :: CmdPart -> String
showsPrec :: Int -> CmdPart -> ShowS
$cshowsPrec :: Int -> CmdPart -> ShowS
Show)

data Command = Command
  { Command -> Text
name :: Text.Text,
    Command -> [CmdPart]
arguments :: [CmdPart],
    Command -> [CmdPart]
flags :: [CmdPart]
  }
  deriving (Command -> Command -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

data ParsedShell = ParsedShell
  { ParsedShell -> Text
original :: Text.Text,
    ParsedShell -> ParseResult
parsed :: ParseResult,
    ParsedShell -> [Command]
presentCommands :: [Command]
  }

data ShellOpts = ShellOpts
  { ShellOpts -> Text
shellName :: Text.Text,
    ShellOpts -> Set Text
envVars :: Set.Set Text.Text
  }

defaultShellOpts :: ShellOpts
defaultShellOpts :: ShellOpts
defaultShellOpts = Text -> Set Text -> ShellOpts
ShellOpts Text
"/bin/sh -c" Set Text
defaultVars
  where
    defaultVars :: Set Text
defaultVars =
      forall a. Ord a => [a] -> Set a
Set.fromList
        [ Text
"HTTP_PROXY",
          Text
"http_proxy",
          Text
"HTTPS_PROXY",
          Text
"https_proxy",
          Text
"FTP_PROXY",
          Text
"ftp_proxy",
          Text
"NO_PROXY",
          Text
"no_proxy"
        ]

addVars :: [Text.Text] -> ShellOpts -> ShellOpts
addVars :: [Text] -> ShellOpts -> ShellOpts
addVars [Text]
vars (ShellOpts Text
n Set Text
v) = Text -> Set Text -> ShellOpts
ShellOpts Text
n (Set Text
v forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> Set a
Set.fromList [Text]
vars)

setShell :: Text.Text -> ShellOpts -> ShellOpts
setShell :: Text -> ShellOpts -> ShellOpts
setShell Text
s (ShellOpts Text
_ Set Text
v) = Text -> Set Text -> ShellOpts
ShellOpts Text
s Set Text
v

shellcheck :: ShellOpts -> ParsedShell -> [PositionedComment]
shellcheck :: ShellOpts -> ParsedShell -> [PositionedComment]
shellcheck (ShellOpts Text
sh Set Text
env) (ParsedShell Text
txt ParseResult
_ [Command]
_) =
  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isInfixOf` Text
sh) [Text]
nonPosixShells Bool -> Bool -> Bool
|| Text -> Bool
hasUnsupportedShebang Text
txt
    then [] -- Do no run for non-posix shells i.e. powershell, cmd.exe
    else [PositionedComment]
runShellCheck
  where
    runShellCheck :: [PositionedComment]
runShellCheck = CheckResult -> [PositionedComment]
crComments forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
SystemInterface m -> CheckSpec -> m CheckResult
checkScript SystemInterface Identity
si CheckSpec
spec
    si :: SystemInterface Identity
si = [(String, String)] -> SystemInterface Identity
mockedSystemInterface [(String
"", String
"")]
    spec :: CheckSpec
spec =
      CheckSpec
emptyCheckSpec
        { csFilename :: String
csFilename = String
"", -- filename can be ommited because we only want the parse results back
          csScript :: String
csScript = String
script,
          csCheckSourced :: Bool
csCheckSourced = Bool
False,
          csExcludedWarnings :: [Integer]
csExcludedWarnings = [Integer]
exclusions,
          csShellTypeOverride :: Maybe Shell
csShellTypeOverride = forall a. Maybe a
Nothing,
          csMinSeverity :: Severity
csMinSeverity = Severity
StyleC
        }
    script :: String
script = Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Text
"#!" forall a. Semigroup a => a -> a -> a
<> Text -> Text
extractShell Text
sh forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
printVars forall a. Semigroup a => a -> a -> a
<> Text
txt
    exclusions :: [Integer]
exclusions =
      [ Integer
2187, -- exclude the warning about the ash shell not being supported
        Integer
1090 -- requires a directive (shell comment) that can't be expressed in a Dockerfile
      ]

    extractShell :: Text -> Text
extractShell Text
s = forall a. a -> Maybe a -> a
fromMaybe Text
"" (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words forall a b. (a -> b) -> a -> b
$ Text
s)
    printVars :: Text
printVars = [Text] -> Text
Text.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Text
v -> Text
"export " forall a. Semigroup a => a -> a -> a
<> Text
v forall a. Semigroup a => a -> a -> a
<> Text
"=1") Set Text
env

nonPosixShells :: [Text.Text]
nonPosixShells :: [Text]
nonPosixShells = [Text
"pwsh", Text
"powershell", Text
"cmd"]

hasUnsupportedShebang :: Text.Text -> Bool
hasUnsupportedShebang :: Text -> Bool
hasUnsupportedShebang Text
script =
  Text
"#!" Text -> Text -> Bool
`Text.isPrefixOf` Text
script Bool -> Bool -> Bool
&&
  Bool -> Bool
not ( forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isPrefixOf` Text
script)
          [ Text
"#!/bin/sh",
            Text
"#!/bin/bash",
            Text
"#!/bin/ksh",
            Text
"#!/usr/bin/env sh",
            Text
"#!/usr/bin/env bash",
            Text
"#!/usr/bin/env ksh"
          ]
      )

parseShell :: Text.Text -> ParsedShell
parseShell :: Text -> ParsedShell
parseShell Text
txt = ParsedShell {original :: Text
original = Text
txt, parsed :: ParseResult
parsed = ParseResult
parsedResult, presentCommands :: [Command]
presentCommands = [Command]
commands}
  where
    parsedResult :: ParseResult
parsedResult =
      forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
Monad m =>
SystemInterface m -> ParseSpec -> m ParseResult
ShellCheck.Parser.parseScript
          ([(String, String)] -> SystemInterface Identity
mockedSystemInterface [(String
"", String
"")])
          ParseSpec
newParseSpec
            { psFilename :: String
psFilename = String
"", -- There is no filename
              psScript :: String
psScript = Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Text
"#!/bin/bash\n" forall a. Semigroup a => a -> a -> a
<> Text
txt,
              psCheckSourced :: Bool
psCheckSourced = Bool
False
            }

    commands :: [Command]
commands = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Token -> Maybe Command
extractNames (ParseResult -> [Token]
findCommandsInResult ParseResult
parsedResult)
    extractNames :: Token -> Maybe Command
extractNames Token
token =
      case Token -> Maybe String
ShellCheck.ASTLib.getCommandName Token
token of
        Maybe String
Nothing -> forall a. Maybe a
Nothing
        Just String
n -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> [CmdPart] -> [CmdPart] -> Command
Command (String -> Text
Text.pack String
n) [CmdPart]
allArgs ([CmdPart] -> [CmdPart]
getAllFlags [CmdPart]
allArgs)
      where
        allArgs :: [CmdPart]
allArgs = Token -> [CmdPart]
extractAllArgs Token
token

findCommandsInResult :: ParseResult -> [Token]
findCommandsInResult :: ParseResult -> [Token]
findCommandsInResult = forall a. (Token -> Maybe a) -> ParseResult -> [a]
extractTokensWith Token -> Maybe Token
commandsExtractor
  where
    commandsExtractor :: Token -> Maybe Token
commandsExtractor = Token -> Maybe Token
ShellCheck.ASTLib.getCommand

extractTokensWith :: forall a. (Token -> Maybe a) -> ParseResult -> [a]
extractTokensWith :: forall a. (Token -> Maybe a) -> ParseResult -> [a]
extractTokensWith Token -> Maybe a
extractor ParseResult
ast =
  case ParseResult -> Maybe Token
prRoot ParseResult
ast of
    Maybe Token
Nothing -> []
    Just Token
script -> forall w a. Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(Token -> m ()) -> Token -> m Token
ShellCheck.AST.doAnalysis Token -> Writer [a] ()
extract Token
script
  where
    extract :: Token -> Writer [a] ()
    extract :: Token -> Writer [a] ()
extract Token
token =
      case Token -> Maybe a
extractor Token
token of
        Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just a
t -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [a
t]

findPipes :: ParsedShell -> [Token]
findPipes :: ParsedShell -> [Token]
findPipes (ParsedShell Text
_ ParseResult
ast [Command]
_) = forall a. (Token -> Maybe a) -> ParseResult -> [a]
extractTokensWith Token -> Maybe Token
pipesExtractor ParseResult
ast
  where
    pipesExtractor :: Token -> Maybe Token
pipesExtractor pipe :: Token
pipe@T_Pipe {} = forall a. a -> Maybe a
Just Token
pipe
    pipesExtractor Token
_ = forall a. Maybe a
Nothing

hasPipes :: ParsedShell -> Bool
hasPipes :: ParsedShell -> Bool
hasPipes = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Token]
findPipes

allCommands :: (Command -> Bool) -> ParsedShell -> Bool
allCommands :: (Command -> Bool) -> ParsedShell -> Bool
allCommands Command -> Bool
check ParsedShell
script = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Command -> Bool
check (ParsedShell -> [Command]
presentCommands ParsedShell
script)

noCommands :: (Command -> Bool) -> ParsedShell -> Bool
noCommands :: (Command -> Bool) -> ParsedShell -> Bool
noCommands Command -> Bool
check = (Command -> Bool) -> ParsedShell -> Bool
allCommands (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Bool
check)

anyCommands :: (Command -> Bool) -> ParsedShell -> Bool
anyCommands :: (Command -> Bool) -> ParsedShell -> Bool
anyCommands Command -> Bool
check ParsedShell
script = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Command -> Bool
check (ParsedShell -> [Command]
presentCommands ParsedShell
script)

findCommandNames :: ParsedShell -> [Text]
findCommandNames :: ParsedShell -> [Text]
findCommandNames ParsedShell
script = forall a b. (a -> b) -> [a] -> [b]
map Command -> Text
name (ParsedShell -> [Command]
presentCommands ParsedShell
script)

cmdHasArgs :: Text.Text -> [Text.Text] -> Command -> Bool
cmdHasArgs :: Text -> [Text] -> Command -> Bool
cmdHasArgs Text
expectedName [Text]
expectedArgs (Command Text
n [CmdPart]
args [CmdPart]
_)
  | Text
expectedName forall a. Eq a => a -> a -> Bool
/= Text
n = Bool
False
  | Bool
otherwise = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
arg | CmdPart Text
arg Int
_ <- [CmdPart]
args, Text
arg forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
expectedArgs]

cmdsHaveArgs :: [Text.Text] -> [Text.Text] -> Command -> Bool
cmdsHaveArgs :: [Text] -> [Text] -> Command -> Bool
cmdsHaveArgs [Text]
expectedNames [Text]
expectedArgs (Command Text
n [CmdPart]
args [CmdPart]
_)
  | Text
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
expectedNames = Bool
False
  | Bool
otherwise = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
arg | CmdPart Text
arg Int
_ <- [CmdPart]
args, Text
arg forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
expectedArgs]

cmdHasPrefixArg :: Text.Text -> Text.Text -> Command -> Bool
cmdHasPrefixArg :: Text -> Text -> Command -> Bool
cmdHasPrefixArg Text
expectedName Text
expectedArg (Command Text
n [CmdPart]
args [CmdPart]
_)
  | Text
expectedName forall a. Eq a => a -> a -> Bool
/= Text
n = Bool
False
  | Bool
otherwise = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
arg | CmdPart Text
arg Int
_ <- [CmdPart]
args, Text
expectedArg Text -> Text -> Bool
`Text.isPrefixOf` Text
arg]

extractAllArgs :: Token -> [CmdPart]
extractAllArgs :: Token -> [CmdPart]
extractAllArgs (T_SimpleCommand Id
_ [Token]
_ (Token
_ : [Token]
allArgs)) = forall a b. (a -> b) -> [a] -> [b]
map Token -> CmdPart
mkPart [Token]
allArgs
  where
    mkPart :: Token -> CmdPart
mkPart Token
token =
      Text -> Int -> CmdPart
CmdPart
        ([Text] -> Text
Text.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ Token -> [String]
ShellCheck.ASTLib.oversimplify Token
token)
        (Id -> Int
mkId (Token -> Id
ShellCheck.AST.getId Token
token))
    mkId :: Id -> Int
mkId (Id Int
i) = Int
i
extractAllArgs Token
_ = []

getArgs :: Command -> [Text.Text]
getArgs :: Command -> [Text]
getArgs Command
cmd = forall a b. (a -> b) -> [a] -> [b]
map CmdPart -> Text
arg (Command -> [CmdPart]
arguments Command
cmd)

getAllFlags :: [CmdPart] -> [CmdPart]
getAllFlags :: [CmdPart] -> [CmdPart]
getAllFlags = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CmdPart -> [CmdPart]
flag
  where
    flag :: CmdPart -> [CmdPart]
flag (CmdPart Text
arg Int
pId)
      | Text
arg forall a. Eq a => a -> a -> Bool
== Text
"--" Bool -> Bool -> Bool
|| Text
arg forall a. Eq a => a -> a -> Bool
== Text
"-" = []
      | Text
"--" Text -> Text -> Bool
`Text.isPrefixOf` Text
arg = [Text -> Int -> CmdPart
CmdPart (Int -> Text -> Text
Text.drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'=') forall a b. (a -> b) -> a -> b
$ Text
arg) Int
pId]
      | Text
"-" Text -> Text -> Bool
`Text.isPrefixOf` Text
arg = forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int -> CmdPart
`CmdPart` Int
pId) (Int -> Text -> [Text]
Text.chunksOf Int
1 (Text -> Text
Text.tail Text
arg))
      | Bool
otherwise = []

getArgsNoFlags :: Command -> [Text.Text]
getArgsNoFlags :: Command -> [Text]
getArgsNoFlags Command
args = forall a b. (a -> b) -> [a] -> [b]
map CmdPart -> Text
arg forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Bool
notAFlagId forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdPart -> Int
partId) (Command -> [CmdPart]
arguments Command
args)
  where
    notAFlagId :: Int -> Bool
notAFlagId Int
pId = Int
pId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map CmdPart -> Int
partId (Command -> [CmdPart]
flags Command
args)

hasFlag :: Text.Text -> Command -> Bool
hasFlag :: Text -> Command -> Bool
hasFlag Text
flag Command {[CmdPart]
flags :: [CmdPart]
flags :: Command -> [CmdPart]
flags} = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
f | CmdPart Text
f Int
_ <- [CmdPart]
flags, Text
f forall a. Eq a => a -> a -> Bool
== Text
flag]

hasAnyFlag :: [Text.Text] -> Command -> Bool
hasAnyFlag :: [Text] -> Command -> Bool
hasAnyFlag [Text]
fs Command {[CmdPart]
flags :: [CmdPart]
flags :: Command -> [CmdPart]
flags} = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
f | CmdPart Text
f Int
_ <- [CmdPart]
flags, Text
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
fs]

hasArg :: Text.Text -> Command -> Bool
hasArg :: Text -> Command -> Bool
hasArg Text
arg Command {[CmdPart]
arguments :: [CmdPart]
arguments :: Command -> [CmdPart]
arguments} = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
a | CmdPart Text
a Int
_ <- [CmdPart]
arguments, Text
a forall a. Eq a => a -> a -> Bool
== Text
arg]

dropFlagArg :: [Text.Text] -> Command -> Command
dropFlagArg :: [Text] -> Command -> Command
dropFlagArg [Text]
flagsToDrop Command {Text
name :: Text
name :: Command -> Text
name, [CmdPart]
arguments :: [CmdPart]
arguments :: Command -> [CmdPart]
arguments, [CmdPart]
flags :: [CmdPart]
flags :: Command -> [CmdPart]
flags} = Text -> [CmdPart] -> [CmdPart] -> Command
Command Text
name [CmdPart]
filterdArgs [CmdPart]
flags
  where
    idsToDrop :: Set Int
idsToDrop = forall a. Ord a => [a] -> Set a
Set.fromList [Int -> [CmdPart] -> Int
getValueId Int
fId [CmdPart]
arguments | CmdPart Text
f Int
fId <- [CmdPart]
flags, Text
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
flagsToDrop]
    filterdArgs :: [CmdPart]
filterdArgs = [CmdPart
arg | arg :: CmdPart
arg@(CmdPart Text
_ Int
aId) <- [CmdPart]
arguments, Bool -> Bool
not (Int
aId forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Int
idsToDrop)]

-- | given a flag and a command, return list of arguments for that particulat
-- flag. E.g., if the command is `useradd -u 12345 luser` and this function is
-- called for the command `u`, it returns ["12345"].
getFlagArg :: Text.Text -> Command -> [Text.Text]
getFlagArg :: Text -> Command -> [Text]
getFlagArg Text
flag Command {[CmdPart]
arguments :: [CmdPart]
arguments :: Command -> [CmdPart]
arguments, [CmdPart]
flags :: [CmdPart]
flags :: Command -> [CmdPart]
flags} = [Text]
extractArgs
  where
    idsToGet :: Set Int
idsToGet = forall a. Ord a => [a] -> Set a
Set.fromList [Int -> [CmdPart] -> Int
getValueId Int
fId [CmdPart]
arguments | CmdPart Text
f Int
fId <- [CmdPart]
flags, Text
f forall a. Eq a => a -> a -> Bool
== Text
flag]
    extractArgs :: [Text]
extractArgs = [Text
arg | (CmdPart Text
arg Int
aId) <- [CmdPart]
arguments, Int
aId forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Int
idsToGet]

getValueId :: Int -> [CmdPart] -> Int
getValueId :: Int -> [CmdPart] -> Int
getValueId Int
fId [CmdPart]
flags = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
min (forall a. Bounded a => a
maxBound :: Int) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
> Int
fId) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CmdPart -> Int
partId [CmdPart]
flags

-- | Check if a command contains a program call in the Run instruction
usingProgram :: Text.Text -> ParsedShell -> Bool
usingProgram :: Text -> ParsedShell -> Bool
usingProgram Text
prog ParsedShell
args = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
cmd | Text
cmd <- ParsedShell -> [Text]
findCommandNames ParsedShell
args, Text
cmd forall a. Eq a => a -> a -> Bool
== Text
prog]

isPipInstall :: Command -> Bool
isPipInstall :: Command -> Bool
isPipInstall cmd :: Command
cmd@(Command Text
name [CmdPart]
_ [CmdPart]
_) = Bool
isStdPipInstall Bool -> Bool -> Bool
|| Bool
isPythonPipInstall
  where
    isStdPipInstall :: Bool
isStdPipInstall =
      Text
"pip" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        Bool -> Bool -> Bool
&& [Text
"install"] forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
getArgs Command
cmd
    isPythonPipInstall :: Bool
isPythonPipInstall =
      Text
"python" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        Bool -> Bool -> Bool
&& [Text
"-m", Text
"pip", Text
"install"] forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
getArgs Command
cmd