language-bash 0.6.0 → 0.6.1
raw patch · 11 files changed
+216/−75 lines, 11 filesdep +QuickCheckdep +language-bashdep +processdep ~basedep ~parsecdep ~transformers
Dependencies added: QuickCheck, language-bash, process, tasty, tasty-quickcheck
Dependency ranges changed: base, parsec, transformers
Files
- .gitignore +2/−1
- README.md +2/−0
- language-bash.cabal +19/−4
- src/Language/Bash/Cond.hs +13/−6
- src/Language/Bash/Expand.hs +63/−27
- src/Language/Bash/Parse.hs +5/−5
- src/Language/Bash/Parse/Internal.hs +5/−0
- src/Language/Bash/Parse/Word.hs +5/−1
- src/Language/Bash/Syntax.hs +40/−23
- src/Language/Bash/Word.hs +16/−8
- tests/Tests.hs +46/−0
.gitignore view
@@ -1,4 +1,5 @@ dist/-cabal-dev/+.cabal-sandbox/+cabal.sandbox.config *.o *.hi
README.md view
@@ -1,4 +1,6 @@ language-bash ------------- +[](https://travis-ci.org/knrafto/language-bash)+ A library for parsing and pretty-printing Bash shell scripts.
language-bash.cabal view
@@ -1,15 +1,16 @@ name: language-bash-version: 0.6.0+version: 0.6.1 category: Language license: BSD3 license-file: LICENSE author: Kyle Raftogianis maintainer: Kyle Raftogianis <kylerafto@gmail.com>-copyright: Copyright (c) 2013 Kyle Raftogianis+copyright: Copyright (c) 2013-2015 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 synopsis: Parsing and pretty-printing Bash shell scripts description: A library for parsing, pretty-printing, and manipulating@@ -41,9 +42,23 @@ Language.Bash.Parse.Internal build-depends:- base >= 4 && < 5,+ base >= 4.6 && < 5, parsec >= 3.0 && < 4.0, pretty >= 1.0 && < 2.0,- transformers >= 0.2 && < 0.4+ transformers >= 0.2 && < 0.5 ghc-options: -Wall++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Tests.hs++ build-depends:+ base,+ language-bash,+ parsec,+ process,+ QuickCheck,+ tasty,+ tasty-quickcheck
src/Language/Bash/Cond.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE- DeriveFoldable+ DeriveDataTypeable+ , DeriveFoldable+ , CPP , DeriveFunctor , DeriveTraversable , OverloadedStrings@@ -15,12 +17,17 @@ import Prelude hiding (negate) import Control.Applicative-import Data.Foldable (Foldable)-import Data.Traversable (Traversable)+import Data.Data (Data)+import Data.Typeable (Typeable) 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 @@ -31,7 +38,7 @@ | Not (CondExpr a) | And (CondExpr a) (CondExpr a) | Or (CondExpr a) (CondExpr a)- deriving (Eq, Read, Show, Functor, Foldable, Traversable)+ deriving (Data, Eq, Read, Show, Typeable, Functor, Foldable, Traversable) instance Pretty a => Pretty (CondExpr a) where pretty = go (0 :: Int)@@ -70,7 +77,7 @@ | Varname -- ^ @-v@ | ZeroString -- ^ @-z@ | NonzeroString -- ^ @-n /string/@ or @/string/@- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Operator UnaryOp where operatorTable =@@ -99,7 +106,7 @@ | ArithLE -- ^ @-le@ | ArithGT -- ^ @-gt@ | ArithGE -- ^ @-ge@- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Operator BinaryOp where operatorTable =
src/Language/Bash/Expand.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase, OverloadedStrings, PatternGuards #-}+{-# LANGUAGE OverloadedStrings, PatternGuards, CPP #-} -- | Shell expansions. module Language.Bash.Expand ( braceExpand@@ -7,21 +7,32 @@ , splitWord ) where +#if __GLASGOW_HASKELL__ >= 710+import Prelude hiding (Word)+#else+import Data.Traversable (traverse)+#endif+ import Control.Applicative import Control.Monad import Data.Char-import Data.Traversable import Text.Parsec.Combinator hiding (optional, manyTill) import Text.Parsec.Prim hiding ((<|>), many, token) import Text.Parsec.String () import Text.PrettyPrint hiding (char) import Language.Bash.Pretty-import Language.Bash.Word+import Language.Bash.Word hiding (prefix) -- | A parser over words. type Parser = Parsec Word () +infixl 3 </>++-- | Backtracking choice.+(</>) :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a+p </> q = try p <|> q+ -- | Run a 'Parser', failing on a parse error. parseUnsafe :: String -> Parser a -> Word -> a parseUnsafe f p w = case parse p (prettyText w) w of@@ -33,27 +44,35 @@ token = tokenPrim (const "") (\pos _ _ -> pos) -- | Parse an unquoted character satisfying a predicate.-satisfy :: (Char -> Bool) -> Parser Char-satisfy p = token $ \case+satisfy :: (Char -> Bool) -> Parser Span+satisfy p = token $ \t -> case t of+ Char c | p c -> Just t+ _ -> Nothing++-- | Parse an unquoted character satisfying a predicate.+satisfy' :: (Char -> Bool) -> Parser Char+satisfy' p = token $ \t -> case t of Char c | p c -> Just c _ -> Nothing -- | Parse a span that is not an unquoted character satisfying a predicate. except :: (Char -> Bool) -> Parser Span-except p = token $ \case+except p = token $ \t -> case t of Char c | p c -> Nothing- s -> Just s+ _ -> Just t -- | Parse an unquoted character.-char :: Char -> Parser Char-char c = satisfy (== c)+char :: Char -> Parser Span+char c = token $ \t -> case t of+ Char d | c == d -> Just t+ _ -> Nothing -- | Parse an unquoted string.-string :: String -> Parser String+string :: String -> Parser Word string = traverse char -- | Parse one of the given characters.-oneOf :: [Char] -> Parser Char+oneOf :: [Char] -> Parser Span oneOf cs = satisfy (`elem` cs) -- | Parse anything but a quoted character.@@ -85,25 +104,42 @@ -- | Brace expand a word. braceExpand :: Word -> [Word]-braceExpand = parseUnsafe "braceExpand" (go "")+braceExpand = parseUnsafe "braceExpand" start where- go delims = try (brace delims)- <|> (:[]) <$> many (noneOf delims)+ prefix a bs = map (a ++) bs+ cross as bs = [a ++ b | a <- as, b <- bs] - brace delims = do- a <- many (noneOf ('{':delims))- _ <- char '{'- bs <- try sequenceExpand <|> braceParts- _ <- char '}'- cs <- go delims- return [ a ++ b ++ c | b <- bs, c <- cs ]+ -- A beginning empty brace is ignored.+ start = prefix <$> string "{}" <*> expr ""+ </> expr "" - braceParts = concatParts <$> go ",}" `sepBy` char ','+ expr delims = foldr ($) [""] <$> many (exprPart delims) - concatParts [] = ["{}"]- concatParts [xs] = map (\x -> "{" ++ x ++ "}") xs- concatParts xss = concat xss+ exprPart delims = cross <$ char '{' <*> brace delims <* char '}'+ </> prefix <$> emptyBrace+ </> prefix . (:[]) <$> noneOf delims + brace delims = concat <$> braceParts delims+ </> sequenceExpand+ </> map (\s -> "{" ++ s ++ "}") <$> expr ",}"++ -- The first part of the outermost brace expression is not delimited by+ -- a close brace.+ braceParts delims =+ (:) <$> expr (if ',' `elem` delims then ",}" else ",") <* char ','+ <*> expr ",}" `sepBy1` char ','++ emptyBrace = do+ a <- token $ \t -> case t of+ Char c | c `elem` ws -> Just t+ Escape c | c `elem` ws -> Just t+ _ -> Nothing+ b <- char '{'+ c <- char '}' <|> oneOf ws+ return [a, b, c]+ where+ ws = " \t\r\n"+ sequenceExpand = do a <- sequencePart b <- string ".." *> sequencePart@@ -111,7 +147,7 @@ inc <- traverse readNumber c map fromString <$> (numExpand a b inc <|> charExpand a b inc) where- sequencePart = many1 (satisfy isAlphaNum)+ sequencePart = many1 (satisfy' isAlphaNum) charExpand a b inc = do x <- readAlpha a@@ -159,7 +195,7 @@ ('~':s, w') -> Just (readPrefix s, w') _ -> Nothing where- split = (,) <$> many (satisfy (/= '/')) <*> getInput+ split = (,) <$> many (satisfy' (/= '/')) <*> getInput readPrefix s | s == "" = Home
src/Language/Bash/Parse.hs view
@@ -20,7 +20,7 @@ import Language.Bash.Parse.Internal import Language.Bash.Pretty import Language.Bash.Syntax-import Language.Bash.Word (Word, fromString, unquote)+import Language.Bash.Word (fromString, unquote) -- | User state. data U = U { postHeredoc :: Maybe (State D U) }@@ -291,13 +291,13 @@ <* word "do" <*> compoundList <* word "done" -- | Parse a list of words for a @for@ or @select@ command.-wordList :: Parser [Word]-wordList = ["$@\""] <$ operator ";" <* newlineList+wordList :: Parser WordList+wordList = Args <$ operator ";" <* newlineList <|> newlineList *> inList <?> "word list" where- inList = word "in" *> many anyWord <* listTerm- <|> return ["$@\""]+ inList = WordList <$ word "in" <*> many anyWord <* listTerm+ <|> pure Args -- | Parse a @for@ command. forCommand :: Parser ShellCommand
src/Language/Bash/Parse/Internal.hs view
@@ -2,6 +2,7 @@ FlexibleContexts , FlexibleInstances , LambdaCase+ , CPP , MultiParamTypeClasses , OverloadedStrings , PatternGuards@@ -35,6 +36,10 @@ -- * Here documents , heredocWord ) where++#if __GLASGOW_HASKELL__ >= 710+import Prelude hiding (Word)+#endif import Control.Applicative import Control.Monad
src/Language/Bash/Parse/Word.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, RecordWildCards #-}+{-# LANGUAGE FlexibleContexts, RecordWildCards, CPP #-} -- | Word-level parsers. module Language.Bash.Parse.Word ( skipSpace@@ -10,6 +10,10 @@ , assign , operator ) where++#if __GLASGOW_HASKELL__ >= 710+import Prelude hiding (Word)+#endif import Control.Applicative import Control.Monad
src/Language/Bash/Syntax.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, CPP #-} -- | Shell script types. module Language.Bash.Syntax ( -- * Commands Command(..) , ShellCommand(..)+ , WordList(..) , CaseClause(..) , CaseTerm(..) -- * Redirections@@ -24,6 +25,12 @@ , RValue(..) ) where +#if __GLASGOW_HASKELL__ >= 710+import Prelude hiding (Word)+#endif++import Data.Data (Data)+import Data.Typeable (Typeable) import Text.PrettyPrint import Language.Bash.Cond (CondExpr)@@ -41,7 +48,7 @@ -- | A Bash command with redirections. data Command = Command ShellCommand [Redir]- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty Command where pretty (Command c rs) = pretty c <+> pretty rs@@ -67,12 +74,12 @@ | Cond (CondExpr Word) -- | A @for /name/ in /words/@ command. If @in /words/@ is absent, -- the word list defaults to @\"$\@\"@.- | For String [Word] List+ | For String WordList List -- | An arithmetic @for ((...))@ command. | ArithFor String List -- | A @select /name/ in /words/@ command. If @in /words/@ is absent, -- the word list defaults to @\"$\@\"@.- | Select String [Word] List+ | Select String WordList List -- | A @case@ command. | Case Word [CaseClause] -- | An @if@ command, with a predicate, consequent, and alternative.@@ -82,7 +89,7 @@ | Until List List -- | A @while@ command. | While List List- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty ShellCommand where pretty (SimpleCommand as ws) = pretty as <+> pretty ws@@ -100,13 +107,13 @@ pretty (Cond e) = "[[" <+> pretty e <+> "]]" pretty (For w ws l) =- "for" <+> pretty w <+> "in" <+> pretty ws <> ";" $+$ doDone l+ "for" <+> pretty w <+> pretty ws <> ";" $+$ doDone l pretty (ArithFor s l) = "for" <+> "((" <> text s <> "))" $+$ doDone l pretty (Select w ws l) =- "select" <+> pretty w <+> "in" <+> pretty ws <> ";" $+$ doDone l+ "select" <+> pretty w <+> pretty ws <> ";" $+$ doDone l pretty (Case w cs) =- "case" <+> pretty w <+> "in" $+$ indent cs $+$ "esac"+ "case" <+> pretty w <+> "in" $+$ (vcat $ map indent cs) $+$ "esac" pretty (If p t f) = "if" <+> pretty p <+> "then" $+$ indent t $+$ pretty (fmap (\l -> "else" $+$ indent l) f) $+$@@ -116,22 +123,32 @@ pretty (While p l) = "while" <+> pretty p <+> doDone l +-- | A word list or @\"$\@\"@.+data WordList+ = Args+ | WordList [Word]+ deriving (Data, Eq, Read, Show, Typeable)++instance Pretty WordList where+ pretty Args = empty+ pretty (WordList ws) = "in" <+> pretty ws+ -- | A single case clause. data CaseClause = CaseClause [Word] List CaseTerm- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty CaseClause where pretty (CaseClause ps l term) = hcat (punctuate " | " (map pretty ps)) <> ")" $+$ indent l $+$- pretty term+ (indent $ pretty term) -- | A case clause terminator. data CaseTerm = Break -- ^ @;;@ | FallThrough -- ^ @;&@ | Continue -- ^ @;;&@- deriving (Eq, Ord, Read, Show, Bounded, Enum)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum) instance Operator CaseTerm where operatorTable = zip [minBound .. maxBound] [";;", ";&", ";;&"]@@ -163,7 +180,7 @@ -- and command substitutions take place. , hereDocument :: Word }- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty Redir where pretty Redir{..} =@@ -186,7 +203,7 @@ = IONumber Int -- | A variable @{/varname/}@ to allocate a file descriptor for. | IOVar String- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty IODesc where pretty (IONumber n) = int n@@ -204,7 +221,7 @@ | InAnd -- ^ @\<&@ | OutAnd -- ^ @\>&@ | InOut -- ^ @\<\>@- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Operator RedirOp where operatorTable = zip [minBound .. maxBound]@@ -217,7 +234,7 @@ data HeredocOp = Here -- ^ @\<\<@ | HereStrip -- ^ @\<\<-@- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Operator HeredocOp where operatorTable = zip [Here, HereStrip] ["<<", "<<-"]@@ -227,14 +244,14 @@ -- | A compound list of statements. newtype List = List [Statement]- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty List where pretty (List as) = pretty as -- | A single statement in a list. data Statement = Statement AndOr ListTerm- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty Statement where pretty (Statement l Sequential) = pretty l <> ";"@@ -249,7 +266,7 @@ data ListTerm = Sequential -- ^ @;@ | Asynchronous -- ^ @&@- deriving (Eq, Ord, Read, Show, Bounded, Enum)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum) instance Operator ListTerm where operatorTable =@@ -269,7 +286,7 @@ | And Pipeline AndOr -- | A @||@ construct. | Or Pipeline AndOr- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty AndOr where pretty (Last p) = pretty p@@ -288,7 +305,7 @@ -- @command1 |& command2@ is treated as a shorthand for -- @command1 2>&1 | command2@. , commands :: [Command]- } deriving (Eq, Read, Show)+ } deriving (Data, Eq, Read, Show, Typeable) instance Pretty Pipeline where pretty Pipeline{..} =@@ -299,7 +316,7 @@ -- | An assignment. data Assign = Assign Parameter AssignOp RValue- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty Assign where pretty (Assign lhs op rhs) = pretty lhs <> pretty op <> pretty rhs@@ -308,7 +325,7 @@ data AssignOp = Equals -- ^ @=@ | PlusEquals -- ^ @+=@- deriving (Eq, Ord, Read, Show, Bounded, Enum)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Bounded, Enum) instance Operator AssignOp where operatorTable = zip [Equals, PlusEquals] ["=", "+="]@@ -322,7 +339,7 @@ = RValue Word -- | An array assignment, as @(subscript, word)@ pairs. | RArray [(Maybe Word, Word)]- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty RValue where pretty (RValue w) = pretty w
src/Language/Bash/Word.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE- FlexibleInstances+ DeriveDataTypeable+ , FlexibleInstances+ , CPP , OverloadedStrings , RecordWildCards , TypeSynonymInstances@@ -23,7 +25,13 @@ , unquote ) where +#if __GLASGOW_HASKELL__ >= 710+import Prelude hiding (Word)+#endif++import Data.Data (Data) import qualified Data.String+import Data.Typeable (Typeable) import Text.PrettyPrint import Language.Bash.Operator@@ -60,7 +68,7 @@ | CommandSubst String -- | A process substitution. | ProcessSubst ProcessSubstOp String- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty Span where pretty (Char c) = char c@@ -79,7 +87,7 @@ -- | A parameter name an optional subscript. data Parameter = Parameter String (Maybe Word)- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) instance Pretty Parameter where pretty (Parameter s sub) = text s <> subscript sub@@ -158,7 +166,7 @@ , convertAll :: Bool , pattern :: Word }- deriving (Eq, Read, Show)+ deriving (Data, Eq, Read, Show, Typeable) prettyParameter :: Bool -> Parameter -> Doc -> Doc prettyParameter bang param suffix =@@ -201,7 +209,7 @@ | AltAssign -- ^ '=', ':=' | AltError -- ^ '?', ':?' | AltReplace -- ^ '+', ':+'- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Operator AltOp where operatorTable = zip [minBound .. maxBound] ["-", "=", "?", "+"]@@ -213,7 +221,7 @@ data LetterCaseOp = ToLower | ToUpper- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Operator LetterCaseOp where operatorTable = zip [ToLower, ToUpper] [",", "^"]@@ -225,7 +233,7 @@ data Direction = Front | Back- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Pretty Direction where pretty Front = "#"@@ -235,7 +243,7 @@ data ProcessSubstOp = ProcessIn -- ^ @\<@ | ProcessOut -- ^ @\>@- deriving (Eq, Ord, Read, Show, Enum, Bounded)+ deriving (Data, Eq, Ord, Read, Show, Typeable, Enum, Bounded) instance Operator ProcessSubstOp where operatorTable = zip [ProcessIn, ProcessOut] ["<", ">"]
+ tests/Tests.hs view
@@ -0,0 +1,46 @@+module Main (main) where++import Control.Applicative+import System.Process (readProcess)+import Test.QuickCheck+import Test.QuickCheck.Monadic+import Test.Tasty+import Test.Tasty.QuickCheck+import Text.Parsec (parse)++import Language.Bash.Expand (braceExpand)+import Language.Bash.Parse.Word (word)+import Language.Bash.Word (unquote)++-- TODO sequence+braceExpr :: Gen String+braceExpr = concat <$> listOf charset+ where+ charset = oneof $+ [ elements ["{", ",", "}"]+ , elements ["\\ ", "\\{", "\\,", "\\}"]+ , (:[]) <$> elements ['a'..'z']+ ]++expandWithBash :: String -> IO String+expandWithBash str = do+ expn <- readProcess "/usr/bin/env" ["bash", "-c", "echo " ++ str] ""+ return $ filter (`notElem` "\r\n") expn++testExpand :: String -> [String]+testExpand s = case parse word "" s of+ Left e -> error (show e)+ Right w -> map unquote (braceExpand w)++-- Tests brace expansion.+prop_expandsLikeBash :: Property+prop_expandsLikeBash = monadicIO $ forAllM braceExpr $ \str -> do+ bash <- run $ expandWithBash str+ let check = unwords . filter (not . null) $ testExpand str+ assert (bash == check)++tests :: TestTree+tests = testProperty "brace expansion" prop_expandsLikeBash++main :: IO ()+main = defaultMain tests