diff --git a/language-bash.cabal b/language-bash.cabal --- a/language-bash.cabal +++ b/language-bash.cabal @@ -1,16 +1,16 @@ name: language-bash -version: 0.7.1 +version: 0.8.0 category: Language license: BSD3 license-file: LICENSE author: Kyle Raftogianis -maintainer: Kyle Raftogianis +maintainer: Kyle Raftogianis copyright: Copyright (c) 2013-2018 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 -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2, GHC == 8.0.2, GHC == 8.4.3 +tested-with: GHC == 7.10.1, GHC == 7.10.2, GHC == 8.0.2, GHC == 8.4.3 synopsis: Parsing and pretty-printing Bash shell scripts description: A library for parsing, pretty-printing, and manipulating diff --git a/src/Language/Bash/Cond.hs b/src/Language/Bash/Cond.hs --- a/src/Language/Bash/Cond.hs +++ b/src/Language/Bash/Cond.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable , DeriveFoldable - , CPP + , DeriveGeneric , DeriveFunctor , DeriveTraversable , OverloadedStrings @@ -19,15 +19,11 @@ import Control.Applicative import Data.Data (Data) import Data.Typeable (Typeable) +import GHC.Generics (Generic) import Text.Parsec hiding ((<|>), token) import Text.Parsec.Expr hiding (Operator) import Text.PrettyPrint hiding (parens) -#if __GLASGOW_HASKELL__ < 710 -import Data.Foldable (Foldable) -import Data.Traversable (Traversable) -#endif - import Language.Bash.Operator import Language.Bash.Pretty @@ -38,7 +34,7 @@ | Not (CondExpr a) | And (CondExpr a) (CondExpr a) | Or (CondExpr a) (CondExpr a) - deriving (Data, Eq, Read, Show, Typeable, Functor, Foldable, Traversable) + deriving (Data, Eq, Read, Show, Typeable, Functor, Foldable, Traversable, Generic) instance Pretty a => Pretty (CondExpr a) where pretty = go (0 :: Int) @@ -77,7 +73,7 @@ | Varname -- ^ @-v@ | ZeroString -- ^ @-z@ | NonzeroString -- ^ @-n /string/@ or @/string/@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Operator UnaryOp where operatorTable = @@ -106,7 +102,7 @@ | ArithLE -- ^ @-le@ | ArithGT -- ^ @-gt@ | ArithGE -- ^ @-ge@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Operator BinaryOp where operatorTable = diff --git a/src/Language/Bash/Expand.hs b/src/Language/Bash/Expand.hs --- a/src/Language/Bash/Expand.hs +++ b/src/Language/Bash/Expand.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, PatternGuards, CPP #-} +{-# LANGUAGE OverloadedStrings, PatternGuards, DeriveGeneric #-} -- | Shell expansions. module Language.Bash.Expand ( braceExpand @@ -7,11 +7,7 @@ , splitWord ) where -#if __GLASGOW_HASKELL__ >= 710 import Prelude hiding ((<>), Word) -#else -import Data.Traversable (traverse) -#endif import Control.Applicative import Control.Monad diff --git a/src/Language/Bash/Parse.hs b/src/Language/Bash/Parse.hs --- a/src/Language/Bash/Parse.hs +++ b/src/Language/Bash/Parse.hs @@ -58,25 +58,27 @@ duck = do u <- getState case postHeredoc u of - Nothing -> () <$ line + Nothing -> () <$ line <* optional (char '\n') Just s -> () <$ setParserState s h <- unlines <$> heredocLines s <- getParserState return (h, s) - line = many (satisfy (/= '\n')) <* optional (char '\n') + line = many (satisfy (/= '\n')) heredocLines = [] <$ eof <|> nextLine nextLine = do l <- process <$> line - if l == end then return [] else (l :) <$> heredocLines + if l == end + then return [] + else (l :) <$ optional (char '\n') <*> heredocLines -- | Parse a newline, skipping any here documents. newline :: Parser String newline = "newline" ?: do - _ <- operator "\n" + _ <- operator "\r\n" <|> operator "\n" u <- getState case postHeredoc u of Nothing -> return () @@ -126,7 +128,7 @@ redirOperator = selectOperator operator "redirection operator" heredocOperator = selectOperator operator "here document operator" --- | Skip a list of redirections. +-- | Parse a list of redirections. redirList :: Parser [Redir] redirList = many redir @@ -152,8 +154,9 @@ 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) + let rs = rs1 ++ rs2 + guard (not $ null as && null ws && null rs) + return $ Command (SimpleCommand as ws) rs assignArg = Left <$> assign <|> Right <$> anyWord @@ -338,11 +341,12 @@ where expr = buildExpressionParser opTable term - term = word "(" *> expr <* word ")" + term = operator "(" *> expr <* operator ")" <|> Cond.Unary <$> unaryOp <*> condWord <|> (condWord >>= wordTerm) - wordTerm w = Cond.Binary w <$> binaryOp <*> condWord + wordTerm w = Cond.Binary w Cond.StrMatch <$ try (word "=~") <*> regexWord + <|> Cond.Binary w <$> binaryOp <*> condWord <|> pure (Cond.Unary Cond.NonzeroString w) opTable = @@ -360,6 +364,39 @@ unaryOp = selectOperator condOperator "unary operator" binaryOp = selectOperator condOperator "binary operator" + regexWord = stringToWord . concat <$> many1 (regexPart " \t\r\n") <* skipSpace + "regular expression" + + regexPart delims = regexParens + <|> regexSingleQuote + <|> regexDoubleQuote + <|> regexEscape + <|> regexChar delims + + regexDelimiters :: Char -> Parser String -> Char -> Parser String + regexDelimiters begin middle end = do + _ <- char begin + parts <- many middle + _ <- char end + return $ [begin] ++ concat parts ++ [end] + + regexParens = regexDelimiters '(' (regexPart ")") ')' + + regexSingleQuote = regexDelimiters '\'' singleQuoteChar '\'' + where + singleQuoteChar = sequence [char '\\', anyChar] + <|> (:[]) <$> noneOf "'" + + regexDoubleQuote = regexDelimiters '"' doubleQuoteChar '"' + where + doubleQuoteChar = sequence [char '\\', anyChar] + <|> (:[]) <$> noneOf "\"" + + regexEscape = sequence [char '\\', anyChar] + + regexChar :: [Char] -> Parser String + regexChar delims = (:[]) <$> noneOf delims + ------------------------------------------------------------------------------- -- Coprocesses ------------------------------------------------------------------------------- @@ -383,12 +420,12 @@ "function definition" where functionDef1 = FunctionDef - <$> try (word "function" *> name + <$> try (word "function" *> functionName <* optional functionParens <* newlineList) <*> functionBody functionDef2 = FunctionDef - <$> try (name <* functionParens <* newlineList) + <$> try (functionName <* functionParens <* newlineList) <*> functionBody functionParens = operator "(" <* operator ")" diff --git a/src/Language/Bash/Parse/Internal.hs b/src/Language/Bash/Parse/Internal.hs --- a/src/Language/Bash/Parse/Internal.hs +++ b/src/Language/Bash/Parse/Internal.hs @@ -2,7 +2,6 @@ FlexibleContexts , FlexibleInstances , LambdaCase - , CPP , MultiParamTypeClasses , PatternGuards , RecordWildCards @@ -21,10 +20,10 @@ , anyWord , word , reservedWord - , unreservedWord , assignBuiltin , ioDesc , name + , functionName -- * Operators , anyOperator , operator @@ -36,9 +35,7 @@ , heredocWord ) where -#if __GLASGOW_HASKELL__ >= 710 import Prelude hiding (Word) -#endif import Control.Applicative import Control.Monad @@ -155,7 +152,7 @@ operators :: [String] operators = [ "(", ")", ";;", ";&", ";;&" - , "|", "|&", "||", "&&", ";", "&", "\n" + , "|", "|&", "||", "&&", ";", "&", "\r\n", "\n" , "<", ">", ">|", ">>", "&>", "&>>", "<<<", "<&", ">&", "<>" , "<<", "<<-" ] @@ -181,11 +178,6 @@ 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 an assignment builtin. assignBuiltin :: Monad m => ParsecT D u m Word assignBuiltin = anyWord `satisfying` (`elem` assignBuiltins) @@ -197,9 +189,18 @@ -- | Parse a variable name. name :: Monad m => ParsecT D u m String -name = (prettyText <$> unreservedWord) `satisfying` isName "name" +name = (prettyText <$> anyWord) `satisfying` isName "name" where isName s = case parse (I.name <* eof) "" (prettyText s) of + Left _ -> False + Right _ -> True + +-- | Parse a function name. +functionName :: Monad m => ParsecT D u m String +functionName = (prettyText <$> anyWord) `satisfying` isFunctionName + "function name" + where + isFunctionName s = case parse (I.functionName <* eof) "" (prettyText s) of Left _ -> False Right _ -> True diff --git a/src/Language/Bash/Parse/Word.hs b/src/Language/Bash/Parse/Word.hs --- a/src/Language/Bash/Parse/Word.hs +++ b/src/Language/Bash/Parse/Word.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, RecordWildCards, CPP #-} +{-# LANGUAGE FlexibleContexts, RecordWildCards #-} -- | Word-level parsers. module Language.Bash.Parse.Word ( skipSpace @@ -6,14 +6,13 @@ , word , heredocWord , name + , functionName , subscript , assign , operator ) where -#if __GLASGOW_HASKELL__ >= 710 import Prelude hiding (Word) -#endif import Control.Applicative import Control.Monad @@ -298,7 +297,7 @@ -- | Parse a word. word :: Stream s m Char => ParsecT s u m Word -word = spans " \t\n&|;()<>" True wordSpan +word = spans " \t\r\n&|;()<>" True wordSpan -- | Parse a here document as a word. This parses substitutions, but not -- most quoting. @@ -315,6 +314,14 @@ where nameStart = letter <|> char '_' nameLetter = alphaNum <|> char '_' + +-- | Parse a function name. +functionName :: Stream s m Char => ParsecT s u m String +functionName = (:) <$> nameStart <*> many nameLetter + where + nameStart = letter <|> specialChar + nameLetter = alphaNum <|> specialChar + specialChar = oneOf "_-.+!" -- | Parse a special parameter name. specialName :: Stream s m Char => ParsecT s u m String diff --git a/src/Language/Bash/Syntax.hs b/src/Language/Bash/Syntax.hs --- a/src/Language/Bash/Syntax.hs +++ b/src/Language/Bash/Syntax.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, CPP #-} +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, DeriveGeneric #-} -- | Shell script types. module Language.Bash.Syntax ( @@ -25,12 +25,11 @@ , RValue(..) ) where -#if __GLASGOW_HASKELL__ >= 710 import Prelude hiding ((<>), Word) -#endif import Data.Data (Data) import Data.Typeable (Typeable) +import GHC.Generics (Generic) import Text.PrettyPrint import Language.Bash.Cond (CondExpr) @@ -43,12 +42,12 @@ indent = nest 4 . pretty -- | Render a @do...done@ block. -doDone :: Pretty a => a -> Doc -doDone a = "do" $+$ indent a $+$ "done" +doDone :: Pretty a => Doc -> a -> Doc +doDone header body = header <+> "do" $+$ indent body $+$ "done" -- | A Bash command with redirections. data Command = Command ShellCommand [Redir] - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty Command where pretty (Command c rs) = pretty c <+> pretty rs @@ -89,7 +88,7 @@ | Until List List -- | A @while@ command. | While List List - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty ShellCommand where pretty (SimpleCommand as ws) = pretty as <+> pretty ws @@ -107,11 +106,11 @@ pretty (Cond e) = "[[" <+> pretty e <+> "]]" pretty (For w ws l) = - "for" <+> pretty w <+> pretty ws <> ";" $+$ doDone l + doDone ("for" <+> pretty w <+> pretty ws <> ";") l pretty (ArithFor s l) = - "for" <+> "((" <> text s <> "))" $+$ doDone l + doDone ("for" <+> "((" <> text s <> "))") l pretty (Select w ws l) = - "select" <+> pretty w <+> pretty ws <> ";" $+$ doDone l + doDone ("select" <+> pretty w <+> pretty ws <> ";") l pretty (Case w cs) = "case" <+> pretty w <+> "in" $+$ (vcat $ map indent cs) $+$ "esac" pretty (If p t f) = @@ -119,15 +118,15 @@ pretty (fmap (\l -> "else" $+$ indent l) f) $+$ "fi" pretty (Until p l) = - "until" <+> pretty p <+> doDone l + doDone ("until" <+> pretty p) l pretty (While p l) = - "while" <+> pretty p <+> doDone l + doDone ("while" <+> pretty p) l -- | A word list or @\"$\@\"@. data WordList = Args | WordList [Word] - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty WordList where pretty Args = empty @@ -135,7 +134,7 @@ -- | A single case clause. data CaseClause = CaseClause [Word] List CaseTerm - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty CaseClause where pretty (CaseClause ps l term) = @@ -148,7 +147,7 @@ = Break -- ^ @;;@ | FallThrough -- ^ @;&@ | Continue -- ^ @;;&@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum) + deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum, Generic) instance Operator CaseTerm where operatorTable = zip [minBound .. maxBound] [";;", ";&", ";;&"] @@ -180,7 +179,7 @@ -- and command substitutions take place. , hereDocument :: Word } - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty Redir where pretty Redir{..} = @@ -203,7 +202,7 @@ = IONumber Int -- | A variable @{/varname/}@ to allocate a file descriptor for. | IOVar String - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty IODesc where pretty (IONumber n) = int n @@ -221,7 +220,7 @@ | InAnd -- ^ @\<&@ | OutAnd -- ^ @\>&@ | InOut -- ^ @\<\>@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Operator RedirOp where operatorTable = zip [minBound .. maxBound] @@ -234,7 +233,7 @@ data HeredocOp = Here -- ^ @\<\<@ | HereStrip -- ^ @\<\<-@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Operator HeredocOp where operatorTable = zip [Here, HereStrip] ["<<", "<<-"] @@ -244,14 +243,14 @@ -- | A compound list of statements. newtype List = List [Statement] - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty List where pretty (List as) = pretty as -- | A single statement in a list. data Statement = Statement AndOr ListTerm - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty Statement where pretty (Statement l Sequential) = pretty l <> ";" @@ -266,7 +265,7 @@ data ListTerm = Sequential -- ^ @;@ | Asynchronous -- ^ @&@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum) + deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum, Generic) instance Operator ListTerm where operatorTable = @@ -286,7 +285,7 @@ | And Pipeline AndOr -- | A @||@ construct. | Or Pipeline AndOr - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty AndOr where pretty (Last p) = pretty p @@ -305,7 +304,7 @@ -- @command1 |& command2@ is treated as a shorthand for -- @command1 2>&1 | command2@. , commands :: [Command] - } deriving (Data, Eq, Read, Show, Typeable) + } deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty Pipeline where pretty Pipeline{..} = @@ -316,7 +315,7 @@ -- | An assignment. data Assign = Assign Parameter AssignOp RValue - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty Assign where pretty (Assign lhs op rhs) = pretty lhs <> pretty op <> pretty rhs @@ -325,7 +324,7 @@ data AssignOp = Equals -- ^ @=@ | PlusEquals -- ^ @+=@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum) + deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum, Generic) instance Operator AssignOp where operatorTable = zip [Equals, PlusEquals] ["=", "+="] @@ -339,7 +338,7 @@ = RValue Word -- | An array assignment, as @(subscript, word)@ pairs. | RArray [(Maybe Word, Word)] - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty RValue where pretty (RValue w) = pretty w diff --git a/src/Language/Bash/Word.hs b/src/Language/Bash/Word.hs --- a/src/Language/Bash/Word.hs +++ b/src/Language/Bash/Word.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveDataTypeable - , CPP + , DeriveGeneric , OverloadedStrings , RecordWildCards , TypeSynonymInstances @@ -21,15 +21,15 @@ , ProcessSubstOp(..) -- * Manipulation , stringToWord + , wordToString , unquote ) where -#if __GLASGOW_HASKELL__ >= 710 import Prelude hiding ((<>), Word) -#endif import Data.Data (Data) import Data.Typeable (Typeable) +import GHC.Generics (Generic) import Text.PrettyPrint import Language.Bash.Operator @@ -63,7 +63,7 @@ | CommandSubst String -- | A process substitution. | ProcessSubst ProcessSubstOp String - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty Span where pretty (Char c) = char c @@ -82,7 +82,7 @@ -- | A parameter name an optional subscript. data Parameter = Parameter String (Maybe Word) - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) instance Pretty Parameter where pretty (Parameter s sub) = text s <> subscript sub @@ -161,7 +161,7 @@ , convertAll :: Bool , pattern :: Word } - deriving (Data, Eq, Read, Show, Typeable) + deriving (Data, Eq, Read, Show, Typeable, Generic) prettyParameter :: Bool -> Parameter -> Doc -> Doc prettyParameter bang param suffix = @@ -204,7 +204,7 @@ | AltAssign -- ^ '=', ':=' | AltError -- ^ '?', ':?' | AltReplace -- ^ '+', ':+' - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Operator AltOp where operatorTable = zip [minBound .. maxBound] ["-", "=", "?", "+"] @@ -216,7 +216,7 @@ data LetterCaseOp = ToLower | ToUpper - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Operator LetterCaseOp where operatorTable = zip [ToLower, ToUpper] [",", "^"] @@ -228,7 +228,7 @@ data Direction = Front | Back - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Pretty Direction where pretty Front = "#" @@ -238,7 +238,7 @@ data ProcessSubstOp = ProcessIn -- ^ @\<@ | ProcessOut -- ^ @\>@ - deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) + deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded, Generic) instance Operator ProcessSubstOp where operatorTable = zip [ProcessIn, ProcessOut] ["<", ">"] @@ -249,6 +249,14 @@ -- | Convert a string to an unquoted word. stringToWord :: String -> Word stringToWord = map Char + +-- | If a word is a plain, unquoted string (e.g. the result of @stringToWord@), +-- returns @Just@ that string; otherwise, returns @Nothing@. +wordToString :: Word -> Maybe String +wordToString = traverse spanToChar + where + spanToChar (Char c) = Just c + spanToChar _ = Nothing -- | Remove all quoting characters from a word. unquote :: Word -> String diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -64,16 +64,16 @@ Left err -> assertFailure $ "parseError: " ++ show err Right ans -> expected @=? ans +wrapCommands :: [Command] -> List +wrapCommands = List . map (\c -> Statement (Last Pipeline {timed = False, timedPosix = False, inverted = False, commands = [c]}) Sequential) + wrapCommand :: Command -> List -wrapCommand c = List [Statement (Last Pipeline {timed = False, timedPosix = False, inverted = False, commands = [c]}) Sequential] +wrapCommand c = wrapCommands [c] -tp :: TestName -> Command -> TestTree -tp source expected = testMatches (filter ((/=) '\n') source) +tp :: TestName -> List -> TestTree +tp source expected = testMatches (show source) (Parse.parse "source" source) - (wrapCommand expected) - -expandString :: String -> [Span] -expandString = map Char + expected unittests :: TestTree unittests = testGroup "Unit tests" @@ -81,35 +81,69 @@ testMatches "testTest" (Cond.parseTestExpr ["!", "-e", "\"asd\""]) (Cond.Not (Cond.Unary Cond.FileExists "\"asd\"")) - , tp "\"$(ls)\"" + , tp "\"$(ls)\"" $ wrapCommand (Command (SimpleCommand [] [[Double [CommandSubst "ls"]]]) []) - , tp "arguments=()" + , tp "arguments=()" $ wrapCommand (Command (SimpleCommand [Assign (Parameter "arguments" Nothing) Equals (RArray [])] []) []) - , tp "cat <