{-
    Copyright 2012-2019 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 #-}
module ShellCheck.ASTLib where

import ShellCheck.AST
import ShellCheck.Regex

import Control.Monad.Writer
import Control.Monad
import Data.Char
import Data.Functor
import Data.Functor.Identity
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import Numeric (showHex)

import Test.QuickCheck

arguments :: Token -> [Token]
arguments (T_SimpleCommand Id
_ [Token]
_ (Token
cmd:[Token]
args)) = [Token]
args

-- Is this a type of loop?
isLoop :: Token -> Bool
isLoop Token
t = case Token
t of
        T_WhileExpression {} -> Bool
True
        T_UntilExpression {} -> Bool
True
        T_ForIn {} -> Bool
True
        T_ForArithmetic {} -> Bool
True
        T_SelectIn {}  -> Bool
True
        Token
_ -> Bool
False

-- Will this split into multiple words when used as an argument?
willSplit :: Token -> Bool
willSplit Token
x =
  case Token
x of
    T_DollarBraced {} -> Bool
True
    T_DollarExpansion {} -> Bool
True
    T_Backticked {} -> Bool
True
    T_BraceExpansion {} -> Bool
True
    T_Glob {} -> Bool
True
    T_Extglob {} -> Bool
True
    T_DoubleQuoted Id
_ [Token]
l -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willBecomeMultipleArgs [Token]
l
    T_NormalWord Id
_ [Token]
l -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willSplit [Token]
l
    Token
_ -> Bool
False

isGlob :: Token -> Bool
isGlob T_Extglob {} = Bool
True
isGlob T_Glob {} = Bool
True
isGlob (T_NormalWord Id
_ [Token]
l) = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
isGlob [Token]
l
isGlob Token
_ = Bool
False

-- Is this shell word a constant?
isConstant :: Token -> Bool
isConstant Token
token =
    case Token
token of
        -- This ignores some cases like ~"foo":
        T_NormalWord Id
_ (T_Literal Id
_ (Char
'~':String
_) : [Token]
_)  -> Bool
False
        T_NormalWord Id
_ [Token]
l   -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isConstant [Token]
l
        T_DoubleQuoted Id
_ [Token]
l -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isConstant [Token]
l
        T_SingleQuoted Id
_ String
_ -> Bool
True
        T_Literal Id
_ String
_ -> Bool
True
        Token
_ -> Bool
False

-- Is this an empty literal?
isEmpty :: Token -> Bool
isEmpty Token
token =
    case Token
token of
        T_NormalWord Id
_ [Token]
l   -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isEmpty [Token]
l
        T_DoubleQuoted Id
_ [Token]
l -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isEmpty [Token]
l
        T_SingleQuoted Id
_ String
"" -> Bool
True
        T_Literal Id
_ String
"" -> Bool
True
        Token
_ -> Bool
False

-- Quick&lazy oversimplification of commands, throwing away details
-- and returning a list like  ["find", ".", "-name", "${VAR}*" ].
oversimplify :: Token -> [String]
oversimplify Token
token =
    case Token
token of
        (T_NormalWord Id
_ [Token]
l) -> [[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Token -> [String]) -> [Token] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [String]
oversimplify [Token]
l)]
        (T_DoubleQuoted Id
_ [Token]
l) -> [[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Token -> [String]) -> [Token] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [String]
oversimplify [Token]
l)]
        (T_SingleQuoted Id
_ String
s) -> [String
s]
        (T_DollarBraced Id
_ Bool
_ Token
_) -> [String
"${VAR}"]
        (T_DollarArithmetic Id
_ Token
_) -> [String
"${VAR}"]
        (T_DollarExpansion Id
_ [Token]
_) -> [String
"${VAR}"]
        (T_Backticked Id
_ [Token]
_) -> [String
"${VAR}"]
        (T_Glob Id
_ String
s) -> [String
s]
        (T_Pipeline Id
_ [Token]
_ [Token
x]) -> Token -> [String]
oversimplify Token
x
        (T_Literal Id
_ String
x) -> [String
x]
        (T_ParamSubSpecialChar Id
_ String
x) -> [String
x]
        (T_SimpleCommand Id
_ [Token]
vars [Token]
words) -> (Token -> [String]) -> [Token] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [String]
oversimplify [Token]
words
        (T_Redirecting Id
_ [Token]
_ Token
foo) -> Token -> [String]
oversimplify Token
foo
        (T_DollarSingleQuoted Id
_ String
s) -> [String
s]
        (T_Annotation Id
_ [Annotation]
_ Token
s) -> Token -> [String]
oversimplify Token
s
        -- Workaround for let "foo = bar" parsing
        (TA_Sequence Id
_ [TA_Expansion Id
_ [Token]
v]) -> (Token -> [String]) -> [Token] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [String]
oversimplify [Token]
v
        Token
_ -> []


-- Turn a SimpleCommand foo -avz --bar=baz into args "a", "v", "z", "bar",
-- each in a tuple of (token, stringFlag). Non-flag arguments are added with
-- stringFlag == "".
getFlagsUntil :: (String -> Bool) -> Token -> [(Token, String)]
getFlagsUntil String -> Bool
stopCondition (T_SimpleCommand Id
_ [Token]
_ (Token
_:[Token]
args)) =
    let tokenAndText :: [(Token, String)]
tokenAndText = (Token -> (Token, String)) -> [Token] -> [(Token, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\Token
x -> (Token
x, [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
x)) [Token]
args
        ([(Token, String)]
flagArgs, [(Token, String)]
rest) = ((Token, String) -> Bool)
-> [(Token, String)] -> ([(Token, String)], [(Token, String)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> Bool
stopCondition (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)]
tokenAndText
    in
        ((Token, String) -> [(Token, String)])
-> [(Token, String)] -> [(Token, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Token, String) -> [(Token, String)]
forall {a}. (a, String) -> [(a, String)]
flag [(Token, String)]
flagArgs [(Token, String)] -> [(Token, String)] -> [(Token, String)]
forall a. [a] -> [a] -> [a]
++ ((Token, String) -> (Token, String))
-> [(Token, String)] -> [(Token, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Token
t, String
_) -> (Token
t, String
"")) [(Token, String)]
rest
  where
    flag :: (a, String) -> [(a, String)]
flag (a
x, Char
'-':Char
'-':String
arg) = [ (a
x, (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') String
arg) ]
    flag (a
x, Char
'-':String
args) = (Char -> (a, String)) -> String -> [(a, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
v -> (a
x, [Char
v])) String
args
    flag (a
x, String
_) = [ (a
x, String
"") ]
getFlagsUntil String -> Bool
_ Token
_ = String -> [(Token, String)]
forall a. HasCallStack => String -> a
error String
"Internal shellcheck error, please report! (getFlags on non-command)"

-- Get all flags in a GNU way, up until --
getAllFlags :: Token -> [(Token, String)]
getAllFlags :: Token -> [(Token, String)]
getAllFlags = (String -> Bool) -> Token -> [(Token, String)]
getFlagsUntil (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--")
-- Get all flags in a BSD way, up until first non-flag argument or --
getLeadingFlags :: Token -> [(Token, String)]
getLeadingFlags = (String -> Bool) -> Token -> [(Token, String)]
getFlagsUntil (\String
x -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--" Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x))

-- Check if a command has a flag.
hasFlag :: Token -> String -> Bool
hasFlag Token
cmd String
str = String
str String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Token, String) -> String) -> [(Token, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Token, String) -> String
forall a b. (a, b) -> b
snd ([(Token, String)] -> [String]) -> [(Token, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ Token -> [(Token, String)]
getAllFlags Token
cmd)

-- Is this token a word that starts with a dash?
isFlag :: Token -> Bool
isFlag Token
token =
    case Token -> [Token]
getWordParts Token
token of
        T_Literal Id
_ (Char
'-':String
_) : [Token]
_ -> Bool
True
        [Token]
_ -> Bool
False

-- Is this token a flag where the - is unquoted?
isUnquotedFlag :: Token -> Bool
isUnquotedFlag Token
token = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
    String
str <- Token -> Maybe String
getLeadingUnquotedString Token
token
    Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str

-- getGnuOpts "erd:u:" will parse a list of arguments tokens like `read`
--     -re -d : -u 3 bar
-- into
--     Just [("r", (-re, -re)), ("e", (-re, -re)), ("d", (-d,:)), ("u", (-u,3)), ("", (bar,bar))]
--
-- Each string flag maps to a tuple of (flag, argument), where argument=flag if it
-- doesn't take a specific one.
--
-- Any unrecognized flag will result in Nothing. The exception is if arbitraryLongOpts
-- is set, in which case --anything will map to "anything".
getGnuOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts String
str [Token]
args = (Bool, Bool)
-> String
-> [(String, Bool)]
-> [Token]
-> Maybe [(String, (Token, Token))]
getOpts (Bool
True, Bool
False) String
str [] [Token]
args

-- As above, except the first non-arg string will treat the rest as arguments
getBsdOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
getBsdOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
getBsdOpts String
str [Token]
args = (Bool, Bool)
-> String
-> [(String, Bool)]
-> [Token]
-> Maybe [(String, (Token, Token))]
getOpts (Bool
False, Bool
False) String
str [] [Token]
args

-- Tests for this are in Commands.hs where it's more frequently used
getOpts ::
    -- Behavioral config: gnu style, allow arbitrary long options
    (Bool, Bool)
    -- A getopts style string
    -> String
    -- List of long options and whether they take arguments
    -> [(String, Bool)]
    -- List of arguments (excluding command)
    -> [Token]
    -- List of flags to tuple of (optionToken, valueToken)
    -> Maybe [(String, (Token, Token))]

getOpts :: (Bool, Bool)
-> String
-> [(String, Bool)]
-> [Token]
-> Maybe [(String, (Token, Token))]
getOpts (Bool
gnu, Bool
arbitraryLongOpts) String
string [(String, Bool)]
longopts [Token]
args = [Token] -> Maybe [(String, (Token, Token))]
process [Token]
args
  where
    flagList :: String -> [(String, Bool)]
flagList (Char
c:Char
':':String
rest) = ([Char
c], Bool
True) (String, Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. a -> [a] -> [a]
: String -> [(String, Bool)]
flagList String
rest
    flagList (Char
c:String
rest)     = ([Char
c], Bool
False) (String, Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. a -> [a] -> [a]
: String -> [(String, Bool)]
flagList String
rest
    flagList []           = [(String, Bool)]
longopts
    flagMap :: Map String Bool
flagMap = [(String, Bool)] -> Map String Bool
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Bool)] -> Map String Bool)
-> [(String, Bool)] -> Map String Bool
forall a b. (a -> b) -> a -> b
$ (String
"", Bool
False) (String, Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. a -> [a] -> [a]
: String -> [(String, Bool)]
flagList String
string

    process :: [Token] -> Maybe [(String, (Token, Token))]
process [] = [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    process (Token
token:[Token]
rest) = do
        case String -> Token -> String
getLiteralStringDef String
"\0" Token
token of
            String
"--" -> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ [Token] -> [(String, (Token, Token))]
forall {b}. [b] -> [(String, (b, b))]
listToArgs [Token]
rest
            Char
'-':Char
'-':String
word -> do
                let (String
name, String
arg) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') String
word
                Bool
needsArg <-
                    if Bool
arbitraryLongOpts
                    then Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Map String Bool -> Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Bool
False String
name Map String Bool
flagMap
                    else String -> Map String Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String Bool
flagMap

                if Bool
needsArg Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
arg
                  then
                    case [Token]
rest of
                        (Token
arg:[Token]
rest2) -> do
                            [(String, (Token, Token))]
more <- [Token] -> Maybe [(String, (Token, Token))]
process [Token]
rest2
                            [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ (String
name, (Token
token, Token
arg)) (String, (Token, Token))
-> [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a. a -> [a] -> [a]
: [(String, (Token, Token))]
more
                        [Token]
_ -> String -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Missing arg"
                  else do
                    [(String, (Token, Token))]
more <- [Token] -> Maybe [(String, (Token, Token))]
process [Token]
rest
                    -- Consider splitting up token to get arg
                    [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ (String
name, (Token
token, Token
token)) (String, (Token, Token))
-> [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a. a -> [a] -> [a]
: [(String, (Token, Token))]
more
            Char
'-':String
opts -> String -> Token -> [Token] -> Maybe [(String, (Token, Token))]
shortToOpts String
opts Token
token [Token]
rest
            String
arg ->
                if Bool
gnu
                then do
                    [(String, (Token, Token))]
more <- [Token] -> Maybe [(String, (Token, Token))]
process [Token]
rest
                    [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ (String
"", (Token
token, Token
token))(String, (Token, Token))
-> [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a. a -> [a] -> [a]
:[(String, (Token, Token))]
more
                else [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ [Token] -> [(String, (Token, Token))]
forall {b}. [b] -> [(String, (b, b))]
listToArgs (Token
tokenToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
rest)

    shortToOpts :: String -> Token -> [Token] -> Maybe [(String, (Token, Token))]
shortToOpts String
opts Token
token [Token]
args =
        case String
opts of
            Char
c:String
rest -> do
                Bool
needsArg <- String -> Map String Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char
c] Map String Bool
flagMap
                case () of
                    ()
_ | Bool
needsArg Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest -> do
                        (Token
next:[Token]
restArgs) <- [Token] -> Maybe [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return [Token]
args
                        [(String, (Token, Token))]
more <- [Token] -> Maybe [(String, (Token, Token))]
process [Token]
restArgs
                        [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ ([Char
c], (Token
token, Token
next))(String, (Token, Token))
-> [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a. a -> [a] -> [a]
:[(String, (Token, Token))]
more
                    ()
_ | Bool
needsArg -> do
                        [(String, (Token, Token))]
more <- [Token] -> Maybe [(String, (Token, Token))]
process [Token]
args
                        [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ ([Char
c], (Token
token, Token
token))(String, (Token, Token))
-> [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a. a -> [a] -> [a]
:[(String, (Token, Token))]
more
                    ()
_ -> do
                        [(String, (Token, Token))]
more <- String -> Token -> [Token] -> Maybe [(String, (Token, Token))]
shortToOpts String
rest Token
token [Token]
args
                        [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, (Token, Token))] -> Maybe [(String, (Token, Token))])
-> [(String, (Token, Token))] -> Maybe [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ ([Char
c], (Token
token, Token
token))(String, (Token, Token))
-> [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a. a -> [a] -> [a]
:[(String, (Token, Token))]
more
            [] -> [Token] -> Maybe [(String, (Token, Token))]
process [Token]
args

    listToArgs :: [b] -> [(String, (b, b))]
listToArgs = (b -> (String, (b, b))) -> [b] -> [(String, (b, b))]
forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> (String
"", (b
x, b
x)))

-- Is this an expansion of multiple items of an array?
isArrayExpansion :: Token -> Bool
isArrayExpansion (T_DollarBraced Id
_ Bool
_ Token
l) =
    let string :: String
string = [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 in
        String
"@" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
string Bool -> Bool -> Bool
||
            Bool -> Bool
not (String
"#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
string) Bool -> Bool -> Bool
&& String
"[@]" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
string
isArrayExpansion Token
_ = Bool
False

-- Is it possible that this arg becomes multiple args?
mayBecomeMultipleArgs :: Token -> Bool
mayBecomeMultipleArgs Token
t = Token -> Bool
willBecomeMultipleArgs Token
t Bool -> Bool -> Bool
|| Token -> Bool
f Token
t
  where
    f :: Token -> Bool
f (T_DollarBraced Id
_ Bool
_ Token
l) =
        let string :: String
string = [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 in
            String
"!" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
string
    f (T_DoubleQuoted Id
_ [Token]
parts) = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
f [Token]
parts
    f (T_NormalWord Id
_ [Token]
parts) = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
f [Token]
parts
    f Token
_ = Bool
False

-- Is it certain that this word will becomes multiple words?
willBecomeMultipleArgs :: Token -> Bool
willBecomeMultipleArgs Token
t = Token -> Bool
willConcatInAssignment Token
t Bool -> Bool -> Bool
|| Token -> Bool
f Token
t
  where
    f :: Token -> Bool
f T_Extglob {} = Bool
True
    f T_Glob {} = Bool
True
    f T_BraceExpansion {} = Bool
True
    f (T_DoubleQuoted Id
_ [Token]
parts) = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
f [Token]
parts
    f (T_NormalWord Id
_ [Token]
parts) = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
f [Token]
parts
    f Token
_ = Bool
False

-- This does token cause implicit concatenation in assignments?
willConcatInAssignment :: Token -> Bool
willConcatInAssignment Token
token =
    case Token
token of
        t :: Token
t@T_DollarBraced {} -> Token -> Bool
isArrayExpansion Token
t
        (T_DoubleQuoted Id
_ [Token]
parts) -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willConcatInAssignment [Token]
parts
        (T_NormalWord Id
_ [Token]
parts) -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willConcatInAssignment [Token]
parts
        Token
_ -> Bool
False

-- Maybe get the literal string corresponding to this token
getLiteralString :: Token -> Maybe String
getLiteralString :: Token -> Maybe String
getLiteralString = (Token -> Maybe String) -> Token -> Maybe String
forall (m :: * -> *).
Monad m =>
(Token -> m String) -> Token -> m String
getLiteralStringExt (Maybe String -> Token -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing)

-- Definitely get a literal string, with a given default for all non-literals
getLiteralStringDef :: String -> Token -> String
getLiteralStringDef :: String -> Token -> String
getLiteralStringDef String
x = Identity String -> String
forall a. Identity a -> a
runIdentity (Identity String -> String)
-> (Token -> Identity String) -> Token -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Identity String) -> Token -> Identity String
forall (m :: * -> *).
Monad m =>
(Token -> m String) -> Token -> m String
getLiteralStringExt (Identity String -> Token -> Identity String
forall a b. a -> b -> a
const (Identity String -> Token -> Identity String)
-> Identity String -> Token -> Identity String
forall a b. (a -> b) -> a -> b
$ String -> Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x)

-- Definitely get a literal string, skipping over all non-literals
onlyLiteralString :: Token -> String
onlyLiteralString :: Token -> String
onlyLiteralString = String -> Token -> String
getLiteralStringDef String
""

-- Maybe get a literal string, but only if it's an unquoted argument.
getUnquotedLiteral :: Token -> Maybe String
getUnquotedLiteral (T_NormalWord Id
_ [Token]
list) =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> Maybe [String] -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> Maybe String) -> [Token] -> Maybe [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> Maybe String
str [Token]
list
  where
    str :: Token -> Maybe String
str (T_Literal Id
_ String
s) = String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
    str Token
_ = Maybe String
forall a. Maybe a
Nothing
getUnquotedLiteral Token
_ = Maybe String
forall a. Maybe a
Nothing

isQuotes :: Token -> Bool
isQuotes Token
t =
    case Token
t of
        T_DoubleQuoted {} -> Bool
True
        T_SingleQuoted {} -> Bool
True
        Token
_ -> Bool
False

-- Get the last unquoted T_Literal in a word like "${var}foo"THIS
-- or nothing if the word does not end in an unquoted literal.
getTrailingUnquotedLiteral :: Token -> Maybe Token
getTrailingUnquotedLiteral :: Token -> Maybe Token
getTrailingUnquotedLiteral Token
t =
    case Token
t of
        (T_NormalWord Id
_ list :: [Token]
list@(Token
_:[Token]
_)) ->
            Token -> Maybe Token
from ([Token] -> Token
forall a. [a] -> a
last [Token]
list)
        Token
_ -> Maybe Token
forall a. Maybe a
Nothing
  where
    from :: Token -> Maybe Token
from Token
t =
        case Token
t of
            T_Literal {} -> Token -> Maybe Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
t
            Token
_ -> Maybe Token
forall a. Maybe a
Nothing

-- Get the leading, unquoted, literal string of a token (if any).
getLeadingUnquotedString :: Token -> Maybe String
getLeadingUnquotedString :: Token -> Maybe String
getLeadingUnquotedString Token
t =
    case Token
t of
        T_NormalWord Id
_ ((T_Literal Id
_ String
s) : [Token]
rest) -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Token] -> String
from [Token]
rest
        Token
_ -> Maybe String
forall a. Maybe a
Nothing
  where
    from :: [Token] -> String
from ((T_Literal Id
_ String
s):[Token]
rest) = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Token] -> String
from [Token]
rest
    from [Token]
_ = String
""

-- Maybe get the literal string of this token and any globs in it.
getGlobOrLiteralString :: Token -> Maybe String
getGlobOrLiteralString = (Token -> Maybe String) -> Token -> Maybe String
forall (m :: * -> *).
Monad m =>
(Token -> m String) -> Token -> m String
getLiteralStringExt Token -> Maybe String
f
  where
    f :: Token -> Maybe String
f (T_Glob Id
_ String
str) = String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
    f Token
_ = Maybe String
forall a. Maybe a
Nothing

-- Maybe get the literal value of a token, using a custom function
-- to map unrecognized Tokens into strings.
getLiteralStringExt :: Monad m => (Token -> m String) -> Token -> m String
getLiteralStringExt :: forall (m :: * -> *).
Monad m =>
(Token -> m String) -> Token -> m String
getLiteralStringExt Token -> m String
more = Token -> m String
g
  where
    allInList :: [Token] -> m String
allInList = ([String] -> String) -> m [String] -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [String] -> m String)
-> ([Token] -> m [String]) -> [Token] -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> m String) -> [Token] -> m [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> m String
g
    g :: Token -> m String
g (T_DoubleQuoted Id
_ [Token]
l) = [Token] -> m String
allInList [Token]
l
    g (T_DollarDoubleQuoted Id
_ [Token]
l) = [Token] -> m String
allInList [Token]
l
    g (T_NormalWord Id
_ [Token]
l) = [Token] -> m String
allInList [Token]
l
    g (TA_Expansion Id
_ [Token]
l) = [Token] -> m String
allInList [Token]
l
    g (T_SingleQuoted Id
_ String
s) = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
    g (T_Literal Id
_ String
s) = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
    g (T_ParamSubSpecialChar Id
_ String
s) = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
    g (T_DollarSingleQuoted Id
_ String
s) = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String -> String
decodeEscapes String
s
    g Token
x = Token -> m String
more Token
x

    -- Bash style $'..' decoding
    decodeEscapes :: String -> String
decodeEscapes (Char
'\\':Char
c:String
cs) =
        case Char
c of
            Char
'a' -> Char
'\a' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'b' -> Char
'\b' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'e' -> Char
'\x1B' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'f' -> Char
'\f' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'n' -> Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'r' -> Char
'\r' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
't' -> Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'v' -> Char
'\v' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'\'' -> Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'"' -> Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'\\' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
'x' ->
                case String
cs of
                    (Char
x:Char
y:String
more) ->
                        if Char -> Bool
isHexDigit Char
x Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
y
                        then Int -> Char
chr (Int
16Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Char -> Int
digitToInt Char
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
digitToInt Char
y)) Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
                        else Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest
            Char
_ | Char -> Bool
isOctDigit Char
c ->
                let digits :: String
digits = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isOctDigit (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
                    num :: Int
num = String -> Int
parseOct String
digits
                in (if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 then Int -> Char
chr Int
num else Char
'?') Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
            Char
_ -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
      where
        rest :: String
rest = String -> String
decodeEscapes String
cs
        parseOct :: String -> Int
parseOct = Int -> String -> Int
f Int
0
          where
            f :: Int -> String -> Int
f Int
n String
"" = Int
n
            f Int
n (Char
c:String
rest) = Int -> String -> Int
f (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) String
rest
    decodeEscapes (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeEscapes String
cs
    decodeEscapes [] = []

-- Is this token a string literal?
isLiteral :: Token -> Bool
isLiteral Token
t = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getLiteralString Token
t

-- Escape user data for messages.
-- Messages generally avoid repeating user data, but sometimes it's helpful.
e4m :: String -> String
e4m = String -> String
escapeForMessage
escapeForMessage :: String -> String
escapeForMessage :: String -> String
escapeForMessage String
str = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
str
  where
    f :: Char -> String
f Char
'\\' = String
"\\\\"
    f Char
'\n' = String
"\\n"
    f Char
'\r' = String
"\\r"
    f Char
'\t' = String
"\\t"
    f Char
'\x1B' = String
"\\e"
    f Char
c =
        if Char -> Bool
shouldEscape Char
c
        then
            if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256
            then String
"\\x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
pad0 Int
2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
toHex Char
c)
            else String
"\\U" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
pad0 Int
4 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
toHex Char
c)
        else [Char
c]

    shouldEscape :: Char -> Bool
shouldEscape Char
c =
        (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isPrint Char
c)
        Bool -> Bool -> Bool
|| (Bool -> Bool
not (Char -> Bool
isAscii Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isLetter Char
c))

    pad0 :: Int -> String -> String
    pad0 :: Int -> String -> String
pad0 Int
n String
s =
        let l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s in
            if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
            then (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l) Char
'0') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
            else String
s
    toHex :: Char -> String
    toHex :: Char -> String
toHex Char
c = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (Char -> Int
ord Char
c) String
""

-- Turn a NormalWord like foo="bar $baz" into a series of constituent elements like [foo=,bar ,$baz]
getWordParts :: Token -> [Token]
getWordParts (T_NormalWord Id
_ [Token]
l)   = (Token -> [Token]) -> [Token] -> [Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [Token]
getWordParts [Token]
l
getWordParts (T_DoubleQuoted Id
_ [Token]
l) = [Token]
l
-- TA_Expansion is basically T_NormalWord for arithmetic expressions
getWordParts (TA_Expansion Id
_ [Token]
l)   = (Token -> [Token]) -> [Token] -> [Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [Token]
getWordParts [Token]
l
getWordParts Token
other                = [Token
other]

-- Return a list of NormalWords that would result from brace expansion
braceExpand :: Token -> [Token]
braceExpand (T_NormalWord Id
id [Token]
list) = Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
take Int
1000 ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ do
    [Token]
items <- (Token -> [Token]) -> [Token] -> [[Token]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> [Token]
part [Token]
list
    Token -> [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> [Token]) -> Token -> [Token]
forall a b. (a -> b) -> a -> b
$ Id -> [Token] -> Token
T_NormalWord Id
id [Token]
items
  where
    part :: Token -> [Token]
part (T_BraceExpansion Id
id [Token]
items) = do
        Token
item <- [Token]
items
        Token -> [Token]
braceExpand Token
item
    part Token
x = Token -> [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return Token
x

-- Maybe get a SimpleCommand from immediate wrappers like T_Redirections
getCommand :: Token -> Maybe Token
getCommand Token
t =
    case Token
t of
        T_Redirecting Id
_ [Token]
_ Token
w -> Token -> Maybe Token
getCommand Token
w
        T_SimpleCommand Id
_ [Token]
_ (Token
w:[Token]
_) -> Token -> Maybe Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
t
        T_Annotation Id
_ [Annotation]
_ Token
t -> Token -> Maybe Token
getCommand Token
t
        Token
_ -> Maybe Token
forall a. Maybe a
Nothing

-- Maybe get the command name string of a token representing a command
getCommandName :: Token -> Maybe String
getCommandName :: Token -> Maybe String
getCommandName = (Maybe String, Token) -> Maybe String
forall a b. (a, b) -> a
fst ((Maybe String, Token) -> Maybe String)
-> (Token -> (Maybe String, Token)) -> Token -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Token -> (Maybe String, Token)
getCommandNameAndToken Bool
False

-- Maybe get the name+arguments of a command.
getCommandArgv :: Token -> Maybe [Token]
getCommandArgv Token
t = do
    (T_SimpleCommand Id
_ [Token]
_ args :: [Token]
args@(Token
_:[Token]
_)) <- Token -> Maybe Token
getCommand Token
t
    [Token] -> Maybe [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return [Token]
args

-- Get the command name token from a command, i.e.
-- the token representing 'ls' in 'ls -la 2> foo'.
-- If it can't be determined, return the original token.
getCommandTokenOrThis :: Token -> Token
getCommandTokenOrThis = (Maybe String, Token) -> Token
forall a b. (a, b) -> b
snd ((Maybe String, Token) -> Token)
-> (Token -> (Maybe String, Token)) -> Token -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Token -> (Maybe String, Token)
getCommandNameAndToken Bool
False

-- Given a command, get the string and token that represents the command name.
-- If direct, return the actual command (e.g. exec in 'exec ls')
-- If not, return the logical command (e.g. 'ls' in 'exec ls')

getCommandNameAndToken :: Bool -> Token -> (Maybe String, Token)
getCommandNameAndToken :: Bool -> Token -> (Maybe String, Token)
getCommandNameAndToken Bool
direct Token
t = (Maybe String, Token)
-> Maybe (Maybe String, Token) -> (Maybe String, Token)
forall a. a -> Maybe a -> a
fromMaybe (Maybe String
forall a. Maybe a
Nothing, Token
t) (Maybe (Maybe String, Token) -> (Maybe String, Token))
-> Maybe (Maybe String, Token) -> (Maybe String, Token)
forall a b. (a -> b) -> a -> b
$ do
    cmd :: Token
cmd@(T_SimpleCommand Id
_ [Token]
_ (Token
w:[Token]
rest)) <- Token -> Maybe Token
getCommand Token
t
    String
s <- Token -> Maybe String
getLiteralString Token
w
    (Maybe String, Token) -> Maybe (Maybe String, Token)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe String, Token) -> Maybe (Maybe String, Token))
-> (Maybe String, Token) -> Maybe (Maybe String, Token)
forall a b. (a -> b) -> a -> b
$ (Maybe String, Token)
-> Maybe (Maybe String, Token) -> (Maybe String, Token)
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe String
forall a. a -> Maybe a
Just String
s, Token
w) (Maybe (Maybe String, Token) -> (Maybe String, Token))
-> Maybe (Maybe String, Token) -> (Maybe String, Token)
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
direct
        Token
actual <- String -> Token -> [Token] -> Maybe Token
forall {p}. String -> p -> [Token] -> Maybe Token
getEffectiveCommandToken String
s Token
cmd [Token]
rest
        (Maybe String, Token) -> Maybe (Maybe String, Token)
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Maybe String
getLiteralString Token
actual, Token
actual)
  where
    getEffectiveCommandToken :: String -> p -> [Token] -> Maybe Token
getEffectiveCommandToken String
str p
cmd [Token]
args =
        let
            firstArg :: Maybe Token
firstArg = do
                Token
arg <- [Token] -> Maybe Token
forall a. [a] -> Maybe a
listToMaybe [Token]
args
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (Bool -> Bool) -> Bool -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Token -> Bool
isFlag Token
arg
                Token -> Maybe Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
arg
        in
            case String
str of
                String
"busybox" -> Maybe Token
firstArg
                String
"builtin" -> Maybe Token
firstArg
                String
"command" -> Maybe Token
firstArg
                String
"run" -> Maybe Token
firstArg -- Used by bats
                String
"exec" -> do
                    [(String, (Token, Token))]
opts <- String -> [Token] -> Maybe [(String, (Token, Token))]
getBsdOpts String
"cla:" [Token]
args
                    (String
_, (Token
t, Token
_)) <- ((String, (Token, Token)) -> Bool)
-> [(String, (Token, Token))] -> Maybe (String, (Token, Token))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> ((String, (Token, Token)) -> String)
-> (String, (Token, Token))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (Token, Token)) -> String
forall a b. (a, b) -> a
fst) [(String, (Token, Token))]
opts
                    Token -> Maybe Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
t
                String
_ -> String -> Maybe Token
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""

-- If a command substitution is a single command, get its name.
--  $(date +%s) = Just "date"
getCommandNameFromExpansion :: Token -> Maybe String
getCommandNameFromExpansion :: Token -> Maybe String
getCommandNameFromExpansion Token
t =
    case Token
t of
        T_DollarExpansion Id
_ [Token
c] -> Token -> Maybe String
extract Token
c
        T_Backticked Id
_ [Token
c] -> Token -> Maybe String
extract Token
c
        T_DollarBraceCommandExpansion Id
_ [Token
c] -> Token -> Maybe String
extract Token
c
        Token
_ -> Maybe String
forall a. Maybe a
Nothing
  where
    extract :: Token -> Maybe String
extract (T_Pipeline Id
_ [Token]
_ [Token
cmd]) = Token -> Maybe String
getCommandName Token
cmd
    extract Token
_ = Maybe String
forall a. Maybe a
Nothing

-- Get the basename of a token representing a command
getCommandBasename :: Token -> Maybe String
getCommandBasename = (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
basename (Maybe String -> Maybe String)
-> (Token -> Maybe String) -> Token -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Maybe String
getCommandName

basename :: String -> String
basename = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

isAssignment :: Token -> Bool
isAssignment Token
t =
    case Token
t of
        T_Redirecting Id
_ [Token]
_ Token
w -> Token -> Bool
isAssignment Token
w
        T_SimpleCommand Id
_ (Token
w:[Token]
_) [] -> Bool
True
        T_Assignment {} -> Bool
True
        T_Annotation Id
_ [Annotation]
_ Token
w -> Token -> Bool
isAssignment Token
w
        Token
_ -> Bool
False

isOnlyRedirection :: Token -> Bool
isOnlyRedirection Token
t =
    case Token
t of
        T_Pipeline Id
_ [Token]
_ [Token
x] -> Token -> Bool
isOnlyRedirection Token
x
        T_Annotation Id
_ [Annotation]
_ Token
w -> Token -> Bool
isOnlyRedirection Token
w
        T_Redirecting Id
_ (Token
_:[Token]
_) Token
c -> Token -> Bool
isOnlyRedirection Token
c
        T_SimpleCommand Id
_ [] [] -> Bool
True
        Token
_ -> Bool
False

isFunction :: Token -> Bool
isFunction Token
t = case Token
t of T_Function {} -> Bool
True; Token
_ -> Bool
False

-- Bats tests are functions for the purpose of 'local' and such
isFunctionLike :: Token -> Bool
isFunctionLike Token
t =
    case Token
t of
        T_Function {} -> Bool
True
        T_BatsTest {} -> Bool
True
        Token
_ -> Bool
False


isBraceExpansion :: Token -> Bool
isBraceExpansion Token
t = case Token
t of T_BraceExpansion {} -> Bool
True; Token
_ -> Bool
False

-- Get the lists of commands from tokens that contain them, such as
-- the conditions and bodies of while loops or branches of if statements.
getCommandSequences :: Token -> [[Token]]
getCommandSequences :: Token -> [[Token]]
getCommandSequences Token
t =
    case Token
t of
        T_Script Id
_ Token
_ [Token]
cmds -> [[Token]
cmds]
        T_BraceGroup Id
_ [Token]
cmds -> [[Token]
cmds]
        T_Subshell Id
_ [Token]
cmds -> [[Token]
cmds]
        T_WhileExpression Id
_ [Token]
cond [Token]
cmds -> [[Token]
cond, [Token]
cmds]
        T_UntilExpression Id
_ [Token]
cond [Token]
cmds -> [[Token]
cond, [Token]
cmds]
        T_ForIn Id
_ String
_ [Token]
_ [Token]
cmds -> [[Token]
cmds]
        T_ForArithmetic Id
_ Token
_ Token
_ Token
_ [Token]
cmds -> [[Token]
cmds]
        T_IfExpression Id
_ [([Token], [Token])]
thens [Token]
elses -> ((([Token], [Token]) -> [[Token]])
-> [([Token], [Token])] -> [[Token]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Token]
a,[Token]
b) -> [[Token]
a,[Token]
b]) [([Token], [Token])]
thens) [[Token]] -> [[Token]] -> [[Token]]
forall a. [a] -> [a] -> [a]
++ [[Token]
elses]
        T_Annotation Id
_ [Annotation]
_ Token
t -> Token -> [[Token]]
getCommandSequences Token
t

        T_DollarExpansion Id
_ [Token]
cmds -> [[Token]
cmds]
        T_DollarBraceCommandExpansion Id
_ [Token]
cmds -> [[Token]
cmds]
        T_Backticked Id
_ [Token]
cmds -> [[Token]
cmds]
        Token
_ -> []

-- Get a list of names of associative arrays
getAssociativeArrays :: Token -> [String]
getAssociativeArrays Token
t =
    [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> (Writer [String] Token -> [String])
-> Writer [String] Token
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [String] Token -> [String]
forall w a. Writer w a -> w
execWriter (Writer [String] Token -> [String])
-> Writer [String] Token -> [String]
forall a b. (a -> b) -> a -> b
$ (Token -> WriterT [String] Identity ())
-> Token -> Writer [String] Token
forall (m :: * -> *).
Monad m =>
(Token -> m ()) -> Token -> m Token
doAnalysis Token -> WriterT [String] Identity ()
f Token
t
  where
    f :: Token -> Writer [String] ()
    f :: Token -> WriterT [String] Identity ()
f t :: Token
t@T_SimpleCommand {} = Maybe (WriterT [String] Identity ())
-> WriterT [String] Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (WriterT [String] Identity ())
 -> WriterT [String] Identity ())
-> Maybe (WriterT [String] Identity ())
-> WriterT [String] Identity ()
forall a b. (a -> b) -> a -> b
$ do
        String
name <- Token -> Maybe String
getCommandName Token
t
        let assocNames :: [String]
assocNames = [String
"declare",String
"local",String
"typeset"]
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
assocNames
        let flags :: [(Token, String)]
flags = Token -> [(Token, String)]
getAllFlags Token
t
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String
"A" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Token, String) -> String) -> [(Token, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Token, String) -> String
forall a b. (a, b) -> b
snd [(Token, String)]
flags
        let args :: [Token]
args = [Token
arg | (Token
arg, String
"") <- [(Token, String)]
flags]
        let names :: [String]
names = (Token -> Maybe String) -> [Token] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Token -> Maybe String) -> Token -> Maybe String
forall (m :: * -> *).
Monad m =>
(Token -> m String) -> Token -> m String
getLiteralStringExt Token -> Maybe String
nameAssignments) [Token]
args
        WriterT [String] Identity ()
-> Maybe (WriterT [String] Identity ())
forall (m :: * -> *) a. Monad m => a -> m a
return (WriterT [String] Identity ()
 -> Maybe (WriterT [String] Identity ()))
-> WriterT [String] Identity ()
-> Maybe (WriterT [String] Identity ())
forall a b. (a -> b) -> a -> b
$ [String] -> WriterT [String] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String]
names
    f Token
_ = () -> WriterT [String] Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    nameAssignments :: Token -> Maybe String
nameAssignments Token
t =
        case Token
t of
            T_Assignment Id
_ AssignmentMode
_ String
name [Token]
_ Token
_ -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
            Token
_ -> Maybe String
forall a. Maybe a
Nothing

-- A Pseudoglob is a wildcard pattern used for checking if a match can succeed.
-- For example, [[ $(cmd).jpg == [a-z] ]] will give the patterns *.jpg and ?, which
-- can be proven never to match.
data PseudoGlob = PGAny | PGMany | PGChar Char
    deriving (PseudoGlob -> PseudoGlob -> Bool
(PseudoGlob -> PseudoGlob -> Bool)
-> (PseudoGlob -> PseudoGlob -> Bool) -> Eq PseudoGlob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PseudoGlob -> PseudoGlob -> Bool
$c/= :: PseudoGlob -> PseudoGlob -> Bool
== :: PseudoGlob -> PseudoGlob -> Bool
$c== :: PseudoGlob -> PseudoGlob -> Bool
Eq, Int -> PseudoGlob -> String -> String
[PseudoGlob] -> String -> String
PseudoGlob -> String
(Int -> PseudoGlob -> String -> String)
-> (PseudoGlob -> String)
-> ([PseudoGlob] -> String -> String)
-> Show PseudoGlob
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PseudoGlob] -> String -> String
$cshowList :: [PseudoGlob] -> String -> String
show :: PseudoGlob -> String
$cshow :: PseudoGlob -> String
showsPrec :: Int -> PseudoGlob -> String -> String
$cshowsPrec :: Int -> PseudoGlob -> String -> String
Show)

-- Turn a word into a PG pattern, replacing all unknown/runtime values with
-- PGMany.
wordToPseudoGlob :: Token -> [PseudoGlob]
wordToPseudoGlob :: Token -> [PseudoGlob]
wordToPseudoGlob = [PseudoGlob] -> Maybe [PseudoGlob] -> [PseudoGlob]
forall a. a -> Maybe a -> a
fromMaybe [PseudoGlob
PGMany] (Maybe [PseudoGlob] -> [PseudoGlob])
-> (Token -> Maybe [PseudoGlob]) -> Token -> [PseudoGlob]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Token -> Maybe [PseudoGlob]
wordToPseudoGlob' Bool
False

-- Turn a word into a PG pattern, but only if we can preserve
-- exact semantics.
wordToExactPseudoGlob :: Token -> Maybe [PseudoGlob]
wordToExactPseudoGlob :: Token -> Maybe [PseudoGlob]
wordToExactPseudoGlob = Bool -> Token -> Maybe [PseudoGlob]
wordToPseudoGlob' Bool
True

wordToPseudoGlob' :: Bool -> Token -> Maybe [PseudoGlob]
wordToPseudoGlob' :: Bool -> Token -> Maybe [PseudoGlob]
wordToPseudoGlob' Bool
exact Token
word =
    [PseudoGlob] -> [PseudoGlob]
simplifyPseudoGlob ([PseudoGlob] -> [PseudoGlob])
-> Maybe [PseudoGlob] -> Maybe [PseudoGlob]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> Maybe [PseudoGlob]
toGlob Token
word
  where
    toGlob :: Token -> Maybe [PseudoGlob]
    toGlob :: Token -> Maybe [PseudoGlob]
toGlob Token
word =
        case Token
word of
            T_NormalWord Id
_ (T_Literal Id
_ (Char
'~':String
str):[Token]
rest) -> do
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
exact
                let this :: [PseudoGlob]
this = (PseudoGlob
PGMany PseudoGlob -> [PseudoGlob] -> [PseudoGlob]
forall a. a -> [a] -> [a]
: ((Char -> PseudoGlob) -> String -> [PseudoGlob]
forall a b. (a -> b) -> [a] -> [b]
map Char -> PseudoGlob
PGChar (String -> [PseudoGlob]) -> String -> [PseudoGlob]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') String
str))
                [PseudoGlob]
tail <- [[PseudoGlob]] -> [PseudoGlob]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PseudoGlob]] -> [PseudoGlob])
-> Maybe [[PseudoGlob]] -> Maybe [PseudoGlob]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Token -> Maybe [PseudoGlob]) -> [Token] -> Maybe [[PseudoGlob]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> Maybe [PseudoGlob]
forall {m :: * -> *}. MonadFail m => Token -> m [PseudoGlob]
f ([Token] -> Maybe [[PseudoGlob]])
-> [Token] -> Maybe [[PseudoGlob]]
forall a b. (a -> b) -> a -> b
$ (Token -> [Token]) -> [Token] -> [Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [Token]
getWordParts [Token]
rest)
                [PseudoGlob] -> Maybe [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PseudoGlob] -> Maybe [PseudoGlob])
-> [PseudoGlob] -> Maybe [PseudoGlob]
forall a b. (a -> b) -> a -> b
$ [PseudoGlob]
this [PseudoGlob] -> [PseudoGlob] -> [PseudoGlob]
forall a. [a] -> [a] -> [a]
++ [PseudoGlob]
tail
            Token
_ -> [[PseudoGlob]] -> [PseudoGlob]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PseudoGlob]] -> [PseudoGlob])
-> Maybe [[PseudoGlob]] -> Maybe [PseudoGlob]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Token -> Maybe [PseudoGlob]) -> [Token] -> Maybe [[PseudoGlob]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> Maybe [PseudoGlob]
forall {m :: * -> *}. MonadFail m => Token -> m [PseudoGlob]
f ([Token] -> Maybe [[PseudoGlob]])
-> [Token] -> Maybe [[PseudoGlob]]
forall a b. (a -> b) -> a -> b
$ Token -> [Token]
getWordParts Token
word)

    f :: Token -> m [PseudoGlob]
f Token
x = case Token
x of
        T_Literal Id
_ String
s      -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PseudoGlob] -> m [PseudoGlob]) -> [PseudoGlob] -> m [PseudoGlob]
forall a b. (a -> b) -> a -> b
$ (Char -> PseudoGlob) -> String -> [PseudoGlob]
forall a b. (a -> b) -> [a] -> [b]
map Char -> PseudoGlob
PGChar String
s
        T_SingleQuoted Id
_ String
s -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PseudoGlob] -> m [PseudoGlob]) -> [PseudoGlob] -> m [PseudoGlob]
forall a b. (a -> b) -> a -> b
$ (Char -> PseudoGlob) -> String -> [PseudoGlob]
forall a b. (a -> b) -> [a] -> [b]
map Char -> PseudoGlob
PGChar String
s
        T_Glob Id
_ String
"?"       -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGAny]
        T_Glob Id
_ String
"*"       -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]
        T_Glob Id
_ (Char
'[':String
_) | Bool -> Bool
not Bool
exact -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGAny]
        Token
_ -> if Bool
exact then String -> m [PseudoGlob]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"" else [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]


-- Reorder a PseudoGlob for more efficient matching, e.g.
-- f?*?**g -> f??*g
simplifyPseudoGlob :: [PseudoGlob] -> [PseudoGlob]
simplifyPseudoGlob :: [PseudoGlob] -> [PseudoGlob]
simplifyPseudoGlob = [PseudoGlob] -> [PseudoGlob]
f
  where
    f :: [PseudoGlob] -> [PseudoGlob]
f [] = []
    f (x :: PseudoGlob
x@(PGChar Char
_) : [PseudoGlob]
rest ) = PseudoGlob
x PseudoGlob -> [PseudoGlob] -> [PseudoGlob]
forall a. a -> [a] -> [a]
: [PseudoGlob] -> [PseudoGlob]
f [PseudoGlob]
rest
    f [PseudoGlob]
list =
        let ([PseudoGlob]
anys, [PseudoGlob]
rest) = (PseudoGlob -> Bool)
-> [PseudoGlob] -> ([PseudoGlob], [PseudoGlob])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\PseudoGlob
x -> PseudoGlob
x PseudoGlob -> PseudoGlob -> Bool
forall a. Eq a => a -> a -> Bool
== PseudoGlob
PGMany Bool -> Bool -> Bool
|| PseudoGlob
x PseudoGlob -> PseudoGlob -> Bool
forall a. Eq a => a -> a -> Bool
== PseudoGlob
PGAny) [PseudoGlob]
list in
            [PseudoGlob] -> [PseudoGlob]
order [PseudoGlob]
anys [PseudoGlob] -> [PseudoGlob] -> [PseudoGlob]
forall a. [a] -> [a] -> [a]
++ [PseudoGlob] -> [PseudoGlob]
f [PseudoGlob]
rest

    order :: [PseudoGlob] -> [PseudoGlob]
order [PseudoGlob]
s = let ([PseudoGlob]
any, [PseudoGlob]
many) = (PseudoGlob -> Bool)
-> [PseudoGlob] -> ([PseudoGlob], [PseudoGlob])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (PseudoGlob -> PseudoGlob -> Bool
forall a. Eq a => a -> a -> Bool
== PseudoGlob
PGAny) [PseudoGlob]
s in
        [PseudoGlob]
any [PseudoGlob] -> [PseudoGlob] -> [PseudoGlob]
forall a. [a] -> [a] -> [a]
++ Int -> [PseudoGlob] -> [PseudoGlob]
forall a. Int -> [a] -> [a]
take Int
1 [PseudoGlob]
many

-- Check whether the two patterns can ever overlap.
pseudoGlobsCanOverlap :: [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobsCanOverlap :: [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobsCanOverlap = [PseudoGlob] -> [PseudoGlob] -> Bool
matchable
  where
    matchable :: [PseudoGlob] -> [PseudoGlob] -> Bool
matchable x :: [PseudoGlob]
x@(PseudoGlob
xf:[PseudoGlob]
xs) y :: [PseudoGlob]
y@(PseudoGlob
yf:[PseudoGlob]
ys) =
        case (PseudoGlob
xf, PseudoGlob
yf) of
            (PseudoGlob
PGMany, PseudoGlob
_) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys Bool -> Bool -> Bool
|| [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
y
            (PseudoGlob
_, PseudoGlob
PGMany) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys Bool -> Bool -> Bool
|| [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
y
            (PseudoGlob
PGAny, PseudoGlob
_) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys
            (PseudoGlob
_, PseudoGlob
PGAny) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys
            (PseudoGlob
_, PseudoGlob
_) -> PseudoGlob
xf PseudoGlob -> PseudoGlob -> Bool
forall a. Eq a => a -> a -> Bool
== PseudoGlob
yf Bool -> Bool -> Bool
&& [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys

    matchable [] [] = Bool
True
    matchable (PseudoGlob
PGMany : [PseudoGlob]
rest) [] = [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
rest []
    matchable (PseudoGlob
_:[PseudoGlob]
_) [] = Bool
False
    matchable [] [PseudoGlob]
r = [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
r []

-- Check whether the first pattern always overlaps the second.
pseudoGlobIsSuperSetof :: [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobIsSuperSetof :: [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobIsSuperSetof = [PseudoGlob] -> [PseudoGlob] -> Bool
matchable
  where
    matchable :: [PseudoGlob] -> [PseudoGlob] -> Bool
matchable x :: [PseudoGlob]
x@(PseudoGlob
xf:[PseudoGlob]
xs) y :: [PseudoGlob]
y@(PseudoGlob
yf:[PseudoGlob]
ys) =
        case (PseudoGlob
xf, PseudoGlob
yf) of
            (PseudoGlob
PGMany, PseudoGlob
PGMany) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys
            (PseudoGlob
PGMany, PseudoGlob
_) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys Bool -> Bool -> Bool
|| [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
y
            (PseudoGlob
_, PseudoGlob
PGMany) -> Bool
False
            (PseudoGlob
PGAny, PseudoGlob
_) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys
            (PseudoGlob
_, PseudoGlob
PGAny) -> Bool
False
            (PseudoGlob
_, PseudoGlob
_) -> PseudoGlob
xf PseudoGlob -> PseudoGlob -> Bool
forall a. Eq a => a -> a -> Bool
== PseudoGlob
yf Bool -> Bool -> Bool
&& [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys

    matchable [] [] = Bool
True
    matchable (PseudoGlob
PGMany : [PseudoGlob]
rest) [] = [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
rest []
    matchable [PseudoGlob]
_ [PseudoGlob]
_ = Bool
False

wordsCanBeEqual :: Token -> Token -> Bool
wordsCanBeEqual Token
x Token
y = [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobsCanOverlap (Token -> [PseudoGlob]
wordToPseudoGlob Token
x) (Token -> [PseudoGlob]
wordToPseudoGlob Token
y)

-- Is this an expansion that can be quoted,
-- e.g. $(foo) `foo` $foo (but not {foo,})?
isQuoteableExpansion :: Token -> Bool
isQuoteableExpansion Token
t = case Token
t of
    T_DollarBraced {} -> Bool
True
    Token
_ -> Token -> Bool
isCommandSubstitution Token
t

isCommandSubstitution :: Token -> Bool
isCommandSubstitution Token
t = case Token
t of
    T_DollarExpansion {} -> Bool
True
    T_DollarBraceCommandExpansion {} -> Bool
True
    T_Backticked {} -> Bool
True
    Token
_ -> Bool
False

-- Is this an expansion that results in a simple string?
isStringExpansion :: Token -> Bool
isStringExpansion Token
t = Token -> Bool
isCommandSubstitution Token
t Bool -> Bool -> Bool
|| case Token
t of
    T_DollarArithmetic {} -> Bool
True
    T_DollarBraced {} -> Bool -> Bool
not (Token -> Bool
isArrayExpansion Token
t)
    Token
_ -> Bool
False

-- Is this a T_Annotation that ignores a specific code?
isAnnotationIgnoringCode :: Integer -> Token -> Bool
isAnnotationIgnoringCode Integer
code Token
t =
    case Token
t of
        T_Annotation Id
_ [Annotation]
anns Token
_ -> (Annotation -> Bool) -> [Annotation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Annotation -> Bool
hasNum [Annotation]
anns
        Token
_ -> Bool
False
  where
    hasNum :: Annotation -> Bool
hasNum (DisableComment Integer
from Integer
to) = Integer
code Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
from Bool -> Bool -> Bool
&& Integer
code Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
to
    hasNum Annotation
_                   = Bool
False

prop_executableFromShebang1 :: Bool
prop_executableFromShebang1 = String -> String
executableFromShebang String
"/bin/sh" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sh"
prop_executableFromShebang2 :: Bool
prop_executableFromShebang2 = String -> String
executableFromShebang String
"/bin/bash" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bash"
prop_executableFromShebang3 :: Bool
prop_executableFromShebang3 = String -> String
executableFromShebang String
"/usr/bin/env ksh" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ksh"
prop_executableFromShebang4 :: Bool
prop_executableFromShebang4 = String -> String
executableFromShebang String
"/usr/bin/env -S foo=bar bash -x" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bash"
prop_executableFromShebang5 :: Bool
prop_executableFromShebang5 = String -> String
executableFromShebang String
"/usr/bin/env --split-string=bash -x" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bash"
prop_executableFromShebang6 :: Bool
prop_executableFromShebang6 = String -> String
executableFromShebang String
"/usr/bin/env --split-string=foo=bar bash -x" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bash"
prop_executableFromShebang7 :: Bool
prop_executableFromShebang7 = String -> String
executableFromShebang String
"/usr/bin/env --split-string bash -x" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bash"
prop_executableFromShebang8 :: Bool
prop_executableFromShebang8 = String -> String
executableFromShebang String
"/usr/bin/env --split-string foo=bar bash -x" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bash"
prop_executableFromShebang9 :: Bool
prop_executableFromShebang9 = String -> String
executableFromShebang String
"/usr/bin/env foo=bar dash" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dash"
prop_executableFromShebang10 :: Bool
prop_executableFromShebang10 = String -> String
executableFromShebang String
"/bin/busybox sh" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ash"
prop_executableFromShebang11 :: Bool
prop_executableFromShebang11 = String -> String
executableFromShebang String
"/bin/busybox ash" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ash"

-- Get the shell executable from a string like '/usr/bin/env bash'
executableFromShebang :: String -> String
executableFromShebang :: String -> String
executableFromShebang = String -> String
shellFor
  where
    re :: Regex
re = String -> Regex
mkRegex String
"/env +(-S|--split-string=?)? *(.*)"
    shellFor :: String -> String
shellFor String
s | String
s String -> Regex -> Bool
`matches` Regex
re =
        case Regex -> String -> Maybe [String]
matchRegex Regex
re String
s of
            Just [String
flag, String
shell] -> [String] -> String
fromEnvArgs (String -> [String]
words String
shell)
            Maybe [String]
_ -> String
""
    shellFor String
sb =
        case String -> [String]
words String
sb of
            [] -> String
""
            [String
x] -> String -> String
basename String
x
            (String
first:String
second:[String]
args) | String -> String
basename String
first String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"busybox" ->
                case String -> String
basename String
second of
                   String
"sh" -> String
"ash" -- busybox sh is ash
                   String
x -> String
x
            (String
first:[String]
args) | String -> String
basename String
first String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"env" ->
                [String] -> String
fromEnvArgs [String]
args
            (String
first:[String]
_) -> String -> String
basename String
first

    fromEnvArgs :: [String] -> String
fromEnvArgs [String]
args = 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
$ (String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
'=') ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
skipFlags [String]
args
    basename :: String -> String
basename String
s = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
s
    skipFlags :: [String] -> [String]
skipFlags = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

return []
runTests :: IO Bool
runTests = $Bool
String
[(String, Property)]
Bool -> Property
[(String, Property)] -> (Property -> IO Result) -> IO Bool
Property -> IO Result
forall prop. Testable prop => prop -> IO Result
forall prop. Testable prop => prop -> Property
runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
property :: forall prop. Testable prop => prop -> Property
quickCheckResult :: forall prop. Testable prop => prop -> IO Result
prop_executableFromShebang11 :: Bool
prop_executableFromShebang10 :: Bool
prop_executableFromShebang9 :: Bool
prop_executableFromShebang8 :: Bool
prop_executableFromShebang7 :: Bool
prop_executableFromShebang6 :: Bool
prop_executableFromShebang5 :: Bool
prop_executableFromShebang4 :: Bool
prop_executableFromShebang3 :: Bool
prop_executableFromShebang2 :: Bool
prop_executableFromShebang1 :: Bool
quickCheckAll