diff --git a/Language/Bash.hs b/Language/Bash.hs --- a/Language/Bash.hs +++ b/Language/Bash.hs @@ -17,8 +17,11 @@ , Language.Bash.Syntax.specialVar , Language.Bash.Syntax.VarName(..) , Language.Bash.Syntax.varName + , Language.Bash.Syntax.FuncName(..) + , Language.Bash.Syntax.funcName , Language.Bash.Syntax.Redirection(..) , Language.Bash.Syntax.FileDescriptor(..) + , Language.Bash.Syntax.Assignment(..) , Language.Bash.PrettyPrinter.PP(..) , Language.Bash.PrettyPrinter.bytes , Language.Bash.PrettyPrinter.builder diff --git a/Language/Bash/Lib.hs b/Language/Bash/Lib.hs --- a/Language/Bash/Lib.hs +++ b/Language/Bash/Lib.hs @@ -21,17 +21,15 @@ regular expressions, checking for GNU or BSD @sed@. The 'Bool' argument determines whether to insert the declaration or not. -} -esed :: (Monoid m) => Identifier -> Bool -> Annotated m -esed ident d | not d = setGNUorBSD - | otherwise = ann_ (Sequence decl setGNUorBSD) +esed :: (Monoid m) => Identifier -> Annotated m +esed ident = setGNUorBSD where - [sed, fgrep, decl, setr, setE, checkGNU, setGNUorBSD] = fmap ann_ + [sed, fgrep, setr, setE, checkGNU, setGNUorBSD] = fmap ann_ [ cmd "sed" ["--version"] , cmd "fgrep" ["-q", "GNU"] - , ArrayDecl ident [] - , ArrayAssign ident ["sed", "-r"] - , ArrayAssign ident ["sed", "-E"] - , Pipe sed fgrep + , Assign (Array ident ["sed", "-r"]) + , Assign (Array ident ["sed", "-E"]) + , dev_null (Pipe sed fgrep) , IfThenElse checkGNU setr setE ] @@ -69,6 +67,16 @@ sudo_write path = Redirect (ann_ tee) Out 1 (Left "/dev/null") where tee = SimpleCommand "sudo" ["tee", path] + + +{-| A statement that allows one to redirect output to a file as root. This is + what you might expect @sudo echo x > privileged_file@ would do (though + that does not actually work). + -} +dev_null :: (Monoid m) => Statement m -> Statement m +dev_null stmt = Redirect (ann_ r2) Out 1 (Left "/dev/null") + where + r2 = Redirect (ann_ stmt) Out 2 (Left "/dev/null") {-| Annotate a statement with the 0 value of a monoid. diff --git a/Language/Bash/PrettyPrinter.hs b/Language/Bash/PrettyPrinter.hs --- a/Language/Bash/PrettyPrinter.hs +++ b/Language/Bash/PrettyPrinter.hs @@ -10,11 +10,13 @@ -} module Language.Bash.PrettyPrinter where +import Control.Applicative import qualified Data.List as List import Data.ByteString.Char8 import Data.Binary.Builder (Builder) import Data.Monoid -import Prelude hiding (concat, length, replicate, lines, drop, null) +import Prelude hiding ( words, unwords, concat, null + , replicate, lines, drop, length ) import Control.Monad.State.Strict import qualified Text.ShellEscape as Esc @@ -41,6 +43,9 @@ pp :: t -> State PPState () instance PP Identifier where pp (Identifier b) = word b +instance PP FuncName where + pp (Simple ident) = pp ident + pp (Fancy b) = word b instance PP SpecialVar where pp = word . specialVarBytes instance PP FileDescriptor where @@ -51,7 +56,7 @@ pp QuestionMark = word "?" pp Tilde = word "~" pp (ReadVar var) = (word . quote) (if s == "$!" then "${!}" else s) - where -- Need to be careful to avoid history expansion of @"@. + where -- Need to be careful to avoid history expansion. s = (('$' `cons`) . identpart) var pp (ReadVarSafe var) = (word . quote . braces0 . identpart) var pp (ReadArray ident expr) = (word . quote . braces) @@ -67,6 +72,8 @@ pp (ARGVLength) = word "$#" pp (Elements ident) = (word . quote . braces) (bytes ident `append` "[@]") + pp (ElementsSafe ident) = (word . quote . braces_) + (bytes ident `append` "[@]") pp (Keys ident) = (word . quote . braces) ('!' `cons` bytes ident `append` "[@]") pp (Length ident) = (word . quote . braces) @@ -89,7 +96,7 @@ mapM_ breakline args outdent NoOp msg | null msg -> word ":" - | otherwise -> word ":" >> (word . Esc.bytes . Esc.bash) msg + | otherwise -> word ":" >> (word . escapeWords) msg Bang t -> hangWord "!" >> binGrp t >> outdent AndAnd t t' -> if isSimple t && (isSimple t' || isAndAnd t') then pp t >> word "&&" >> nl >> pp t' @@ -104,15 +111,15 @@ Background t t' -> binGrp t >> word "&" >> nl >> pp t' Group t -> curlyOpen >> pp t >> curlyClose >> outdent Subshell t -> roundOpen >> pp t >> roundClose >> outdent - Function ident t -> do wordcat ["function ", bytes ident] + Function fname t -> do wordcat ["function ", bytes fname] inword "{" >> pp t >> outword "}" - IfThen t t' -> do hangWord "if" >> pp t >> outdent >> nl - inword "then" >> pp t' >> outword "fi" - IfThenElse t t' t'' -> do hangWord "if" >> pp t >> outdent >> nl - inword "then" >> pp t' >> outdent - nl - inword "else" >> pp t'' - outword "fi" + IfThen t t' -> do hangWord "if" >> pp t >> outdent >> nl + inword "then" >> pp t' + outword "fi" + IfThenElse t t' t'' -> do hangWord "if" >> pp t >> outdent >> nl + inword "then" >> pp t' >> outdent >> nl + inword "else" >> pp t'' + outword "fi" For var vals t -> do hangWord (concat ["for ", bytes var, " in"]) mapM_ breakline vals outdent >> nl @@ -125,25 +132,36 @@ Until t t' -> do hangWord "until" >> pp t >> outdent >> nl inword "do" >> pp t' >> outword "done" -- BraceBrace _ -> error "[[ ]]" - VarAssign var val -> do hang (bytes var `mappend` "=") + Assign (Var var val) -> do hang (bytes var `mappend` "=") pp val >> outdent - Export var val -> do hangcat ["export ", bytes var, "="] + Assign (Array var exps) -> do hangcat [bytes var, "=("] + array_pp pp exps >> word ")" + nl >> outdent + Assign (Dict var pairs) -> do hangcat [bytes var, "=("] + array_pp keyset pairs + nl >> outdent >> word ")" + Declare (Var var val) -> do hang $ concat ["declare ", bytes var, "="] pp val >> outdent - ArrayDecl var exprs -> do hangcat ["declare -a ", bytes var, "=("] - array_pp pp exprs >> word ")" + Declare (Array var exps) -> do hangcat ["declare -a ", bytes var, "=("] + array_pp pp exps >> word ")" nl >> outdent - ArrayUpdate var key val -> pp (DictUpdate var key val) - ArrayAssign var exprs -> do hangcat [bytes var, "=("] - array_pp pp exprs >> word ")" + Declare (Dict var pairs) -> do hangcat ["declare -A ", bytes var, "=("] + array_pp keyset pairs >> word ")" nl >> outdent - DictDecl var pairs -> do hangcat ["declare -A ", bytes var, "=("] + Local (Var var val) -> do hang $ concat ["local ", bytes var, "="] + pp val >> outdent + Local (Array var exps) -> do hangcat ["local -a ", bytes var, "=("] + array_pp pp exps >> word ")" + nl >> outdent + Local (Dict var pairs) -> do hangcat ["local -A ", bytes var, "=("] array_pp keyset pairs >> word ")" nl >> outdent + Export var val -> do hangcat ["export ", bytes var, "="] + pp val >> outdent + IsSet var -> wordcat ["[[ ${",identpart var,":+true} ]]"] + ArrayUpdate var key val -> pp (DictUpdate var key val) DictUpdate var key val -> wordcat [bytes var, "[", bytes key, "]=", bytes val] - DictAssign var pairs -> do hangcat [bytes var, "=("] - array_pp keyset pairs - nl >> outdent >> word ")" Redirect stmt d fd t -> do redirectGrp stmt word (render_redirect d fd t) @@ -172,6 +190,8 @@ braces0 b = "${" `append` b `append` ":-}" +braces_ b = concat ["${", b, ":+${", b, "}}"] + brackets b = cons '[' b `snoc` ']' identpart (VarSpecial special) = (drop 1 . bytes) special @@ -235,4 +255,6 @@ pp ann word close outdent >> outdent + +escapeWords s = unwords ((Esc.bytes . Esc.bash) <$> words s) diff --git a/Language/Bash/Syntax.hs b/Language/Bash/Syntax.hs --- a/Language/Bash/Syntax.hs +++ b/Language/Bash/Syntax.hs @@ -11,7 +11,7 @@ -} module Language.Bash.Syntax where -import Prelude hiding (all) +import Prelude hiding (all, any, elem) import Control.Applicative import Control.Arrow ((***)) import Control.Monad @@ -20,7 +20,7 @@ import Data.Maybe import Data.Word (Word8) import Data.ByteString.Char8 -import Data.Foldable hiding (all) +import Data.Foldable hiding (all, any, elem) import Data.Monoid import qualified Text.ShellEscape as Esc @@ -55,7 +55,7 @@ | Background (Annotated t) (Annotated t) | Group (Annotated t) | Subshell (Annotated t) - | Function Identifier (Annotated t) + | Function FuncName (Annotated t) | IfThen (Annotated t) (Annotated t) | IfThenElse (Annotated t) (Annotated t) (Annotated t) | For Identifier [Expression t] (Annotated t) @@ -63,14 +63,13 @@ | While (Annotated t) (Annotated t) | Until (Annotated t) (Annotated t) -- BraceBrace (ConditionalExpression t) - | VarAssign Identifier (Expression t) + | Assign (Assignment t) + | Declare (Assignment t) + | Local (Assignment t) | Export Identifier (Expression t) - | ArrayDecl Identifier [Expression t] + | IsSet VarName | ArrayUpdate Identifier (Expression t) (Expression t) - | ArrayAssign Identifier [Expression t] - | DictDecl Identifier [(Identifier, Expression t)] | DictUpdate Identifier (Expression t) (Expression t) - | DictAssign Identifier [(Expression t, Expression t)] | Redirect (Annotated t) Redirection FileDescriptor (Either (Expression t) FileDescriptor) deriving instance (Eq t) => Eq (Statement t) @@ -89,7 +88,7 @@ Background ann ann' -> Background (f' ann) (f' ann') Group ann -> Group (f' ann) Subshell ann -> Subshell (f' ann) - Function ident ann -> Function ident (f' ann) + Function fname ann -> Function fname (f' ann) IfThen ann ann' -> IfThen (f' ann) (f' ann') IfThenElse a a' a'' -> IfThenElse (f' a) (f' a') (f' a'') For ident args ann -> For ident (fmap f' args) (f' ann) @@ -97,14 +96,13 @@ While ann ann' -> While (f' ann) (f' ann') Until ann ann' -> Until (f' ann) (f' ann') -- BraceBrace (ConditionalExpression t) - VarAssign ident expr -> VarAssign ident (f' expr) + Assign a -> Assign (f' a) + Declare a -> Declare (f' a) + Local a -> Local (f' a) Export ident expr -> Export ident (f' expr) - ArrayDecl ident assigns -> ArrayDecl ident (fmap f' assigns) + IsSet var -> IsSet var ArrayUpdate ident a b -> ArrayUpdate ident (f' a) (f' b) - ArrayAssign ident assigns -> ArrayAssign ident (fmap f' assigns) - DictDecl ident assigns -> DictDecl ident (fmap (id *** f') assigns) DictUpdate ident a b -> DictUpdate ident (f' a) (f' b) - DictAssign ident assigns -> DictAssign ident (fmap (f' *** f') assigns) Redirect ann r fd chan -> Redirect (f' ann) r fd (fmapExprFD chan) where f' = fmap f @@ -131,14 +129,13 @@ While ann ann' -> f' ann `mappend` f' ann' Until ann ann' -> f' ann `mappend` f' ann' -- BraceBrace ConditionalExpression - VarAssign _ expr -> f' expr + Assign a -> f' a + Declare a -> f' a + Local a -> f' a Export _ expr -> f' expr - ArrayDecl _ assigns -> foldMap f' assigns + IsSet _ -> mempty ArrayUpdate _ a b -> f' a `mappend` f' b - ArrayAssign _ assigns -> foldMap f' assigns - DictDecl _ assigns -> foldMap (f' . snd) assigns DictUpdate _ a b -> f' a `mappend` f' b - DictAssign _ assigns -> foldMap foldMapPair assigns Redirect ann _ _ chan -> f' ann `mappend` foldMapExprFD chan where f' = foldMap f @@ -160,6 +157,7 @@ | ARGVElements | ARGVLength | Elements Identifier + | ElementsSafe Identifier | Keys Identifier | Length VarName | Trim Trim VarName (Expression t) @@ -189,6 +187,7 @@ ARGVElements -> ARGVElements ARGVLength -> ARGVLength Elements ident -> Elements ident + ElementsSafe ident -> Elements ident Keys ident -> Keys ident Length ident -> Length ident Trim trim v expr -> Trim trim v (fmap f expr) @@ -211,6 +210,7 @@ ARGVElements -> mempty ARGVLength -> mempty Elements _ -> mempty + ElementsSafe _ -> mempty Keys _ -> mempty Length _ -> mempty Trim _ _ expr -> foldMap f expr @@ -259,6 +259,59 @@ okayTail c = (isAlphaNum c || c == '_') && isAscii c okayHead c = (isAlpha c || c == '_') && isAscii c +{-| Bash functions can have surprising names. Once the word containing the + name of the function has been identified by the Bash parser, the only + constraint as of this writing is that it not be all digits and contain + neither quotes nor dollar signs. Thus the following are all callable + functions: + + > function http://duckduckgo.com { curl -sSfL http://duckduckgo.com?q="$1" ;} + > function 123.0 { echo 123.0 ;} + > function + { echo "$@" | sed 's/ / + /g' | bc ;} + + Yet a function name may only be parsed if its surroundings constitute a + valid function declaration. So we are not able to declare these functions: + + > function par()ens { echo '(' "$@" ')' ;} + > function (parens) { echo '(' "$@" ')' ;} + + (The parser thinks the parens are there to separate the function name from + the function body.) + + Some functions can be declared but not called. For example: + + > function for { echo for ;} + > function x=y { echo x is y ;} + + Calling the former results in a syntax error. A call to the latter is + parsed as an assignment. + + It is possible to override important builtins with function declarations. + For example: + + > function set { echo Haha! ;} + > function declare { echo Surprise! ;} + + Overall, Bash function names are quite flexible but inconsistent and + potentially a cause of grave errors. + + -} +data FuncName = Simple Identifier | Fancy ByteString +deriving instance Eq FuncName +deriving instance Ord FuncName +deriving instance Show FuncName +instance IsString FuncName where + fromString = fromJust . funcName . fromString + +{-| Produce a 'FuncName', choosing the 'Simple' constructor if the name is a + simple identifier. + -} +funcName :: ByteString -> Maybe FuncName +funcName bytes = (Simple <$> identifier bytes) + <|> Fancy bytes <$ guard (not invalid) + where + invalid = all isDigit bytes || any (`elem` "()$'\"") bytes + {-| The names of special variables, with otherwise illegal identifiers, are represented by this type. -} @@ -382,4 +435,26 @@ deriving instance (Ord t) => Ord (ConditionalExpression t) deriving instance (Show t) => Show (ConditionalExpression t) +data Assignment t + = Var Identifier (Expression t) + | Array Identifier [Expression t] + | Dict Identifier [(Expression t, Expression t)] +deriving instance (Eq t) => Eq (Assignment t) +deriving instance (Ord t) => Ord (Assignment t) +deriving instance (Show t) => Show (Assignment t) +instance Functor Assignment where + fmap f assign = case assign of + Var ident expr -> Var ident (f' expr) + Array ident assigns -> Array ident (fmap f' assigns) + Dict ident assigns -> Dict ident (fmap (f' *** f') assigns) + where + f' = fmap f +instance Foldable Assignment where + foldMap f assign = case assign of + Var _ expr -> f' expr + Array _ assigns -> foldMap f' assigns + Dict _ assigns -> foldMap foldMapPair assigns + where + f' = foldMap f + foldMapPair (x, y) = f' x `mappend` f' y diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ import Distribution.Simple -main = defaultMain + +main = defaultMain + diff --git a/bash.cabal b/bash.cabal --- a/bash.cabal +++ b/bash.cabal @@ -1,5 +1,5 @@ name : bash -version : 0.1.7 +version : 0.1.8 category : Language license : BSD3 license-file : LICENSE diff --git a/tests.bash b/tests.bash --- a/tests.bash +++ b/tests.bash @@ -7,7 +7,7 @@ set -o nounset -o errexit -o pipefail declare -a esed=() -if sed --version | fgrep -q GNU &>/dev/null +if { sed --version | fgrep -q GNU ;} &>/dev/null then esed=(sed -r) else