From e872906a9da39f1fe8b843096fa6a04baaaa991f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Moritz=20R=C3=B6hrich?= Date: Sun, 2 May 2021 14:28:12 +0200 Subject: [PATCH] pretty printer: detect escape character from AST - Add escape character detection logic to the pretty printer - Replace the escape character on demand for printing - Add tests ensuring correct default behaviour - Version bump to 10.0.0 due to API change When pretty printing, look ahead into the AST to be printed to determine which escape character to choose. Then use that character during printing. This is possibly a major breaking change in the API, because `Arguments Text` is no longer an instance of `Pretty`. Instead the pretty printer expects all instructions to be of type `Instruction Text` and not `Instruction args`. This allows the arguments to the instructions to be printed with the correct escape character. --- language-docker.cabal | 6 +-- package.yaml | 8 ++-- src/Language/Docker/Parser.hs | 3 -- src/Language/Docker/PrettyPrint.hs | 56 ++++++++++++++----------- src/Language/Docker/Syntax.hs | 3 ++ test/Language/Docker/IntegrationSpec.hs | 30 ++++++++++++- test/Language/Docker/PrettyPrintSpec.hs | 5 ++- test/fixtures/6.Dockerfile | 3 ++ test/fixtures/7.Dockerfile | 3 ++ test/fixtures/8.Dockerfile | 4 ++ 10 files changed, 83 insertions(+), 38 deletions(-) create mode 100644 test/fixtures/6.Dockerfile create mode 100644 test/fixtures/7.Dockerfile create mode 100644 test/fixtures/8.Dockerfile diff --git a/language-docker.cabal b/language-docker.cabal index 780dcc0..ab78b01 100644 --- a/language-docker.cabal +++ b/language-docker.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 4c166335e4f8bb1979bf3b9b406bb34b47d9c7f6a89f165a58ba5c696e84e54e +-- hash: 2c9caaab990151b5cf17795136674a3655d2422f22f1e4c84806741c1309e5bd name: language-docker -version: 9.4.0 +version: 10.0.0 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. @@ -79,7 +79,7 @@ test-suite hspec Paths_language_docker hs-source-dirs: test - default-extensions: OverloadedStrings OverloadedStrings OverloadedLists + default-extensions: OverloadedStrings ImplicitParams Rank2Types OverloadedLists build-depends: HUnit >=1.2 , QuickCheck diff --git a/package.yaml b/package.yaml index 4270f95..1a58fb6 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: language-docker -version: '9.4.0' +version: '10.0.0' 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 @@ -26,6 +26,8 @@ extra-source-files: - test/fixtures/2.Dockerfile default-extensions: - OverloadedStrings + - ImplicitParams + - Rank2Types dependencies: - base >=4.8 && <5 @@ -48,9 +50,6 @@ library: - -Wredundant-constraints - -fno-warn-unused-do-bind - -fno-warn-orphans - default-extensions: - - ImplicitParams - - Rank2Types exposed-modules: - Language.Docker - Language.Docker.Parser @@ -62,7 +61,6 @@ tests: main: Spec.hs source-dirs: test default-extensions: - - OverloadedStrings - OverloadedLists dependencies: - hspec diff --git a/src/Language/Docker/Parser.hs b/src/Language/Docker/Parser.hs index d17a857..cc783fe 100644 --- a/src/Language/Docker/Parser.hs +++ b/src/Language/Docker/Parser.hs @@ -68,6 +68,3 @@ doParse path txt = do -- | Changes crlf line endings to simple line endings dos2unix :: T.Text -> T.Text dos2unix = T.replace "\r\n" "\n" - -defaultEsc :: Char -defaultEsc = '\\' diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs index 08de49d..d9e8b83 100644 --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -27,22 +27,29 @@ data EscapeAccum escaping :: !Bool } -instance Pretty (Arguments Text) where - pretty = prettyPrintArguments - -- | Pretty print a 'Dockerfile' to a 'Text' prettyPrint :: Dockerfile -> L.Text prettyPrint = renderLazy . layoutPretty opts . prettyPrintDockerfile where opts = LayoutOptions Unbounded -prettyPrintDockerfile :: Pretty (Arguments args) => [InstructionPos args] -> Doc ann +prettyPrintDockerfile :: [InstructionPos Text] -> Doc ann prettyPrintDockerfile instr = doPrint instr <> "\n" where - doPrint = vsep . fmap prettyPrintInstructionPos + doPrint ips = + let ?esc = findEscapeChar ips + in (vsep . fmap prettyPrintInstructionPos ) ips + +findEscapeChar :: [InstructionPos args] -> Char +findEscapeChar [] = defaultEsc +findEscapeChar (i:is) = + case i of + InstructionPos {instruction = (Pragma (Escape (EscapeChar c)))} -> c + InstructionPos {instruction = (Pragma _)} -> findEscapeChar is + _ -> defaultEsc -- | Pretty print a 'InstructionPos' to a 'Doc' -prettyPrintInstructionPos :: Pretty (Arguments args) => InstructionPos args -> Doc ann +prettyPrintInstructionPos :: (?esc :: Char) => InstructionPos Text -> Doc ann prettyPrintInstructionPos (InstructionPos i _ _) = prettyPrintInstruction i prettyPrintImage :: Image -> Doc ann @@ -75,42 +82,41 @@ prettyPrintBaseImage BaseImage {..} = do Nothing -> mempty Just (Digest d) -> "@" <> pretty d -prettyPrintPairs :: Pairs -> Doc ann +prettyPrintPairs :: (?esc :: Char) => Pairs -> Doc ann prettyPrintPairs ps = align $ sepLine $ fmap prettyPrintPair ps where - sepLine = concatWith (\x y -> x <> " \\" <> line <> y) + sepLine = concatWith (\x y -> x <> " " <> pretty ?esc <> line <> y) -prettyPrintPair :: (Text, Text) -> Doc ann +prettyPrintPair :: (?esc :: Char) => (Text, Text) -> Doc ann prettyPrintPair (k, v) = pretty k <> pretty '=' <> doubleQoute v -prettyPrintArguments :: Arguments Text -> Doc ann +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 "&&" = "\\\n &&" + helper "&&" = pretty ?esc <> "\n &&" helper a = pretty a -prettyPrintJSON :: [Text] -> Doc ann +prettyPrintJSON :: (?esc :: Char) => [Text] -> Doc ann prettyPrintJSON args = list (fmap doubleQoute args) -doubleQoute :: Text -> Doc ann +doubleQoute :: (?esc :: Char) => Text -> Doc ann doubleQoute w = enclose dquote dquote (pretty (escapeQuotes w)) -escapeQuotes :: Text -> L.Text +escapeQuotes :: (?esc :: Char) => Text -> L.Text escapeQuotes text = case Text.foldr accumulate (EscapeAccum mempty 0 False) text of EscapeAccum buffer _ False -> B.toLazyText buffer EscapeAccum buffer count True -> case count `mod` 2 of - 0 -> B.toLazyText (B.singleton '\\' <> buffer) + 0 -> B.toLazyText (B.singleton ?esc <> buffer) _ -> B.toLazyText buffer where accumulate '"' EscapeAccum {buffer, escaping = False} = EscapeAccum (B.singleton '"' <> buffer) 0 True - accumulate '\\' EscapeAccum {buffer, escaping = True, count} = - EscapeAccum (B.singleton '\\' <> buffer) (count + 1) True accumulate c EscapeAccum {buffer, escaping = True, count} - | even count = EscapeAccum (B.singleton c <> B.singleton '\\' <> buffer) 0 False + | c == ?esc = EscapeAccum (B.singleton ?esc <> buffer) (count + 1) True + | even count = EscapeAccum (B.singleton c <> B.singleton ?esc <> buffer) 0 False | otherwise = EscapeAccum (B.singleton c <> buffer) 0 False -- It was already escaped accumulate c EscapeAccum {buffer, escaping = False} = EscapeAccum (B.singleton c <> buffer) 0 False @@ -159,7 +165,7 @@ prettyPrintRetries = maybe mempty pp where pp (Retries r) = "--retries=" <> pretty r -prettyPrintRunMount :: Maybe RunMount -> Doc ann +prettyPrintRunMount :: (?esc :: Char) => Maybe RunMount -> Doc ann prettyPrintRunMount Nothing = mempty prettyPrintRunMount (Just mount) = "--mount=" <> case mount of @@ -235,7 +241,7 @@ prettyPrintPragma :: PragmaDirective -> Doc ann prettyPrintPragma (Escape (EscapeChar esc)) = "escape = " <> pretty esc prettyPrintPragma (Syntax (SyntaxImage img)) = "syntax = " <> prettyPrintImage img -prettyPrintInstruction :: Pretty (Arguments args) => Instruction args -> Doc ann +prettyPrintInstruction :: (?esc :: Char) => Instruction Text -> Doc ann prettyPrintInstruction i = case i of Maintainer m -> do @@ -249,7 +255,7 @@ prettyPrintInstruction i = pretty k <> "=" <> pretty v Entrypoint e -> do "ENTRYPOINT" - pretty e + prettyPrintArguments e Stopsignal s -> do "STOPSIGNAL" pretty s @@ -267,7 +273,7 @@ prettyPrintInstruction i = prettyPrintRunMount mount prettyPrintRunNetwork network prettyPrintRunSecurity security - pretty c + prettyPrintArguments c Copy CopyArgs {sourcePaths, targetPath, chownFlag, chmodFlag, sourceFlag} -> do "COPY" prettyPrintChown chownFlag @@ -276,7 +282,7 @@ prettyPrintInstruction i = prettyPrintFileList sourcePaths targetPath Cmd c -> do "CMD" - pretty c + prettyPrintArguments c Label l -> do "LABEL" prettyPrintPairs l @@ -305,7 +311,7 @@ prettyPrintInstruction i = prettyPrintFileList sourcePaths targetPath Shell args -> do "SHELL" - pretty args + prettyPrintArguments args Healthcheck NoCheck -> "HEALTHCHECK NONE" Healthcheck (Check CheckArgs {..}) -> do "HEALTHCHECK" @@ -314,7 +320,7 @@ prettyPrintInstruction i = prettyPrintDuration "--start-period=" startPeriod prettyPrintRetries retries "CMD" - pretty checkCommand + prettyPrintArguments checkCommand where (>>) = spaceCat diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs index 1b27bdb..91538ea 100644 --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -371,3 +371,6 @@ data InstructionPos args lineNumber :: !Linenumber } deriving (Eq, Ord, Show, Functor) + +defaultEsc :: Char +defaultEsc = '\\' diff --git a/test/Language/Docker/IntegrationSpec.hs b/test/Language/Docker/IntegrationSpec.hs index d2cfbab..04c01dc 100644 --- a/test/Language/Docker/IntegrationSpec.hs +++ b/test/Language/Docker/IntegrationSpec.hs @@ -4,7 +4,7 @@ import qualified Data.Text as Text import qualified Data.Text.IO import qualified Data.Text.Lazy.IO as L import Language.Docker.Parser -import Language.Docker.PrettyPrint (prettyPrint) +import Language.Docker.PrettyPrint (prettyPrint, prettyPrintDockerfile) import Test.HUnit hiding (Label) import Test.Hspec import Text.Megaparsec hiding (Label) @@ -42,6 +42,34 @@ spec = do Right a -> L.putStr $ prettyPrint a Left err -> assertFailure $ errorBundlePretty err + describe "escape character detection logic" $ do + it "ensure the pretty printer respects escape pragmas" $ do + fromDisk <- Data.Text.IO.readFile "test/fixtures/6.Dockerfile" + let ast = parseText fromDisk + in case ast of + Right a -> + let fromAst = prettyPrintDockerfile a + in assertEqual "error" fromDisk (Text.pack . show $ fromAst) + Left err -> assertFailure $ errorBundlePretty err + + it "ensure escape character '\\' is used as default" $ do + fromDisk <- Data.Text.IO.readFile "test/fixtures/7.Dockerfile" + let ast = parseText fromDisk + in case ast of + Right a -> + let fromAst = prettyPrintDockerfile a + in assertEqual "error" fromDisk (Text.pack . show $ fromAst) + Left err -> assertFailure $ errorBundlePretty err + + it "ensure the printer ignores escape pragmas in the wrong place" $ do + fromDisk <- Data.Text.IO.readFile "test/fixtures/8.Dockerfile" + let ast = parseText fromDisk + in case ast of + Right a -> + let fromAst = prettyPrintDockerfile a + in assertEqual "error" fromDisk (Text.pack . show $ fromAst) + Left err -> assertFailure $ errorBundlePretty err + describe "parse text" $ do it "1.Dockerfile" $ do contents <- Data.Text.IO.readFile "test/fixtures/1.Dockerfile" diff --git a/test/Language/Docker/PrettyPrintSpec.hs b/test/Language/Docker/PrettyPrintSpec.hs index 1920250..3f73045 100644 --- a/test/Language/Docker/PrettyPrintSpec.hs +++ b/test/Language/Docker/PrettyPrintSpec.hs @@ -145,4 +145,7 @@ assertPretty expected instruction = assertEqual prettyPrintStrict :: Instruction Text.Text -> Text.Text prettyPrintStrict = - renderStrict . layoutPretty (LayoutOptions Unbounded) . prettyPrintInstruction + let ?esc = defaultEsc + in renderStrict + . layoutPretty (LayoutOptions Unbounded) + . prettyPrintInstruction diff --git a/test/fixtures/6.Dockerfile b/test/fixtures/6.Dockerfile new file mode 100644 index 0000000..da55d14 --- /dev/null +++ b/test/fixtures/6.Dockerfile @@ -0,0 +1,3 @@ +# escape = ` +RUN cmd a ` + && cmd b diff --git a/test/fixtures/7.Dockerfile b/test/fixtures/7.Dockerfile new file mode 100644 index 0000000..cdbfb55 --- /dev/null +++ b/test/fixtures/7.Dockerfile @@ -0,0 +1,3 @@ +FROM debian:buster +RUN cmd a \ + && cmd b diff --git a/test/fixtures/8.Dockerfile b/test/fixtures/8.Dockerfile new file mode 100644 index 0000000..2e4de4f --- /dev/null +++ b/test/fixtures/8.Dockerfile @@ -0,0 +1,4 @@ +FROM debian:buster +# escape = ` +RUN cmd a \ + && cmd b