language-bash 0.8.0 → 0.9.0

raw patch · 10 files changed

+266/−121 lines, 10 filesdep +directorydep +filepathdep +prettyprinterdep −prettyPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, filepath, prettyprinter, tasty-golden

Dependencies removed: pretty

API changes (from Hackage documentation)

Files

• .gitignore +1/−0
• language-bash.cabal +8/−5
• src/Language/Bash/Cond.hs +1/−2
• src/Language/Bash/Expand.hs +5/−4
• src/Language/Bash/Operator.hs +2/−4
• src/Language/Bash/Parse.hs +4/−3
• src/Language/Bash/Pretty.hs +32/−29
• src/Language/Bash/Syntax.hs +137/−48
• src/Language/Bash/Word.hs +27/−22
• tests/Tests.hs +49/−4

@@ -4,3 +4,4 @@ *.o *.hi .stack-work+tests/pretty/*.out

@@ -1,5 +1,5 @@ name:               language-bash-version:            0.8.0+version:            0.9.0 category:           Language license:            BSD3 license-file:       LICENSE@@ -42,10 +42,10 @@     Language.Bash.Parse.Internal    build-depends:-    base         >= 4.6 && < 5,-    parsec       >= 3.0 && < 4.0,-    pretty       >= 1.0 && < 2.0,-    transformers >= 0.2 && < 0.6+    base          >= 4.6 && < 5,+    parsec        >= 3.0 && < 4.0,+    prettyprinter >= 1.2 && < 2.0,+    transformers  >= 0.2 && < 0.6    ghc-options: -Wall @@ -56,11 +56,14 @@    build-depends:     base,+    directory,+    filepath,     language-bash,     parsec,     process,     QuickCheck,     tasty,+    tasty-golden,     tasty-quickcheck,     tasty-hunit,     tasty-expected-failure

@@ -22,10 +22,9 @@ import GHC.Generics           (Generic) import Text.Parsec            hiding ((<|>), token) import Text.Parsec.Expr       hiding (Operator)-import Text.PrettyPrint       hiding (parens)+import Data.Text.Prettyprint.Doc (Pretty(..), (<+>))  import Language.Bash.Operator-import Language.Bash.Pretty  -- | Bash conditional expressions. data CondExpr a

@@ -7,15 +7,16 @@     , splitWord     ) where -import Prelude hiding ((<>), Word)+import Prelude hiding (Word)  import Control.Applicative import Control.Monad import Data.Char+import Data.Monoid            ((<>)) import Text.Parsec.Combinator hiding (optional, manyTill) import Text.Parsec.Prim       hiding ((<|>), many, token) import Text.Parsec.String     ()-import Text.PrettyPrint       hiding (char)+import Data.Text.Prettyprint.Doc (Pretty(..))  import Language.Bash.Pretty import Language.Bash.Word     hiding (prefix)@@ -180,10 +181,10 @@  instance Pretty TildePrefix where     pretty Home         = "~"-    pretty (UserHome s) = "~" <> text s+    pretty (UserHome s) = "~" <> pretty s     pretty PWD          = "~+"     pretty OldPWD       = "~-"-    pretty (Dirs n)     = "~" <> int n+    pretty (Dirs n)     = "~" <> pretty n  -- | Strip the tilde prefix of a word, if any. tildePrefix :: Word -> Maybe (TildePrefix, Word)

@@ -8,9 +8,7 @@  import Control.Applicative import Data.Foldable-import Text.PrettyPrint--import Language.Bash.Pretty+import Data.Text.Prettyprint.Doc (Doc, pretty)  -- | String operators. class Eq a => Operator a where@@ -25,5 +23,5 @@ selectOperator p = select p operatorTable  -- | Render an operator.-prettyOperator :: Operator a => a -> Doc+prettyOperator :: Operator a => a -> Doc ann prettyOperator = pretty . flip lookup operatorTable

@@ -58,13 +58,13 @@     duck = do         u <- getState         case postHeredoc u of-            Nothing -> () <$ line <* optional (char '\n')+            Nothing -> () <$ line             Just s  -> () <$ setParserState s         h <- unlines <$> heredocLines         s <- getParserState         return (h, s) -    line = many (satisfy (/= '\n'))+    line = many (satisfy (/= '\n')) <* optional (char '\n')      heredocLines = [] <$ eof                <|> nextLine@@ -73,7 +73,7 @@         l <- process <$> line         if l == end             then return []-            else (l :) <$ optional (char '\n') <*> heredocLines+            else (l :) <$> heredocLines  -- | Parse a newline, skipping any here documents. newline :: Parser String@@ -84,6 +84,7 @@         Nothing -> return ()         Just s  -> () <$ setParserState s     setState $ U Nothing+    skipSpace     return "\n"  -- | Parse a list terminator.

@@ -1,38 +1,41 @@ -- | Pretty-printing of Bash scripts. This tries to stay close to the format -- used by the Bash builtin @declare -f@.-module Language.Bash.Pretty-    ( Pretty(..)-    , prettyText-    ) where--import Text.PrettyPrint---- | A class of types which may be pretty-printed.-class Pretty a where-    -- | Pretty-print to a 'Doc'.-    pretty     :: a -> Doc--    -- | Pretty-print a list. By default, this separates each element with-    -- a space using 'hsep'.-    prettyList :: [a] -> Doc-    prettyList = hsep . map pretty--instance Pretty a => Pretty [a] where-    pretty = prettyList+module Language.Bash.Pretty where -instance Pretty Doc where-    pretty = id+import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Internal+import Data.Text.Prettyprint.Doc.Render.String -instance Pretty Char where-    pretty c   = text [c]-    prettyList = text+-- | @x $+$ y@ concatenates @x@ and @y@ with a 'line' in between+($+$) :: Doc ann -> Doc ann -> Doc ann+x $+$ y = x <> line <> y -instance Pretty a => Pretty (Maybe a) where-    pretty = maybe empty pretty+-- | Behaves like '$+$' except that if one of the documents was empty we do not concatenate at all.+-- 'mempty' is the identity of '$+$':+--+-- prop> x $++$ mempty == x+--+-- and+--+-- prop> mempty $++$ y == y+($++$) :: Doc ann -> Doc ann -> Doc ann+Empty $++$ y     = y+x     $++$ Empty = x+x     $++$ y     = x <> line <> y -instance (Pretty a, Pretty b) => Pretty (Either a b) where-    pretty = either pretty pretty+-- | Behaves like '<+>' except that if one of the documents was empty we do not concatenate at all.+-- 'mempty' is the identity of '<+>':+--+-- prop> x <++> mempty == x+--+-- and+--+-- prop> mempty <++> y == y+(<++>) :: Doc ann -> Doc ann -> Doc ann+Empty <++> y     = y+x     <++> Empty = x+x     <++> y     = x <+> y  -- | Pretty-print to a 'String'. prettyText :: Pretty a => a -> String-prettyText = render . pretty+prettyText = renderString . layoutPretty defaultLayoutOptions . pretty

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, OverloadedStrings, RecordWildCards, DeriveGeneric #-} -- | Shell script types. module Language.Bash.Syntax     (@@ -25,33 +25,109 @@     , RValue(..)     ) where -import Prelude hiding ((<>), Word)+import Prelude hiding (Word)  import Data.Data        (Data)+import Data.List        (intersperse)+import Data.Semigroup   (Semigroup(..)) import Data.Typeable    (Typeable) import GHC.Generics     (Generic)-import Text.PrettyPrint+import Data.Text.Prettyprint.Doc (Doc, Pretty(..), (<+>), hardline, hcat, hsep, indent, nest, nesting, punctuate, vcat)+import Data.Text.Prettyprint.Doc.Internal (Doc(Empty))  import Language.Bash.Cond     (CondExpr) import Language.Bash.Operator import Language.Bash.Pretty import Language.Bash.Word +-- | The BashDoc monoid is used for building Statements, AndOr or Pipelines.+-- Consider the following situation: We have the following command+--+-- > cat <<EOF+-- > some here doc+-- > EOF+--+-- and we want to pipe its output to another arbitrary command @cmd@.+-- We want this pipeline to look like this:+--+-- > cat <<EOF |+-- > some here doc+-- > EOF+-- > cmd+--+-- Note the @|@ at the end of the first line: If we were simply pretty printing the @cat@ command we had no idea where to insert the pipe symbol.+-- And that's the purpose of BashDoc: We store possible suffixes to such lines, commands and the here documents attached to them separately and do the concatenation in the Semigroup instance of BashDoc.+data BashDoc ann = BashDoc+    (Doc ann) -- ^ The head: This is stuff we want to put before the line break and here documents+    (Doc ann) -- ^ The tail: Everthing which follows the here documents+    (Doc ann) -- ^ Collected here documents++instance Semigroup (BashDoc ann) where+    BashDoc Empty Empty Empty <> y = y+    x <> BashDoc Empty Empty Empty = x+    BashDoc h1 t1 Empty <> BashDoc h2 t2 hds2 = BashDoc h1 (t1 <> h2 <++> t2) hds2+    BashDoc h1 t1 hds1  <> BashDoc h2 t2 hds2 = BashDoc h1 (t1 <> noIndent (h2 $++$ hds1) $++$ t2) hds2+        where+            noIndent doc = nesting $ \i -> nest (- i) doc++instance Monoid (BashDoc ann) where+    mempty = BashDoc mempty mempty mempty+    mappend = (<>)++docOp :: Doc ann -> BashDoc ann+docOp xs = BashDoc xs mempty mempty++prettyBashDoc :: BashDoc ann -> Doc ann+prettyBashDoc (BashDoc h t hds) = h <++> t $++$ hds++-- | A utility class for pretty printing without heredocs+class ToBashDoc a where+    toBashDoc :: a -> BashDoc ann++prettyHeredocs :: [Redir] -> Doc ann+prettyHeredocs [] = mempty+prettyHeredocs rs = mconcat $ intersperse hardline $ map prettyHeredoc rs+    where+        prettyHeredoc Heredoc{..} = pretty hereDocument <> pretty heredocDelim+        prettyHeredoc _ = mempty+ -- | Indent by 4 columns.-indent :: Pretty a => a -> Doc-indent = nest 4 . pretty+indent' :: Doc ann -> Doc ann+indent' = indent 4 --- | Render a @do...done@ block.-doDone :: Pretty a => Doc -> a -> Doc-doDone header body = header <+> "do" $+$ indent body $+$ "done"+-- | Render a conditional command with a block.+prettyBlock :: Doc ann -> Doc ann -> Doc ann -> Doc ann -> Doc ann -> Doc ann+prettyBlock pre cond bs block be = pre <+> cond <+> bs $+$ block $+$ be +-- | Render a conditional command with a block whose condition is a list of statements.+prettyBlockList :: Doc ann -> List -> Doc ann -> Doc ann -> Doc ann -> Doc ann+prettyBlockList pre l bs block be+    | hasHeredoc l = pre <+> pretty l $+$ bs $+$ block $+$ be+    | otherwise    = prettyBlock pre (pretty l) bs block be++-- | Does the last statement in a list have a here doc attached?+hasHeredoc :: List -> Bool+hasHeredoc (List []) = False+hasHeredoc (List xs) = let+    Statement l _ = last xs+    BashDoc _ _ hds = toBashDoc l+    in case hds of+        Empty -> False+        _     -> True+ -- | A Bash command with redirections. data Command = Command ShellCommand [Redir]     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty Command where-    pretty (Command c rs) = pretty c <+> pretty rs+    pretty = prettyBashDoc . toBashDoc +instance ToBashDoc Command where+    toBashDoc (Command c rs) = BashDoc mempty (pretty c <++> pretty rs) (prettyHeredocs $ filter isHeredoc rs)+        where+            isHeredoc Heredoc{..} = True+            isHeredoc _ = False+ -- | A Bash command. data ShellCommand       -- | A simple command consisting of assignments followed by words.@@ -91,36 +167,37 @@     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty ShellCommand where-    pretty (SimpleCommand as ws)  = pretty as <+> pretty ws-    pretty (AssignBuiltin w args) = pretty w <+> pretty args+    pretty (SimpleCommand as ws)  = pretty as <++> pretty ws+    pretty (AssignBuiltin w args) = pretty w <++> hsep (map (either pretty pretty) args)     pretty (FunctionDef name l) =-        text name <+> "()" $+$ pretty (Group l)+        pretty name <+> "()" $+$ pretty (Group l)     pretty (Coproc name c) =-        "coproc" <+> text name <+> pretty c+        "coproc" <+> pretty name <+> pretty c     pretty (Subshell l) =         "(" <+> pretty l <+> ")"     pretty (Group l) =-        "{" $+$ indent l $+$ "}"+        "{" $+$ indent' (pretty l) $+$ "}"     pretty (Arith s) =-        "((" <> text s <> "))"+        "((" <> pretty s <> "))"     pretty (Cond e) =         "[[" <+> pretty e <+> "]]"     pretty (For w ws l) =-        doDone ("for" <+> pretty w <+> pretty ws <> ";") l+        prettyBlock "for" (pretty w <+> pretty ws <> ";") "do" (indent' $ pretty l) "done"     pretty (ArithFor s l) =-        doDone ("for" <+> "((" <> text s <> "))") l+        prettyBlock "for" ("((" <> pretty s <> "))") "do" (indent' $ pretty l) "done"     pretty (Select w ws l) =-        doDone ("select" <+> pretty w <+> pretty ws <> ";") l+        prettyBlock "select" (pretty w <++> pretty ws <> ";") "do" (indent' $ pretty l) "done"     pretty (Case w cs) =-        "case" <+> pretty w <+> "in" $+$ (vcat $ map indent cs) $+$ "esac"+        prettyBlock "case" (pretty w) "in" (vcat $ map (indent' . pretty) cs) "esac"     pretty (If p t f) =-        "if" <+> pretty p <+> "then" $+$ indent t $+$-        pretty (fmap (\l -> "else" $+$ indent l) f) $+$+        prettyBlockList "if" p "then"+        (indent' (pretty t) $++$ (maybe mempty (\l -> "else" $+$ indent' (pretty l)) f)+        )         "fi"     pretty (Until p l) =-        doDone ("until" <+> pretty p) l+        prettyBlockList "until" p "do" (indent' $ pretty l) "done"     pretty (While p l) =-        doDone ("while" <+> pretty p) l+        prettyBlockList "while" p "do" (indent' $ pretty l) "done"  -- | A word list or @\"$\@\"@. data WordList@@ -129,7 +206,7 @@     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty WordList where-    pretty Args          = empty+    pretty Args          = mempty     pretty (WordList ws) = "in" <+> pretty ws  -- | A single case clause.@@ -139,8 +216,8 @@ instance Pretty CaseClause where     pretty (CaseClause ps l term) =         hcat (punctuate " | " (map pretty ps)) <> ")" $+$-        indent l $+$-        (indent $ pretty term)+        indent' (pretty l) $+$+        (indent' $ pretty term)  -- | A case clause terminator. data CaseTerm@@ -186,15 +263,11 @@         pretty redirDesc <> pretty redirOp <> pretty redirTarget     pretty Heredoc{..} =         pretty heredocOp <>-        text (if heredocDelimQuoted+        pretty (if heredocDelimQuoted               then "'" ++ heredocDelim ++ "'"-              else heredocDelim) <> "\n" <>-        pretty hereDocument <> text heredocDelim <> "\n"+              else heredocDelim) -    prettyList = foldr f empty-      where-        f a@Redir{}   b = pretty a <+> b-        f a@Heredoc{} b = pretty a <> b+    prettyList = hsep . map pretty  -- | A redirection file descriptor. data IODesc@@ -205,8 +278,8 @@     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty IODesc where-    pretty (IONumber n) = int n-    pretty (IOVar n)    = "{" <> text n <> "}"+    pretty (IONumber n) = pretty n+    pretty (IOVar n)    = "{" <> pretty n <> "}"  -- | A redirection operator. data RedirOp@@ -253,14 +326,16 @@     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty Statement where-    pretty (Statement l Sequential)   = pretty l <> ";"-    pretty (Statement l Asynchronous) = pretty l <+> "&"+    pretty = prettyBashDoc . toBashDoc -    prettyList = foldr f empty+    prettyList = foldr f mempty       where-        f a@(Statement _ Sequential)   b = pretty a $+$ b-        f a@(Statement _ Asynchronous) b = pretty a <+> b+        f a@(Statement _ Sequential)   b = pretty a $++$ b+        f a@(Statement _ Asynchronous) b = pretty a <++> b +instance ToBashDoc Statement where+    toBashDoc (Statement l lt) = toBashDoc l <> toBashDoc lt+ -- | A statement terminator. data ListTerm     = Sequential    -- ^ @;@@@ -277,6 +352,10 @@ instance Pretty ListTerm where     pretty = prettyOperator +instance ToBashDoc ListTerm where+    toBashDoc Sequential = docOp ";"+    toBashDoc Asynchronous = docOp "&"+ -- | A right-associative list of pipelines. data AndOr       -- | The last pipeline of a list.@@ -288,10 +367,13 @@     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty AndOr where-    pretty (Last p)  = pretty p-    pretty (And p a) = pretty p <+> "&&" <+> pretty a-    pretty (Or p a)  = pretty p <+> "||" <+> pretty a+    pretty = prettyBashDoc . toBashDoc +instance ToBashDoc AndOr where+    toBashDoc (Last p)  = toBashDoc p+    toBashDoc (And p a) = toBashDoc p <> docOp " &&" <> toBashDoc a+    toBashDoc (Or p a)  = toBashDoc p <> docOp " ||" <> toBashDoc a+ -- | A (possibly timed or inverted) pipeline, linked with @|@ or @|&@. data Pipeline = Pipeline     { -- | 'True' if the pipeline is timed with @time@.@@ -307,18 +389,25 @@     } deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty Pipeline where-    pretty Pipeline{..} =-        (if timed      then "time" else empty) <+>-        (if timedPosix then "-p"   else empty) <+>-        (if inverted   then "!"    else empty) <+>-        hcat (punctuate " | " (map pretty commands))+    pretty = prettyBashDoc . toBashDoc +instance ToBashDoc Pipeline where+    toBashDoc Pipeline{..} = let+        timed'      = if timed      then "time" else mempty+        timedPosix' = if timedPosix then "-p"   else mempty+        inverted'   = if inverted   then "!"    else mempty+        space       = if timed || timedPosix || inverted then " " else mempty+        prefix = BashDoc mempty (timed' <++> timedPosix' <++> inverted' <> space) mempty+        in prefix <> mconcat (intersperse (docOp " |") (map toBashDoc commands))+ -- | An assignment. data Assign = Assign Parameter AssignOp RValue     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty Assign where     pretty (Assign lhs op rhs) = pretty lhs <> pretty op <> pretty rhs++    prettyList = hsep . map pretty  -- | An assignment operator. data AssignOp

@@ -1,6 +1,7 @@ {-# LANGUAGE     DeriveDataTypeable   , DeriveGeneric+  , FlexibleInstances   , OverloadedStrings   , RecordWildCards   , TypeSynonymInstances@@ -25,15 +26,16 @@     , unquote     ) where -import Prelude hiding ((<>), Word)+import Prelude hiding (Word)  import           Data.Data        (Data)+import           Data.Monoid      ((<>)) import           Data.Typeable    (Typeable) import           GHC.Generics     (Generic)-import           Text.PrettyPrint+import           Data.Text.Prettyprint.Doc (Doc, Pretty(..), hcat, hsep, layoutCompact)+import           Data.Text.Prettyprint.Doc.Render.String (renderString)  import           Language.Bash.Operator-import           Language.Bash.Pretty  -- | A Bash word, broken up into logical spans. type Word = [Span]@@ -66,28 +68,31 @@     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty Span where-    pretty (Char c)           = char c-    pretty (Escape c)         = "\\" <> char c+    pretty (Char c)           = pretty c+    pretty (Escape c)         = "\\" <> pretty c     pretty (Single w)         = "\'" <> pretty w <> "\'"     pretty (Double w)         = "\"" <> pretty w <> "\""     pretty (ANSIC w)          = "$\'" <> pretty w <> "\'"     pretty (Locale w)         = "$\"" <> pretty w <> "\""     pretty (Backquote w)      = "`" <> pretty w <> "`"     pretty (ParamSubst s)     = pretty s-    pretty (ArithSubst s)     = "$((" <> text s <> "))"-    pretty (CommandSubst s)   = "$(" <> text s <> ")"-    pretty (ProcessSubst c s) = pretty c <> "(" <> text s <> ")"+    pretty (ArithSubst s)     = "$((" <> pretty s <> "))"+    pretty (CommandSubst s)   = "$(" <> pretty s <> ")"+    pretty (ProcessSubst c s) = pretty c <> "(" <> pretty s <> ")"      prettyList = hcat . map pretty +instance {-# OVERLAPS #-} Pretty [Word] where+    pretty = hsep . map pretty+ -- | A parameter name an optional subscript. data Parameter = Parameter String (Maybe Word)     deriving (Data, Eq, Read, Show, Typeable, Generic)  instance Pretty Parameter where-    pretty (Parameter s sub) = text s <> subscript sub+    pretty (Parameter s sub) = pretty s <> subscript sub       where-        subscript Nothing  = empty+        subscript Nothing  = mempty         subscript (Just w) = "[" <> pretty w <> "]"  -- | A parameter substitution.@@ -163,33 +168,33 @@         }     deriving (Data, Eq, Read, Show, Typeable, Generic) -prettyParameter :: Bool -> Parameter -> Doc -> Doc+prettyParameter :: Bool -> Parameter -> Doc ann -> Doc ann prettyParameter bang param suffix =-    "${" <> (if bang then "!" else empty) <> pretty param <> suffix <> "}"+    "${" <> (if bang then "!" else mempty) <> pretty param <> suffix <> "}" -twiceWhen :: Bool -> Doc -> Doc+twiceWhen :: Bool -> Doc ann -> Doc ann twiceWhen False d = d twiceWhen True  d = d <> d  instance Pretty ParamSubst where     pretty Bare{..}       = "$" <> pretty parameter-    pretty Brace{..}      = prettyParameter indirect parameter empty+    pretty Brace{..}      = prettyParameter indirect parameter mempty     pretty Alt{..}        = prettyParameter indirect parameter $-        (if testNull then ":" else empty) <>+        (if testNull then ":" else mempty) <>         pretty altOp <>         pretty altWord     pretty Substring{..}  = prettyParameter indirect parameter $         ":" <> pretty subOffset <>-        (if null subLength then empty else ":") <> pretty subLength-    pretty Prefix{..}     = "${!" <> text prefix <> char modifier <> "}"-    pretty Indices{..}    = prettyParameter True parameter empty+        (if null subLength then mempty else ":") <> pretty subLength+    pretty Prefix{..}     = "${!" <> pretty prefix <> pretty modifier <> "}"+    pretty Indices{..}    = prettyParameter True parameter mempty     pretty Length{..}     = "${#" <> pretty parameter <> "}"     pretty Delete{..}     = prettyParameter indirect parameter $         twiceWhen longest (pretty deleteDirection) <>         pretty pattern     pretty Replace{..}    = prettyParameter indirect parameter $         "/" <>-        (if replaceAll then "/" else empty) <>+        (if replaceAll then "/" else mempty) <>         pretty replaceDirection <>         pretty pattern <>         "/" <>@@ -260,12 +265,12 @@  -- | Remove all quoting characters from a word. unquote :: Word -> String-unquote = render . unquoteWord+unquote = renderString . layoutCompact . unquoteWord   where     unquoteWord = hcat . map unquoteSpan -    unquoteSpan (Char c)   = char c-    unquoteSpan (Escape c) = char c+    unquoteSpan (Char c)   = pretty c+    unquoteSpan (Escape c) = pretty c     unquoteSpan (Single w) = unquoteWord w     unquoteSpan (Double w) = unquoteWord w     unquoteSpan (ANSIC w)  = unquoteWord w

@@ -2,10 +2,13 @@  import           Control.Applicative ((<$>)) import           Control.Monad+import           System.Directory (listDirectory)+import           System.FilePath ((</>), (-<.>), takeExtension) import           System.Process           (readProcess) import           Test.QuickCheck import           Test.QuickCheck.Monadic  as QCM import           Test.Tasty+import           Test.Tasty.Golden import           Test.Tasty.QuickCheck import           Test.Tasty.HUnit import           Test.Tasty.ExpectedFailure (expectFail)@@ -14,6 +17,7 @@   import qualified Language.Bash.Parse      as Parse+import           Language.Bash.Pretty     (prettyText) import           Language.Bash.Syntax import qualified Language.Bash.Cond       as Cond import           Language.Bash.Word@@ -58,6 +62,23 @@ properties :: TestTree properties = testGroup "Properties" [testProperty "brace expansion" prop_expandsLikeBash] +discoverPrettyTests :: FilePath -> IO TestTree+discoverPrettyTests fp = do+    fs <- listDirectory fp+    let shFs = filter (\fp' -> takeExtension fp' == ".sh") fs+    return $ testGroup "Pretty printing" $ map (\shFn -> testPretty shFn (fp </> shFn)) shFs++testPretty :: TestName -> FilePath -> TestTree+testPretty name shFp = do+    let outFp    = shFp -<.> "out"+        goldenFp = shFp -<.> "golden"+    goldenVsFileDiff name (\ref new -> ["diff", "-u", ref, new]) goldenFp outFp $ do+        cnt <- readFile shFp+        parsed <- case Parse.parse shFp cnt of+            Left err -> assertFailure $ show err+            Right parsed -> return parsed+        writeFile outFp $ prettyText parsed ++ "\n"+ testMatches :: (Eq a, Show a) => TestName -> Either Text.Parsec.Error.ParseError a -> a -> TestTree testMatches name parsed expected = testCase name $            case parsed of@@ -93,6 +114,15 @@                   heredocDelimQuoted = False,                   hereDocument = [Char 'a',Char 's',Char 'd',Escape '`',                                   Char '\n']}])+  , tp "cat <<EOF\nfoo\nEOF\n  cat" $ wrapCommands+      [ Command+          (SimpleCommand [] [stringToWord "cat"])+          [Heredoc {heredocOp = Here,+                    heredocDelim = "EOF",+                    heredocDelimQuoted = False,+                    hereDocument = [Char 'f',Char 'o',Char 'o',Char '\n']}]+      , Command (SimpleCommand [] [stringToWord "cat"]) []+      ]   , tp "cat <<\"EOF\"\nasd\\`\nEOF" $ wrapCommand        (Command         (SimpleCommand [] [stringToWord "cat"])@@ -100,6 +130,17 @@                   heredocDelim = "EOF",                   heredocDelimQuoted = True,                   hereDocument = stringToWord "asd\\`\n"}])+  , tp "cat <<EOF1 <<EOF2\nt1\nEOF1\nt2\nEOF2" $ wrapCommand+        (Command+        (SimpleCommand [] [stringToWord "cat"])+        [Heredoc {heredocOp = Here,+                  heredocDelim = "EOF1",+                  heredocDelimQuoted = False,+                  hereDocument = stringToWord "t1\n"}+        ,Heredoc {heredocOp = Here,+                  heredocDelim = "EOF2",+                  heredocDelimQuoted = False,+                  hereDocument = stringToWord "t2\n"}])   , tp "echo $((2 + 2))" $ wrapCommand        (Command         (SimpleCommand [] [stringToWord "echo", [ArithSubst "2 + 2"]])@@ -150,8 +191,12 @@ failingtests = testGroup "Failing tests" (map expectFail   []) -tests :: TestTree-tests = testGroup "Tests" [properties, unittests, failingtests]- main :: IO ()-main = defaultMain tests+main = do+    pptests <- discoverPrettyTests "tests/pretty"+    defaultMain $ testGroup "Tests"+        [ properties+        , unittests+        , failingtests+        , pptests+        ]