diff --git a/Language/Bash/Lib.hs b/Language/Bash/Lib.hs --- a/Language/Bash/Lib.hs +++ b/Language/Bash/Lib.hs @@ -61,6 +61,16 @@ , "-o", "pipefail" ] +{-| 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). + -} +sudo_write :: (Monoid m) => Expression m -> Statement m +sudo_write path = Redirect (ann_ tee) Out 1 (Left "/dev/null") + where + tee = SimpleCommand "sudo" ["tee", path] + + {-| Annotate a statement with the 0 value of a monoid. -} ann_ :: (Monoid m) => Statement m -> Annotated m diff --git a/Language/Bash/PrettyPrinter.hs b/Language/Bash/PrettyPrinter.hs --- a/Language/Bash/PrettyPrinter.hs +++ b/Language/Bash/PrettyPrinter.hs @@ -11,9 +11,9 @@ module Language.Bash.PrettyPrinter where import qualified Data.List as List -import Data.Word (Word8) import Data.ByteString.Char8 import Data.Binary.Builder (Builder) +import Data.Monoid import Prelude hiding (concat, length, replicate, lines, drop, null) import Control.Monad.State.Strict @@ -49,11 +49,14 @@ pp (Literal lit) = word (Esc.bytes lit) pp Asterisk = word "*" pp QuestionMark = word "?" - pp (ReadVar var) = (word . quote . ('$' `cons`) . identpart) var + pp Tilde = word "~" + pp (ReadVar var) = (word . quote) (if s == "$!" then "${!}" else s) + where -- Need to be careful to avoid history expansion of @"@. + s = (('$' `cons`) . identpart) var pp (ReadVarSafe var) = (word . quote . braces0 . identpart) var - pp (ReadArray ident expr) = (word . braces) + pp (ReadArray ident expr) = (word . quote . braces) (bytes ident `append` brackets (bytes expr)) - pp (ReadArraySafe ident expr) = (word . braces0) + pp (ReadArraySafe ident expr) = (word . quote . braces0) (bytes ident `append` brackets (bytes expr)) -- Examples that all work for nasty arguments containing brackets: -- echo "${array[$1]}" @@ -64,8 +67,12 @@ pp (ARGVLength) = word "$#" pp (Elements ident) = (word . quote . braces) (bytes ident `append` "[@]") + pp (Keys ident) = (word . quote . braces) + ('!' `cons` bytes ident `append` "[@]") pp (Length ident) = (word . quote . braces) ('#' `cons` identpart ident) + pp (Trim trim var expr) = (word . quote . braces . mconcat) + [identpart var, trimPrinter trim, bytes expr] pp (ArrayLength ident) = (word . quote . braces) ('#' `cons` bytes ident `append` "[@]") pp (Concat expr0 expr1) = wordcat [bytes expr0, bytes expr1] @@ -111,7 +118,7 @@ Until t t' -> do hang "until" >> pp t >> outdent >> nl inword "do" >> pp t' >> outword "done" -- BraceBrace _ -> error "[[ ]]" - VarAssign var val -> pp var >> word "=" >> pp val + VarAssign var val -> wordcat [bytes var, "=", bytes val] ArrayDecl var exprs -> do hangcat ["declare -a ", bytes var, "=("] array_pp pp exprs >> word ")" nl >> outdent @@ -122,8 +129,8 @@ DictDecl var pairs -> do hangcat ["declare -A ", bytes var, "=("] array_pp keyset pairs >> word ")" nl >> outdent - DictUpdate var key val -> do hangcat [bytes var, "[", bytes key, "]="] - pp val >> outdent + 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 ")" @@ -132,12 +139,12 @@ hangcat = hang . concat -array_pp ppF [ ] = return () +array_pp _ [ ] = return () array_pp ppF (h:t) = ppF h >> mapM_ ppFNL t where ppFNL x = nl >> ppF x -keyset (key, val) = word "[" >> pp key >> word "]=" >> pp val +keyset (key, val) = wordcat ["[", bytes key, "]=", bytes val] case_clause (ptrn, stmt) = do hang (bytes ptrn `append` ") ") pp stmt >> word ";;" >> outdent >> nl @@ -157,9 +164,15 @@ brackets b = '[' `cons` b `snoc` ']' -identpart (Left special) = (drop 1 . bytes) special -identpart (Right ident) = bytes ident +identpart (VarSpecial special) = (drop 1 . bytes) special +identpart (VarIdent ident) = bytes ident +trimPrinter :: Trim -> ByteString +trimPrinter ShortestLeading = "#" +trimPrinter LongestLeading = "##" +trimPrinter ShortestTrailing = "%" +trimPrinter LongestTrailing = "%%" + binGrp a@(Annotated _ stmt) = case stmt of Bang _ -> curlyOpen >> pp a >> curlyClose AndAnd _ _ -> curlyOpen >> pp a >> curlyClose @@ -200,5 +213,4 @@ pp ann word close outdent >> outdent - diff --git a/Language/Bash/Script.hs b/Language/Bash/Script.hs --- a/Language/Bash/Script.hs +++ b/Language/Bash/Script.hs @@ -81,7 +81,7 @@ tokenFGREPq :: ByteString -> Statement t tokenFGREPq token - = SimpleCommand "fgrep" ["-q", literal token, ReadVar (Left Dollar0)] + = SimpleCommand "fgrep" ["-q", literal token, ReadVar (VarSpecial Dollar0)] {-| Scan @$0@ the SHA1 of the statement before running. -} diff --git a/Language/Bash/Syntax.hs b/Language/Bash/Syntax.hs --- a/Language/Bash/Syntax.hs +++ b/Language/Bash/Syntax.hs @@ -12,7 +12,9 @@ module Language.Bash.Syntax where import Prelude hiding (all) +import Control.Applicative import Control.Arrow ((***)) +import Control.Monad import Data.Char import Data.String import Data.Maybe @@ -144,14 +146,17 @@ data Expression t = Literal Esc.Bash | Asterisk | QuestionMark - | ReadVar (Either SpecialVar Identifier) - | ReadVarSafe (Either SpecialVar Identifier) + | Tilde + | ReadVar VarName + | ReadVarSafe VarName | ReadArray Identifier (Expression t) | ReadArraySafe Identifier (Expression t) | ARGVElements | ARGVLength | Elements Identifier - | Length (Either SpecialVar Identifier) + | Keys Identifier + | Length VarName + | Trim Trim VarName (Expression t) | ArrayLength Identifier | Concat (Expression t) (Expression t) | Eval (Annotated t) @@ -170,6 +175,7 @@ Literal esc -> Literal esc Asterisk -> Asterisk QuestionMark -> QuestionMark + Tilde -> Tilde ReadVar v -> ReadVar v ReadVarSafe v -> ReadVarSafe v ReadArray ident expr -> ReadArray ident (fmap f expr) @@ -177,7 +183,9 @@ ARGVElements -> ARGVElements ARGVLength -> ARGVLength Elements ident -> Elements ident + Keys ident -> Keys ident Length ident -> Length ident + Trim trim v expr -> Trim trim v (fmap f expr) ArrayLength ident -> ArrayLength ident Concat expr expr' -> Concat (fmap f expr) (fmap f expr') Eval ann -> Eval (fmap f ann) @@ -189,6 +197,7 @@ Literal _ -> mempty Asterisk -> mempty QuestionMark -> mempty + Tilde -> mempty ReadVar _ -> mempty ReadVarSafe _ -> mempty ReadArray _ expr -> foldMap f expr @@ -196,7 +205,9 @@ ARGVElements -> mempty ARGVLength -> mempty Elements _ -> mempty + Keys _ -> mempty Length _ -> mempty + Trim _ _ expr -> foldMap f expr ArrayLength _ -> mempty Concat expr expr' -> foldMap f expr `mappend` foldMap f expr' Eval ann -> foldMap f ann @@ -209,6 +220,17 @@ literal :: ByteString -> Expression t literal = Literal . Esc.bash +data VarName = VarIdent Identifier | VarSpecial SpecialVar +deriving instance Eq VarName +deriving instance Ord VarName +deriving instance Show VarName +instance IsString VarName where + fromString = fromJust . varName . fromString + +varName :: ByteString -> Maybe VarName +varName bytes = (VarSpecial <$> specialVar bytes) `mplus` + (VarIdent <$> identifier bytes) + {-| The type of legal Bash identifiers, strings beginning with letters or @_@ and containing letters, @_@ and digits. -} @@ -231,6 +253,64 @@ okayTail c = (isAlphaNum c || c == '_') && isAscii c okayHead c = (isAlpha c || c == '_') && isAscii c +{-| The names of special variables, with otherwise illegal identifiers, are + represented by this type. + -} +data SpecialVar + = DollarQuestion | DollarHyphen | DollarDollar + | DollarBang | DollarUnderscore + | Dollar0 | Dollar1 | Dollar2 | Dollar3 | Dollar4 + | Dollar5 | Dollar6 | Dollar7 | Dollar8 | Dollar9 +deriving instance Eq SpecialVar +deriving instance Ord SpecialVar +deriving instance Show SpecialVar +instance IsString SpecialVar where + fromString = fromJust . specialVar . fromString + +{-| Try to render a 'SpecialVar' from a 'ByteString'. + -} +specialVar :: ByteString -> Maybe SpecialVar +specialVar b | "$?" == b = Just DollarQuestion + | "$-" == b = Just DollarHyphen + | "$$" == b = Just DollarDollar + | "$!" == b = Just DollarBang + | "$_" == b = Just DollarUnderscore + | "$0" == b = Just Dollar0 + | "$1" == b = Just Dollar1 + | "$2" == b = Just Dollar2 + | "$3" == b = Just Dollar3 + | "$4" == b = Just Dollar4 + | "$5" == b = Just Dollar5 + | "$6" == b = Just Dollar6 + | "$7" == b = Just Dollar7 + | "$8" == b = Just Dollar8 + | "$9" == b = Just Dollar9 + | otherwise = Nothing + +specialVarBytes :: SpecialVar -> ByteString +specialVarBytes DollarQuestion = "$?" +specialVarBytes DollarHyphen = "$-" +specialVarBytes DollarDollar = "$$" +specialVarBytes DollarBang = "$!" +specialVarBytes DollarUnderscore = "$_" +specialVarBytes Dollar0 = "$0" +specialVarBytes Dollar1 = "$1" +specialVarBytes Dollar2 = "$2" +specialVarBytes Dollar3 = "$3" +specialVarBytes Dollar4 = "$4" +specialVarBytes Dollar5 = "$5" +specialVarBytes Dollar6 = "$6" +specialVarBytes Dollar7 = "$7" +specialVarBytes Dollar8 = "$8" +specialVarBytes Dollar9 = "$9" + + +data Trim = ShortestLeading | LongestLeading + | ShortestTrailing | LongestTrailing +deriving instance Eq Trim +deriving instance Ord Trim +deriving instance Show Trim + {-| A file descriptor in Bash is simply a number between 0 and 255. -} newtype FileDescriptor = FileDescriptor Word8 @@ -296,44 +376,4 @@ deriving instance (Ord t) => Ord (ConditionalExpression t) deriving instance (Show t) => Show (ConditionalExpression t) -{-| The names of special variables, with otherwise illegal identifiers, are - represented by this type. - -} -data SpecialVar - = DollarQuestion | Dollar0 | Dollar1 | Dollar2 | Dollar3 | Dollar4 - | Dollar5 | Dollar6 | Dollar7 | Dollar8 | Dollar9 -deriving instance Eq SpecialVar -deriving instance Ord SpecialVar -deriving instance Show SpecialVar -instance IsString SpecialVar where - fromString = fromJust . specialVar . fromString - -{-| Try to render a 'SpecialVar' from a 'ByteString'. - -} -specialVar :: ByteString -> Maybe SpecialVar -specialVar b | "$?" == b = Just DollarQuestion - | "$0" == b = Just Dollar0 - | "$1" == b = Just Dollar1 - | "$2" == b = Just Dollar2 - | "$3" == b = Just Dollar3 - | "$4" == b = Just Dollar4 - | "$5" == b = Just Dollar5 - | "$6" == b = Just Dollar6 - | "$7" == b = Just Dollar7 - | "$8" == b = Just Dollar8 - | "$9" == b = Just Dollar9 - | otherwise = Nothing - -specialVarBytes :: SpecialVar -> ByteString -specialVarBytes DollarQuestion = "$?" -specialVarBytes Dollar0 = "$0" -specialVarBytes Dollar1 = "$1" -specialVarBytes Dollar2 = "$2" -specialVarBytes Dollar3 = "$3" -specialVarBytes Dollar4 = "$4" -specialVarBytes Dollar5 = "$5" -specialVarBytes Dollar6 = "$6" -specialVarBytes Dollar7 = "$7" -specialVarBytes Dollar8 = "$8" -specialVarBytes Dollar9 = "$9" diff --git a/bash.cabal b/bash.cabal --- a/bash.cabal +++ b/bash.cabal @@ -1,5 +1,5 @@ name : bash -version : 0.0.0 +version : 0.1.1 category : Language license : BSD3 license-file : LICENSE diff --git a/tests.bash b/tests.bash --- a/tests.bash +++ b/tests.bash @@ -56,17 +56,21 @@ #> let ls = Annotated () . SimpleCommand "ls" . (:[]) #> let echo = Annotated () . SimpleCommand "echo" +#> let vRANDOM = VarIdent "RANDOM" +#> let randomLT_ n = SimpleCommand "[" [ReadVar vRANDOM), "-lt", n, "]"] +#> let randomLT n = Annotated () (randomLT_ n) #> let commented a b = Annotated (Lines a b) -#> let ifStmt = Annotated () (IfThenElse (ls ".") (ls ".") (ls "/")) +#> let ifAnn a b c = Annotated () (IfThenElse a b c) +#> let ifStmt = ifAnn (randomLT "40000") (randomLT "10000") (randomLT "45000") #> let whileStmt = Annotated () (While ifStmt (echo ["ok"])) #> let redirectStmt = Annotated () (Redirect whileStmt Append 1 (Left "fo&o")) #> render redirectStmt -while if ls . +while if $'[' "$RANDOM" -lt 40000 $']' then - ls . + $'[' "$RANDOM" -lt 10000 $']' else - ls / + $'[' "$RANDOM" -lt 45000 $']' fi do echo ok @@ -79,7 +83,7 @@ echo dudes. ;} 1>msg #> let (varX :: Identifier) = "x" -#> let readX = ReadVarSafe (Right varX) +#> let readX = ReadVarSafe (VarIdent varX) #> let lsX = Annotated () (SimpleCommand "ls" [readX]) #> let lsMsg = Annotated () (SimpleCommand "echo" ["Failed to `ls':", readX]) #> let lsErr = Annotated () (Redirect lsMsg Out 1 (Right 2)) @@ -100,11 +104,11 @@ #> let wfStmt = Annotated () lsWWW `AndAnd` forStmt #> render wfStmt { cd /var/www - while if ls . + while if $'[' "$RANDOM" -lt 40000 $']' then - ls . + $'[' "$RANDOM" -lt 10000 $']' else - ls / + $'[' "$RANDOM" -lt 45000 $']' fi do echo ok @@ -117,11 +121,11 @@ #> let redirected = Annotated () $ Redirect whileStmt Out 2 (Left "/err") #> render $ OrOr redirected forStmt -while if ls . +while if $'[' "$RANDOM" -lt 40000 $']' then - ls . + $'[' "$RANDOM" -lt 10000 $']' else - ls / + $'[' "$RANDOM" -lt 45000 $']' fi do echo ok @@ -141,7 +145,7 @@ #> let clause1 = clause "second" #> let clause_ = (Asterisk, echoRem ["?"]) #> let clauses = [clause0, clause1, clause_] -#> let caseStmt = noRem $ Case (ReadVarSafe (Left Dollar1)) clauses +#> let caseStmt = noRem $ Case (ReadVarSafe (VarSpecial Dollar1)) clauses #> render caseStmt case "${1:-}" in first) # Remark. @@ -199,15 +203,15 @@ )" "$( # Comment. while # Comment. if # Comment. - ls . + $'[' "$RANDOM" -lt 40000 $']' # Comment. then # Comment. - ls . + $'[' "$RANDOM" -lt 10000 $']' # Comment. else # Comment. - ls / + $'[' "$RANDOM" -lt 45000 $']' # Comment. fi # Comment. @@ -220,15 +224,15 @@ )" mid <( # Comment. while # Comment. if # Comment. - ls . + $'[' "$RANDOM" -lt 40000 $']' # Comment. then # Comment. - ls . + $'[' "$RANDOM" -lt 10000 $']' # Comment. else # Comment. - ls / + $'[' "$RANDOM" -lt 45000 $']' # Comment. fi # Comment. @@ -242,8 +246,8 @@ #-echo #> let (varX :: Identifier) = "x" -#> let readX = ReadVar (Right varX) -#> let lengthX = Length (Right varX) +#> let readX = ReadVar (VarIdent varX) +#> let lengthX = Length (VarIdent varX) #> let echoX = Annotated () (SimpleCommand "echo" [readX, "----", lengthX]) #> let seq4 = Annotated () (SimpleCommand "seq" ["1","4"]) #> let forSeq = For varX [Eval seq4, EvalUnquoted seq4] echoX @@ -252,4 +256,36 @@ do echo "$x" ---- "${#x}" done + +#> let lsRoot = ls (Concat Tilde "root") +#> render lsRoot +ls ~root + +#> let (patterns :: Identifier) = "patterns" +#> let (string :: Identifier) = "string" +#> let identSTRING = VarIdent string +#> let readSTRING = ReadVar identSTRING +#> let readPATTERN0 = ReadArray patterns (literal "leading") +#> let readPATTERN1 = ReadArray patterns (literal "trailing") +#> let setSTRING = Annotated () (VarAssign string "ab/cd/ef") +#> let setPATTERNS = Annotated () (DictDecl patterns [("leading", "ab")]) +#> let setPATTERN1 = Annotated () (DictUpdate patterns "trailing" "ef") +#> let trimLFixed = Trim ShortestLeading identSTRING readPATTERN0 +#> let trimTFixed = Trim ShortestTrailing identSTRING readPATTERN1 +#> let glob0 :: Expression () = Concat Asterisk "/" +#> let glob1 :: Expression () = Concat "/" Asterisk +#> let trimSL = Trim ShortestLeading identSTRING glob0 +#> let trimLL = Trim LongestLeading identSTRING glob0 +#> let trimST = Trim ShortestTrailing identSTRING glob1 +#> let trimLT = Trim LongestTrailing identSTRING glob1 +#> let trims = [trimLFixed, trimTFixed, trimSL, trimLL, trimST, trimLT] +#> let sequence a b = Annotated () (Sequence a b) +#> let set_ = setSTRING `sequence` setPATTERNS `sequence` setPATTERN1 +#> let echoSubs = Annotated () (SimpleCommand "echo" trims) +#> render (set_ `sequence` echoSubs) +string=ab/cd/ef +declare -A patterns=( [leading]=ab ) +patterns[trailing]=ef +echo "${string#"${patterns[leading]}"}" "${string%"${patterns[trailing]}"}" \ + "${string#*/}" "${string##*/}" "${string%/*}" "${string%%/*}"