{-# LANGUAGE RecordWildCards #-}
-- | Bash script and input parsing.
module Language.Bash.Parse
    ( parse
    ) where

import           Control.Applicative          hiding (many)
import           Control.Monad
import           Data.Either
import           Data.Functor.Identity
import           Text.Parsec.Char             hiding (newline)
import           Text.Parsec.Combinator       hiding (optional)
import           Text.Parsec.Error            (ParseError)
import           Text.Parsec.Expr
import           Text.Parsec.Pos
import           Text.Parsec.Prim             hiding (parse, (<|>))

import qualified Language.Bash.Cond           as Cond
import           Language.Bash.Operator
import           Language.Bash.Parse.Internal
import           Language.Bash.Syntax
import           Language.Bash.Word           (unquote, stringToWord)

-- | User state.
data U = U { U -> Maybe (State D U)
postHeredoc :: Maybe (State D U) }

-- | Bash parser type.
type Parser = ParsecT D U Identity

-- | Parse a script or input line into a (possibly empty) list of commands.
parse :: SourceName -> String -> Either ParseError List
parse :: SourceName -> SourceName -> Either ParseError List
parse SourceName
source = Parsec D U List -> U -> SourceName -> D -> Either ParseError List
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser Parsec D U List
script (Maybe (State D U) -> U
U Maybe (State D U)
forall a. Maybe a
Nothing) SourceName
source (D -> Either ParseError List)
-> (SourceName -> D) -> SourceName -> Either ParseError List
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> SourceName -> D
pack (SourceName -> SourcePos
initialPos SourceName
source)

-------------------------------------------------------------------------------
-- Basic parsers
-------------------------------------------------------------------------------

infixl 3 </>
infix  0 ?:

-- | Backtracking choice.
(</>) :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
ParsecT s u m a
p </> :: forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> ParsecT s u m a
q = ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m a
p ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT s u m a
q

-- | Name a parser from the front.
(?:) :: String -> ParsecT s u m a -> ParsecT s u m a
?: :: forall s u (m :: * -> *) a.
SourceName -> ParsecT s u m a -> ParsecT s u m a
(?:) = (ParsecT s u m a -> SourceName -> ParsecT s u m a)
-> SourceName -> ParsecT s u m a -> ParsecT s u m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParsecT s u m a -> SourceName -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
(<?>)

-- | Parse the next here document.
heredoc :: Bool -> String -> Parser String
heredoc :: Bool -> SourceName -> Parser SourceName
heredoc Bool
strip SourceName
end = SourceName
"here document" SourceName -> Parser SourceName -> Parser SourceName
forall s u (m :: * -> *) a.
SourceName -> ParsecT s u m a -> ParsecT s u m a
?: do
    (SourceName
h, State D U
s) <- ParsecT D U Identity (SourceName, State D U)
-> ParsecT D U Identity (SourceName, State D U)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT D U Identity (SourceName, State D U)
duck
    U -> ParsecT D U Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (U -> ParsecT D U Identity ()) -> U -> ParsecT D U Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (State D U) -> U
U (State D U -> Maybe (State D U)
forall a. a -> Maybe a
Just State D U
s)
    SourceName -> Parser SourceName
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
h
  where
    process :: SourceName -> SourceName
process = if Bool
strip then (Char -> Bool) -> SourceName -> SourceName
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') else SourceName -> SourceName
forall a. a -> a
id

    duck :: ParsecT D U Identity (SourceName, State D U)
duck = do
        U
u <- ParsecT D U Identity U
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        case U -> Maybe (State D U)
postHeredoc U
u of
            Maybe (State D U)
Nothing -> () () -> Parser SourceName -> ParsecT D U Identity ()
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser SourceName
forall {u}. ParsecT D u Identity SourceName
line
            Just State D U
s  -> () () -> ParsecT D U Identity (State D U) -> ParsecT D U Identity ()
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ State D U -> ParsecT D U Identity (State D U)
forall (m :: * -> *) s u.
Monad m =>
State s u -> ParsecT s u m (State s u)
setParserState State D U
s
        SourceName
h <- [SourceName] -> SourceName
unlines ([SourceName] -> SourceName)
-> ParsecT D U Identity [SourceName] -> Parser SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity [SourceName]
forall {u}. ParsecT D u Identity [SourceName]
heredocLines
        State D U
s <- ParsecT D U Identity (State D U)
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
        (SourceName, State D U)
-> ParsecT D U Identity (SourceName, State D U)
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName
h, State D U
s)

    line :: ParsecT D u Identity SourceName
line = ParsecT D u Identity Char -> ParsecT D u Identity SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT D u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')) ParsecT D u Identity SourceName
-> ParsecT D u Identity (Maybe Char)
-> ParsecT D u Identity SourceName
forall a b.
ParsecT D u Identity a
-> ParsecT D u Identity b -> ParsecT D u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D u Identity Char -> ParsecT D u Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> ParsecT D u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n')

    heredocLines :: ParsecT D u Identity [SourceName]
heredocLines = [] [SourceName]
-> ParsecT D u Identity () -> ParsecT D u Identity [SourceName]
forall a b. a -> ParsecT D u Identity b -> ParsecT D u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT D u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
               ParsecT D u Identity [SourceName]
-> ParsecT D u Identity [SourceName]
-> ParsecT D u Identity [SourceName]
forall a.
ParsecT D u Identity a
-> ParsecT D u Identity a -> ParsecT D u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT D u Identity [SourceName]
nextLine

    nextLine :: ParsecT D u Identity [SourceName]
nextLine = do
        SourceName
l <- SourceName -> SourceName
process (SourceName -> SourceName)
-> ParsecT D u Identity SourceName
-> ParsecT D u Identity SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D u Identity SourceName
forall {u}. ParsecT D u Identity SourceName
line
        if SourceName
l SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName
end
            then [SourceName] -> ParsecT D u Identity [SourceName]
forall a. a -> ParsecT D u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else (SourceName
l SourceName -> [SourceName] -> [SourceName]
forall a. a -> [a] -> [a]
:) ([SourceName] -> [SourceName])
-> ParsecT D u Identity [SourceName]
-> ParsecT D u Identity [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D u Identity [SourceName]
heredocLines

-- | Parse a newline, skipping any here documents.
newline :: Parser String
newline :: Parser SourceName
newline = SourceName
"newline" SourceName -> Parser SourceName -> Parser SourceName
forall s u (m :: * -> *) a.
SourceName -> ParsecT s u m a -> ParsecT s u m a
?: do
    SourceName
_ <- SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"\r\n" Parser SourceName -> Parser SourceName -> Parser SourceName
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"\n"
    U
u <- ParsecT D U Identity U
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    case U -> Maybe (State D U)
postHeredoc U
u of
        Maybe (State D U)
Nothing -> () -> ParsecT D U Identity ()
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just State D U
s  -> () () -> ParsecT D U Identity (State D U) -> ParsecT D U Identity ()
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ State D U -> ParsecT D U Identity (State D U)
forall (m :: * -> *) s u.
Monad m =>
State s u -> ParsecT s u m (State s u)
setParserState State D U
s
    U -> ParsecT D U Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (U -> ParsecT D U Identity ()) -> U -> ParsecT D U Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (State D U) -> U
U Maybe (State D U)
forall a. Maybe a
Nothing
    ParsecT D U Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpace
    SourceName -> Parser SourceName
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
"\n"

-- | Parse a list terminator.
listTerm :: Parser ListTerm
listTerm :: Parser ListTerm
listTerm = Parser ListTerm
term Parser ListTerm -> ParsecT D U Identity () -> Parser ListTerm
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList Parser ListTerm -> SourceName -> Parser ListTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"list terminator"
  where
    term :: Parser ListTerm
term = ListTerm
Sequential   ListTerm -> Parser SourceName -> Parser ListTerm
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser SourceName
newline
       Parser ListTerm -> Parser ListTerm -> Parser ListTerm
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ListTerm
Sequential   ListTerm -> Parser SourceName -> Parser ListTerm
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
";"
       Parser ListTerm -> Parser ListTerm -> Parser ListTerm
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ListTerm
Asynchronous ListTerm -> Parser SourceName -> Parser ListTerm
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"&"

-- | Skip zero or more newlines.
newlineList :: Parser ()
newlineList :: ParsecT D U Identity ()
newlineList = Parser SourceName -> ParsecT D U Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany Parser SourceName
newline

-------------------------------------------------------------------------------
-- Simple commands
-------------------------------------------------------------------------------

-- | Skip a redirection.
redir :: Parser Redir
redir :: Parser Redir
redir = Parser Redir
forall {u}. ParsecT D u Identity Redir
normalRedir
    Parser Redir -> Parser Redir -> Parser Redir
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Redir
heredocRedir
    Parser Redir -> SourceName -> Parser Redir
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"redirection"
  where
    normalRedir :: ParsecT D u Identity Redir
normalRedir = do
        Maybe IODesc
redirDesc   <- ParsecT D u Identity IODesc -> ParsecT D u Identity (Maybe IODesc)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT D u Identity IODesc
forall (m :: * -> *) u. Monad m => ParsecT D u m IODesc
ioDesc
        RedirOp
redirOp     <- ParsecT D u Identity RedirOp
forall {u}. ParsecT D u Identity RedirOp
redirOperator
        Word
redirTarget <- ParsecT D u Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord
        Redir -> ParsecT D u Identity Redir
forall a. a -> ParsecT D u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Redir{Word
Maybe IODesc
RedirOp
redirDesc :: Maybe IODesc
redirOp :: RedirOp
redirTarget :: Word
redirDesc :: Maybe IODesc
redirOp :: RedirOp
redirTarget :: Word
..}

    heredocRedir :: Parser Redir
heredocRedir = do
        HeredocOp
heredocOp <- ParsecT D U Identity HeredocOp
forall {u}. ParsecT D u Identity HeredocOp
heredocOperator
        Word
w <- ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord
        let heredocDelim :: SourceName
heredocDelim = Word -> SourceName
unquote Word
w
            heredocDelimQuoted :: Bool
heredocDelimQuoted = SourceName -> Word
stringToWord SourceName
heredocDelim Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
w
        SourceName
h <- Bool -> SourceName -> Parser SourceName
heredoc (HeredocOp
heredocOp HeredocOp -> HeredocOp -> Bool
forall a. Eq a => a -> a -> Bool
== HeredocOp
HereStrip) SourceName
heredocDelim
        Word
hereDocument <- if Bool
heredocDelimQuoted
                        then Word -> ParsecT D U Identity Word
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName -> Word
stringToWord SourceName
h)
                        else SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) s u.
Monad m =>
SourceName -> ParsecT s u m Word
heredocWord SourceName
h
        Redir -> Parser Redir
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Heredoc{Bool
SourceName
Word
HeredocOp
heredocOp :: HeredocOp
heredocDelim :: SourceName
heredocDelimQuoted :: Bool
hereDocument :: Word
heredocOp :: HeredocOp
heredocDelim :: SourceName
heredocDelimQuoted :: Bool
hereDocument :: Word
..}

    redirOperator :: ParsecT D u Identity RedirOp
redirOperator   = (SourceName -> ParsecT D u Identity SourceName)
-> ParsecT D u Identity RedirOp
forall (f :: * -> *) a c.
(Alternative f, Operator a) =>
(SourceName -> f c) -> f a
selectOperator SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator ParsecT D u Identity RedirOp
-> SourceName -> ParsecT D u Identity RedirOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"redirection operator"
    heredocOperator :: ParsecT D u Identity HeredocOp
heredocOperator = (SourceName -> ParsecT D u Identity SourceName)
-> ParsecT D u Identity HeredocOp
forall (f :: * -> *) a c.
(Alternative f, Operator a) =>
(SourceName -> f c) -> f a
selectOperator SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator ParsecT D u Identity HeredocOp
-> SourceName -> ParsecT D u Identity HeredocOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"here document operator"

-- | Parse a list of redirections.
redirList :: Parser [Redir]
redirList :: Parser [Redir]
redirList = Parser Redir -> Parser [Redir]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Redir
redir

-- | Parse part of a command.
commandParts :: Parser a -> Parser ([a], [Redir])
commandParts :: forall a. Parser a -> Parser ([a], [Redir])
commandParts Parser a
p = [Either a Redir] -> ([a], [Redir])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either a Redir] -> ([a], [Redir]))
-> ParsecT D U Identity [Either a Redir]
-> ParsecT D U Identity ([a], [Redir])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity (Either a Redir)
-> ParsecT D U Identity [Either a Redir]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT D U Identity (Either a Redir)
part
  where
    part :: ParsecT D U Identity (Either a Redir)
part = a -> Either a Redir
forall a b. a -> Either a b
Left  (a -> Either a Redir)
-> Parser a -> ParsecT D U Identity (Either a Redir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p
       ParsecT D U Identity (Either a Redir)
-> ParsecT D U Identity (Either a Redir)
-> ParsecT D U Identity (Either a Redir)
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Redir -> Either a Redir
forall a b. b -> Either a b
Right (Redir -> Either a Redir)
-> Parser Redir -> ParsecT D U Identity (Either a Redir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Redir
redir

-- | Parse a simple command.
simpleCommand :: Parser Command
simpleCommand :: Parser Command
simpleCommand = do
    ParsecT D U Identity Word -> ParsecT D U Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
reservedWord
    Parser Command
assignCommand Parser Command -> Parser Command -> Parser Command
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> Parser Command
normalCommand
  where
    assignCommand :: Parser Command
assignCommand = SourceName
"assignment builtin" SourceName -> Parser Command -> Parser Command
forall s u (m :: * -> *) a.
SourceName -> ParsecT s u m a -> ParsecT s u m a
?: do
        [Redir]
rs1 <- Parser [Redir]
redirList
        Word
w <- ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
assignBuiltin
        ([Either Assign Word]
args, [Redir]
rs2) <- Parser (Either Assign Word)
-> Parser ([Either Assign Word], [Redir])
forall a. Parser a -> Parser ([a], [Redir])
commandParts Parser (Either Assign Word)
forall {u}. ParsecT D u Identity (Either Assign Word)
assignArg
        Command -> Parser Command
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Command -> Parser Command) -> Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ ShellCommand -> [Redir] -> Command
Command (Word -> [Either Assign Word] -> ShellCommand
AssignBuiltin Word
w [Either Assign Word]
args) ([Redir]
rs1 [Redir] -> [Redir] -> [Redir]
forall a. [a] -> [a] -> [a]
++ [Redir]
rs2)

    normalCommand :: Parser Command
normalCommand = SourceName
"simple command" SourceName -> Parser Command -> Parser Command
forall s u (m :: * -> *) a.
SourceName -> ParsecT s u m a -> ParsecT s u m a
?: do
        ([Assign]
as, [Redir]
rs1) <- Parser Assign -> Parser ([Assign], [Redir])
forall a. Parser a -> Parser ([a], [Redir])
commandParts Parser Assign
forall (m :: * -> *) u. Monad m => ParsecT D u m Assign
assign
        ([Word]
ws, [Redir]
rs2) <- ParsecT D U Identity Word -> Parser ([Word], [Redir])
forall a. Parser a -> Parser ([a], [Redir])
commandParts ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord
        let rs :: [Redir]
rs = [Redir]
rs1 [Redir] -> [Redir] -> [Redir]
forall a. [a] -> [a] -> [a]
++ [Redir]
rs2
        Bool -> ParsecT D U Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Assign] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Assign]
as Bool -> Bool -> Bool
&& [Word] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word]
ws Bool -> Bool -> Bool
&& [Redir] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Redir]
rs)
        Command -> Parser Command
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Command -> Parser Command) -> Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ ShellCommand -> [Redir] -> Command
Command ([Assign] -> [Word] -> ShellCommand
SimpleCommand [Assign]
as [Word]
ws) [Redir]
rs

    assignArg :: ParsecT D u Identity (Either Assign Word)
assignArg = Assign -> Either Assign Word
forall a b. a -> Either a b
Left  (Assign -> Either Assign Word)
-> ParsecT D u Identity Assign
-> ParsecT D u Identity (Either Assign Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D u Identity Assign
forall (m :: * -> *) u. Monad m => ParsecT D u m Assign
assign
            ParsecT D u Identity (Either Assign Word)
-> ParsecT D u Identity (Either Assign Word)
-> ParsecT D u Identity (Either Assign Word)
forall a.
ParsecT D u Identity a
-> ParsecT D u Identity a -> ParsecT D u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word -> Either Assign Word
forall a b. b -> Either a b
Right (Word -> Either Assign Word)
-> ParsecT D u Identity Word
-> ParsecT D u Identity (Either Assign Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D u Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord

-------------------------------------------------------------------------------
-- Lists
-------------------------------------------------------------------------------

-- | A list with one command.
singleton :: ShellCommand -> List
singleton :: ShellCommand -> List
singleton ShellCommand
c =
    [Statement] -> List
List [AndOr -> ListTerm -> Statement
Statement (Pipeline -> AndOr
Last ([Command] -> Pipeline
unmodifiedPipeline [ShellCommand -> [Redir] -> Command
Command ShellCommand
c []])) ListTerm
Sequential]

-- | An unmodified pipeline.
unmodifiedPipeline :: [Command] -> Pipeline
unmodifiedPipeline :: [Command] -> Pipeline
unmodifiedPipeline [Command]
cs = Pipeline
    { timed :: Bool
timed      = Bool
False
    , timedPosix :: Bool
timedPosix = Bool
False
    , inverted :: Bool
inverted   = Bool
False
    , commands :: [Command]
commands   = [Command]
cs
    }

-- | Parse a pipeline.
pipelineCommand :: Parser Pipeline
pipelineCommand :: Parser Pipeline
pipelineCommand = Parser Pipeline
time
              Parser Pipeline -> Parser Pipeline -> Parser Pipeline
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pipeline
invert
              Parser Pipeline -> Parser Pipeline -> Parser Pipeline
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pipeline
pipeline1
              Parser Pipeline -> SourceName -> Parser Pipeline
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"pipeline"
  where
    invert :: Parser Pipeline
invert = do
        Word
_ <- SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"!"
        Pipeline
p <- Parser Pipeline
pipeline0
        Pipeline -> Parser Pipeline
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pipeline -> Parser Pipeline) -> Pipeline -> Parser Pipeline
forall a b. (a -> b) -> a -> b
$ Pipeline
p { inverted :: Bool
inverted = Bool -> Bool
not (Pipeline -> Bool
inverted Pipeline
p) }

    time :: Parser Pipeline
time = do
        Word
_ <- SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"time"
        Pipeline
p <- Parser Pipeline
posixFlag Parser Pipeline -> Parser Pipeline -> Parser Pipeline
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pipeline
invert Parser Pipeline -> Parser Pipeline -> Parser Pipeline
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pipeline
pipeline0
        Pipeline -> Parser Pipeline
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pipeline -> Parser Pipeline) -> Pipeline -> Parser Pipeline
forall a b. (a -> b) -> a -> b
$ Pipeline
p { timed :: Bool
timed = Bool
True }

    posixFlag :: Parser Pipeline
posixFlag = do
        Word
_ <- SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"-p"
        Maybe Word
_ <- ParsecT D U Identity Word -> ParsecT D U Identity (Maybe Word)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"--")
        Pipeline
p <- Parser Pipeline
invert Parser Pipeline -> Parser Pipeline -> Parser Pipeline
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Pipeline
pipeline0
        Pipeline -> Parser Pipeline
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pipeline -> Parser Pipeline) -> Pipeline -> Parser Pipeline
forall a b. (a -> b) -> a -> b
$ Pipeline
p { timedPosix :: Bool
timedPosix = Bool
True }

    pipeline0 :: Parser Pipeline
pipeline0 = [Command] -> Pipeline
unmodifiedPipeline ([Command] -> Pipeline)
-> ParsecT D U Identity [Command] -> Parser Pipeline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity [Command]
commandList0
    pipeline1 :: Parser Pipeline
pipeline1 = [Command] -> Pipeline
unmodifiedPipeline ([Command] -> Pipeline)
-> ParsecT D U Identity [Command] -> Parser Pipeline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity [Command]
commandList1

    commandList0 :: ParsecT D U Identity [Command]
commandList0 = [Command]
-> ParsecT D U Identity [Command] -> ParsecT D U Identity [Command]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT D U Identity [Command]
commandList1
    commandList1 :: ParsecT D U Identity [Command]
commandList1 = do
        Command
c <- Parser Command
command
        Command -> ParsecT D U Identity [Command]
pipelineSep Command
c ParsecT D U Identity [Command]
-> ParsecT D U Identity [Command] -> ParsecT D U Identity [Command]
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Command] -> ParsecT D U Identity [Command]
forall a. a -> ParsecT D U Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Command
c]

    pipelineSep :: Command -> ParsecT D U Identity [Command]
pipelineSep Command
c = do
        Command
c' <- Command
c          Command -> Parser SourceName -> Parser Command
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"|"
          Parser Command -> Parser Command -> Parser Command
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Command -> Command
addRedir Command
c Command -> Parser SourceName -> Parser Command
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"|&"
        (Command
c' Command -> [Command] -> [Command]
forall a. a -> [a] -> [a]
:) ([Command] -> [Command])
-> ParsecT D U Identity [Command] -> ParsecT D U Identity [Command]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity [Command]
commandList0

    addRedir :: Command -> Command
addRedir (Command ShellCommand
c [Redir]
rs) = ShellCommand -> [Redir] -> Command
Command ShellCommand
c (Redir
stderrRedir Redir -> [Redir] -> [Redir]
forall a. a -> [a] -> [a]
: [Redir]
rs)

    stderrRedir :: Redir
stderrRedir = Maybe IODesc -> RedirOp -> Word -> Redir
Redir (IODesc -> Maybe IODesc
forall a. a -> Maybe a
Just (Int -> IODesc
IONumber Int
2)) RedirOp
OutAnd (SourceName -> Word
stringToWord SourceName
"1")

-- | Parse a compound list of commands.
compoundList :: Parser List
compoundList :: Parsec D U List
compoundList = [Statement] -> List
List ([Statement] -> List)
-> ParsecT D U Identity ()
-> ParsecT D U Identity ([Statement] -> List)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT D U Identity ()
newlineList ParsecT D U Identity ([Statement] -> List)
-> ParsecT D U Identity [Statement] -> Parsec D U List
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity Statement -> ParsecT D U Identity [Statement]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT D U Identity Statement
statement Parsec D U List -> SourceName -> Parsec D U List
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"list"
  where
    statement :: ParsecT D U Identity Statement
statement = AndOr -> ListTerm -> Statement
Statement (AndOr -> ListTerm -> Statement)
-> ParsecT D U Identity AndOr
-> ParsecT D U Identity (ListTerm -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity AndOr
andOr ParsecT D U Identity (ListTerm -> Statement)
-> Parser ListTerm -> ParsecT D U Identity Statement
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ListTerm -> Parser ListTerm -> Parser ListTerm
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ListTerm
Sequential Parser ListTerm
listTerm

    andOr :: ParsecT D U Identity AndOr
andOr = do
        Pipeline
p <- Parser Pipeline
pipelineCommand
        let rest :: ParsecT D U Identity AndOr
rest = Pipeline -> AndOr -> AndOr
And Pipeline
p (AndOr -> AndOr)
-> Parser SourceName -> ParsecT D U Identity (AndOr -> AndOr)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"&&" ParsecT D U Identity (AndOr -> AndOr)
-> ParsecT D U Identity () -> ParsecT D U Identity (AndOr -> AndOr)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList ParsecT D U Identity (AndOr -> AndOr)
-> ParsecT D U Identity AndOr -> ParsecT D U Identity AndOr
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity AndOr
andOr
               ParsecT D U Identity AndOr
-> ParsecT D U Identity AndOr -> ParsecT D U Identity AndOr
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pipeline -> AndOr -> AndOr
Or  Pipeline
p (AndOr -> AndOr)
-> Parser SourceName -> ParsecT D U Identity (AndOr -> AndOr)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"||" ParsecT D U Identity (AndOr -> AndOr)
-> ParsecT D U Identity () -> ParsecT D U Identity (AndOr -> AndOr)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList ParsecT D U Identity (AndOr -> AndOr)
-> ParsecT D U Identity AndOr -> ParsecT D U Identity AndOr
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity AndOr
andOr
        ParsecT D U Identity AndOr
rest ParsecT D U Identity AndOr
-> ParsecT D U Identity AndOr -> ParsecT D U Identity AndOr
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AndOr -> ParsecT D U Identity AndOr
forall a. a -> ParsecT D U Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pipeline -> AndOr
Last Pipeline
p)

-- | Parse a possible empty compound list of commands.
inputList :: Parser List
inputList :: Parsec D U List
inputList = ParsecT D U Identity ()
newlineList ParsecT D U Identity () -> Parsec D U List -> Parsec D U List
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> List -> Parsec D U List -> Parsec D U List
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([Statement] -> List
List []) Parsec D U List
compoundList

-- | Parse a command group, wrapped either in braces or in a @do...done@ block.
doGroup :: Parser List
doGroup :: Parsec D U List
doGroup = SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"do" ParsecT D U Identity Word -> Parsec D U List -> Parsec D U List
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec D U List
compoundList Parsec D U List -> ParsecT D U Identity Word -> Parsec D U List
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"done"
      Parsec D U List -> Parsec D U List -> Parsec D U List
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"{"  ParsecT D U Identity Word -> Parsec D U List -> Parsec D U List
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec D U List
compoundList Parsec D U List -> ParsecT D U Identity Word -> Parsec D U List
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"}"

-------------------------------------------------------------------------------
-- Compound commands
-------------------------------------------------------------------------------

-- | Parse a compound command.
shellCommand :: Parser ShellCommand
shellCommand :: Parser ShellCommand
shellCommand = Parser ShellCommand
group
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
ifCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
caseCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
forCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
whileCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
untilCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
selectCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
condCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
arithCommand
           Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
subshell
           Parser ShellCommand -> SourceName -> Parser ShellCommand
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"compound command"

-- | Parse a @case@ command.
caseCommand :: Parser ShellCommand
caseCommand :: Parser ShellCommand
caseCommand = Word -> [CaseClause] -> ShellCommand
Case (Word -> [CaseClause] -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (Word -> [CaseClause] -> ShellCommand)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"case"
          ParsecT D U Identity (Word -> [CaseClause] -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity ([CaseClause] -> ShellCommand)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord ParsecT D U Identity ([CaseClause] -> ShellCommand)
-> ParsecT D U Identity ()
-> ParsecT D U Identity ([CaseClause] -> ShellCommand)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList
          ParsecT D U Identity ([CaseClause] -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity ([CaseClause] -> ShellCommand)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"in" ParsecT D U Identity ([CaseClause] -> ShellCommand)
-> ParsecT D U Identity ()
-> ParsecT D U Identity ([CaseClause] -> ShellCommand)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList
          ParsecT D U Identity ([CaseClause] -> ShellCommand)
-> ParsecT D U Identity [CaseClause] -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity [CaseClause]
clauses
  where
    clauses :: ParsecT D U Identity [CaseClause]
clauses = [] [CaseClause]
-> ParsecT D U Identity Word -> ParsecT D U Identity [CaseClause]
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"esac"
          ParsecT D U Identity [CaseClause]
-> ParsecT D U Identity [CaseClause]
-> ParsecT D U Identity [CaseClause]
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do [Word]
p <- ParsecT D U Identity [Word]
forall {u}. ParsecT D u Identity [Word]
pattern
                 List
c <- Parsec D U List
inputList
                 (CaseTerm -> CaseClause) -> ParsecT D U Identity [CaseClause]
nextClause ([Word] -> List -> CaseTerm -> CaseClause
CaseClause [Word]
p List
c)

    nextClause :: (CaseTerm -> CaseClause) -> ParsecT D U Identity [CaseClause]
nextClause CaseTerm -> CaseClause
f = (:) (CaseClause -> [CaseClause] -> [CaseClause])
-> ParsecT D U Identity CaseClause
-> ParsecT D U Identity ([CaseClause] -> [CaseClause])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CaseTerm -> CaseClause
f (CaseTerm -> CaseClause)
-> ParsecT D U Identity CaseTerm -> ParsecT D U Identity CaseClause
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity CaseTerm
forall {u}. ParsecT D u Identity CaseTerm
clauseTerm) ParsecT D U Identity ([CaseClause] -> [CaseClause])
-> ParsecT D U Identity ()
-> ParsecT D U Identity ([CaseClause] -> [CaseClause])
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList ParsecT D U Identity ([CaseClause] -> [CaseClause])
-> ParsecT D U Identity [CaseClause]
-> ParsecT D U Identity [CaseClause]
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity [CaseClause]
clauses
               ParsecT D U Identity [CaseClause]
-> ParsecT D U Identity [CaseClause]
-> ParsecT D U Identity [CaseClause]
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [CaseTerm -> CaseClause
f CaseTerm
Break] [CaseClause]
-> ParsecT D U Identity () -> ParsecT D U Identity [CaseClause]
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT D U Identity ()
newlineList ParsecT D U Identity [CaseClause]
-> ParsecT D U Identity Word -> ParsecT D U Identity [CaseClause]
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"esac"

    pattern :: ParsecT D u Identity [Word]
pattern = ParsecT D u Identity SourceName
-> ParsecT D u Identity (Maybe SourceName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"(")
           ParsecT D u Identity (Maybe SourceName)
-> ParsecT D u Identity [Word] -> ParsecT D u Identity [Word]
forall a b.
ParsecT D u Identity a
-> ParsecT D u Identity b -> ParsecT D u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT D u Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord ParsecT D u Identity Word
-> ParsecT D u Identity SourceName -> ParsecT D u Identity [Word]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"|"
          ParsecT D u Identity [Word]
-> ParsecT D u Identity SourceName -> ParsecT D u Identity [Word]
forall a b.
ParsecT D u Identity a
-> ParsecT D u Identity b -> ParsecT D u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
")"
          ParsecT D u Identity [Word]
-> SourceName -> ParsecT D u Identity [Word]
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"pattern list"

    clauseTerm :: ParsecT D u Identity CaseTerm
clauseTerm = (SourceName -> ParsecT D u Identity SourceName)
-> ParsecT D u Identity CaseTerm
forall (f :: * -> *) a c.
(Alternative f, Operator a) =>
(SourceName -> f c) -> f a
selectOperator SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator ParsecT D u Identity CaseTerm
-> SourceName -> ParsecT D u Identity CaseTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"case clause terminator"

-- | Parse a @while@ command.
whileCommand :: Parser ShellCommand
whileCommand :: Parser ShellCommand
whileCommand = List -> List -> ShellCommand
While (List -> List -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (List -> List -> ShellCommand)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"while"
           ParsecT D U Identity (List -> List -> ShellCommand)
-> Parsec D U List -> ParsecT D U Identity (List -> ShellCommand)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList
           ParsecT D U Identity (List -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (List -> ShellCommand)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"do" ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList Parser ShellCommand
-> ParsecT D U Identity Word -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"done"

-- | Parse an @until@ command.
untilCommand :: Parser ShellCommand
untilCommand :: Parser ShellCommand
untilCommand = List -> List -> ShellCommand
Until (List -> List -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (List -> List -> ShellCommand)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"until"
           ParsecT D U Identity (List -> List -> ShellCommand)
-> Parsec D U List -> ParsecT D U Identity (List -> ShellCommand)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList
           ParsecT D U Identity (List -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (List -> ShellCommand)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"do" ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList Parser ShellCommand
-> ParsecT D U Identity Word -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"done"

-- | Parse a list of words for a @for@ or @select@ command.
wordList :: Parser WordList
wordList :: Parser WordList
wordList = WordList
Args WordList -> Parser SourceName -> Parser WordList
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
";" Parser WordList -> ParsecT D U Identity () -> Parser WordList
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList
       Parser WordList -> Parser WordList -> Parser WordList
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT D U Identity ()
newlineList ParsecT D U Identity () -> Parser WordList -> Parser WordList
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WordList
inList
       Parser WordList -> SourceName -> Parser WordList
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"word list"
  where
    inList :: Parser WordList
inList = [Word] -> WordList
WordList ([Word] -> WordList)
-> ParsecT D U Identity Word
-> ParsecT D U Identity ([Word] -> WordList)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"in" ParsecT D U Identity ([Word] -> WordList)
-> ParsecT D U Identity [Word] -> Parser WordList
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity Word -> ParsecT D U Identity [Word]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord Parser WordList -> Parser ListTerm -> Parser WordList
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ListTerm
listTerm
         Parser WordList -> Parser WordList -> Parser WordList
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WordList -> Parser WordList
forall a. a -> ParsecT D U Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WordList
Args

-- | Parse a @for@ command.
forCommand :: Parser ShellCommand
forCommand :: Parser ShellCommand
forCommand = SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"for" ParsecT D U Identity Word
-> Parser ShellCommand -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ShellCommand
arithFor_ Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
for_)
  where
    arithFor_ :: Parser ShellCommand
arithFor_ = SourceName -> List -> ShellCommand
ArithFor (SourceName -> List -> ShellCommand)
-> Parser SourceName -> ParsecT D U Identity (List -> ShellCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
arith ParsecT D U Identity (List -> ShellCommand)
-> ParsecT D U Identity (Maybe ListTerm)
-> ParsecT D U Identity (List -> ShellCommand)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ListTerm -> ParsecT D U Identity (Maybe ListTerm)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ListTerm
listTerm ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
doGroup

    for_ :: Parser ShellCommand
for_ = SourceName -> WordList -> List -> ShellCommand
For (SourceName -> WordList -> List -> ShellCommand)
-> Parser SourceName
-> ParsecT D U Identity (WordList -> List -> ShellCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
name ParsecT D U Identity (WordList -> List -> ShellCommand)
-> Parser WordList -> ParsecT D U Identity (List -> ShellCommand)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WordList
wordList ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
doGroup

-- | Parse a @select@ command.
selectCommand :: Parser ShellCommand
selectCommand :: Parser ShellCommand
selectCommand = SourceName -> WordList -> List -> ShellCommand
Select (SourceName -> WordList -> List -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT
     D U Identity (SourceName -> WordList -> List -> ShellCommand)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"select" ParsecT
  D U Identity (SourceName -> WordList -> List -> ShellCommand)
-> Parser SourceName
-> ParsecT D U Identity (WordList -> List -> ShellCommand)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
name ParsecT D U Identity (WordList -> List -> ShellCommand)
-> Parser WordList -> ParsecT D U Identity (List -> ShellCommand)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WordList
wordList ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
doGroup

-- | Parse an @if@ command.
ifCommand :: Parser ShellCommand
ifCommand :: Parser ShellCommand
ifCommand = SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"if" ParsecT D U Identity Word
-> Parser ShellCommand -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ShellCommand
if_
  where
    if_ :: Parser ShellCommand
if_ = List -> List -> Maybe List -> ShellCommand
If (List -> List -> Maybe List -> ShellCommand)
-> Parsec D U List
-> ParsecT D U Identity (List -> Maybe List -> ShellCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec D U List
compoundList ParsecT D U Identity (List -> Maybe List -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (List -> Maybe List -> ShellCommand)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"then" ParsecT D U Identity (List -> Maybe List -> ShellCommand)
-> Parsec D U List
-> ParsecT D U Identity (Maybe List -> ShellCommand)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList ParsecT D U Identity (Maybe List -> ShellCommand)
-> ParsecT D U Identity (Maybe List) -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity (Maybe List)
alternative

    alternative :: ParsecT D U Identity (Maybe List)
alternative = List -> Maybe List
forall a. a -> Maybe a
Just (List -> Maybe List)
-> (ShellCommand -> List) -> ShellCommand -> Maybe List
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShellCommand -> List
singleton (ShellCommand -> Maybe List)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (ShellCommand -> Maybe List)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"elif" ParsecT D U Identity (ShellCommand -> Maybe List)
-> Parser ShellCommand -> ParsecT D U Identity (Maybe List)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ShellCommand
if_
              ParsecT D U Identity (Maybe List)
-> ParsecT D U Identity (Maybe List)
-> ParsecT D U Identity (Maybe List)
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> List -> Maybe List
forall a. a -> Maybe a
Just             (List -> Maybe List)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (List -> Maybe List)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"else" ParsecT D U Identity (List -> Maybe List)
-> Parsec D U List -> ParsecT D U Identity (Maybe List)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList ParsecT D U Identity (Maybe List)
-> ParsecT D U Identity Word -> ParsecT D U Identity (Maybe List)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"fi"
              ParsecT D U Identity (Maybe List)
-> ParsecT D U Identity (Maybe List)
-> ParsecT D U Identity (Maybe List)
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe List
forall a. Maybe a
Nothing          Maybe List
-> ParsecT D U Identity Word -> ParsecT D U Identity (Maybe List)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"fi"

-- | Parse a subshell command.
subshell :: Parser ShellCommand
subshell :: Parser ShellCommand
subshell = List -> ShellCommand
Subshell (List -> ShellCommand)
-> Parser SourceName -> ParsecT D U Identity (List -> ShellCommand)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"(" ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList Parser ShellCommand -> Parser SourceName -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
")"

-- | Parse a command group.
group :: Parser ShellCommand
group :: Parser ShellCommand
group = List -> ShellCommand
Group (List -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (List -> ShellCommand)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"{" ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
compoundList Parser ShellCommand
-> ParsecT D U Identity Word -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"}"

-- | Parse an arithmetic command.
arithCommand :: Parser ShellCommand
arithCommand :: Parser ShellCommand
arithCommand = SourceName -> ShellCommand
Arith (SourceName -> ShellCommand)
-> Parser SourceName -> Parser ShellCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
arith

-- | Parse a conditional command.
condCommand :: Parser ShellCommand
condCommand :: Parser ShellCommand
condCommand = CondExpr Word -> ShellCommand
Cond (CondExpr Word -> ShellCommand)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (CondExpr Word -> ShellCommand)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"[[" ParsecT D U Identity (CondExpr Word -> ShellCommand)
-> ParsecT D U Identity (CondExpr Word) -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity (CondExpr Word)
expr Parser ShellCommand
-> ParsecT D U Identity Word -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"]]"
  where
    expr :: ParsecT D U Identity (CondExpr Word)
expr = OperatorTable D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser OperatorTable D U Identity (CondExpr Word)
forall {u} {a}. [[Operator D u Identity (CondExpr a)]]
opTable ParsecT D U Identity (CondExpr Word)
term

    term :: ParsecT D U Identity (CondExpr Word)
term = SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"(" Parser SourceName
-> ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT D U Identity (CondExpr Word)
expr ParsecT D U Identity (CondExpr Word)
-> Parser SourceName -> ParsecT D U Identity (CondExpr Word)
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> Parser SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
")"
       ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UnaryOp -> Word -> CondExpr Word
forall a. UnaryOp -> a -> CondExpr a
Cond.Unary (UnaryOp -> Word -> CondExpr Word)
-> ParsecT D U Identity UnaryOp
-> ParsecT D U Identity (Word -> CondExpr Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity UnaryOp
forall {u}. ParsecT D u Identity UnaryOp
unaryOp ParsecT D U Identity (Word -> CondExpr Word)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (CondExpr Word)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity Word
forall {u}. ParsecT D u Identity Word
condWord
       ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT D U Identity Word
forall {u}. ParsecT D u Identity Word
condWord ParsecT D U Identity Word
-> (Word -> ParsecT D U Identity (CondExpr Word))
-> ParsecT D U Identity (CondExpr Word)
forall a b.
ParsecT D U Identity a
-> (a -> ParsecT D U Identity b) -> ParsecT D U Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> ParsecT D U Identity (CondExpr Word)
wordTerm)

    wordTerm :: Word -> ParsecT D U Identity (CondExpr Word)
wordTerm Word
w = Word -> BinaryOp -> Word -> CondExpr Word
forall a. a -> BinaryOp -> a -> CondExpr a
Cond.Binary Word
w BinaryOp
Cond.StrMatch (Word -> CondExpr Word)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (Word -> CondExpr Word)
forall a b. a -> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT D U Identity Word -> ParsecT D U Identity Word
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"=~") ParsecT D U Identity (Word -> CondExpr Word)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (CondExpr Word)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity Word
regexWord
             ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word -> BinaryOp -> Word -> CondExpr Word
forall a. a -> BinaryOp -> a -> CondExpr a
Cond.Binary Word
w (BinaryOp -> Word -> CondExpr Word)
-> ParsecT D U Identity BinaryOp
-> ParsecT D U Identity (Word -> CondExpr Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D U Identity BinaryOp
forall {u}. ParsecT D u Identity BinaryOp
binaryOp ParsecT D U Identity (Word -> CondExpr Word)
-> ParsecT D U Identity Word
-> ParsecT D U Identity (CondExpr Word)
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT D U Identity Word
forall {u}. ParsecT D u Identity Word
condWord
             ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
-> ParsecT D U Identity (CondExpr Word)
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CondExpr Word -> ParsecT D U Identity (CondExpr Word)
forall a. a -> ParsecT D U Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnaryOp -> Word -> CondExpr Word
forall a. UnaryOp -> a -> CondExpr a
Cond.Unary UnaryOp
Cond.NonzeroString Word
w)

    opTable :: [[Operator D u Identity (CondExpr a)]]
opTable =
        [ [ParsecT D u Identity (CondExpr a -> CondExpr a)
-> Operator D u Identity (CondExpr a)
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (CondExpr a -> CondExpr a
forall a. CondExpr a -> CondExpr a
Cond.Not (CondExpr a -> CondExpr a)
-> ParsecT D u Identity Word
-> ParsecT D u Identity (CondExpr a -> CondExpr a)
forall a b. a -> ParsecT D u Identity b -> ParsecT D u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D u Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"!")]
        , [ParsecT D u Identity (CondExpr a -> CondExpr a -> CondExpr a)
-> Assoc -> Operator D u Identity (CondExpr a)
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix  (CondExpr a -> CondExpr a -> CondExpr a
forall a. CondExpr a -> CondExpr a -> CondExpr a
Cond.And (CondExpr a -> CondExpr a -> CondExpr a)
-> ParsecT D u Identity SourceName
-> ParsecT D u Identity (CondExpr a -> CondExpr a -> CondExpr a)
forall a b. a -> ParsecT D u Identity b -> ParsecT D u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"&&") Assoc
AssocLeft]
        , [ParsecT D u Identity (CondExpr a -> CondExpr a -> CondExpr a)
-> Assoc -> Operator D u Identity (CondExpr a)
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix  (CondExpr a -> CondExpr a -> CondExpr a
forall a. CondExpr a -> CondExpr a -> CondExpr a
Cond.Or  (CondExpr a -> CondExpr a -> CondExpr a)
-> ParsecT D u Identity SourceName
-> ParsecT D u Identity (CondExpr a -> CondExpr a -> CondExpr a)
forall a b. a -> ParsecT D u Identity b -> ParsecT D u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"||") Assoc
AssocLeft]
        ]

    condWord :: ParsecT D u Identity Word
condWord = ParsecT D u Identity Word
forall (m :: * -> *) u. Monad m => ParsecT D u m Word
anyWord ParsecT D u Identity Word
-> (Word -> Bool) -> ParsecT D u Identity Word
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> (a -> Bool) -> ParsecT s u m a
`satisfying` (Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= SourceName -> Word
stringToWord SourceName
"]]")
           ParsecT D u Identity Word
-> ParsecT D u Identity Word -> ParsecT D u Identity Word
forall a.
ParsecT D u Identity a
-> ParsecT D u Identity a -> ParsecT D u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceName -> Word
stringToWord (SourceName -> Word)
-> ParsecT D u Identity SourceName -> ParsecT D u Identity Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT D u Identity SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
anyOperator
           ParsecT D u Identity Word
-> SourceName -> ParsecT D u Identity Word
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"word"

    condOperator :: SourceName -> ParsecT D u Identity Word
condOperator SourceName
op = ParsecT D u Identity Word
forall {u}. ParsecT D u Identity Word
condWord ParsecT D u Identity Word
-> (Word -> Bool) -> ParsecT D u Identity Word
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> (a -> Bool) -> ParsecT s u m a
`satisfying` (Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName -> Word
stringToWord SourceName
op) ParsecT D u Identity Word
-> SourceName -> ParsecT D u Identity Word
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
op

    unaryOp :: ParsecT D u Identity UnaryOp
unaryOp  = (SourceName -> ParsecT D u Identity Word)
-> ParsecT D u Identity UnaryOp
forall (f :: * -> *) a c.
(Alternative f, Operator a) =>
(SourceName -> f c) -> f a
selectOperator SourceName -> ParsecT D u Identity Word
forall {u}. SourceName -> ParsecT D u Identity Word
condOperator ParsecT D u Identity UnaryOp
-> SourceName -> ParsecT D u Identity UnaryOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"unary operator"
    binaryOp :: ParsecT D u Identity BinaryOp
binaryOp = (SourceName -> ParsecT D u Identity Word)
-> ParsecT D u Identity BinaryOp
forall (f :: * -> *) a c.
(Alternative f, Operator a) =>
(SourceName -> f c) -> f a
selectOperator SourceName -> ParsecT D u Identity Word
forall {u}. SourceName -> ParsecT D u Identity Word
condOperator ParsecT D u Identity BinaryOp
-> SourceName -> ParsecT D u Identity BinaryOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"binary operator"

    regexWord :: ParsecT D U Identity Word
regexWord = SourceName -> Word
stringToWord (SourceName -> Word)
-> ([SourceName] -> SourceName) -> [SourceName] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SourceName] -> SourceName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([SourceName] -> Word)
-> ParsecT D U Identity [SourceName] -> ParsecT D U Identity Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SourceName -> ParsecT D U Identity [SourceName]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (SourceName -> Parser SourceName
regexPart SourceName
" \t\r\n") ParsecT D U Identity Word
-> ParsecT D U Identity () -> ParsecT D U Identity Word
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpace
            ParsecT D U Identity Word
-> SourceName -> ParsecT D U Identity Word
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"regular expression"

    regexPart :: SourceName -> Parser SourceName
regexPart SourceName
delims = Parser SourceName
regexParens
                   Parser SourceName -> Parser SourceName -> Parser SourceName
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SourceName
regexSingleQuote
                   Parser SourceName -> Parser SourceName -> Parser SourceName
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SourceName
regexDoubleQuote
                   Parser SourceName -> Parser SourceName -> Parser SourceName
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SourceName
forall {u}. ParsecT D u Identity SourceName
regexEscape
                   Parser SourceName -> Parser SourceName -> Parser SourceName
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceName -> Parser SourceName
regexChar SourceName
delims

    regexDelimiters :: Char -> Parser String -> Char -> Parser String
    regexDelimiters :: Char -> Parser SourceName -> Char -> Parser SourceName
regexDelimiters Char
begin Parser SourceName
middle Char
end = do
        Char
_ <- Char -> ParsecT D U Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
begin
        [SourceName]
parts <- Parser SourceName -> ParsecT D U Identity [SourceName]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser SourceName
middle
        Char
_ <- Char -> ParsecT D U Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
end
        SourceName -> Parser SourceName
forall a. a -> ParsecT D U Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName -> Parser SourceName)
-> SourceName -> Parser SourceName
forall a b. (a -> b) -> a -> b
$ [Char
begin] SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ [SourceName] -> SourceName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [SourceName]
parts SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ [Char
end]

    regexParens :: Parser SourceName
regexParens = Char -> Parser SourceName -> Char -> Parser SourceName
regexDelimiters Char
'(' (SourceName -> Parser SourceName
regexPart SourceName
")") Char
')'

    regexSingleQuote :: Parser SourceName
regexSingleQuote = Char -> Parser SourceName -> Char -> Parser SourceName
regexDelimiters Char
'\'' Parser SourceName
forall {u}. ParsecT D u Identity SourceName
singleQuoteChar Char
'\''
      where
        singleQuoteChar :: ParsecT D u Identity SourceName
singleQuoteChar = [ParsecT D u Identity Char] -> ParsecT D u Identity SourceName
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Char -> ParsecT D u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\', ParsecT D u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar]
                      ParsecT D u Identity SourceName
-> ParsecT D u Identity SourceName
-> ParsecT D u Identity SourceName
forall a.
ParsecT D u Identity a
-> ParsecT D u Identity a -> ParsecT D u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> SourceName -> SourceName
forall a. a -> [a] -> [a]
:[]) (Char -> SourceName)
-> ParsecT D u Identity Char -> ParsecT D u Identity SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> ParsecT D u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
"'"

    regexDoubleQuote :: Parser SourceName
regexDoubleQuote = Char -> Parser SourceName -> Char -> Parser SourceName
regexDelimiters Char
'"' Parser SourceName
forall {u}. ParsecT D u Identity SourceName
doubleQuoteChar Char
'"'
      where
        doubleQuoteChar :: ParsecT D u Identity SourceName
doubleQuoteChar = [ParsecT D u Identity Char] -> ParsecT D u Identity SourceName
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Char -> ParsecT D u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\', ParsecT D u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar]
                      ParsecT D u Identity SourceName
-> ParsecT D u Identity SourceName
-> ParsecT D u Identity SourceName
forall a.
ParsecT D u Identity a
-> ParsecT D u Identity a -> ParsecT D u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> SourceName -> SourceName
forall a. a -> [a] -> [a]
:[]) (Char -> SourceName)
-> ParsecT D u Identity Char -> ParsecT D u Identity SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> ParsecT D u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
"\""

    regexEscape :: ParsecT D u Identity SourceName
regexEscape = [ParsecT D u Identity Char] -> ParsecT D u Identity SourceName
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Char -> ParsecT D u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\', ParsecT D u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar]

    regexChar :: [Char] -> Parser String
    regexChar :: SourceName -> Parser SourceName
regexChar SourceName
delims = (Char -> SourceName -> SourceName
forall a. a -> [a] -> [a]
:[]) (Char -> SourceName)
-> ParsecT D U Identity Char -> Parser SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> ParsecT D U Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
delims

-------------------------------------------------------------------------------
-- Coprocesses
-------------------------------------------------------------------------------

-- | Parse a coprocess command.
coproc :: Parser ShellCommand
coproc :: Parser ShellCommand
coproc = SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"coproc" ParsecT D U Identity Word
-> Parser ShellCommand -> Parser ShellCommand
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ShellCommand
coprocCommand Parser ShellCommand -> SourceName -> Parser ShellCommand
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"coprocess"
  where
    coprocCommand :: Parser ShellCommand
coprocCommand = SourceName -> Command -> ShellCommand
Coproc (SourceName -> Command -> ShellCommand)
-> Parser SourceName
-> ParsecT D U Identity (Command -> ShellCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> Parser SourceName -> Parser SourceName
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option SourceName
"COPROC" Parser SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
name
                           ParsecT D U Identity (Command -> ShellCommand)
-> Parser Command -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ShellCommand -> [Redir] -> Command
Command (ShellCommand -> [Redir] -> Command)
-> Parser ShellCommand -> ParsecT D U Identity ([Redir] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ShellCommand
shellCommand ParsecT D U Identity ([Redir] -> Command)
-> Parser [Redir] -> Parser Command
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Redir] -> Parser [Redir]
forall a. a -> ParsecT D U Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
                Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> SourceName -> Command -> ShellCommand
Coproc SourceName
"COPROC" (Command -> ShellCommand) -> Parser Command -> Parser ShellCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Command
simpleCommand

-------------------------------------------------------------------------------
-- Function definitions
-------------------------------------------------------------------------------

-- | Parse a function definition.
functionDef :: Parser ShellCommand
functionDef :: Parser ShellCommand
functionDef = Parser ShellCommand
functionDef2
          Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
functionDef1
          Parser ShellCommand -> SourceName -> Parser ShellCommand
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function definition"
  where
    functionDef1 :: Parser ShellCommand
functionDef1 = SourceName -> List -> ShellCommand
FunctionDef
               (SourceName -> List -> ShellCommand)
-> Parser SourceName -> ParsecT D U Identity (List -> ShellCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SourceName -> Parser SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (SourceName -> ParsecT D U Identity Word
forall (m :: * -> *) u. Monad m => SourceName -> ParsecT D u m Word
word SourceName
"function" ParsecT D U Identity Word -> Parser SourceName -> Parser SourceName
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
functionName
                        Parser SourceName
-> ParsecT D U Identity (Maybe SourceName) -> Parser SourceName
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser SourceName -> ParsecT D U Identity (Maybe SourceName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SourceName
forall {u}. ParsecT D u Identity SourceName
functionParens Parser SourceName -> ParsecT D U Identity () -> Parser SourceName
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList)
               ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
functionBody

    functionDef2 :: Parser ShellCommand
functionDef2 = SourceName -> List -> ShellCommand
FunctionDef
               (SourceName -> List -> ShellCommand)
-> Parser SourceName -> ParsecT D U Identity (List -> ShellCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SourceName -> Parser SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser SourceName
forall (m :: * -> *) u. Monad m => ParsecT D u m SourceName
functionName Parser SourceName -> Parser SourceName -> Parser SourceName
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser SourceName
forall {u}. ParsecT D u Identity SourceName
functionParens Parser SourceName -> ParsecT D U Identity () -> Parser SourceName
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
newlineList)
               ParsecT D U Identity (List -> ShellCommand)
-> Parsec D U List -> Parser ShellCommand
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec D U List
functionBody

    functionParens :: ParsecT D u Identity SourceName
functionParens = SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
"(" ParsecT D u Identity SourceName
-> ParsecT D u Identity SourceName
-> ParsecT D u Identity SourceName
forall a b.
ParsecT D u Identity a
-> ParsecT D u Identity b -> ParsecT D u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SourceName -> ParsecT D u Identity SourceName
forall (m :: * -> *) u.
Monad m =>
SourceName -> ParsecT D u m SourceName
operator SourceName
")"

    functionBody :: Parsec D U List
functionBody = ShellCommand -> List
unwrap (ShellCommand -> List) -> Parser ShellCommand -> Parsec D U List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ShellCommand
group
               Parsec D U List -> Parsec D U List -> Parsec D U List
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ShellCommand -> List
singleton (ShellCommand -> List) -> Parser ShellCommand -> Parsec D U List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ShellCommand
shellCommand

    unwrap :: ShellCommand -> List
unwrap (Group List
l) = List
l
    unwrap ShellCommand
_         = [Statement] -> List
List []

-------------------------------------------------------------------------------
-- Commands
-------------------------------------------------------------------------------

-- | Parse a single command.
command :: Parser Command
command :: Parser Command
command = ShellCommand -> [Redir] -> Command
Command (ShellCommand -> [Redir] -> Command)
-> Parser ShellCommand -> ParsecT D U Identity ([Redir] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ShellCommand
compoundCommand ParsecT D U Identity ([Redir] -> Command)
-> Parser [Redir] -> Parser Command
forall a b.
ParsecT D U Identity (a -> b)
-> ParsecT D U Identity a -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Redir]
redirList
      Parser Command -> Parser Command -> Parser Command
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
simpleCommand
      Parser Command -> SourceName -> Parser Command
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"command"
  where
    compoundCommand :: Parser ShellCommand
compoundCommand = Parser ShellCommand
shellCommand
                  Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
coproc
                  Parser ShellCommand -> Parser ShellCommand -> Parser ShellCommand
forall a.
ParsecT D U Identity a
-> ParsecT D U Identity a -> ParsecT D U Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ShellCommand
functionDef

-- | Parse an entire script (e.g. a file) as a list of commands.
script :: Parser List
script :: Parsec D U List
script = ParsecT D U Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpace ParsecT D U Identity () -> Parsec D U List -> Parsec D U List
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec D U List
inputList Parsec D U List -> ParsecT D U Identity () -> Parsec D U List
forall a b.
ParsecT D U Identity a
-> ParsecT D U Identity b -> ParsecT D U Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT D U Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof