WIP: Multiline shell

.gitignore

@@ -1,5 +1,8 @@
 *.hi
 *.o
+# leftovers from code coverage
+*.tix
+
 .stack-work
 dist-newstyle
 

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)

src/Language/Docker/Parser/Prelude.hs

@@ -35,6 +35,7 @@
     stringWithEscaped,
     symbol,
     untilEol,
+    untilEol',
     untilHeredoc,
     whitespace,
     module Megaparsec,
@@ -118,6 +119,13 @@
 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 @@
             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 @@
             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

src/Language/Docker/PrettyPrint.hs

@@ -94,10 +94,7 @@
 
 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)
@@ -293,7 +290,7 @@
       CopyArgs {sourcePaths, targetPath}
       CopyFlags {chmodFlag, chownFlag, linkFlag, parentsFlag, sourceFlag, excludeFlags} -> do
         "COPY"
         prettyPrintChown chownFlag
         prettyPrintChmod chmodFlag
         pretty linkFlag
         pretty parentsFlag

src/Language/Docker/Syntax.hs

@@ -42,11 +42,11 @@
     if "/" `isInfixOf` img
       then
         let parts = endBy "/" img
          in if "." `isInfixOf` head parts
               then
                 Image
                   (Just (Registry (Text.pack (head parts))))
                   (Text.pack . intercalate "/" $ tail parts)
               else Image Nothing (Text.pack img)
       else Image Nothing (Text.pack img)
 
@@ -399,7 +399,7 @@
 instance IsString (RunArgs Text) where
   fromString s =
     RunArgs
-      (ArgumentsText . Text.pack $ s)
+      (ArgumentsText $ Text.pack s)
       RunFlags
         { mount = mempty,
           security = Nothing,

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"]]
 

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"]

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" ]