language-bash (empty) → 0.2.0

raw patch · 11 files changed

+1351/−0 lines, 11 filesdep +basedep +parsecdep +prettysetup-changed

Dependencies added: base, parsec, pretty, transformers

Files

• .gitignore +4/−0
• LICENSE +30/−0
• README.md +4/−0
• Setup.hs +2/−0
• language-bash.cabal +44/−0
• src/Language/Bash/Parse.hs +396/−0
• src/Language/Bash/Parse/Builder.hs +109/−0
• src/Language/Bash/Parse/Internal.hs +196/−0
• src/Language/Bash/Parse/Packrat.hs +186/−0
• src/Language/Bash/Pretty.hs +155/−0
• src/Language/Bash/Syntax.hs +225/−0

@@ -0,0 +1,4 @@+dist/+cabal-dev/+*.o+*.hi

@@ -0,0 +1,30 @@+Copyright (c) 2013, Kyle Raftogianis++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Kyle Raftogianis nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,4 @@+language-bash+-------------++A library for parsing and pretty-printing Bash shell scripts.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,44 @@+name:               language-bash+version:            0.2.0+category:           Language+license:            BSD3+license-file:       LICENSE+author:             Kyle Raftogianis+maintainer:         Kyle Raftogianis <kylerafto@gmail.com>+copyright:          Copyright (c) 2013 Kyle Raftogianis+build-type:         Simple+cabal-version:      >= 1.8+homepage:           http://github.com/knrafto/language-bash/+bug-reports:        http://github.com/knrafto/language-bash/issues+synopsis:           Parsing and pretty-printing Bash shell scripts+description:+    A library for parsing and pretty-printing Bash shell scripts.++extra-source-files:+  .gitignore+  README.md++source-repository head+  type: git+  location: git://github.com/knrafto/language-bash.git++library+  hs-source-dirs: src++  exposed-modules:+    Language.Bash.Parse+    Language.Bash.Parse.Builder+    Language.Bash.Pretty+    Language.Bash.Syntax++  other-modules:+    Language.Bash.Parse.Internal+    Language.Bash.Parse.Packrat++  build-depends:+    base         >= 4   && < 5,+    parsec       >= 3.0 && < 4.0,+    pretty       >= 1.0 && < 2.0,+    transformers >= 0.2 && < 0.4++  ghc-options: -Wall

@@ -0,0 +1,396 @@+-- | 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.Pos+import           Text.Parsec.Prim             hiding (parse, (<|>))++import qualified Language.Bash.Parse.Internal as I+import           Language.Bash.Parse.Packrat+import           Language.Bash.Syntax++-- | User state.+data U = 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 source = runParser script (U Nothing) source . pack (initialPos source)++-------------------------------------------------------------------------------+-- Basic parsers+-------------------------------------------------------------------------------++infixl 3 </>+infix  0 ?:++-- | Backtracking choice.+(</>) :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a+p </> q = try p <|> q++-- | Name a parser from the front.+(?:) :: String -> ParsecT s u m a -> ParsecT s u m a+(?:) = flip (<?>)++-- | Get the next line of input.+line :: Parser String+line = lookAhead anyChar *> many (satisfy (/= '\n')) <* optional (char '\n')++-- | Parse the next here document.+heredoc :: Bool -> String -> Parser String+heredoc strip end = "here document" ?: do+    (h, s) <- lookAhead duck+    setState $ U (Just s)+    return h+  where+    process = if strip then dropWhile (== '\t') else id++    duck = do+        u <- getState+        case postHeredoc u of+            Nothing -> () <$ line+            Just s  -> () <$ setParserState s+        h <- unlines <$> heredocLines+        s <- getParserState+        return (h, s)++    heredocLines = do+        l <- process <$> line+        if l == end then return [] else (l :) <$> heredocLines++-- | Parse a newline, skipping any here documents.+newline :: Parser String+newline = "newline" ?: do+    _ <- operator "\n"+    u <- getState+    case postHeredoc u of+        Nothing -> return ()+        Just s  -> () <$ setParserState s+    setState $ U Nothing+    return "\n"++-- | Parse a list terminator.+listTerm :: Parser ListTerm+listTerm = term <* newlineList <?> "list terminator"+  where+    term = Sequential   <$ newline+       <|> Sequential   <$ operator ";"+       <|> Asynchronous <$ operator "&"++-- | Skip zero or more newlines.+newlineList :: Parser ()+newlineList = skipMany newline++-------------------------------------------------------------------------------+-- Simple commands+-------------------------------------------------------------------------------++-- | Skip a redirection.+redir :: Parser Redir+redir = normalRedir+    <|> heredocRedir+    <?> "redirection"+  where+    normalRedir = do+        desc   <- optional ioDesc+        op     <- redirOperator+        target <- anyWord+        return Redir+            { redirDesc   = desc+            , redirOp     = op+            , redirTarget = target+            }++    heredocRedir = do+        (strip, op) <- heredocOperator+        w <- anyWord+        let delim = I.unquote w+        h <- heredoc strip delim+        return Heredoc+            { redirOp            = op+            , heredocDelim       = delim+            , heredocDelimQuoted = delim /= w+            , document           = h+            }++    heredocOperator = (,) False <$> operator "<<"+                  <|> (,) True  <$> operator "<<-"++-- | Skip a list of redirections.+redirList :: Parser [Redir]+redirList = many redir++-- | Parse part of a command.+commandParts :: Parser a -> Parser ([a], [Redir])+commandParts p = partitionEithers <$> many part+  where+    part = Left  <$> p+       <|> Right <$> redir++-- | Parse a simple command.+simpleCommand :: Parser Command+simpleCommand = do+    notFollowedBy reservedWord+    assignCommand </> normalCommand+  where+    assignCommand = "assignment builtin" ?: do+        rs1 <- redirList+        w <- assignBuiltin+        (args, rs2) <- commandParts assignArg+        return $ Command (AssignBuiltin w args) (rs1 ++ rs2)++    normalCommand = "simple command" ?: do+        (as, rs1) <- commandParts assign+        (ws, rs2) <- commandParts anyWord+        guard (not $ null as && null ws)+        return $ Command (SimpleCommand as ws) (rs1 ++ rs2)++    assignArg = Left  <$> assign+            <|> Right <$> anyWord++-------------------------------------------------------------------------------+-- Lists+-------------------------------------------------------------------------------++-- | A list with one command.+singleton :: ShellCommand -> List+singleton c =+    List [Statement (Last (unmodifiedPipeline [Command c []])) Sequential]++-- | An unmodified pipeline.+unmodifiedPipeline :: [Command] -> Pipeline+unmodifiedPipeline cs = Pipeline+    { timed      = False+    , timedPosix = False+    , inverted   = False+    , commands   = cs+    }++-- | Parse a pipeline.+pipelineCommand :: Parser Pipeline+pipelineCommand = time+              <|> invert+              <|> pipeline1+              <?> "pipeline"+  where+    invert = do+        _ <- word "!"+        p <- pipeline0+        return $ p { inverted = not (inverted p) }++    time = do+        _ <- word "time"+        p <- posixFlag <|> invert <|> pipeline0+        return $ p { timed = True }++    posixFlag = do+        _ <- word "-p"+        _ <- optional (word "--")+        p <- invert <|> pipeline0+        return $ p { timedPosix = True }++    pipeline0 = unmodifiedPipeline <$> commandList0+    pipeline1 = unmodifiedPipeline <$> commandList1++    commandList0 = option [] commandList1+    commandList1 = do+        c <- command+        pipelineSep c <|> pure [c]++    pipelineSep c = do+        c' <- c          <$ operator "|"+          <|> addRedir c <$ operator "|&"+        (c' :) <$> commandList0++    addRedir (Command c rs) = Command c (stderrRedir : rs)++    stderrRedir = Redir (Just (IONumber 2)) ">&" "1"++-- | Parse a compound list of commands.+compoundList :: Parser List+compoundList = List <$ newlineList <*> many1 statement <?> "list"+  where+    statement = Statement <$> andOr <*> option Sequential listTerm++    andOr = do+        p <- pipelineCommand+        let rest = And p <$ operator "&&" <* newlineList <*> andOr+               <|> Or  p <$ operator "||" <* newlineList <*> andOr+        rest <|> pure (Last p)++-- | Parse a possible empty compound list of commands.+inputList :: Parser List+inputList = newlineList *> option (List []) compoundList++-- | Parse a command group, wrapped either in braces or in a @do...done@ block.+doGroup :: Parser List+doGroup = word "do" *> compoundList <* word "done"+      <|> word "{"  *> compoundList <* word "}"++-------------------------------------------------------------------------------+-- Compound commands+-------------------------------------------------------------------------------++-- | Parse a compound command.+shellCommand :: Parser ShellCommand+shellCommand = group+           <|> ifCommand+           <|> caseCommand+           <|> forCommand+           <|> whileCommand+           <|> untilCommand+           <|> selectCommand+           <|> condCommand+           <|> arithCommand+           <|> subshell+           <?> "compound command"++-- | Parse a @case@ command.+caseCommand :: Parser ShellCommand+caseCommand = Case <$ word "case"+          <*> anyWord <* newlineList+          <*  word "in" <* newlineList+          <*> clauses+  where+    clauses = [] <$ word "esac"+          <|> do p <- pattern+                 c <- inputList+                 nextClause (CaseClause p c)++    nextClause f = (:) <$> (f <$> clauseTerm) <* newlineList <*> clauses+               <|> [f Break] <$ newlineList <* word "esac"++    pattern = optional (operator "(")+           *> anyWord `sepBy` operator "|"+          <*  operator ")"+          <?> "pattern list"++    clauseTerm = Break       <$ operator ";;"+             <|> FallThrough <$ operator ";&"+             <|> Continue    <$ operator ";;&"+             <?> "case clause terminator"++-- | Parse a @while@ command.+whileCommand :: Parser ShellCommand+whileCommand = While <$ word "while"+           <*> compoundList+           <*  word "do" <*> compoundList <* word "done"++-- | Parse an @until@ command.+untilCommand :: Parser ShellCommand+untilCommand = Until <$ word "until"+           <*> compoundList+           <*  word "do" <*> compoundList <* word "done"++-- | Parse a list of words for a @for@ or @select@ command.+wordList :: Parser [Word]+wordList = ["$@\""] <$ operator ";" <* newlineList+       <|> newlineList *> inList+       <?> "word list"+  where+    inList = word "in" *> many anyWord <* listTerm+         <|> return ["$@\""]++-- | Parse a @for@ command.+forCommand :: Parser ShellCommand+forCommand = word "for" *> (arithFor_ <|> for_)+  where+    arithFor_ = ArithFor <$> arith <* optional listTerm <*> doGroup++    for_ = For <$> anyWord <*> wordList <*> doGroup++-- | Parse a @select@ command.+selectCommand :: Parser ShellCommand+selectCommand = Select <$ word "select" <*> anyWord <*> wordList <*> doGroup++-- | Parse an @if@ command.+ifCommand :: Parser ShellCommand+ifCommand = word "if" *> if_+  where+    if_ = If <$> compoundList <* word "then" <*> compoundList <*> alternative++    alternative = Just . singleton <$ word "elif" <*> if_+              <|> Just             <$ word "else" <*> compoundList <* word "fi"+              <|> Nothing          <$ word "fi"++-- | Parse a subshell command.+subshell :: Parser ShellCommand+subshell = Subshell <$ operator "(" <*> compoundList <* operator ")"++-- | Parse a command group.+group :: Parser ShellCommand+group = Group <$ word "{" <*> compoundList <* word "}"++-- | Parse an arithmetic command.+arithCommand :: Parser ShellCommand+arithCommand = Arith <$> arith++-- | Parse a conditional command.+condCommand :: Parser ShellCommand+condCommand = Cond <$ word "[[" <*> many1 condWord <* word "]]"++-------------------------------------------------------------------------------+-- Coprocesses+-------------------------------------------------------------------------------++-- | Parse a coprocess command.+coproc :: Parser ShellCommand+coproc = word "coproc" *> coprocCommand <?> "coprocess"+  where+    coprocCommand = Coproc <$> option "COPROC" name+                           <*> (Command <$> shellCommand <*> pure [])+                </> Coproc "COPROC" <$> simpleCommand++-------------------------------------------------------------------------------+-- Function definitions+-------------------------------------------------------------------------------++-- | Parse a function definition.+functionDef :: Parser ShellCommand+functionDef = functionDef2+          </> functionDef1+          <?> "function definition"+  where+    functionDef1 = FunctionDef <$ word "function" <*> anyWord+               <*  optional functionParens <* newlineList+               <*> functionBody++    functionDef2 = FunctionDef <$> unreservedWord+               <*  functionParens <* newlineList+               <*> functionBody++    functionParens = operator "(" <* operator ")"++    functionBody = unwrap <$> group+               <|> singleton <$> shellCommand++    unwrap (Group l) = l+    unwrap _         = List []++-------------------------------------------------------------------------------+-- Commands+-------------------------------------------------------------------------------++-- | Parse a single command.+command :: Parser Command+command = Command <$> compoundCommand <*> redirList+      <|> simpleCommand+      <?> "command"+  where+    compoundCommand = shellCommand+                  <|> coproc+                  <|> functionDef++-- | Parse an entire script (e.g. a file) as a list of commands.+script :: Parser List+script = skipSpace *> inputList <* eof

@@ -0,0 +1,109 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Builder-based parsing. This is useful for parsing Bash\'s complicated+-- words.+module Language.Bash.Parse.Builder+    ( -- * Builders+      Builder+    , fromChar+    , fromString+    , toString+      -- * Monoid parsing+    , (<+>)+    , many+    , many1+      -- * Characters+    , oneOf+    , noneOf+    , char+    , anyChar+    , satisfy+    , string+      -- * Spans+    , span+    , matchedPair+    ) where++import           Prelude                hiding (span)++import           Control.Applicative    hiding (many)+import qualified Control.Applicative    as Applicative+import           Data.Monoid+import qualified Text.Parsec.Char       as P+import           Text.Parsec.Prim       hiding ((<|>), many)++infixr 4 <+>++-- | An efficient 'String' builder.+type Builder = Endo String++-- | Construct a 'Builder' from a 'Char'.+fromChar :: Char -> Builder+fromChar = Endo . showChar++-- | Construct a 'Builder' from a 'String'.+fromString :: String -> Builder+fromString = Endo . showString++-- | Convert a 'Builder' to a 'String'.+toString :: Builder -> String+toString = flip appEndo ""++-- | Append two monoidal results.+(<+>) :: (Applicative f, Monoid a) => f a -> f a -> f a+(<+>) = liftA2 mappend++-- | Concat zero or more monoidal results.+many :: (Alternative f, Monoid a) => f a -> f a+many = fmap mconcat . Applicative.many++-- | Concat one or more monoidal results.+many1 :: (Alternative f, Monoid a) => f a -> f a+many1 = fmap mconcat . Applicative.some++-- | 'Builder' version of 'P.oneOf'.+oneOf :: Stream s m Char => [Char] -> ParsecT s u m Builder+oneOf cs = fromChar <$> P.oneOf cs++-- | 'Builder' version of 'P.noneOf'.+noneOf :: Stream s m Char => [Char] -> ParsecT s u m Builder+noneOf cs = fromChar <$> P.noneOf cs++-- | 'Builder' version of 'P.char'.+char :: Stream s m Char => Char -> ParsecT s u m Builder+char c = fromChar c <$ P.char c++-- | 'Builder' version of 'P.anyChar'.+anyChar :: Stream s m Char => ParsecT s u m Builder+anyChar = fromChar <$> P.anyChar++-- | 'Builder' version of 'P.satisfy'.+satisfy :: Stream s m Char => (Char -> Bool) -> ParsecT s u m Builder+satisfy p = fromChar <$> P.satisfy p++-- | 'Builder' version of 'P.string'.+string :: Stream s m Char => String -> ParsecT s u m Builder+string s = fromString s <$ P.string s++-- | @span start end escape@ parses a span of text starting with @start@ and+-- ending with @end@, with possible @escape@ sequences inside.+span+    :: Stream s m Char+    => Char+    -> Char+    -> ParsecT s u m Builder+    -> ParsecT s u m Builder+span start end esc = char start *> many inner <* char end+  where+    inner = esc <|> satisfy (/= end)++-- | @matchedPair start end escape@ parses @span start end escape@, including+-- the surrounding @start@ and @end@ characters.+matchedPair+    :: Stream s m Char+    => Char+    -> Char+    -> ParsecT s u m Builder+    -> ParsecT s u m Builder+matchedPair start end esc = char start <+> many inner <+> char end+  where+    inner = esc <|> satisfy (/= end)

@@ -0,0 +1,196 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Low-level parsers.+module Language.Bash.Parse.Internal+    ( skipSpace+    , word+    , arith+    , name+    , assign+    , operator+    , unquote+    ) where++import           Control.Applicative+import           Data.Monoid+import           Text.Parsec.Char+import           Text.Parsec.Combinator      hiding (optional)+import           Text.Parsec.Prim            hiding ((<|>), many)+import           Text.Parsec.String          ()++import           Language.Bash.Parse.Builder (Builder, (<+>))+import qualified Language.Bash.Parse.Builder as B+import           Language.Bash.Syntax++-- | @surroundBy p sep@ parses zero or more occurences of @p@, beginning,+-- ending, and separated by @sep@.+surroundBy+    :: Stream s m t+    => ParsecT s u m a+    -> ParsecT s u m sep+    -> ParsecT s u m [a]+surroundBy p sep = sep *> endBy p sep++-- | Skip spaces, tabs, and comments.+skipSpace :: Stream s m Char => ParsecT s u m ()+skipSpace = skipMany spaceChar <* optional comment <?> "whitespace"+  where+    spaceChar = try (B.string "\\\n")+            <|> B.oneOf " \t"++    comment = char '#' *> many (satisfy (/= '\n'))++-- | Parse a backslash-escaped sequence.+escape :: Stream s m Char => ParsecT s u m Builder+escape = B.char '\\' <+> B.anyChar++-- | Parse a single-quoted string.+singleQuote :: Stream s m Char => ParsecT s u m Builder+singleQuote = B.matchedPair '\'' '\'' empty++-- | Parse a double-quoted string.+doubleQuote :: Stream s m Char => ParsecT s u m Builder+doubleQuote = B.matchedPair '"' '"' $ escape <|> backquote <|> dollar++-- | Parse an ANSI C string.+ansiQuote :: Stream s m Char => ParsecT s u m Builder+ansiQuote = B.char '$' <+> B.matchedPair '\'' '\'' escape++-- | Parse a locale string.+localeQuote :: Stream s m Char => ParsecT s u m Builder+localeQuote = B.char '$' <+> doubleQuote++-- | Parse a backquoted string.+backquote :: Stream s m Char => ParsecT s u m Builder+backquote = B.matchedPair '`' '`' escape++-- | Parse a brace-style parameter expansion, an arithmetic substitution,+-- or a command substitution.+dollar :: Stream s m Char => ParsecT s u m Builder+dollar = B.char '$' <+> rest+  where+    rest = braceParameter+       <|> try arithSubst+       <|> commandSubst+       <|> return mempty++    braceParameter = B.matchedPair '{' '}' $+            escape+        <|> singleQuote+        <|> doubleQuote+        <|> backquote+        <|> dollar++    arithSubst = B.string "((" <+> parens <+> B.string "))"++    commandSubst = subst++-- | Parse a process substitution.+processSubst :: Stream s m Char => ParsecT s u m Builder+processSubst = B.oneOf "<>" <+> subst++-- | Parse a parenthesized substitution.+subst :: Stream s m Char => ParsecT s u m Builder+subst = B.matchedPair '(' ')' $+        subst+    <|> B.char '#' <+> B.many (B.satisfy (/= '\n')) <+> B.char '\n'+    <|> escape+    <|> singleQuote+    <|> doubleQuote+    <|> backquote+    <|> dollar++-- | Parse a parenthesized expression.+parens :: Stream s m Char => ParsecT s u m Builder+parens = B.many inner+  where+    inner = B.matchedPair '(' ')' parens++-- | Parse a word part.+wordSpan :: Stream s m Char => ParsecT s u m Builder+wordSpan = mempty <$ try (string "\\\n")+       <|> escape+       <|> singleQuote+       <|> doubleQuote+       <|> try ansiQuote+       <|> try localeQuote+       <|> backquote+       <|> dollar+       <|> try processSubst++-- | Parse a word.+word :: Stream s m Char => ParsecT s u m String+word = B.toString <$> B.many wordPart <?> "word"+  where+    wordPart = wordSpan+           <|> B.noneOf " \t\n|&;()<>"++-- | Parse an arithmetic expression.+arith :: Stream s m Char => ParsecT s u m String+arith = B.toString <$> parens <?> "arithmetic expression"++-- | Parse a name.+name :: Stream s m Char => ParsecT s u m String+name = (:) <$> nameStart <*> many nameLetter+  where+    nameStart  = letter   <|> char '_'+    nameLetter = alphaNum <|> char '_'++-- | Parse an assignment.+assign :: Stream s m Char => ParsecT s u m Assign+assign = Assign <$> lvalue <*> assignOp <*> rvalue <?> "assignment"+  where+    lvalue = LValue <$> name <*> optional subscript++    subscript = B.toString <$> B.span '[' ']' wordSpan++    assignOp = Equals     <$ string "="+           <|> PlusEquals <$ string "+="++    rvalue = RArray <$  char '(' <*> arrayElems <* char ')'+         <|> RValue <$> word++    arrayElems = arrayElem `surroundBy` skipArraySpace++    arrayElem = do+        s <- optional (subscript <* char '=')+        w <- word+        case (s, w) of+            (Nothing, "") -> empty+            _             -> return (s, w)++    skipArraySpace = char '\n' `surroundBy` skipSpace++-- | Parse the longest available operator from a list.+operator :: Stream s m Char => [String] -> ParsecT s u m String+operator ops = go ops <?> "operator"+  where+    go xs+        | null xs      = empty+        | "" `elem` xs = try (continue xs) <|> pure ""+        | otherwise    = continue xs++    continue xs = do+        c <- anyChar+        (c :) <$> go (prefix c xs)++    prefix c = map tail . filter (\x -> not (null x) && head x == c)++-- | Unquote a word.+unquote :: String -> String+unquote s = case parse unquoteBare s s of+    Left _   -> s+    Right s' -> B.toString s'+  where+    unquoteBare = B.many $+            try unquoteEscape+        <|> try unquoteSingle+        <|> try unquoteDouble+        <|> try unquoteAnsi+        <|> try unquoteLocale+        <|> B.anyChar++    unquoteEscape = char '\\' *> B.anyChar+    unquoteSingle = B.span '\'' '\'' empty+    unquoteDouble = B.span '\"' '\"' unquoteEscape+    unquoteAnsi   = char '$' *> B.span '\'' '\'' unquoteEscape+    unquoteLocale = char '$' *> unquoteDouble

@@ -0,0 +1,186 @@+{-# LANGUAGE+    FlexibleContexts+  , FlexibleInstances+  , LambdaCase+  , MultiParamTypeClasses+  , PatternGuards+  , RecordWildCards+  #-}+-- | Memoized packrat parsing, inspired by Edward Kmett\'s+-- \"A Parsec Full of Rats\".+module Language.Bash.Parse.Packrat+    ( -- * Packrat parsing+      D+    , pack+      -- * Whitespace+    , I.skipSpace+      -- * Words+    , anyWord+    , word+    , reservedWord+    , unreservedWord+    , condWord+    , assignBuiltin+    , ioDesc+    , name+      -- * Operators+    , anyOperator+    , operator+    , redirOperator+      -- * Assignments+    , assign+      -- * Arithmetic expressions+    , arith+    ) where++import           Control.Applicative+import           Control.Monad+import           Data.Function+import           Data.Functor.Identity+import           Text.Parsec.Char+import           Text.Parsec.Combinator       hiding (optional)+import           Text.Parsec.Prim             hiding ((<|>), token)+import           Text.Parsec.Pos++import qualified Language.Bash.Parse.Internal as I+import           Language.Bash.Syntax++-- | A memoized result.+type Result d a = Consumed (Reply d () a)++-- | Build a parser from a field accessor.+rat :: Monad m => (d -> Result d a) -> ParsecT d u m a+rat f = mkPT $ \s0 -> return $+    return . patch s0 <$> f (stateInput s0)+  where+    patch (State _ _ u) (Ok a (State s p _) err) = Ok a (State s p u) err+    patch _             (Error e)                = Error e++-- | Obtain a result from a stateless parser.+womp :: d -> SourcePos -> ParsecT d () Identity a -> Result d a+womp d pos p = fmap runIdentity . runIdentity $+    runParsecT p (State d pos ())++-- | A token.+data Token+    = TWord Word+    | TIODesc IODesc++-- | A stream with memoized results.+data D = D+    { _token       :: Result D Token+    , _anyWord     :: Result D Word+    , _ioDesc      :: Result D IODesc+    , _anyOperator :: Result D String+    , _assign      :: Result D Assign+    , _uncons      :: Maybe (Char, D)+    }++instance Monad m => Stream D m Char where+    uncons = return . _uncons++-- | Create a source from a string.+pack :: SourcePos -> String -> D+pack p s = fix $ \d ->+    let result       = womp d p+        _token       = result $ do+            t <- I.word+            guard $ not (null t)+            next <- optional (lookAhead anyChar)+            I.skipSpace+            return $ case next of+                Just c | c == '<' || c == '>'+                       , Right desc <- parse (descriptor <* eof) "" t+                  -> TIODesc desc+                _ -> TWord t+        _anyWord     = result $ token >>= \case+            TWord w -> return w+            _       -> empty+        _ioDesc      = result $ token >>= \case+            TIODesc desc -> return desc+            _            -> empty+        _anyOperator = result $ I.operator normalOps <* I.skipSpace+        _assign      = result $ I.assign <* I.skipSpace+        _uncons      = case s of+            []     -> Nothing+            (x:xs) -> Just (x, pack (updatePosChar p x) xs)+    in  D {..}++-- | Parse a value satisfying the predicate.+satisfying+    :: (Stream s m t, Show a)+    => ParsecT s u m a+    -> (a -> Bool)+    -> ParsecT s u m a+satisfying a p = try $ do+    t <- a+    if p t then return t else unexpected (show t)++-- | Parse a descriptor.+descriptor :: Stream s m Char => ParsecT s u m IODesc+descriptor = IONumber . read <$> many1 digit+         <|> IOVar <$ char '{' <*> I.name <* char '}'++-- | Parse a single token.+token :: Monad m => ParsecT D u m Token+token = try (rat _token) <?> "token"++-- | Parse any word.+anyWord :: Monad m => ParsecT D u m Word+anyWord = try (rat _anyWord) <?> "word"++-- | Parse the given word.+word :: Monad m => Word -> ParsecT D u m Word+word w = anyWord `satisfying` (== w) <?> w++-- | Parse a reversed word.+reservedWord :: Monad m => ParsecT D u m Word+reservedWord = anyWord `satisfying` (`elem` reservedWords) <?> "reserved word"++-- | Parse a word that is not reserved.+unreservedWord :: Monad m => ParsecT D u m Word+unreservedWord = anyWord `satisfying` (`notElem` reservedWords)+    <?> "unreserved word"++-- | Parse a word in a @[[...]]@ command.+condWord :: Monad m => ParsecT D u m Word+condWord = (anyWord <|> anyOperator) `satisfying` (/= "]]")++-- | Parse an assignment builtin.+assignBuiltin :: Monad m => ParsecT D u m Word+assignBuiltin = anyWord `satisfying` (`elem` assignBuiltins)+    <?> "assignment builtin"++-- | Parse a redirection word or number.+ioDesc :: Monad m => ParsecT D u m IODesc+ioDesc = try (rat _ioDesc) <?> "IO descriptor"++-- | Parse a variable name.+name :: Monad m => ParsecT D u m String+name = unreservedWord `satisfying` isName <?> "name"+  where+    isName s = case parse (I.name <* eof) "" s of+        Left _  -> False+        Right _ -> True++-- | Parse any operator.+anyOperator :: Monad m => ParsecT D u m String+anyOperator = try (rat _anyOperator) <?> "operator"++-- | Parse a given operator.+operator :: Monad m => String -> ParsecT D u m String+operator op = anyOperator `satisfying` (== op) <?> op++-- | Parse a non-heredoc redirection operator.+redirOperator :: Monad m => ParsecT D u m String+redirOperator = anyOperator `satisfying` (`elem` redirOps)+    <?> "redirection operator"++-- | Parse an assignment.+assign :: Monad m => ParsecT D u m Assign+assign = try (rat _assign) <?> "assignment"++-- | Parse an arithmetic expression.+arith :: Monad m => ParsecT D u m String+arith = try (string "((") *> I.arith <* string "))" <* I.skipSpace+    <?> "arithmetic expression"

@@ -0,0 +1,155 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+-- | Pretty-printing of Bash scripts. This tries to stay close to the format+-- used by the Bash builtin @declare -f@.+module Language.Bash.Pretty+    ( Pretty(..)+    , render+    ) where++import Text.PrettyPrint++import Language.Bash.Syntax++-- | A class of types which may be pretty-printed.+class Pretty a where+    -- | Pretty-print to a 'Doc'.+    pretty     :: a -> Doc++    -- | Pretty-print a list. By default, this separates each element with+    -- a space using 'hsep'.+    prettyList :: [a] -> Doc+    prettyList = hsep . map pretty++instance Pretty a => Pretty [a] where+    pretty = prettyList++instance Pretty Doc where+    pretty = id++instance Pretty Char where+    pretty c   = text [c]+    prettyList = text++instance Pretty a => Pretty (Maybe a) where+    pretty = maybe empty pretty++instance (Pretty a, Pretty b) => Pretty (Either a b) where+    pretty = either pretty pretty++instance Pretty Command where+    pretty (Command c rs) = pretty c <+> pretty rs++instance Pretty Redir where+    pretty Redir{..} =+        pretty redirDesc <> text redirOp <> text redirTarget+    pretty Heredoc{..} =+        text redirOp <>+        text (if heredocDelimQuoted+              then "'" ++ heredocDelim ++ "'"+              else heredocDelim) <> "\n" <>+        text document <> text heredocDelim <> "\n"++    prettyList = foldr f empty+      where+        f a@(Redir{})   b = pretty a <+> b+        f a@(Heredoc{}) b = pretty a <> b++instance Pretty IODesc where+    pretty (IONumber n) = int n+    pretty (IOVar n)    = "{" <> text n <> "}"++instance Pretty ShellCommand where+    pretty (SimpleCommand as ws)  = pretty as <+> pretty ws+    pretty (AssignBuiltin w args) = text w <+> pretty args+    pretty (FunctionDef name l) =+        text name <+> "()" $+$ pretty (Group l)+    pretty (Coproc name c) =+        "coproc" <+> text name <+> pretty c+    pretty (Subshell l) =+        "(" <+> pretty l <+> ")"+    pretty (Group l) =+        "{" $+$ indent l $+$ "}"+    pretty (Arith s) =+        "((" <> text s <> "))"+    pretty (Cond ws) =+        "[[" <+> pretty ws <+> "]]"+    pretty (For w ws l) =+        "for" <+> text w <+> "in" <+> pretty ws <> ";" $+$ doDone l+    pretty (ArithFor s l) =+        "for" <+> "((" <> text s <> "))" $+$ doDone l+    pretty (Select w ws l) =+        "select" <+> text w <+> "in" <+> pretty ws <> ";" $+$ doDone l+    pretty (Case w cs) =+        "case" <+> text w <+> "in" $+$ indent cs $+$ "esac"+    pretty (If p t f) =+        "if" <+> pretty p <+> "then" $+$ indent t $+$+        pretty (fmap (\l -> "else" $+$ indent l) f) $+$+        "fi"+    pretty (Until p l) =+        "until" <+> pretty p <+> doDone l+    pretty (While p l) =+        "while" <+> pretty p <+> doDone l++instance Pretty CaseClause where+    pretty (CaseClause ps l term) =+        hcat (punctuate " | " (map text ps)) <> ")" $+$+        indent l $+$+        pretty term++instance Pretty CaseTerm where+    pretty Break       = ";;"+    pretty FallThrough = ";&"+    pretty Continue    = ";;&"++instance Pretty List where+    pretty (List as) = pretty as++instance Pretty Statement where+    pretty (Statement l Sequential)   = pretty l <> ";"+    pretty (Statement l Asynchronous) = pretty l <+> "&"++    prettyList = foldr f empty+      where+        f a@(Statement _ Sequential)   b = pretty a $+$ b+        f a@(Statement _ Asynchronous) b = pretty a <+> b++instance Pretty ListTerm where+    pretty Sequential   = ";"+    pretty Asynchronous = "&"++instance Pretty AndOr where+    pretty (Last p)  = pretty p+    pretty (And p a) = pretty p <+> "&&" <+> pretty a+    pretty (Or p a)  = pretty p <+> "||" <+> pretty a++instance Pretty Pipeline where+    pretty Pipeline{..} =+        (if timed      then "time" else empty) <+>+        (if timedPosix then "-p"   else empty) <+>+        (if inverted   then "!"    else empty) <+>+        pretty commands++instance Pretty Assign where+    pretty (Assign lhs op rhs) = pretty lhs <> pretty op <> pretty rhs++instance Pretty LValue where+    pretty (LValue name sub) =+        text name <> pretty (fmap (\s -> "[" ++ s ++ "]") sub)++instance Pretty AssignOp where+    pretty Equals     = "="+    pretty PlusEquals = "+="++instance Pretty RValue where+    pretty (RValue w)  = text w+    pretty (RArray rs) = "(" <> hsep (map f rs) <> ")"+      where+        f (sub, w) = pretty (fmap (\s -> "[" ++ s ++ "]=") sub) <> text w++-- | Indent by 4 columns.+indent :: Pretty a => a -> Doc+indent = nest 4 . pretty++-- | Render a @do...done@ block.+doDone :: Pretty a => a -> Doc+doDone a = "do" $+$ indent a $+$ "done"

@@ -0,0 +1,225 @@+-- | Shell script types.+module Language.Bash.Syntax+    ( -- * Syntax+      -- ** Words+      Word+    , Subscript+      -- ** Commands+    , Command(..)+    , Redir(..)+    , IODesc(..)+    , ShellCommand(..)+    , CaseClause(..)+    , CaseTerm(..)+      -- * Lists+    , List(..)+    , Statement(..)+    , ListTerm(..)+    , AndOr(..)+    , Pipeline(..)+      -- * Assignments+    , Assign(..)+    , LValue(..)+    , AssignOp(..)+    , RValue(..)+      -- * Syntax elements+    , reservedWords+    , assignBuiltins+    , redirOps+    , heredocOps+    , controlOps+    , normalOps+    ) where++-- | A Bash word.+type Word = String++-- | A variable subscript @[...]@.+type Subscript = Word++-- | A Bash command with redirections.+data Command = Command ShellCommand [Redir]+    deriving (Eq, Read, Show)++-- | A redirection.+data Redir+    -- | A redirection.+    = Redir+        { -- | An optional file descriptor.+          redirDesc   :: Maybe IODesc+          -- | The redirection operator.+        , redirOp     :: String+          -- | The redirection target.+        , redirTarget :: Word+        }+    -- | A here document.+    | Heredoc+        { redirOp            :: String+          -- | The here document delimiter.+        , heredocDelim       :: String+          -- | 'True' if the delimiter was quoted.+        , heredocDelimQuoted :: Bool+          -- | The document itself.+        , document           :: String+        }+    deriving (Eq, Read, Show)++-- | A redirection file descriptor.+data IODesc+    -- | A file descriptor number.+    = IONumber Int+    -- | A variable @{/varname/}@ to allocate a file descriptor for.+    | IOVar String+    deriving (Eq, Read, Show)++-- | A Bash command.+data ShellCommand+    -- | A simple command consisting of assignments followed by words.+    = SimpleCommand [Assign] [Word]+    -- | The shell builtins @declare@, @eval@, @export@, @local@, @readonly@,+    -- and @typeset@ can accept both assignments and words as arguments.+    | AssignBuiltin Word [Either Assign Word]+    -- | A function name and definition.+    | FunctionDef String List+    -- | A named coprocess.+    | Coproc String Command+    -- | A @(...)@ list, denoting a subshell.+    | Subshell List+    -- | A @{...}@ list.+    | Group List+    -- | An arithmetic expression.+    | Arith String+    -- | A Bash @[[...]]@ conditional expression.+    | Cond [Word]+    -- | A @for /word/ in /words/@ command. If @in /words/@ is absent,+    -- the word list defaults to @\"$\@\"@.+    | For Word [Word] List+    -- | An arithmetic @for ((...))@ command.+    | ArithFor String List+    -- | A @select /word/ in /words/@ command. If @in /words/@ is absent,+    -- the word list defaults to @\"$\@\"@.+    | Select Word [Word] List+    -- | A @case@ command.+    | Case Word [CaseClause]+    -- | An @if@ command, with a predicate, consequent, and alternative.+    -- @elif@ clauses are parsed as nested @if@ statements.+    | If List List (Maybe List)+    -- | An @until@ command.+    | Until List List+    -- | A @while@ command.+    | While List List+    deriving (Eq, Read, Show)++-- | A single case clause.+data CaseClause = CaseClause [Word] List CaseTerm+    deriving (Eq, Read, Show)++-- | A case clause terminator.+data CaseTerm+    -- | The @;;@ operator.+    = Break+    -- | The @;&@ operator.+    | FallThrough+    -- | The @;;&@ operator.+    | Continue+    deriving (Eq, Ord, Read, Show, Bounded, Enum)++-- | A compound list of statements.+newtype List = List [Statement]+    deriving (Eq, Read, Show)++-- | A single statement in a list.+data Statement = Statement AndOr ListTerm+    deriving (Eq, Read, Show)++-- | A statement terminator.+data ListTerm+    -- | The @;@ operator.+    = Sequential+    -- | The @&@ operator.+    | Asynchronous+    deriving (Eq, Ord, Read, Show, Bounded, Enum)++-- | A right-associative list of pipelines.+data AndOr+    -- | The last pipeline of a list.+    = Last Pipeline+    -- | An @&&@ construct.+    | And Pipeline AndOr+    -- | An @||@ construct.+    | Or Pipeline AndOr+    deriving (Eq, Read, Show)++-- | A (possibly timed or inverted) pipeline, linked with @|@ or @|&@.+data Pipeline = Pipeline+    { -- | 'True' if the pipeline is timed with @time@.+      timed      :: Bool+      -- | 'True' if the pipeline is timed with the @-p@ flag.+    , timedPosix :: Bool+      -- | 'True' if the pipeline is inverted with @!@.+    , inverted   :: Bool+      -- | A list of commands, separated by @|@, or @|&@.+      -- @command1 |& command2@ is treated as a shorthand for+      -- @command1 2>&1 | command2@.+    , commands   :: [Command]+    } deriving (Eq, Read, Show)++-- | An assignment.+data Assign = Assign LValue AssignOp RValue+    deriving (Eq, Read, Show)++-- | The left side of an assignment.+data LValue = LValue String (Maybe Subscript)+    deriving (Eq, Read, Show)++-- | An assignment operator.+data AssignOp+    -- | The @=@ operator.+    = Equals+    -- | The @+=@ operator.+    | PlusEquals+    deriving (Eq, Ord, Read, Show, Bounded, Enum)++-- | The right side of an assignment.+data RValue+    -- | A simple word.+    = RValue Word+    -- | An array assignment.+    | RArray [(Maybe Subscript, Word)]+    deriving (Eq, Read, Show)++-- | Shell reserved words.+reservedWords :: [Word]+reservedWords =+    [ "!", "[[", "]]", "{", "}"+    , "if", "then", "else", "elif", "fi"+    , "case", "esac", "for", "select", "while", "until"+    , "in", "do", "done", "time", "function"+    ]++-- | Shell assignment builtins. These builtins can take assignments as+-- arguments.+assignBuiltins :: [Word]+assignBuiltins =+    [ "alias", "declare", "export", "eval"+    , "let", "local", "readonly", "typeset"+    ]++-- | Redirection operators, not including here document operators.+redirOps :: [String]+redirOps = [">", "<", ">>", ">|", "<>", "<<<", "<&", ">&", "&>", "&>>"]++-- | Here document operators.+heredocOps :: [String]+heredocOps = ["<<", "<<-"]++-- | Shell control operators.+controlOps :: [String]+controlOps =+    [ "(", ")", ";;", ";&", ";;&"+    , "|", "|&", "||", "&&", ";", "&", "\n"+    ]++-- | All normal operators.+normalOps :: [String]+normalOps = redirOps ++ heredocOps ++ controlOps