diff --git a/language-docker.cabal b/language-docker.cabal --- a/language-docker.cabal +++ b/language-docker.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 723b9670b2b0a9fecb8914d87e55f64c1f0fac09afa4d901a24ae08d04b612bc +-- hash: 45d12a07b59b5903ce169f73c62a7e76c05e07f20c8a859dd83b4b7aaaa0b081 name: language-docker -version: 10.4.2 +version: 10.4.3 synopsis: Dockerfile parser, pretty-printer and embedded DSL description: All functions for parsing and pretty-printing Dockerfiles are exported through @Language.Docker@. For more fine-grained operations look for specific modules that implement a certain functionality. See the for the source-code and examples. @@ -74,7 +74,7 @@ , bytestring >=0.10 , containers , data-default-class - , megaparsec >=8.0 + , megaparsec >=9.0.0 , prettyprinter , split >=0.2 , text @@ -101,6 +101,7 @@ ImplicitParams Rank2Types OverloadedLists + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-unused-do-bind -fno-warn-orphans build-depends: HUnit >=1.2 , QuickCheck @@ -111,7 +112,7 @@ , hspec , hspec-megaparsec , language-docker - , megaparsec >=8.0 + , megaparsec >=9.0.0 , prettyprinter , split >=0.2 , text diff --git a/src/Language/Docker/Parser/Arguments.hs b/src/Language/Docker/Parser/Arguments.hs --- a/src/Language/Docker/Parser/Arguments.hs +++ b/src/Language/Docker/Parser/Arguments.hs @@ -10,7 +10,7 @@ -- Parse arguments of a command in the exec form argumentsExec :: (?esc :: Char) => Parser (Arguments Text) argumentsExec = do - args <- brackets $ commaSep doubleQuotedStringUnescaped + args <- brackets $ commaSep doubleQuotedStringEscaped return $ ArgumentsList (T.unwords args) -- Parse arguments of a command in the shell form diff --git a/src/Language/Docker/Parser/Pairs.hs b/src/Language/Docker/Parser/Pairs.hs --- a/src/Language/Docker/Parser/Pairs.hs +++ b/src/Language/Docker/Parser/Pairs.hs @@ -8,14 +8,7 @@ import Language.Docker.Parser.Prelude import Language.Docker.Syntax --- We cannot use string literal because it swallows space --- and therefore have to implement quoted values by ourselves -doubleQuotedValue :: (?esc :: Char) => Parser Text -doubleQuotedValue = between (string "\"") (string "\"") (stringWithEscaped ['"'] Nothing) -singleQuotedValue :: (?esc :: Char) => Parser Text -singleQuotedValue = between (string "'") (string "'") (stringWithEscaped ['\''] Nothing) - unquotedString :: (?esc :: Char) => (Char -> Bool) -> Parser Text unquotedString acceptCondition = do str <- stringWithEscaped [' ', '\t'] (Just (\c -> acceptCondition c && c /= '"' && c /= '\'')) @@ -33,8 +26,8 @@ variants = many $ choice - [ doubleQuotedValue "a string inside double quotes", - singleQuotedValue "a string inside single quotes", + [ doubleQuotedStringEscaped "a string inside double quotes", + singleQuotedStringEscaped "a string inside single quotes", unquotedString acceptCondition "a string with no quotes" ] diff --git a/src/Language/Docker/Parser/Prelude.hs b/src/Language/Docker/Parser/Prelude.hs --- a/src/Language/Docker/Parser/Prelude.hs +++ b/src/Language/Docker/Parser/Prelude.hs @@ -12,7 +12,7 @@ comment, customError, doubleQuotedString, - doubleQuotedStringUnescaped, + doubleQuotedStringEscaped, eol, heredoc, heredocContent, @@ -27,6 +27,7 @@ requiredWhitespace, reserved, singleQuotedString, + singleQuotedStringEscaped, someUnless, spaceSep1, stringWithEscaped, @@ -144,19 +145,22 @@ doubleQuotedString :: Parser Text doubleQuotedString = quotedString '\"' --- | Special variant of the doubleQuotedString parser. --- This removes escaped newlines from the quoted string. --- When using the exec form for CMD, RUN and ENTRYPOINT, this mirrors the --- behavior of Docker. -doubleQuotedStringUnescaped :: (?esc :: Char) => Parser Text -doubleQuotedStringUnescaped = do - let needle = T.pack [ ?esc, '\n' ] - in T.replace needle "" <$> doubleQuotedString +-- | Special variants of the string parsers dealing with escaped line breaks +-- and escaped quote characters well. +singleQuotedStringEscaped :: (?esc :: Char) => Parser Text +singleQuotedStringEscaped = quotedStringEscaped '\'' +doubleQuotedStringEscaped :: (?esc :: Char) => Parser Text +doubleQuotedStringEscaped = quotedStringEscaped '\"' + quotedString :: Char -> Parser Text quotedString c = do - lit <- char c >> manyTill anySingle (char c) + lit <- char c >> manyTill L.charLiteral (char c) return $ T.pack lit + +quotedStringEscaped :: (?esc :: Char) => Char -> Parser Text +quotedStringEscaped q = + between (char q) (char q) $ stringWithEscaped [q] Nothing brackets :: (?esc :: Char) => Parser a -> Parser a brackets = between (symbol "[" *> whitespace) (whitespace *> symbol "]") diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -12,9 +12,9 @@ import Data.Set (Set) import Data.String (fromString) import Data.Text (Text) -import Data.Text.Prettyprint.Doc -import Data.Text.Prettyprint.Doc.Internal (Doc (Empty)) -import Data.Text.Prettyprint.Doc.Render.Text (renderLazy) +import Prettyprinter +import Prettyprinter.Internal (Doc (Empty)) +import Prettyprinter.Render.Text (renderLazy) import Language.Docker.Syntax import Prelude hiding ((<>), (>>)) import qualified Data.Set as Set diff --git a/test/Language/Docker/IntegrationSpec.hs b/test/Language/Docker/IntegrationSpec.hs --- a/test/Language/Docker/IntegrationSpec.hs +++ b/test/Language/Docker/IntegrationSpec.hs @@ -135,29 +135,29 @@ it "Dockerfile UTF-8 with BOM" $ do parsed <- parseFile "test/fixtures/Dockerfile.bom.utf8" case parsed of - Right a -> return () + Right _ -> return () Left err -> assertFailure $ errorBundlePretty err it "Dockerfile UTF-16 Little Endian with BOM" $ do parsed <- parseFile "test/fixtures/Dockerfile.bom.utf16le" case parsed of - Right a -> return () + Right _ -> return () Left err -> assertFailure $ errorBundlePretty err it "Dockerfile UTF-16 Big Endian with BOM" $ do parsed <- parseFile "test/fixtures/Dockerfile.bom.utf16be" case parsed of - Right a -> return () + Right _ -> return () Left err -> assertFailure $ errorBundlePretty err it "Dockerfile UTF-32 Little Endian with BOM" $ do parsed <- parseFile "test/fixtures/Dockerfile.bom.utf32le" case parsed of - Right a -> return () + Right _ -> return () Left err -> assertFailure $ errorBundlePretty err it "Dockerfile UTF-32 Big Endian with BOM" $ do parsed <- parseFile "test/fixtures/Dockerfile.bom.utf32be" case parsed of - Right a -> return () + Right _ -> return () Left err -> assertFailure $ errorBundlePretty err diff --git a/test/Language/Docker/ParseCmdSpec.hs b/test/Language/Docker/ParseCmdSpec.hs --- a/test/Language/Docker/ParseCmdSpec.hs +++ b/test/Language/Docker/ParseCmdSpec.hs @@ -1,13 +1,8 @@ module Language.Docker.ParseCmdSpec where -import Data.Default.Class (def) -import Language.Docker.Parser import Language.Docker.Syntax -import Test.HUnit hiding (Label) import Test.Hspec import TestHelper -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Set as Set import qualified Data.Text as Text @@ -20,6 +15,7 @@ it "quoted command params" $ assertAst "CMD [\"echo\", \"1\"]" [Cmd ["echo", "1"]] it "Parses commas correctly" $ assertAst "CMD [ \"echo\" ,\"-e\" , \"1\"]" [Cmd ["echo", "-e", "1"]] + --------------------------------------------------------------------------- -- This is the Dockefile statement under test (cleaned of Haskell escapes): -- -- CMD [ "/bin/sh", "-c", \ @@ -34,4 +30,35 @@ " echo bar\" \\", " ]" ] - in assertAst cmd [ Cmd [ "/bin/sh", "-c", "echo foo && echo bar" ] ] + in assertAst cmd [ Cmd [ "/bin/sh", "-c", "echo foo && echo bar" ] ] + it "parse exec style CMD with long broken lines" $ do + let cmd = + Text.unlines + [ "# escape = `", + "CMD [ \"/bin/sh\", \"-c\", `", + " \"echo foo && `", + " echo bar\" `", + " ]" + ] + in assertAst + cmd + [ Pragma ( Escape ( EscapeChar '`' ) ), + Cmd [ "/bin/sh", "-c", "echo foo && echo bar" ] + ] + --------------------------------------------------------------------------- + + it "parse exec style CMD with escaped characters" $ do + let cmd = + Text.unlines + [ "CMD [ \"sbt\", \"set reStart / mainClass := Some(\\\"Main\\\");~reStart\" ]" ] + in assertAst cmd [ Cmd [ "sbt", "set reStart / mainClass := Some(\"Main\");~reStart" ] ] + it "parse exec style CMD with windows style escaped characters" $ do + let cmd = + Text.unlines + [ "# escape = `", + "CMD [ \"sbt\", \"set reStart / mainClass := Some(`\"Main`\");~reStart\" ]" ] + in assertAst + cmd + [ Pragma ( Escape ( EscapeChar '`' ) ), + Cmd [ "sbt", "set reStart / mainClass := Some(\"Main\");~reStart" ] + ] diff --git a/test/Language/Docker/ParseCopySpec.hs b/test/Language/Docker/ParseCopySpec.hs --- a/test/Language/Docker/ParseCopySpec.hs +++ b/test/Language/Docker/ParseCopySpec.hs @@ -1,10 +1,8 @@ module Language.Docker.ParseCopySpec where import qualified Data.Text as Text -import Language.Docker.Parser import Language.Docker.Syntax import TestHelper -import Test.HUnit hiding (Label) import Test.Hspec diff --git a/test/Language/Docker/ParsePragmaSpec.hs b/test/Language/Docker/ParsePragmaSpec.hs --- a/test/Language/Docker/ParsePragmaSpec.hs +++ b/test/Language/Docker/ParsePragmaSpec.hs @@ -1,10 +1,8 @@ module Language.Docker.ParsePragmaSpec where import qualified Data.Text as Text -import Language.Docker.Parser import Language.Docker.Syntax import TestHelper -import Test.HUnit hiding (Label) import Test.Hspec diff --git a/test/Language/Docker/ParseRunSpec.hs b/test/Language/Docker/ParseRunSpec.hs --- a/test/Language/Docker/ParseRunSpec.hs +++ b/test/Language/Docker/ParseRunSpec.hs @@ -1,12 +1,9 @@ module Language.Docker.ParseRunSpec where import Data.Default.Class (def) -import Language.Docker.Parser import Language.Docker.Syntax -import Test.HUnit hiding (Label) import Test.Hspec import TestHelper -import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Set as Set import qualified Data.Text as Text diff --git a/test/Language/Docker/ParserSpec.hs b/test/Language/Docker/ParserSpec.hs --- a/test/Language/Docker/ParserSpec.hs +++ b/test/Language/Docker/ParserSpec.hs @@ -2,12 +2,9 @@ import Data.Default.Class (def) import qualified Data.Text as Text -import Language.Docker.Parser import Language.Docker.Syntax import TestHelper -import Test.HUnit hiding (Label) import Test.Hspec -import Text.Megaparsec hiding (Label) spec :: Spec diff --git a/test/Language/Docker/PrettyPrintSpec.hs b/test/Language/Docker/PrettyPrintSpec.hs --- a/test/Language/Docker/PrettyPrintSpec.hs +++ b/test/Language/Docker/PrettyPrintSpec.hs @@ -3,17 +3,13 @@ module Language.Docker.PrettyPrintSpec where - -import Data.Default.Class (def) import qualified Data.Text as Text -import Data.Text.Prettyprint.Doc -import Data.Text.Prettyprint.Doc.Render.Text -import Language.Docker.Parser +import Prettyprinter +import Prettyprinter.Render.Text import Language.Docker.Syntax import Language.Docker.PrettyPrint import Test.HUnit hiding (Label) import Test.Hspec -import Text.Megaparsec hiding (Label) spec :: Spec @@ -138,10 +134,10 @@ in assertPretty "# syntax = docker/dockerfile:1.0" img assertPretty :: Text.Text -> Instruction Text.Text -> Assertion -assertPretty expected instruction = assertEqual +assertPretty expected inst = assertEqual "prettyfied instruction not pretty enough" expected - (prettyPrintStrict instruction) + (prettyPrintStrict inst) prettyPrintStrict :: Instruction Text.Text -> Text.Text prettyPrintStrict = diff --git a/test/TestHelper.hs b/test/TestHelper.hs --- a/test/TestHelper.hs +++ b/test/TestHelper.hs @@ -36,7 +36,7 @@ assertAst :: HasCallStack => Text.Text -> [Instruction Text.Text] -> Assertion assertAst s ast = case parseText s of - Left err -> assertFailure $ errorBundlePretty err + Left errmsg -> assertFailure $ errorBundlePretty errmsg Right dockerfile -> assertEqual "ASTs are not equal" ast $ map instruction dockerfile expectFail :: HasCallStack => Text.Text -> Assertion