{-
    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 _ _ (cmd :: Token
cmd:args :: [Token]
args)) = [Token]
args

-- Is this a type of loop?
isLoop :: Token -> Bool
isLoop t :: 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
        _ -> Bool
False

-- Will this split into multiple words when used as an argument?
willSplit :: Token -> Bool
willSplit x :: 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 _ l :: [Token]
l -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willBecomeMultipleArgs [Token]
l
    T_NormalWord _ l :: [Token]
l -> (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willSplit [Token]
l
    _ -> Bool
False

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

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

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

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


-- 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 :: ([Char] -> Bool) -> Token -> [(Token, [Char])]
getFlagsUntil stopCondition :: [Char] -> Bool
stopCondition (T_SimpleCommand _ _ (_:args :: [Token]
args)) =
    let tokenAndText :: [(Token, [Char])]
tokenAndText = (Token -> (Token, [Char])) -> [Token] -> [(Token, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Token
x -> (Token
x, [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Token -> [[Char]]
oversimplify Token
x)) [Token]
args
        (flagArgs :: [(Token, [Char])]
flagArgs, rest :: [(Token, [Char])]
rest) = ((Token, [Char]) -> Bool)
-> [(Token, [Char])] -> ([(Token, [Char])], [(Token, [Char])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([Char] -> Bool
stopCondition ([Char] -> Bool)
-> ((Token, [Char]) -> [Char]) -> (Token, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token, [Char]) -> [Char]
forall a b. (a, b) -> b
snd) [(Token, [Char])]
tokenAndText
    in
        ((Token, [Char]) -> [(Token, [Char])])
-> [(Token, [Char])] -> [(Token, [Char])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Token, [Char]) -> [(Token, [Char])]
forall a. (a, [Char]) -> [(a, [Char])]
flag [(Token, [Char])]
flagArgs [(Token, [Char])] -> [(Token, [Char])] -> [(Token, [Char])]
forall a. [a] -> [a] -> [a]
++ ((Token, [Char]) -> (Token, [Char]))
-> [(Token, [Char])] -> [(Token, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (\(t :: Token
t, _) -> (Token
t, "")) [(Token, [Char])]
rest
  where
    flag :: (a, [Char]) -> [(a, [Char])]
flag (x :: a
x, '-':'-':arg :: [Char]
arg) = [ (a
x, (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '=') [Char]
arg) ]
    flag (x :: a
x, '-':args :: [Char]
args) = (Char -> (a, [Char])) -> [Char] -> [(a, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (\v :: Char
v -> (a
x, [Char
v])) [Char]
args
    flag (x :: a
x, _) = [ (a
x, "") ]
getFlagsUntil _ _ = [Char] -> [(Token, [Char])]
forall a. HasCallStack => [Char] -> a
error "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, [Char])]
getAllFlags = ([Char] -> Bool) -> Token -> [(Token, [Char])]
getFlagsUntil ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "--")
-- Get all flags in a BSD way, up until first non-flag argument or --
getLeadingFlags :: Token -> [(Token, [Char])]
getLeadingFlags = ([Char] -> Bool) -> Token -> [(Token, [Char])]
getFlagsUntil (\x :: [Char]
x -> [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "--" Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ "-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x))

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

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

-- Is this token a flag where the - is unquoted?
isUnquotedFlag :: Token -> Bool
isUnquotedFlag token :: 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
    [Char]
str <- Token -> Maybe [Char]
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
$ "-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
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 :: [Char] -> [Token] -> Maybe [([Char], (Token, Token))]
getGnuOpts str :: [Char]
str args :: [Token]
args = (Bool, Bool)
-> [Char]
-> [([Char], Bool)]
-> [Token]
-> Maybe [([Char], (Token, Token))]
getOpts (Bool
True, Bool
False) [Char]
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 :: [Char] -> [Token] -> Maybe [([Char], (Token, Token))]
getBsdOpts str :: [Char]
str args :: [Token]
args = (Bool, Bool)
-> [Char]
-> [([Char], Bool)]
-> [Token]
-> Maybe [([Char], (Token, Token))]
getOpts (Bool
False, Bool
False) [Char]
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)
-> [Char]
-> [([Char], Bool)]
-> [Token]
-> Maybe [([Char], (Token, Token))]
getOpts (gnu :: Bool
gnu, arbitraryLongOpts :: Bool
arbitraryLongOpts) string :: [Char]
string longopts :: [([Char], Bool)]
longopts args :: [Token]
args = [Token] -> Maybe [([Char], (Token, Token))]
process [Token]
args
  where
    flagList :: [Char] -> [([Char], Bool)]
flagList (c :: Char
c:':':rest :: [Char]
rest) = ([Char
c], Bool
True) ([Char], Bool) -> [([Char], Bool)] -> [([Char], Bool)]
forall a. a -> [a] -> [a]
: [Char] -> [([Char], Bool)]
flagList [Char]
rest
    flagList (c :: Char
c:rest :: [Char]
rest)     = ([Char
c], Bool
False) ([Char], Bool) -> [([Char], Bool)] -> [([Char], Bool)]
forall a. a -> [a] -> [a]
: [Char] -> [([Char], Bool)]
flagList [Char]
rest
    flagList []           = [([Char], Bool)]
longopts
    flagMap :: Map [Char] Bool
flagMap = [([Char], Bool)] -> Map [Char] Bool
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], Bool)] -> Map [Char] Bool)
-> [([Char], Bool)] -> Map [Char] Bool
forall a b. (a -> b) -> a -> b
$ ("", Bool
False) ([Char], Bool) -> [([Char], Bool)] -> [([Char], Bool)]
forall a. a -> [a] -> [a]
: [Char] -> [([Char], Bool)]
flagList [Char]
string

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

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

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

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

-- Is this an expansion of multiple items of an array?
isArrayExpansion :: Token -> Bool
isArrayExpansion (T_DollarBraced _ _ l :: Token
l) =
    let string :: [Char]
string = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Token -> [[Char]]
oversimplify Token
l in
        "@" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
string Bool -> Bool -> Bool
||
            Bool -> Bool
not ("#" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
string) Bool -> Bool -> Bool
&& "[@]" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
string
isArrayExpansion _ = Bool
False

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

-- Is it certain that this word will becomes multiple words?
willBecomeMultipleArgs :: Token -> Bool
willBecomeMultipleArgs t :: 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 _ parts :: [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 _ parts :: [Token]
parts) = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
f [Token]
parts
    f _ = Bool
False

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

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

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

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

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

isQuotes :: Token -> Bool
isQuotes t :: Token
t =
    case Token
t of
        T_DoubleQuoted {} -> Bool
True
        T_SingleQuoted {} -> Bool
True
        _ -> 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 t :: Token
t =
    case Token
t of
        (T_NormalWord _ list :: [Token]
list@(_:_)) ->
            Token -> Maybe Token
from ([Token] -> Token
forall a. [a] -> a
last [Token]
list)
        _ -> Maybe Token
forall a. Maybe a
Nothing
  where
    from :: Token -> Maybe Token
from t :: Token
t =
        case Token
t of
            T_Literal {} -> Token -> Maybe Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
t
            _ -> 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 [Char]
getLeadingUnquotedString t :: Token
t =
    case Token
t of
        T_NormalWord _ ((T_Literal _ s :: [Char]
s) : rest :: [Token]
rest) -> [Char] -> Maybe [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Token] -> [Char]
from [Token]
rest
        _ -> Maybe [Char]
forall a. Maybe a
Nothing
  where
    from :: [Token] -> [Char]
from ((T_Literal _ s :: [Char]
s):rest :: [Token]
rest) = [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Token] -> [Char]
from [Token]
rest
    from _ = ""

-- Maybe get the literal string of this token and any globs in it.
getGlobOrLiteralString :: Token -> Maybe [Char]
getGlobOrLiteralString = (Token -> Maybe [Char]) -> Token -> Maybe [Char]
forall (m :: * -> *).
Monad m =>
(Token -> m [Char]) -> Token -> m [Char]
getLiteralStringExt Token -> Maybe [Char]
f
  where
    f :: Token -> Maybe [Char]
f (T_Glob _ str :: [Char]
str) = [Char] -> Maybe [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
str
    f _ = Maybe [Char]
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 :: (Token -> m [Char]) -> Token -> m [Char]
getLiteralStringExt more :: Token -> m [Char]
more = Token -> m [Char]
g
  where
    allInList :: [Token] -> m [Char]
allInList = ([[Char]] -> [Char]) -> m [[Char]] -> m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[Char]] -> m [Char])
-> ([Token] -> m [[Char]]) -> [Token] -> m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> m [Char]) -> [Token] -> m [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> m [Char]
g
    g :: Token -> m [Char]
g (T_DoubleQuoted _ l :: [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (T_DollarDoubleQuoted _ l :: [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (T_NormalWord _ l :: [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (TA_Expansion _ l :: [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (T_SingleQuoted _ s :: [Char]
s) = [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
    g (T_Literal _ s :: [Char]
s) = [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
    g (T_ParamSubSpecialChar _ s :: [Char]
s) = [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
    g (T_DollarSingleQuoted _ s :: [Char]
s) = [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
decodeEscapes [Char]
s
    g x :: Token
x = Token -> m [Char]
more Token
x

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

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

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

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

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

-- Return a list of NormalWords that would result from brace expansion
braceExpand :: Token -> [Token]
braceExpand (T_NormalWord id :: Id
id list :: [Token]
list) = Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
take 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
id items :: [Token]
items) = do
        Token
item <- [Token]
items
        Token -> [Token]
braceExpand Token
item
    part x :: 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 t :: Token
t =
    case Token
t of
        T_Redirecting _ _ w :: Token
w -> Token -> Maybe Token
getCommand Token
w
        T_SimpleCommand _ _ (w :: Token
w:_) -> Token -> Maybe Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
t
        T_Annotation _ _ t :: Token
t -> Token -> Maybe Token
getCommand Token
t
        _ -> 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 [Char]
getCommandName = (Maybe [Char], Token) -> Maybe [Char]
forall a b. (a, b) -> a
fst ((Maybe [Char], Token) -> Maybe [Char])
-> (Token -> (Maybe [Char], Token)) -> Token -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Token -> (Maybe [Char], Token)
getCommandNameAndToken Bool
False

-- Maybe get the name+arguments of a command.
getCommandArgv :: Token -> Maybe [Token]
getCommandArgv t :: Token
t = do
    (T_SimpleCommand _ _ args :: [Token]
args@(_:_)) <- 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 [Char], Token) -> Token
forall a b. (a, b) -> b
snd ((Maybe [Char], Token) -> Token)
-> (Token -> (Maybe [Char], Token)) -> Token -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Token -> (Maybe [Char], 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 [Char], Token)
getCommandNameAndToken direct :: Bool
direct t :: Token
t = (Maybe [Char], Token)
-> Maybe (Maybe [Char], Token) -> (Maybe [Char], Token)
forall a. a -> Maybe a -> a
fromMaybe (Maybe [Char]
forall a. Maybe a
Nothing, Token
t) (Maybe (Maybe [Char], Token) -> (Maybe [Char], Token))
-> Maybe (Maybe [Char], Token) -> (Maybe [Char], Token)
forall a b. (a -> b) -> a -> b
$ do
    cmd :: Token
cmd@(T_SimpleCommand _ _ (w :: Token
w:rest :: [Token]
rest)) <- Token -> Maybe Token
getCommand Token
t
    [Char]
s <- Token -> Maybe [Char]
getLiteralString Token
w
    (Maybe [Char], Token) -> Maybe (Maybe [Char], Token)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe [Char], Token) -> Maybe (Maybe [Char], Token))
-> (Maybe [Char], Token) -> Maybe (Maybe [Char], Token)
forall a b. (a -> b) -> a -> b
$ (Maybe [Char], Token)
-> Maybe (Maybe [Char], Token) -> (Maybe [Char], Token)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s, Token
w) (Maybe (Maybe [Char], Token) -> (Maybe [Char], Token))
-> Maybe (Maybe [Char], Token) -> (Maybe [Char], 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 <- [Char] -> Token -> [Token] -> Maybe Token
forall p. [Char] -> p -> [Token] -> Maybe Token
getEffectiveCommandToken [Char]
s Token
cmd [Token]
rest
        (Maybe [Char], Token) -> Maybe (Maybe [Char], Token)
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Maybe [Char]
getLiteralString Token
actual, Token
actual)
  where
    getEffectiveCommandToken :: [Char] -> p -> [Token] -> Maybe Token
getEffectiveCommandToken str :: [Char]
str cmd :: p
cmd args :: [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 [Char]
str of
                "busybox" -> Maybe Token
firstArg
                "builtin" -> Maybe Token
firstArg
                "command" -> Maybe Token
firstArg
                "run" -> Maybe Token
firstArg -- Used by bats
                "exec" -> do
                    [([Char], (Token, Token))]
opts <- [Char] -> [Token] -> Maybe [([Char], (Token, Token))]
getBsdOpts "cla:" [Token]
args
                    (_, (t :: Token
t, _)) <- (([Char], (Token, Token)) -> Bool)
-> [([Char], (Token, Token))] -> Maybe ([Char], (Token, Token))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool)
-> (([Char], (Token, Token)) -> [Char])
-> ([Char], (Token, Token))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], (Token, Token)) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], (Token, Token))]
opts
                    Token -> Maybe Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
t
                _ -> [Char] -> Maybe Token
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ""

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

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

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

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

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

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

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


isBraceExpansion :: Token -> Bool
isBraceExpansion t :: Token
t = case Token
t of T_BraceExpansion {} -> Bool
True; _ -> 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 t :: Token
t =
    case Token
t of
        T_Script _ _ cmds :: [Token]
cmds -> [[Token]
cmds]
        T_BraceGroup _ cmds :: [Token]
cmds -> [[Token]
cmds]
        T_Subshell _ cmds :: [Token]
cmds -> [[Token]
cmds]
        T_WhileExpression _ cond :: [Token]
cond cmds :: [Token]
cmds -> [[Token]
cond, [Token]
cmds]
        T_UntilExpression _ cond :: [Token]
cond cmds :: [Token]
cmds -> [[Token]
cond, [Token]
cmds]
        T_ForIn _ _ _ cmds :: [Token]
cmds -> [[Token]
cmds]
        T_ForArithmetic _ _ _ _ cmds :: [Token]
cmds -> [[Token]
cmds]
        T_IfExpression _ thens :: [([Token], [Token])]
thens elses :: [Token]
elses -> ((([Token], [Token]) -> [[Token]])
-> [([Token], [Token])] -> [[Token]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a :: [Token]
a,b :: [Token]
b) -> [[Token]
a,[Token]
b]) [([Token], [Token])]
thens) [[Token]] -> [[Token]] -> [[Token]]
forall a. [a] -> [a] -> [a]
++ [[Token]
elses]
        T_Annotation _ _ t :: Token
t -> Token -> [[Token]]
getCommandSequences Token
t

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

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

    nameAssignments :: Token -> Maybe [Char]
nameAssignments t :: Token
t =
        case Token
t of
            T_Assignment _ _ name :: [Char]
name _ _ -> [Char] -> Maybe [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
name
            _ -> Maybe [Char]
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 -> [Char] -> [Char]
[PseudoGlob] -> [Char] -> [Char]
PseudoGlob -> [Char]
(Int -> PseudoGlob -> [Char] -> [Char])
-> (PseudoGlob -> [Char])
-> ([PseudoGlob] -> [Char] -> [Char])
-> Show PseudoGlob
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PseudoGlob] -> [Char] -> [Char]
$cshowList :: [PseudoGlob] -> [Char] -> [Char]
show :: PseudoGlob -> [Char]
$cshow :: PseudoGlob -> [Char]
showsPrec :: Int -> PseudoGlob -> [Char] -> [Char]
$cshowsPrec :: Int -> PseudoGlob -> [Char] -> [Char]
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' exact :: Bool
exact word :: 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 word :: Token
word =
        case Token
word of
            T_NormalWord _ (T_Literal _ ('~':str :: [Char]
str):rest :: [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) -> [Char] -> [PseudoGlob]
forall a b. (a -> b) -> [a] -> [b]
map Char -> PseudoGlob
PGChar ([Char] -> [PseudoGlob]) -> [Char] -> [PseudoGlob]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '/') [Char]
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
            _ -> [[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 x :: Token
x = case Token
x of
        T_Literal _ s :: [Char]
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) -> [Char] -> [PseudoGlob]
forall a b. (a -> b) -> [a] -> [b]
map Char -> PseudoGlob
PGChar [Char]
s
        T_SingleQuoted _ s :: [Char]
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) -> [Char] -> [PseudoGlob]
forall a b. (a -> b) -> [a] -> [b]
map Char -> PseudoGlob
PGChar [Char]
s
        T_Glob _ "?"       -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGAny]
        T_Glob _ "*"       -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]
        T_Glob _ ('[':_) | Bool -> Bool
not Bool
exact -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGAny]
        _ -> if Bool
exact then [Char] -> m [PseudoGlob]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "" 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 _) : rest :: [PseudoGlob]
rest ) = PseudoGlob
x PseudoGlob -> [PseudoGlob] -> [PseudoGlob]
forall a. a -> [a] -> [a]
: [PseudoGlob] -> [PseudoGlob]
f [PseudoGlob]
rest
    f list :: [PseudoGlob]
list =
        let (anys :: [PseudoGlob]
anys, rest :: [PseudoGlob]
rest) = (PseudoGlob -> Bool)
-> [PseudoGlob] -> ([PseudoGlob], [PseudoGlob])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\x :: 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 s :: [PseudoGlob]
s = let (any :: [PseudoGlob]
any, many :: [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 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@(xf :: PseudoGlob
xf:xs :: [PseudoGlob]
xs) y :: [PseudoGlob]
y@(yf :: PseudoGlob
yf:ys :: [PseudoGlob]
ys) =
        case (PseudoGlob
xf, PseudoGlob
yf) of
            (PGMany, _) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys Bool -> Bool -> Bool
|| [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
y
            (_, PGMany) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys Bool -> Bool -> Bool
|| [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
y
            (PGAny, _) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys
            (_, PGAny) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys
            (_, _) -> 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 (PGMany : rest :: [PseudoGlob]
rest) [] = [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
rest []
    matchable (_:_) [] = Bool
False
    matchable [] r :: [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@(xf :: PseudoGlob
xf:xs :: [PseudoGlob]
xs) y :: [PseudoGlob]
y@(yf :: PseudoGlob
yf:ys :: [PseudoGlob]
ys) =
        case (PseudoGlob
xf, PseudoGlob
yf) of
            (PGMany, PGMany) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys
            (PGMany, _) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
x [PseudoGlob]
ys Bool -> Bool -> Bool
|| [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
y
            (_, PGMany) -> Bool
False
            (PGAny, _) -> [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
xs [PseudoGlob]
ys
            (_, PGAny) -> Bool
False
            (_, _) -> 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 (PGMany : rest :: [PseudoGlob]
rest) [] = [PseudoGlob] -> [PseudoGlob] -> Bool
matchable [PseudoGlob]
rest []
    matchable _ _ = Bool
False

wordsCanBeEqual :: Token -> Token -> Bool
wordsCanBeEqual x :: Token
x y :: 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 t :: Token
t = case Token
t of
    T_DollarBraced {} -> Bool
True
    _ -> Token -> Bool
isCommandSubstitution Token
t

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

-- Is this an expansion that results in a simple string?
isStringExpansion :: Token -> Bool
isStringExpansion t :: 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)
    _ -> Bool
False

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

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

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

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

return []
runTests :: IO Bool
runTests = Bool
Bool -> Property
[([Char], Property)] -> (Property -> IO Result) -> IO Bool
Property -> IO Result
forall prop. Testable prop => prop -> IO Result
forall prop. Testable prop => prop -> Property
runQuickCheckAll :: [([Char], 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