{-
    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/>.
-}
module ShellCheck.ASTLib where

import ShellCheck.AST

import Control.Monad.Writer
import Control.Monad
import Data.Char
import Data.Functor
import Data.Functor.Identity
import Data.List
import Data.Maybe

-- 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
'~':[Char]
_) : [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
_ [Char]
_ -> Bool
True
        T_Literal Id
_ [Char]
_ -> 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
_ [Char]
"" -> Bool
True
        T_Literal Id
_ [Char]
"" -> Bool
True
        Token
_ -> Bool
False

-- Quick&lazy oversimplification of commands, throwing away details
-- and returning a list like  ["find", ".", "-name", "${VAR}*" ].
oversimplify :: Token -> [[Char]]
oversimplify Token
token =
    case Token
token of
        (T_NormalWord Id
_ [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 Id
_ [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 Id
_ [Char]
s) -> [[Char]
s]
        (T_DollarBraced Id
_ Bool
_ Token
_) -> [[Char]
"${VAR}"]
        (T_DollarArithmetic Id
_ Token
_) -> [[Char]
"${VAR}"]
        (T_DollarExpansion Id
_ [Token]
_) -> [[Char]
"${VAR}"]
        (T_Backticked Id
_ [Token]
_) -> [[Char]
"${VAR}"]
        (T_Glob Id
_ [Char]
s) -> [[Char]
s]
        (T_Pipeline Id
_ [Token]
_ [Token
x]) -> Token -> [[Char]]
oversimplify Token
x
        (T_Literal Id
_ [Char]
x) -> [[Char]
x]
        (T_ParamSubSpecialChar Id
_ [Char]
x) -> [[Char]
x]
        (T_SimpleCommand Id
_ [Token]
vars [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 Id
_ [Token]
_ Token
foo) -> Token -> [[Char]]
oversimplify Token
foo
        (T_DollarSingleQuoted Id
_ [Char]
s) -> [[Char]
s]
        (T_Annotation Id
_ [Annotation]
_ Token
s) -> Token -> [[Char]]
oversimplify Token
s
        -- Workaround for let "foo = bar" parsing
        (TA_Sequence Id
_ [TA_Expansion Id
_ [Token]
v]) -> (Token -> [[Char]]) -> [Token] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [[Char]]
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 :: ([Char] -> Bool) -> Token -> [(Token, [Char])]
getFlagsUntil [Char] -> Bool
stopCondition (T_SimpleCommand Id
_ [Token]
_ (Token
_:[Token]
args)) =
    let tokenAndText :: [(Token, [Char])]
tokenAndText = (Token -> (Token, [Char])) -> [Token] -> [(Token, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (\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
        ([(Token, [Char])]
flagArgs, [(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 (\(Token
t, [Char]
_) -> (Token
t, [Char]
"")) [(Token, [Char])]
rest
  where
    flag :: (a, [Char]) -> [(a, [Char])]
flag (a
x, Char
'-':Char
'-':[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
'=') [Char]
arg) ]
    flag (a
x, Char
'-':[Char]
args) = (Char -> (a, [Char])) -> [Char] -> [(a, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
v -> (a
x, [Char
v])) [Char]
args
    flag (a
x, [Char]
_) = [ (a
x, [Char]
"") ]
getFlagsUntil [Char] -> Bool
_ Token
_ = [Char] -> [(Token, [Char])]
forall a. HasCallStack => [Char] -> a
error [Char]
"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
== [Char]
"--")
-- 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 (\[Char]
x -> [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"--" Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"-" [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 Token
cmd [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 =
    case Token -> [Token]
getWordParts Token
token of
        T_Literal Id
_ (Char
'-':[Char]
_) : [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
    [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] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
str

-- Given a T_DollarBraced, return a simplified version of the string contents.
bracedString :: Token -> [Char]
bracedString (T_DollarBraced Id
_ Bool
_ Token
l) = [[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
bracedString Token
_ = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal shellcheck error, please report! (bracedString on non-variable)"

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

-- Maybe get a literal string, but only if it's an unquoted argument.
getUnquotedLiteral :: Token -> Maybe [Char]
getUnquotedLiteral (T_NormalWord Id
_ [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 Id
_ [Char]
s) = [Char] -> Maybe [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
    str Token
_ = Maybe [Char]
forall a. Maybe a
Nothing
getUnquotedLiteral Token
_ = Maybe [Char]
forall a. Maybe a
Nothing

-- 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 [Char]
getLeadingUnquotedString Token
t =
    case Token
t of
        T_NormalWord Id
_ ((T_Literal Id
_ [Char]
s) : [Token]
_) -> [Char] -> Maybe [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
        Token
_ -> Maybe [Char]
forall a. Maybe a
Nothing

-- 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 Id
_ [Char]
str) = [Char] -> Maybe [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
str
    f Token
_ = 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 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 Id
_ [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (T_DollarDoubleQuoted Id
_ [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (T_NormalWord Id
_ [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (TA_Expansion Id
_ [Token]
l) = [Token] -> m [Char]
allInList [Token]
l
    g (T_SingleQuoted Id
_ [Char]
s) = [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
    g (T_Literal Id
_ [Char]
s) = [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
    g (T_ParamSubSpecialChar Id
_ [Char]
s) = [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
s
    g (T_DollarSingleQuoted Id
_ [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 Token
x = Token -> m [Char]
more Token
x

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


-- 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 [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
. Token -> (Maybe [Char], Token)
getCommandNameAndToken

-- 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 [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
. Token -> (Maybe [Char], Token)
getCommandNameAndToken

getCommandNameAndToken :: Token -> (Maybe String, Token)
getCommandNameAndToken :: Token -> (Maybe [Char], Token)
getCommandNameAndToken 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
    (T_SimpleCommand Id
_ [Token]
_ (Token
w:[Token]
rest)) <- Token -> Maybe Token
getCommand Token
t
    [Char]
s <- Token -> Maybe [Char]
getLiteralString Token
w
    if [Char]
"busybox" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
s Bool -> Bool -> Bool
|| [Char]
"builtin" [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
s
        then
            case [Token]
rest of
                (Token
applet:[Token]
_) -> (Maybe [Char], Token) -> Maybe (Maybe [Char], Token)
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Maybe [Char]
getLiteralString Token
applet, Token
applet)
                [Token]
_ -> (Maybe [Char], Token) -> Maybe (Maybe [Char], Token)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s, Token
w)
        else
            (Maybe [Char], Token) -> Maybe (Maybe [Char], Token)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s, Token
w)


-- If a command substitution is a single command, get its name.
--  $(date +%s) = Just "date"
getCommandNameFromExpansion :: Token -> Maybe String
getCommandNameFromExpansion :: Token -> Maybe [Char]
getCommandNameFromExpansion Token
t =
    case Token
t of
        T_DollarExpansion Id
_ [Token
c] -> Token -> Maybe [Char]
extract Token
c
        T_Backticked Id
_ [Token
c] -> Token -> Maybe [Char]
extract Token
c
        T_DollarBraceCommandExpansion Id
_ [Token
c] -> Token -> Maybe [Char]
extract Token
c
        Token
_ -> Maybe [Char]
forall a. Maybe a
Nothing
  where
    extract :: Token -> Maybe [Char]
extract (T_Pipeline Id
_ [Token]
_ [Token
cmd]) = Token -> Maybe [Char]
getCommandName Token
cmd
    extract Token
_ = 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
  where
    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] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
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
_ [Char]
_ [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 -> [[Char]]
getAssociativeArrays 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 = [[Char]
"declare",[Char]
"local",[Char]
"typeset"]
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
name [[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
$ [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
"A" ([[Char]] -> Bool) -> [[Char]] -> Bool
forall a b. (a -> b) -> a -> b
$ ((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, [Char]) -> Token) -> [(Token, [Char])] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map (Token, [Char]) -> Token
forall a b. (a, b) -> a
fst ([(Token, [Char])] -> [Token])
-> ([(Token, [Char])] -> [(Token, [Char])])
-> [(Token, [Char])]
-> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Token, [Char]) -> Bool) -> [(Token, [Char])] -> [(Token, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Char]
"" ([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])] -> [Token]) -> [(Token, [Char])] -> [Token]
forall a b. (a -> b) -> a -> b
$ [(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 Token
_ = () -> WriterT [[Char]] Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    nameAssignments :: Token -> Maybe [Char]
nameAssignments Token
t =
        case Token
t of
            T_Assignment Id
_ AssignmentMode
_ [Char]
name [Token]
_ Token
_ -> [Char] -> Maybe [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
name
            Token
_ -> 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 -> Maybe [PseudoGlob]
wordToPseudoGlob :: Token -> Maybe [PseudoGlob]
wordToPseudoGlob Token
word =
    [PseudoGlob] -> [PseudoGlob]
simplifyPseudoGlob ([PseudoGlob] -> [PseudoGlob])
-> ([[PseudoGlob]] -> [PseudoGlob])
-> [[PseudoGlob]]
-> [PseudoGlob]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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 :: * -> *). Monad m => Token -> m [PseudoGlob]
f (Token -> [Token]
getWordParts Token
word)
  where
    f :: Token -> m [PseudoGlob]
f Token
x = case Token
x of
        T_Literal Id
_ [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 Id
_ [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_DollarBraced {} -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]
        T_DollarExpansion {} -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]
        T_Backticked {} -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]

        T_Glob Id
_ [Char]
"?" -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGAny]
        T_Glob Id
_ (Char
'[':[Char]
_)  -> [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_Extglob {} -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]

        Token
_ -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]

-- Turn a word into a PG pattern, but only if we can preserve
-- exact semantics.
wordToExactPseudoGlob :: Token -> Maybe [PseudoGlob]
wordToExactPseudoGlob :: Token -> Maybe [PseudoGlob]
wordToExactPseudoGlob Token
word =
    [PseudoGlob] -> [PseudoGlob]
simplifyPseudoGlob ([PseudoGlob] -> [PseudoGlob])
-> ([[PseudoGlob]] -> [PseudoGlob])
-> [[PseudoGlob]]
-> [PseudoGlob]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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 -> [Token]
getWordParts Token
word)
  where
    f :: Token -> m [PseudoGlob]
f Token
x = case Token
x of
        T_Literal Id
_ [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 Id
_ [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 Id
_ [Char]
"?" -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGAny]
        T_Glob Id
_ [Char]
"*" -> [PseudoGlob] -> m [PseudoGlob]
forall (m :: * -> *) a. Monad m => a -> m a
return [PseudoGlob
PGMany]
        Token
_ -> [Char] -> m [PseudoGlob]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Unknown token type"

-- 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 = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    ([PseudoGlob] -> [PseudoGlob] -> Bool)
-> Maybe [PseudoGlob] -> Maybe [PseudoGlob] -> Maybe Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobsCanOverlap (Token -> Maybe [PseudoGlob]
wordToPseudoGlob Token
x) (Token -> Maybe [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 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
ts) = Integer
code Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
ts
    hasNum Annotation
_                   = Bool
False