bash (empty) → 0.0.0
raw patch · 12 files changed
+1271/−0 lines, 12 filesdep +SHAdep +basedep +binarysetup-changed
Dependencies added: SHA, base, binary, bytestring, containers, hxt-regex-xmlschema, mtl, shell-escape
Files
- LICENSE +28/−0
- Language/Bash.hs +38/−0
- Language/Bash/Annotations.hs +51/−0
- Language/Bash/Lib.hs +69/−0
- Language/Bash/PrettyPrinter.hs +204/−0
- Language/Bash/PrettyPrinter/State.hs +126/−0
- Language/Bash/Script.hs +108/−0
- Language/Bash/Syntax.hs +339/−0
- README +6/−0
- Setup.hs +2/−0
- bash.cabal +45/−0
- tests.bash +255/−0
+ LICENSE view
@@ -0,0 +1,28 @@++ ©2011 Jason Dusek.++ 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.++ . Names of the contributors to this software may not be used to endorse or+ promote products derived from this software without specific prior written+ permission.++ This software is provided by the 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 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. +
+ Language/Bash.hs view
@@ -0,0 +1,38 @@+{-| Types and functions for generation of Bash scripts, with safe escaping+ and composition of a large subset of Bash statements and expressions.++ This module is meant to be imported qualified -- perhaps as @Bash@ -- and+ contains everything you need to build and render Bash scripts. For+ examples of usage, look at "Language.Bash.Lib".++ -}+module Language.Bash+ ( Language.Bash.Syntax.Statement(..)+ , Language.Bash.Syntax.Annotated(..)+ , Language.Bash.Syntax.Expression(..)+ , Language.Bash.Syntax.literal+ , Language.Bash.Syntax.Identifier()+ , Language.Bash.Syntax.identifier+ , Language.Bash.Syntax.SpecialVar()+ , Language.Bash.Syntax.specialVar+ , Language.Bash.Syntax.Redirection(..)+ , Language.Bash.Syntax.FileDescriptor(..)+ , Language.Bash.PrettyPrinter.PP(..)+ , Language.Bash.PrettyPrinter.bytes+ , Language.Bash.PrettyPrinter.builder+ , Language.Bash.PrettyPrinter.State.PPState()+ , Language.Bash.PrettyPrinter.State.render+ , Language.Bash.PrettyPrinter.State.nlCol+ , Language.Bash.Script.script+ , Language.Bash.Script.script_sha1+ , module Language.Bash.Annotations+ , module Language.Bash.Lib+ ) where++import Language.Bash.Syntax+import Language.Bash.PrettyPrinter+import Language.Bash.PrettyPrinter.State+import Language.Bash.Annotations+import Language.Bash.Script+import Language.Bash.Lib+
+ Language/Bash/Annotations.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings+ , StandaloneDeriving+ #-}+{-| Some convenient annotations for Bash scripts, provided with example+ pretty printer typeclass instances.+ -}+module Language.Bash.Annotations where++import Control.Monad+import Data.ByteString.Char8++import Language.Bash.Syntax (Statement(..))+import Language.Bash.PrettyPrinter (PP(..), Annotation(..))+import Language.Bash.PrettyPrinter.State+++{-| Append some raw lines, in flow, above and below a statement.+ -}+data Lines = Lines [ByteString]+ [ByteString]+deriving instance Eq Lines+deriving instance Ord Lines+deriving instance Show Lines+instance Annotation Lines where+ annotate (Lines above below) stmt = do unlines above+ pp stmt+ when ([] /= below)+ (nl >> unlines below)+ where+ unlines = mapM_ (\x -> word x >> nl)+++{-| Annotate a statement with statements of different types, with special+ rules for empty 'NoOp' statements -- as long as the 'ByteString'+ \"comment\" in the 'NoOp' is empty, the 'NoOp' is simply elided.+ -}+data Statements a b = Statements (Statement a)+ (Statement b)+deriving instance (Eq a, Eq b) => Eq (Statements a b)+deriving instance (Ord a, Ord b) => Ord (Statements a b)+deriving instance (Show a, Show b) => Show (Statements a b)+instance (Annotation a, Annotation b) => Annotation (Statements a b) where+ annotate (Statements above below) stmt = pp' above >> pp' stmt >> pp' below+ where+ pp' (NoOp b) | b == "" = return ()+ pp' x = pp x+++instance (PP t, PP t') => Annotation (t, t') where+ annotate (above, below) stmt = pp above >> pp stmt >> pp below+
+ Language/Bash/Lib.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings+ , NoMonomorphismRestriction+ #-}+{-| Shortcuts for Bash generation that also demonstrate use of the library.+ -}+module Language.Bash.Lib where++import Data.Monoid+import Data.ByteString.Char8 (ByteString, pack)++import Language.Bash.Syntax+++{-| Create a simple command from expressions.+ -}+cmd :: Expression t -> [Expression t] -> Statement t+cmd expr exprs = SimpleCommand expr exprs+++{-| Declare or assign an array to a @sed@ command line that will use extended+ 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)+ where+ [sed, fgrep, decl, 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+ , IfThenElse checkGNU setr setE ]+++{-| Perform a statement for integer values ranging from the first integral+ parameter to the second, using @seq@.+ -}+for+ :: (Monoid m, Integral i)+ => Identifier -> i -> i -> Annotated m -> Statement m+for ident a z ann = For ident [EvalUnquoted (ann_ (seqAZ a z))] ann+++{-| Evaluate @seq@ for the given arguments.+ -}+seqAZ :: (Integral i) => i -> i -> Statement t+seqAZ a z = SimpleCommand "seq" [lshow a, lshow z]+ where+ lshow = literal . pack . show+++{-| A set statement that covers a few error handling options, setting+ @errexit@, @nounset@ and @pipefail@.+ -}+setSafe :: Statement t+setSafe = SimpleCommand "set" [ "-o", "errexit"+ , "-o", "nounset"+ , "-o", "pipefail" ]+++{-| Annotate a statement with the 0 value of a monoid.+ -}+ann_ :: (Monoid m) => Statement m -> Annotated m+ann_ = Annotated mempty++
+ Language/Bash/PrettyPrinter.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE OverloadedStrings+ , StandaloneDeriving+ , RecordWildCards+ , NamedFieldPuns+ , NoMonomorphismRestriction+ , GeneralizedNewtypeDeriving+ , UndecidableInstances+ #-}+{-| Pretty printer for Bash.+ -}+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 Prelude hiding (concat, length, replicate, lines, drop, null)+import Control.Monad.State.Strict++import qualified Text.ShellEscape as Esc++import Language.Bash.Syntax+import Language.Bash.PrettyPrinter.State+++bytes :: (PP t) => t -> ByteString+bytes = renderBytes (nlCol 0) . pp++builder :: (PP t) => t -> Builder+builder = render (nlCol 0) . pp++bytes_state = renderBytes (nlCol 0)+++class Annotation t where+ annotate :: t -> Statement t -> State PPState ()+instance Annotation () where+ annotate _ stmt = pp stmt++class PP t where+ pp :: t -> State PPState ()+instance PP Identifier where+ pp (Identifier b) = word b+instance PP SpecialVar where+ pp = word . specialVarBytes+instance PP FileDescriptor where+ pp (FileDescriptor w) = (word . pack . show) w+instance (Annotation t) => PP (Expression t) where+ pp (Literal lit) = word (Esc.bytes lit)+ pp Asterisk = word "*"+ pp QuestionMark = word "?"+ pp (ReadVar var) = (word . quote . ('$' `cons`) . identpart) var+ pp (ReadVarSafe var) = (word . quote . braces0 . identpart) var+ pp (ReadArray ident expr) = (word . braces)+ (bytes ident `append` brackets (bytes expr))+ pp (ReadArraySafe ident expr) = (word . braces0)+ (bytes ident `append` brackets (bytes expr))+ -- Examples that all work for nasty arguments containing brackets:+ -- echo "${array[$1]}"+ -- echo "${array["$1"]}"+ -- echo "${array["$1""$2"]}"+ -- Looks like we can get away with murder here.+ pp (ARGVElements) = word "\"$@\""+ pp (ARGVLength) = word "$#"+ pp (Elements ident) = (word . quote . braces)+ (bytes ident `append` "[@]")+ pp (Length ident) = (word . quote . braces)+ ('#' `cons` identpart ident)+ pp (ArrayLength ident) = (word . quote . braces)+ ('#' `cons` bytes ident `append` "[@]")+ pp (Concat expr0 expr1) = wordcat [bytes expr0, bytes expr1]+ pp (Eval ann) = inlineEvalPrinter "\"$(" ")\"" ann+ pp (EvalUnquoted ann) = inlineEvalPrinter "$(" ")" ann+ pp (ProcessIn ann) = inlineEvalPrinter "<(" ")" ann+ pp (ProcessOut ann) = inlineEvalPrinter ">(" ")" ann+instance (Annotation t) => PP (Annotated t) where+ pp (Annotated t stmt) = annotate t stmt+instance (Annotation t) => PP (Statement t) where+ pp term = case term of+ SimpleCommand cmd args -> do hangMultiline cmd+ mapM_ breakline args+ outdent+ NoOp msg | null msg -> word ":"+ | otherwise -> word ":" >> (word . Esc.bytes . Esc.bash) msg+ Bang t -> hang "!" >> binGrp t >> outdent+ AndAnd t t' -> binGrp t >> word "&&" >> nl >> binGrp t'+ OrOr t t' -> binGrp t >> word "||" >> nl >> binGrp t'+ Pipe t t' -> binGrp t >> word "|" >> nl >> binGrp t'+ Sequence t t' -> pp t >> nl >> pp t'+ 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]+ inword " {" >> pp t >> outword "}"+ IfThen t t' -> do hang "if" >> pp t >> outdent >> nl+ inword "then" >> pp t' >> outword "fi"+ IfThenElse t t' t'' -> do hang "if" >> pp t >> outdent >> nl+ inword "then" >> pp t' >> outdent+ nl+ inword "else" >> pp t''+ outword "fi"+ For var vals t -> do hang (concat ["for ", bytes var, " in"])+ mapM_ breakline vals+ outdent >> nl+ inword "do" >> pp t >> outword "done"+ Case expr cases -> do word "case" >> pp expr >> inword "in"+ mapM_ case_clause cases+ outword "esac"+ While t t' -> do hang "while" >> pp t >> outdent >> nl+ inword "do" >> pp t' >> outword "done"+ 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+ ArrayDecl var exprs -> do hangcat ["declare -a ", bytes var, "=("]+ array_pp pp exprs >> word ")"+ nl >> outdent+ ArrayUpdate var key val -> pp (DictUpdate var key val)+ ArrayAssign var exprs -> do hangcat [bytes var, "=("]+ array_pp pp exprs >> word ")"+ nl >> outdent+ 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+ 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)++hangcat = hang . concat++array_pp ppF [ ] = 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++case_clause (ptrn, stmt) = do hang (bytes ptrn `append` ") ")+ pp stmt >> word ";;" >> outdent >> nl++render_redirect direction fd target =+ concat [ bytes fd, case direction of In -> "<"+ Out -> ">"+ Append -> ">>"+ , case target of Left expr -> bytes expr+ Right fd' -> '&' `cons` bytes fd' ]++quote b = '"' `cons` b `snoc` '"'++braces b = "${" `append` b `snoc` '}'++braces0 b = "${" `append` b `append` ":-}"++brackets b = '[' `cons` b `snoc` ']'++identpart (Left special) = (drop 1 . bytes) special+identpart (Right ident) = bytes ident++binGrp a@(Annotated _ stmt) = case stmt of+ Bang _ -> curlyOpen >> pp a >> curlyClose+ AndAnd _ _ -> curlyOpen >> pp a >> curlyClose+ OrOr _ _ -> curlyOpen >> pp a >> curlyClose+ Pipe _ _ -> curlyOpen >> pp a >> curlyClose+ Sequence _ _ -> curlyOpen >> pp a >> curlyClose+ Background _ _ -> curlyOpen >> pp a >> curlyClose+ _ -> pp a++redirectGrp a@(Annotated _ stmt) = case stmt of+ Redirect _ _ _ _ -> curlyOpen >> pp a >> curlyClose+ _ -> binGrp a++breakline :: (PP t) => t -> State PPState ()+breakline printable = do+ PPState{..} <- get+ when (columns + maxLineLength printed + 1 > 79 && columns /= sum indents)+ (opM [Word "\\", Newline])+ pp printable+ where+ printed = bytes printable++hangMultiline printable = do+ pp printable+ opM [Indent (finalLineLength printed + 1)]+ where+ printed = bytes printable++maxLineLength = fromIntegral . List.foldl' max 0 . fmap length . lines++finalLineLength b = case lines b of+ [ ] -> 0+ h:t -> (fromIntegral . length . List.last) (h:t)++inlineEvalPrinter open close ann = do+ indentPadToNextWord+ hang open+ pp ann+ word close+ outdent >> outdent++
+ Language/Bash/PrettyPrinter/State.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings+ , RecordWildCards+ , NamedFieldPuns+ , NoMonomorphismRestriction+ #-}+{-| Pretty printer state, used within a state monad computation.+ -}+module Language.Bash.PrettyPrinter.State where++import qualified Data.List as List+import Data.Monoid+import Prelude hiding (lines, round, concat, length, replicate)+import Data.Binary.Builder (Builder, toLazyByteString)+import qualified Data.Binary.Builder as Builder+import Data.ByteString.Char8 hiding (null)+import Data.ByteString.Lazy (toChunks)+import Data.Word+import Control.Monad.State.Strict+++{-| State of pretty printing -- string being built, indent levels, present+ column, brace nesting.+ -}+data PPState = PPState { indents :: [Word]+ , curly :: [()]+ , round :: [()]+ , columns :: Word+ , string :: Builder }+instance Show PPState where+ show PPState{..} = "PPState { indents=" ++ show indents+ ++ " curly=" ++ show curly+ ++ " round=" ++ show round+ ++ " columns=" ++ show columns+ ++ " string=" ++ "..." ++ " }"++{-| Produce a builder from a pretty printer state computation.+ -}+render :: PPState -> State PPState () -> Builder+render init computation = string $ execState computation init++renderBytes :: PPState -> State PPState () -> ByteString+renderBytes = ((concat . toChunks . toLazyByteString) .) . render++{-| Pretty printer state starting on a new line indented to the given column.+ -}+nlCol :: Word -> PPState+nlCol w = PPState [w] [()] [()] 0 Builder.empty+++{-| Operations we can perform while pretty printing.+ -}+data PPOp = Indent Word -- ^ Indent by N spaces.+ | Outdent -- ^ Remove and indentation level.+ | Word ByteString -- ^ Add a word to a line.+ | Newline -- ^ Move to newline.+ | Curly Bool -- ^ Introduce a level of braces.+ | Round Bool -- ^ Introduce a level of parens.+++{-| Apply an operation to a state.+ -}+op :: PPState -> PPOp -> PPState+op state@PPState{..} x = case x of+ Indent w -> state { indents = w:indents }+ Outdent -> state { indents = tSafe indents }+ Curly f | f -> state { indents = 2:indents, curly = ():curly+ , string = curly_s, columns = columns+2 }+ | otherwise -> state { indents = tSafe indents+ , curly = tSafe curly, string = s_curly }+ Round f | f -> state { indents = 2:indents, round = ():round+ , string = round_s, columns = columns+2 }+ | otherwise -> state { indents = tSafe indents+ , round = tSafe round, string = s_round }+ Newline | columns == 0 -> state+ | otherwise -> state { string = sNL, columns = 0 }+ Word b -> state { string = s', columns = c' }+ where+ c' = columns + cast (length padded)+ s' = string `mappend` Builder.fromByteString padded+ dent = cast (sum indents)+ padded | columns == 0 = replicate dent ' ' `append` b+ | otherwise = ' ' `cons` b+ where+ tSafe list = if null list then [] else List.tail list+ sNL = string `mappend` Builder.fromByteString "\n"+ curly_s = Builder.fromByteString "{" `mappend` string+ s_curly = string `mappend` Builder.fromByteString " ;}"+ round_s = Builder.fromByteString "(" `mappend` string+ s_round = string `mappend` Builder.fromByteString " )"++opM :: [PPOp] -> State PPState ()+opM = mapM_ (modify . flip op)++nl :: State PPState ()+nl = opM [Newline]+hang :: ByteString -> State PPState ()+hang b = opM [Word b, Indent (cast (length b) + 1)]+word :: ByteString -> State PPState ()+word b = opM [Word b]+wordcat :: [ByteString] -> State PPState ()+wordcat = word . concat+outdent :: State PPState ()+outdent = opM [Outdent]+inword :: ByteString -> State PPState ()+inword b = opM [Word b, Indent 2, Newline]+outword :: ByteString -> State PPState ()+outword b = opM [Newline, Outdent, Word b]+curlyOpen :: State PPState ()+curlyOpen = opM [Curly True]+curlyClose :: State PPState ()+curlyClose = opM [Curly False]+roundOpen :: State PPState ()+roundOpen = opM [Round True]+roundClose :: State PPState ()+roundClose = opM [Round False]+indentPadToNextWord :: State PPState ()+indentPadToNextWord = do+ PPState{..} <- get+ let x = sum indents+ columns' = columns + 1+ indent | columns' > x = columns' - x+ | otherwise = 0+ opM [Indent indent]++cast = fromIntegral+
+ Language/Bash/Script.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings+ , ScopedTypeVariables+ #-}+{-| Utilities for turning statements into full scripts.+ -}+module Language.Bash.Script where++import Data.Binary.Builder (Builder, fromByteString)+import Data.ByteString.Char8 (ByteString, append)+import qualified Data.ByteString.Char8+import qualified Data.ByteString.Lazy+import Data.Foldable+import Data.Monoid++import qualified Data.Digest.Pure.SHA++import Language.Bash.Syntax+import Language.Bash.Lib+import Language.Bash.Annotations+import Language.Bash.PrettyPrinter+import Language.Bash.PrettyPrinter.State+++{-| Produce a script beginning with @#!\/bin\/bash@ and a safe set statement.+ -}+script :: (Annotation t) => Statement t -> Builder+script statement = mconcat [ fromByteString "#!/bin/bash\n"+ , builder (setSafe :: Statement ())+ , fromByteString "\n\n"+ , builder statement ]+++{-| Produce a script beginning with @#!\/bin\/bash@ and some (optional)+ documentation. Cause the script to be scanned for SHA-1 hash of the setup+ (first statement argument) and main (second statement argument) before+ running the safe set statement and running the second argument.+ -}+script_sha1+ :: forall t t'. (Annotation t, Annotation t')+ => ByteString -> Statement t -> Statement t' -> Builder+script_sha1 docs setup main = mconcat [ fromByteString "#!/bin/bash\n\n"+ , remarks+ , fromByteString "######## Setup."+ , fromByteString "\n\n"+ , fromByteString setup'+ , fromByteString "\n\n"+ , fromByteString "######## Main."+ , fromByteString "\n\n"+ , builder tokenCheck' ]+ where+ setup' = bytes setup+ main' = bytes main+ mainSafe = Sequence (dance setSafe) (dance main)+ token = sha1 (append setup' main')+ tokenCheck' :: Statement (Statements (Statements t' ()) ())+ tokenCheck' = tokenCheck token mainSafe+ remarks | docs == mempty = fromByteString ""+ | otherwise = fromByteString (docs `mappend` "\n\n")+++{-| Scan @$0@ for the token before running, producing a statement annotated+ with the initial statement. This is a bit clumsy but is used internally.+ -}+tokenCheck :: ByteString -> Statement t -> Statement (Statements t t')+tokenCheck token stmt =+ IfThen (Annotated (Statements noop noop) (tokenFGREPq token))+ (dance stmt)++{-| Scan @$0@ for the token before running, correctly producing monoidal+ annotations. The function argument provides an annotation for the @fgrep@+ check generated to search for the token. (@const mempty@ would be+ appropriate in most cases.)+ -}+mtokenCheck :: (Monoid t) => ByteString+ -> (Statement t -> t) -> Statement t+ -> Statement t+mtokenCheck token f statement = IfThen (Annotated (f check) check)+ (Annotated (fold statement) statement)+ where+ check = tokenFGREPq token++tokenFGREPq :: ByteString -> Statement t+tokenFGREPq token+ = SimpleCommand "fgrep" ["-q", literal token, ReadVar (Left Dollar0)]++{-| Scan @$0@ the SHA1 of the statement before running.+ -}+sha1Check :: (Annotation t, Annotation t')+ => Statement t -> Statement (Statements t t')+sha1Check stmt = tokenCheck ((sha1 . bytes) stmt) stmt+++sha1 :: ByteString -> ByteString+sha1 = Data.ByteString.Char8.pack+ . Data.Digest.Pure.SHA.showDigest+ . Data.Digest.Pure.SHA.sha1+ . Data.ByteString.Lazy.fromChunks+ . (:[])++{-| The noop dance -- annotate a 'NoOp' with a statement, essentially as a+ type coercion.+ -}+dance :: Statement t -> Annotated (Statements t t')+dance stmt = Annotated (Statements stmt noop) noop++noop :: Statement any+noop = NoOp ""+
+ Language/Bash/Syntax.hs view
@@ -0,0 +1,339 @@+{-# LANGUAGE EmptyDataDecls+ , OverloadedStrings+ , StandaloneDeriving+ , GeneralizedNewtypeDeriving+ , NoMonomorphismRestriction+ #-}+{-| Bash statements and expressions. The statement tree is a functor,+ supporting arbitrary annotations; this is intended to support analysis of+ effects and privilege levels as well as commenting and arbitrary code+ inclusion.+ -}+module Language.Bash.Syntax where++import Prelude hiding (all)+import Control.Arrow ((***))+import Data.Char+import Data.String+import Data.Maybe+import Data.Word (Word8)+import Data.ByteString.Char8+import Data.Foldable hiding (all)+import Data.Monoid++import qualified Text.ShellEscape as Esc+++{-| The 'Annotated' type captures the annotatedness of a tree of Bash+ statements. It is 'Foldable' and a 'Functor'.+ -}+data Annotated t = Annotated { annotation :: t+ , statement :: Statement t }+deriving instance (Eq t) => Eq (Annotated t)+deriving instance (Ord t) => Ord (Annotated t)+deriving instance (Show t) => Show (Annotated t)+instance Functor Annotated where+ fmap f (Annotated t stmt) = Annotated (f t) (fmap f stmt)+instance Foldable Annotated where+ foldMap f (Annotated t stmt) = f t `mappend` foldMap f stmt++{-| The 'Statement' type captures the different kind of statements that may+ exist in a Bash statement tree. It is mutually recursive with 'Annotated'.+ It is a 'Foldable' and a 'Functor'.+ -}+data Statement t+ = SimpleCommand (Expression t) [Expression t]+ | NoOp ByteString+ | Bang (Annotated t)+ | AndAnd (Annotated t) (Annotated t)+ | OrOr (Annotated t) (Annotated t)+ | Pipe (Annotated t) (Annotated t)+ | Sequence (Annotated t) (Annotated t)+ | Background (Annotated t) (Annotated t)+ | Group (Annotated t)+ | Subshell (Annotated t)+ | Function Identifier (Annotated t)+ | IfThen (Annotated t) (Annotated t)+ | IfThenElse (Annotated t) (Annotated t) (Annotated t)+ | For Identifier [Expression t] (Annotated t)+ | Case (Expression t) [(Expression t, Annotated t)]+ | While (Annotated t) (Annotated t)+ | Until (Annotated t) (Annotated t)+-- BraceBrace (ConditionalExpression t)+ | VarAssign Identifier (Expression t)+ | ArrayDecl Identifier [Expression t]+ | 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)+deriving instance (Ord t) => Ord (Statement t)+deriving instance (Show t) => Show (Statement t)+instance Functor Statement where+ fmap f stmt = case stmt of+ SimpleCommand cmd args -> SimpleCommand (f' cmd) (fmap f' args)+ NoOp b -> NoOp b+ Bang ann -> Bang (f' ann)+ AndAnd ann ann' -> AndAnd (f' ann) (f' ann')+ OrOr ann ann' -> OrOr (f' ann) (f' ann')+ Pipe ann ann' -> Pipe (f' ann) (f' ann')+ Sequence ann ann' -> Sequence (f' ann) (f' ann')+ 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)+ 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)+ Case expr cases -> Case (f' expr) (fmap (f' *** f') cases)+ 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)+ ArrayDecl ident assigns -> ArrayDecl ident (fmap f' assigns)+ 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+ fmapExprFD (Left expr) = Left (f' expr)+ fmapExprFD (Right fd) = Right fd+instance Foldable Statement where+ foldMap f stmt = case stmt of+ SimpleCommand cmd args -> f' cmd `mappend` foldMap f' args+ NoOp _ -> mempty+ Bang ann -> f' ann+ AndAnd ann ann' -> f' ann `mappend` f' ann'+ OrOr ann ann' -> f' ann `mappend` f' ann'+ Pipe ann ann' -> f' ann `mappend` f' ann'+ Sequence ann ann' -> f' ann `mappend` f' ann'+ Background ann ann' -> f' ann `mappend` f' ann'+ Group ann -> f' ann+ Subshell ann -> f' ann+ Function _ ann -> f' ann+ IfThen ann ann' -> f' ann `mappend` f' ann'+ IfThenElse a a' a'' -> foldMap f' [a, a', a'']+ For _ args ann -> foldMap f' args `mappend` f' ann+ Case expr cases -> f' expr `mappend` foldMap foldMapPair cases+ While ann ann' -> f' ann `mappend` f' ann'+ Until ann ann' -> f' ann `mappend` f' ann'+-- BraceBrace ConditionalExpression+ VarAssign _ expr -> f' expr+ ArrayDecl _ assigns -> foldMap f' assigns+ 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+ foldMapExprFD (Left expr) = f' expr+ foldMapExprFD (Right _) = mempty+ foldMapPair (x, y) = f' x `mappend` f' y++{-| The type of Bash expressions, handling many kinds of variable reference as+ well as eval and process substitution. It is 'Foldable' and a 'Functor'.+ -}+data Expression t = Literal Esc.Bash+ | Asterisk+ | QuestionMark+ | ReadVar (Either SpecialVar Identifier)+ | ReadVarSafe (Either SpecialVar Identifier)+ | ReadArray Identifier (Expression t)+ | ReadArraySafe Identifier (Expression t)+ | ARGVElements+ | ARGVLength+ | Elements Identifier+ | Length (Either SpecialVar Identifier)+ | ArrayLength Identifier+ | Concat (Expression t) (Expression t)+ | Eval (Annotated t)+ | EvalUnquoted (Annotated t)+ | ProcessIn (Annotated t)+ | ProcessOut (Annotated t)+-- TODO | IndirectExpansion Identifier+-- TODO | Substring, Replacement, &c.+deriving instance (Eq t) => Eq (Expression t)+deriving instance (Ord t) => Ord (Expression t)+deriving instance (Show t) => Show (Expression t)+instance IsString (Expression t) where+ fromString = literal . fromString+instance Functor Expression where+ fmap f expr = case expr of+ Literal esc -> Literal esc+ Asterisk -> Asterisk+ QuestionMark -> QuestionMark+ ReadVar v -> ReadVar v+ ReadVarSafe v -> ReadVarSafe v+ ReadArray ident expr -> ReadArray ident (fmap f expr)+ ReadArraySafe ident expr -> ReadArraySafe ident (fmap f expr)+ ARGVElements -> ARGVElements+ ARGVLength -> ARGVLength+ Elements ident -> Elements ident+ Length ident -> Length ident+ ArrayLength ident -> ArrayLength ident+ Concat expr expr' -> Concat (fmap f expr) (fmap f expr')+ Eval ann -> Eval (fmap f ann)+ EvalUnquoted ann -> EvalUnquoted (fmap f ann)+ ProcessIn ann -> ProcessIn (fmap f ann)+ ProcessOut ann -> ProcessOut (fmap f ann)+instance Foldable Expression where+ foldMap f expr = case expr of+ Literal _ -> mempty+ Asterisk -> mempty+ QuestionMark -> mempty+ ReadVar _ -> mempty+ ReadVarSafe _ -> mempty+ ReadArray _ expr -> foldMap f expr+ ReadArraySafe _ expr -> foldMap f expr+ ARGVElements -> mempty+ ARGVLength -> mempty+ Elements _ -> mempty+ Length _ -> mempty+ ArrayLength _ -> mempty+ Concat expr expr' -> foldMap f expr `mappend` foldMap f expr'+ Eval ann -> foldMap f ann+ EvalUnquoted ann -> foldMap f ann+ ProcessIn ann -> foldMap f ann+ ProcessOut ann -> foldMap f ann++{-| Escape a 'ByteString' to produce a literal expression.+ -}+literal :: ByteString -> Expression t+literal = Literal . Esc.bash++{-| The type of legal Bash identifiers, strings beginning with letters or @_@+ and containing letters, @_@ and digits.+ -}+newtype Identifier = Identifier ByteString+deriving instance Eq Identifier+deriving instance Ord Identifier+deriving instance Show Identifier+instance IsString Identifier where+ fromString = fromJust . identifier . fromString++{-| Produce an 'Identifier' from a 'ByteString' of legal format.+ -}+identifier :: ByteString -> Maybe Identifier+identifier bytes = do+ (c, bytes') <- uncons bytes+ if okayHead c && all okayTail bytes'+ then Just (Identifier bytes)+ else Nothing+ where+ okayTail c = (isAlphaNum c || c == '_') && isAscii c+ okayHead c = (isAlpha c || c == '_') && isAscii c++{-| A file descriptor in Bash is simply a number between 0 and 255.+ -}+newtype FileDescriptor = FileDescriptor Word8+deriving instance Eq FileDescriptor+deriving instance Ord FileDescriptor+deriving instance Num FileDescriptor+deriving instance Show FileDescriptor++{-| Redirection \"directions\".+ -}+data Redirection = In -- ^ Input redirection, @<@.+ | Out -- ^ Output redirection, @>@.+ | Append -- ^ Appending output, @>>@.+deriving instance Eq Redirection+deriving instance Ord Redirection+deriving instance Show Redirection++{-| Unused at present.+ -}+data ConditionalExpression t+ = File_a (Expression t)+ | File_b (Expression t)+ | File_c (Expression t)+ | File_d (Expression t)+ | File_e (Expression t)+ | File_f (Expression t)+ | File_g (Expression t)+ | File_h (Expression t)+ | File_k (Expression t)+ | File_p (Expression t)+ | File_r (Expression t)+ | File_s (Expression t)+ | File_t (Expression t)+ | File_u (Expression t)+ | File_w (Expression t)+ | File_x (Expression t)+ | File_O (Expression t)+ | File_G (Expression t)+ | File_L (Expression t)+ | File_S (Expression t)+ | File_N (Expression t)+ | File_nt (Expression t) (Expression t)+ | File_ot (Expression t) (Expression t)+ | File_ef (Expression t) (Expression t)+ | OptSet (Expression t)+ | StringEmpty (Expression t)+ | StringNonempty (Expression t)+ | StringEq (Expression t) (Expression t)+ | StringNotEq (Expression t) (Expression t)+ | StringLT (Expression t) (Expression t)+ | StringGT (Expression t) (Expression t)+ | StringRE (Expression t) (Expression t)+ | NumEq (Expression t) (Expression t)+ | NumNotEq (Expression t) (Expression t)+ | NumLT (Expression t) (Expression t)+ | NumLEq (Expression t) (Expression t)+ | NumGT (Expression t) (Expression t)+ | NumGEq (Expression t) (Expression t)+ | Not (Expression t) (Expression t)+ | And (Expression t) (Expression t)+ | Or (Expression t) (Expression t)+deriving instance (Eq t) => Eq (ConditionalExpression t)+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"+
+ README view
@@ -0,0 +1,6 @@+ Language.Bash allows for high-level, safe construction of a subset of valid+ Bash scripts. Escaping, nesting and composition of script statements and+ expressions is handled automatically.++ Please read tests.bash to see some examples, along with their output.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bash.cabal view
@@ -0,0 +1,45 @@+name : bash+version : 0.0.0+category : Language+license : BSD3+license-file : LICENSE+author : Jason Dusek+maintainer : oss@solidsnack.be+homepage : http://github.com/solidsnack/bash+synopsis : Bash generation library.+description :+ A library for generation of Bash scripts, handling escaping, statement+ grouping and expression formation at a high level.+ .+ The top-level module, Language.Bash, is all you need to import to access the+ package's functionality. The module Language.Bash.Lib contains some+ examples, as does the test script, tests.bash, included with the source+ distribution.++cabal-version : >= 1.6+build-type : Simple+extra-source-files : README+ , tests.bash++flag split-base++library+ if flag(split-base)+ build-depends : base >= 4 && < 5+ else+ build-depends : base < 4+ build-depends : containers+ , bytestring >= 0.9+ , shell-escape >= 0.1.1+ , binary >= 0.5.0.2+ , hxt-regex-xmlschema >= 9.0.0+ , mtl >= 2.0.1.0+ , SHA >= 1.4.1.3+ exposed-modules : Language.Bash+ Language.Bash.Syntax+ Language.Bash.Script+ Language.Bash.PrettyPrinter+ Language.Bash.PrettyPrinter.State+ Language.Bash.Annotations+ Language.Bash.Lib+
+ tests.bash view
@@ -0,0 +1,255 @@+#!/bin/bash+# This script is literate Bashkell. Lines beginning with #> are passed to+# GHCi during the test.+## Sketching quine-style test script.+## let set = SimpleCommand "set"+## let set' = set ["-o", "nounset", "-o", "errexit", "-o", "pipefail"]+set -o nounset -o errexit -o pipefail++declare -a esed=()+if sed --version | fgrep -q GNU &>/dev/null+then+ esed=(sed -r)+else+ esed=(sed -E)+fi++function body {+ "${esed[@]}" '1,/^exit 0$/ d'+}++function ghci_commands {+ "${esed[@]}" -n '/^#> (.+)$/ { s//\1/ ; p ;} ; /^$/ { p ;}'+}++function results_filter {+ "${esed[@]}" -n '/^########!/,/^########-/ {+ /^########[!-]/ { s/^.+$// ;}+ p+ }' "$@"+}++case "${1:-}" in+ commands) cat "$0" | body | ghci_commands ;;+ ''|tests) cat "$0" | body ;;+ filter) results_filter "$@" ;;+ ghci) cat "$0" | body | ghci_commands | ghci ;;+ test) "$0" ghci 2>/dev/null | results_filter ;;+ *) echo "Arugment error." 1>&2 ;;+esac++exit 0++#> :set prompt "#>\n"+#> :set -XOverloadedStrings+#> :set -XNoMonomorphismRestriction+#> :set -XScopedTypeVariables+#> :load ./Language/Bash.hs+#> let start = "\n########!\n"+#> let end = "\n########-\n"+#> let concatB = Data.ByteString.Char8.concat+#> let bookend b = Data.ByteString.Char8.putStr (concatB [start, b, end])+#> let render = bookend . bytes+#> let unlazy = concatB . Data.ByteString.Lazy.toChunks+#> let unbuilder = unlazy . Data.Binary.Builder.toLazyByteString+#> let buildrender = bookend . unbuilder++#> let ls = Annotated () . SimpleCommand "ls" . (:[])+#> let echo = Annotated () . SimpleCommand "echo"+#> let commented a b = Annotated (Lines a b)++#> let ifStmt = Annotated () (IfThenElse (ls ".") (ls ".") (ls "/"))+#> let whileStmt = Annotated () (While ifStmt (echo ["ok"]))+#> let redirectStmt = Annotated () (Redirect whileStmt Append 1 (Left "fo&o"))+#> render redirectStmt+while if ls .+ then+ ls .+ else+ ls /+ fi+do+ echo ok+done 1>>$'fo&o'++#> let sqnc = Annotated () (Sequence (echo ["-n","hello "]) (echo ["dudes."]))+#> let redirectStmt = Annotated () (Redirect sqnc Out 1 (Left "msg"))+#> render redirectStmt+{ echo -n $'hello '+ echo dudes. ;} 1>msg++#> let (varX :: Identifier) = "x"+#> let readX = ReadVarSafe (Right 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))+#> let lsOr = Annotated () (lsX `OrOr` lsErr)+#> let apacheLogs = "/var/log/apache2/" `Concat` Concat Asterisk ".log"+#> let for = For varX [apacheLogs, "/var/log/httpd"] lsOr+#> let forStmt = Annotated () for+#> render forStmt+for x in /var/log/apache2/*.log /var/log/httpd+do+ ls "${x:-}" ||+ { echo $'Failed to `ls\':' "${x:-}" 1>&2 ;}+done++#> let cdApache = Annotated () $ SimpleCommand "cd" ["/var/www"]+#> let cdWhile = Annotated () (Sequence cdApache whileStmt)+#> let lsWWW = Redirect cdWhile Append 2 (Left "/err")+#> let wfStmt = Annotated () lsWWW `AndAnd` forStmt+#> render wfStmt+{ cd /var/www+ while if ls .+ then+ ls .+ else+ ls /+ fi+ do+ echo ok+ done ;} 2>>/err &&+for x in /var/log/apache2/*.log /var/log/httpd+do+ ls "${x:-}" ||+ echo $'Failed to `ls\':' "${x:-}" 1>&2+done++#> let redirected = Annotated () $ Redirect whileStmt Out 2 (Left "/err")+#> render $ OrOr redirected forStmt+while if ls .+ then+ ls .+ else+ ls /+ fi+do+ echo ok+done 2>/err ||+for x in /var/log/apache2/*.log /var/log/httpd+do+ ls "${x:-}" ||+ echo $'Failed to `ls\':' "${x:-}" 1>&2+done++#> let rem = Annotated (Lines ["# Remark."] [])+#> let noRem = Annotated (Lines [] [])+#> let echoRem = Annotated (Lines ["#+echo"] ["#-echo"]) . SimpleCommand "echo"+#> let echoCase = echoRem ["-n", "case: "]+#> let clause ex = (ex, rem (Sequence echoCase (echoRem [ex])))+#> let clause0 = clause "first"+#> let clause1 = clause "second"+#> let clause_ = (Asterisk, echoRem ["?"])+#> let clauses = [clause0, clause1, clause_]+#> let caseStmt = noRem $ Case (ReadVarSafe (Left Dollar1)) clauses+#> render caseStmt+case "${1:-}" in+ first) # Remark.+ #+echo+ echo -n $'case: '+ #-echo+ #+echo+ echo first+ #-echo+ ;;+ second) # Remark.+ #+echo+ echo -n $'case: '+ #-echo+ #+echo+ echo second+ #-echo+ ;;+ *) #+echo+ echo $'?'+ #-echo+ ;;+esac++#> let a = SimpleCommand "echo" ["a"] :: Statement ()+#> let b = SimpleCommand "echo" ["b"] :: Statement ()+#> let pre = script_sha1 "# Silly script." a b+#> buildrender pre+#!/bin/bash++# Silly script.++######## Setup.++echo a++######## Main.++if fgrep -q f4b85e070cfe2c7990b5fa6b0603182921430d56 "$0"+then+ set -o errexit -o nounset -o pipefail+ echo b+fi++#> let remWhile = fmap (const (Lines ["# Comment."] ["# Comment."])) whileStmt+#> let processWhile = ProcessIn remWhile+#> let evalWhile = Eval remWhile+#> let evalEcho = Eval (echoRem ["before"])+#> let echoWhile = echoRem [evalEcho, evalWhile, "mid", processWhile, "after"]+#> render echoWhile+#+echo+echo "$( #+echo+ echo before+ #-echo+ )" "$( # Comment.+ while # Comment.+ if # Comment.+ ls .+ # Comment.+ then+ # Comment.+ ls .+ # Comment.+ else+ # Comment.+ ls /+ # Comment.+ fi+ # Comment.+ do+ # Comment.+ echo ok+ # Comment.+ done+ # Comment.+ )" mid <( # Comment.+ while # Comment.+ if # Comment.+ ls .+ # Comment.+ then+ # Comment.+ ls .+ # Comment.+ else+ # Comment.+ ls /+ # Comment.+ fi+ # Comment.+ do+ # Comment.+ echo ok+ # Comment.+ done+ # Comment.+ ) after+#-echo++#> let (varX :: Identifier) = "x"+#> let readX = ReadVar (Right varX)+#> let lengthX = Length (Right varX)+#> let echoX = Annotated () (SimpleCommand "echo" [readX, "----", lengthX])+#> let seq4 = Annotated () (SimpleCommand "seq" ["1","4"])+#> let forSeq = For varX [Eval seq4, EvalUnquoted seq4] echoX+#> render (Annotated () forSeq)+for x in "$( seq 1 4 )" $( seq 1 4 )+do+ echo "$x" ---- "${#x}"+done+