diff --git a/.gitignore b/.gitignore index e8bc8af..bf13c6e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,8 @@ *.hi *.o +# leftovers from code coverage +*.tix + .stack-work dist-newstyle diff --git a/src/Language/Docker/Parser/Arguments.hs b/src/Language/Docker/Parser/Arguments.hs index 00c5b9a..e227f6c 100644 --- a/src/Language/Docker/Parser/Arguments.hs +++ b/src/Language/Docker/Parser/Arguments.hs @@ -17,9 +17,7 @@ argumentsExec = do argumentsShell :: (?esc :: Char) => Parser (Arguments Text) argumentsShell = try (ArgumentsText <$> untilHeredoc) - <|> (ArgumentsText <$> toEnd) - where - toEnd = untilEol "the shell arguments" + <|> (ArgumentsText <$> untilEol' "the shell arguments") -- Parse arguments of a command in the heredoc format argumentsHeredoc :: (?esc :: Char) => Parser (Arguments Text) diff --git a/src/Language/Docker/Parser/Prelude.hs b/src/Language/Docker/Parser/Prelude.hs index ca47106..dacb949 100644 --- a/src/Language/Docker/Parser/Prelude.hs +++ b/src/Language/Docker/Parser/Prelude.hs @@ -35,6 +35,7 @@ module Language.Docker.Parser.Prelude stringWithEscaped, symbol, untilEol, + untilEol', untilHeredoc, whitespace, module Megaparsec, @@ -118,6 +119,13 @@ castToSpace :: FoundWhitespace -> Text castToSpace FoundWhitespace = " " castToSpace MissingWhitespace = "" +castToNl :: (?esc :: Char) => FoundWhitespace -> Text +castToNl FoundWhitespace = T.pack [' ', ?esc, '\n'] +castToNl MissingWhitespace = T.pack [?esc, '\n'] + +castToEmpty :: FoundWhitespace -> Text +castToEmpty _ = "" + eol :: (?esc :: Char) => Parser () eol = void ws "end of line" where @@ -129,6 +137,17 @@ eol = void ws "end of line" void escapedLineBreaks ] +eol' :: (?esc :: Char) => Parser Text +eol' = mconcat <$> ws "end of line" + where + ws = + some $ + choice + [ onlySpaces1, + takeWhile1P Nothing isNl, + escapedLineBreaks' + ] + reserved :: (?esc :: Char) => Text -> Parser () reserved name = void (lexeme (string' name) T.unpack name) @@ -310,6 +329,62 @@ untilEol name = do takeWhile1P Nothing (== ?esc) <* notFollowedBy (char '\n') ] +-- Parse value until end of line is reached into list of lines separated at escaped newlines +-- Notably, empty lines (or comments) after an escaped newline also continue the line. This is +-- called an empty continuation line. +-- In case of an empty continuation line, we artificially insert escaped newlines to make the +-- escaped line breaks explicit. There are two reasons: +-- 1) this makes the text have the same meaning as interpreted by Docker if parsed by other tools +-- (e.g. Shellcheck) by escaping line breaks +-- 2) this keeps the line numbers correct by keeping the line breaks +-- E.g.: +-- ``` +-- RUN echo \ +-- +-- # comment +-- +-- RUN hello +-- is interpreted by Docker the same as +-- ``` +-- RUN echo RUN hello +-- ``` +-- but the shell commands would need to be passed to Shellcheck as +-- ``` +-- echo \ +-- \ +-- \ +-- \ +-- RUN hello +-- ``` +-- to keep the line numbers correct. +untilEol' :: (?esc :: Char) => String -> Parser Text +untilEol' name = do + res <- predicate + when (null res) $ fail ("expecting " ++ name) + pure $ combine res + where + predicate = + many $ + choice + [ emptyContinuationLines, + escapedLineBreaks', + takeWhile1P (Just name) (\c -> c /= '\n' && c /= ?esc), + takeWhile1P (Just name) (== ?esc) <* notFollowedBy (char '\n') + ] + + combine :: [Text] -> Text + combine [] = "" + combine [x] = x + combine (x:x':xs) + | x' == T.pack [ ?esc, '\n' ] = x <> x' <> combine xs + | otherwise = x <> combine (x':xs) + + emptyContinuationLines :: (?esc :: Char) => Parser Text + emptyContinuationLines = do + s <- string $ T.pack [ ?esc, '\n' ] + l <- many $ choice [ char '\n', char '#' *> takeWhileP Nothing (/= '\n') *> char '\n' ] + return $ s <> foldl (<>) "" ( fmap (\c -> T.pack [?esc, c]) l ) + symbol :: (?esc :: Char) => Text -> Parser Text symbol name = do x <- string name diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs index 02343f6..71fdda8 100644 --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -94,10 +94,7 @@ prettyPrintPair (k, v) = pretty k <> pretty '=' <> doubleQoute v prettyPrintArguments :: (?esc :: Char) => Arguments Text -> Doc ann prettyPrintArguments (ArgumentsList as) = prettyPrintJSON (Text.words as) -prettyPrintArguments (ArgumentsText as) = hsep (fmap helper (Text.words as)) - where - helper "&&" = pretty ?esc <> "\n &&" - helper a = pretty a +prettyPrintArguments (ArgumentsText as) = vsep (fmap pretty (Text.lines as)) prettyPrintJSON :: (?esc :: Char) => [Text] -> Doc ann prettyPrintJSON args = list (fmap doubleQoute args) diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs index 53ecc70..a3c7791 100644 --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -399,7 +399,7 @@ data RunArgs args = RunArgs (Arguments args) RunFlags instance IsString (RunArgs Text) where fromString s = RunArgs - (ArgumentsText . Text.pack $ s) + (ArgumentsText $ Text.pack s) RunFlags { mount = mempty, security = Nothing, diff --git a/test/Language/Docker/ParseCmdSpec.hs b/test/Language/Docker/ParseCmdSpec.hs index e94b522..76dd32d 100644 --- a/test/Language/Docker/ParseCmdSpec.hs +++ b/test/Language/Docker/ParseCmdSpec.hs @@ -9,9 +9,13 @@ import qualified Data.Text as Text spec :: Spec spec = do describe "parse CMD instructions" $ do - it "one line cmd" $ assertAst "CMD true" [Cmd "true"] + it "one line cmd" $ assertAst "CMD true" [Cmd (ArgumentsText "true")] it "cmd over several lines" $ - assertAst "CMD true \\\n && true" [Cmd "true && true"] + assertAst "CMD true \\\n && true" [Cmd (ArgumentsText "true \\\n && true")] + + it "cmd over several lines with comments" $ + assertAst "CMD true \\\n# foobar comment\n && true" [Cmd (ArgumentsText "true \\\n\\\n && true")] + it "quoted command params" $ assertAst "CMD [\"echo\", \"1\"]" [Cmd ["echo", "1"]] it "Parses commas correctly" $ assertAst "CMD [ \"echo\" ,\"-e\" , \"1\"]" [Cmd ["echo", "-e", "1"]] diff --git a/test/Language/Docker/ParseRunSpec.hs b/test/Language/Docker/ParseRunSpec.hs index 0f4a067..37bb744 100644 --- a/test/Language/Docker/ParseRunSpec.hs +++ b/test/Language/Docker/ParseRunSpec.hs @@ -13,10 +13,10 @@ spec = do describe "parse RUN instructions" $ do it "escaped with space before" $ let dockerfile = Text.unlines ["RUN yum install -y \\", "imagemagick \\", "mysql"] - in assertAst dockerfile [Run "yum install -y imagemagick mysql"] + in assertAst dockerfile [Run "yum install -y \\\nimagemagick \\\nmysql"] it "escaped linebreak, indented" $ let file = Text.unlines [ "RUN foo ; \\", " bar" ] - in assertAst file [ Run "foo ; bar" ] + in assertAst file [ Run "foo ; \\\n bar" ] it "does not choke on unmatched brackets" $ let dockerfile = Text.unlines ["RUN [foo"] in assertAst dockerfile [Run "[foo"] diff --git a/test/Language/Docker/ParserSpec.hs b/test/Language/Docker/ParserSpec.hs index 61c1b06..185f61e 100644 --- a/test/Language/Docker/ParserSpec.hs +++ b/test/Language/Docker/ParserSpec.hs @@ -236,6 +236,25 @@ spec = do dockerfile [ Env [("A", "a.sh"), ("B", "b.sh"), ("c", "true")] ] + + it "comment in escaped lines" $ + let dockerfile = + Text.unlines + [ "RUN foo \\", + "# comment", + " bar" + ] + in assertAst dockerfile [ Run "foo \\\n\\\n bar" ] + + it "comment in the same line with comment continuation" $ + let dockerfile = + Text.unlines + [ "RUN echo foo # comment \\", + "continued comment", + "RUN echo bar" + ] + in assertAst dockerfile [ Run "echo foo # comment \\\ncontinued comment", Run "echo bar" ] + it "accepts backslash inside string" $ let dockerfile = "RUN grep 'foo \\.'" in assertAst dockerfile [Run $ RunArgs (ArgumentsText "grep 'foo \\.'") def] @@ -271,3 +290,28 @@ spec = do it "should handle lowercase instructions (#7 - https://github.com/beijaflor-io/haskell-language-dockerfile/issues/7)" $ let content = "from ubuntu" in assertAst content [From (untaggedImage "ubuntu")] + + describe "empty line continuations" $ do + it "should handle empty line continuations" $ + let content = Text.unlines [ "RUN one \\", "", "RUN two" ] + in assertAst content [ Run "one \\\n\\\nRUN two" ] + + it "line continuations - multiple empty lines" $ + let content = Text.unlines [ "RUN one \\", "", "", "", "RUN two" ] + in assertAst content [ Run "one \\\n\\\n\\\n\\\nRUN two" ] + + it "line continuations - comments" $ + let content = Text.unlines [ "RUN one \\", "", "# comment", "", "RUN two" ] + in assertAst content [ Run "one \\\n\\\n\\\n\\\nRUN two" ] + + it "line continuations - comment on same line" $ + let content = Text.unlines [ "RUN one \\ # comment", "", "# comment", "", "RUN two" ] + in assertAst content [ Run "one \\ # comment", Comment " comment", Run "two" ] + + it "should correctly separate instructions 1 - empty line" $ + let content = Text.unlines [ "RUN one", "", "RUN two" ] + in assertAst content [ Run "one", Run "two" ] + + it "should correctly separate instructions 2 - no line between" $ + let content = Text.unlines [ "RUN one", "RUN two" ] + in assertAst content [ Run "one", Run "two" ]