AST: encode the specific form of pair in the AST

language-docker.cabal

@@ -3,8 +3,6 @@ cabal-version: 1.12
 -- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
---
--- hash: 309a0c933f6e5edbdfbe096391f0b79e6a6f9218347d912f390d58a9c7c7c475
 
 name:           language-docker
 version:        10.4.0
@@ -87,6 +85,8 @@ test-suite hspec
   other-modules:
       Language.Docker.IntegrationSpec
       Language.Docker.ParseCopySpec
+      Language.Docker.ParseEnvSpec
+      Language.Docker.ParseLabelSpec
       Language.Docker.ParsePragmaSpec
       Language.Docker.ParserSpec
       Language.Docker.ParseRunSpec

src/Language/Docker/Parser/Pairs.hs

@@ -38,20 +38,24 @@ singleValue acceptCondition = mconcat <$> variants
             unquotedString acceptCondition <?> "a string with no quotes"
           ]
 
-pair :: (?esc :: Char) => Parser (Text, Text)
+pair :: (?esc :: Char) => Parser (Pair (Text, Text))
 pair = do
   key <- singleValue (/= '=')
-  value <- withEqualSign <|> withoutEqualSign
-  return (key, value)
+  choice
+    [ withEqualSign key <?> "key=value pair",
+      withoutEqualSign key <?> "`key value` pair"
+    ]
   where
-    withEqualSign = do
+    withEqualSign key = do
       void $ char '='
-      singleValue (\c -> c /= ' ' && c /= '\t')
-    withoutEqualSign = do
+      value <- singleValue (\c -> c /= ' ' && c /= '\t')
+      return $ KeyEqValuePair (key, value)
+    withoutEqualSign key = do
       requiredWhitespace
-      untilEol "value"
+      value <- untilEol "value"
+      return $ KeySpValuePair (key, value)
 
-pairs :: (?esc :: Char) => Parser Pairs
+pairs :: (?esc :: Char) => Parser (Pairs (Text, Text))
 pairs = (pair <?> "a key value pair (key=value)") `sepEndBy1` requiredWhitespace
 
 parseLabel :: (?esc :: Char) => Parser (Instruction Text)

src/Language/Docker/PrettyPrint.hs

@@ -84,13 +84,14 @@ prettyPrintBaseImage BaseImage {..} = do
         Nothing -> mempty
         Just (Digest d) -> "@" <> pretty d
 
-prettyPrintPairs :: (?esc :: Char) => Pairs -> Doc ann
+prettyPrintPairs :: (?esc :: Char) => Pairs (Text, Text) -> Doc ann
 prettyPrintPairs ps = align $ sepLine $ fmap prettyPrintPair ps
   where
     sepLine = concatWith (\x y -> x <> " " <> pretty ?esc <> line <> y)
 
-prettyPrintPair :: (?esc :: Char) => (Text, Text) -> Doc ann
-prettyPrintPair (k, v) = pretty k <> pretty '=' <> doubleQoute v
+prettyPrintPair :: (?esc :: Char) => Pair (Text, Text) -> Doc ann
+prettyPrintPair (KeyEqValuePair (k, v)) = pretty k <> pretty '=' <> doubleQoute v
+prettyPrintPair (KeySpValuePair (k, v)) = pretty k <> pretty ' ' <> doubleQoute v
 
 prettyPrintArguments :: (?esc :: Char) => Arguments Text -> Doc ann
 prettyPrintArguments (ArgumentsList as) = prettyPrintJSON (Text.words as)

src/Language/Docker/Syntax.hs

@@ -211,7 +211,12 @@ data CheckArgs args
       }
   deriving (Show, Eq, Ord, Functor)
 
-type Pairs = [(Text, Text)]
+data Pair kv
+  = KeyEqValuePair kv
+  | KeySpValuePair kv
+  deriving (Show, Eq, Ord, Functor)
+
+type Pairs kv = [Pair kv]
 
 data RunMount
   = BindMount !BindOpts
@@ -338,7 +343,7 @@ data Instruction args
   = From !BaseImage
   | Add !AddArgs
   | User !Text
-  | Label !Pairs
+  | Label !(Pairs (args, args))
   | Stopsignal !Text
   | Copy !CopyArgs
   | Run !(RunArgs args)
@@ -349,7 +354,7 @@ data Instruction args
   | Volume !Text
   | Entrypoint !(Arguments args)
   | Maintainer !Text
-  | Env !Pairs
+  | Env !(Pairs (args, args))
   | Arg
       !Text
       !(Maybe Text)

test/Language/Docker/ParseEnvSpec.hs

@@ -0,0 +1,140 @@
+module Language.Docker.ParseEnvSpec (spec) where
+
+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 Text.Megaparsec hiding (Label)
+import Test.Hspec
+
+
+spec :: Spec
+spec = do
+  describe "parse ENV" $ do
+    it "parses unquoted pair" $
+      assertAst "ENV foo=bar" [ Env [ KeyEqValuePair ("foo", "bar") ] ]
+    it "parse with space between key and value" $
+      assertAst "ENV foo bar" [ Env [ KeySpValuePair ("foo", "bar") ] ]
+    it "parse with more then one (white)space between key and value" $
+      let dockerfile = "ENV          NODE_VERSION  \t   v5.7.1"
+          ast = [ Env [ KeySpValuePair ("NODE_VERSION", "v5.7.1") ] ]
+       in assertAst dockerfile ast
+    it "parse quoted value pair" $
+      assertAst "ENV foo=\"bar\"" [ Env [ KeyEqValuePair ("foo", "bar") ] ]
+    it "parse multiple unquoted pairs" $
+      assertAst
+        "ENV foo=bar baz=foo"
+        [ Env [ KeyEqValuePair ("foo", "bar"), KeyEqValuePair ("baz", "foo") ] ]
+    it "parse multiple quoted pairs" $
+      assertAst
+        "ENV foo=\"bar\" baz=\"foo\""
+        [ Env [ KeyEqValuePair ("foo", "bar"), KeyEqValuePair ("baz", "foo") ] ]
+    it "env works before cmd" $
+      let dockerfile = "ENV PATH=\"/root\"\nCMD [\"hadolint\",\"-i\"]"
+          ast =
+            [ Env [ KeyEqValuePair ("PATH", "/root") ],
+              Cmd [ "hadolint", "-i" ]
+            ]
+       in assertAst dockerfile ast
+    it "parse with two spaces between" $
+      let dockerfile = "ENV NODE_VERSION=v5.7.1  DEBIAN_FRONTEND=noninteractive"
+          ast =
+            [ Env
+                [ KeyEqValuePair ("NODE_VERSION", "v5.7.1"),
+                  KeyEqValuePair ("DEBIAN_FRONTEND", "noninteractive")
+                ]
+            ]
+       in assertAst dockerfile ast
+    it "have envs on multiple lines" $
+      let dockerfile =
+            Text.unlines
+              [ "FROM busybox",
+                "ENV NODE_VERSION=v5.7.1 \\",
+                "DEBIAN_FRONTEND=noninteractive"
+              ]
+          ast =
+            [ From (untaggedImage "busybox"),
+              Env
+                [ KeyEqValuePair ("NODE_VERSION", "v5.7.1"),
+                  KeyEqValuePair ("DEBIAN_FRONTEND", "noninteractive")
+                ]
+            ]
+       in assertAst dockerfile ast
+    it "parses long env over multiple lines" $
+      let dockerfile =
+            Text.unlines
+              [ "ENV LD_LIBRARY_PATH=\"/usr/lib/\" \\",
+                "APACHE_RUN_USER=\"www-data\" APACHE_RUN_GROUP=\"www-data\""
+              ]
+          ast =
+            [ Env
+                [ KeyEqValuePair ("LD_LIBRARY_PATH", "/usr/lib/"),
+                  KeyEqValuePair ("APACHE_RUN_USER", "www-data"),
+                  KeyEqValuePair ("APACHE_RUN_GROUP", "www-data")
+                ]
+            ]
+       in assertAst dockerfile ast
+    it "parse single var list" $
+      assertAst
+        "ENV foo val1 val2 val3 val4"
+        [ Env [ KeySpValuePair ("foo", "val1 val2 val3 val4") ] ]
+    it "parses many env lines with an equal sign in the value" $
+      let dockerfile =
+            Text.unlines
+              [ "ENV TOMCAT_VERSION 9.0.2",
+                "ENV TOMCAT_URL foo.com?q=1"
+              ]
+          ast =
+            [ Env [ KeySpValuePair ("TOMCAT_VERSION", "9.0.2") ],
+              Env [ KeySpValuePair ("TOMCAT_URL", "foo.com?q=1") ]
+            ]
+       in assertAst dockerfile ast
+    it "parses many env lines in mixed style" $
+      let dockerfile =
+            Text.unlines
+              [ "ENV myName=\"John Doe\" myDog=Rex\\ The\\ Dog \\",
+                "    myCat=fluffy"
+              ]
+          ast =
+            [ Env
+                [ KeyEqValuePair ("myName", "John Doe"),
+                  KeyEqValuePair ("myDog", "Rex The Dog"),
+                  KeyEqValuePair ("myCat", "fluffy")
+                ]
+            ]
+       in assertAst dockerfile ast
+    it "parses many env with backslashes" $
+      let dockerfile =
+            Text.unlines
+              [ "ENV JAVA_HOME=C:\\\\jdk1.8.0_112"
+              ]
+          ast =
+            [ Env [ KeyEqValuePair ("JAVA_HOME", "C:\\\\jdk1.8.0_112") ]
+            ]
+       in assertAst dockerfile ast
+    it "parses env with % in them" $
+      let dockerfile =
+            Text.unlines
+              [ "ENV PHP_FPM_ACCESS_FORMAT=\"prefix \\\"quoted\\\" suffix\""
+              ]
+          ast =
+            [ Env
+                [ KeyEqValuePair
+                    ("PHP_FPM_ACCESS_FORMAT", "prefix \"quoted\" suffix")
+                ]
+            ]
+       in assertAst dockerfile ast
+    it "parses env with % in them" $
+      let dockerfile =
+            Text.unlines
+              [ "ENV PHP_FPM_ACCESS_FORMAT=\"%R - %u %t \\\"%m %r\\\" %s\""
+              ]
+          ast =
+            [ Env
+                [ KeyEqValuePair
+                    ("PHP_FPM_ACCESS_FORMAT", "%R - %u %t \"%m %r\" %s")
+                ]
+            ]
+       in assertAst dockerfile ast

test/Language/Docker/ParseLabelSpec.hs

@@ -0,0 +1,25 @@
+module Language.Docker.ParseLabelSpec (spec) where
+
+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
+spec = do
+  describe "parse LABEL" $ do
+    it "parse label" $
+      assertAst "LABEL foo=bar" [ Label [ KeyEqValuePair ("foo", "bar") ] ]
+    it "parse space separated label" $
+      assertAst "LABEL foo bar baz" [ Label [ KeySpValuePair ("foo", "bar baz") ] ]
+    it "parse quoted labels" $
+      assertAst "LABEL \"foo bar\"=baz" [ Label [ KeyEqValuePair ("foo bar", "baz") ] ]
+    it "parses multiline labels" $
+      let dockerfile = Text.unlines [ "LABEL foo=bar \\", "hobo=mobo" ]
+          ast = [ Label [ KeyEqValuePair ("foo", "bar"), KeyEqValuePair ("hobo", "mobo") ] ]
+       in assertAst dockerfile ast

test/Language/Docker/ParserSpec.hs

@@ -67,113 +67,6 @@ spec = do
       assertAst
         "FROM myfolder/imagename:5.12-dev"
         [From (taggedImage (Image Nothing "myfolder/imagename") "5.12-dev")]
-  describe "parse LABEL" $ do
-    it "parse label" $ assertAst "LABEL foo=bar" [Label [("foo", "bar")]]
-    it "parse space separated label" $ assertAst "LABEL foo bar baz" [Label [("foo", "bar baz")]]
-    it "parse quoted labels" $ assertAst "LABEL \"foo bar\"=baz" [Label [("foo bar", "baz")]]
-    it "parses multiline labels" $
-      let dockerfile = Text.unlines ["LABEL foo=bar \\", "hobo=mobo"]
-          ast = [Label [("foo", "bar"), ("hobo", "mobo")]]
-       in assertAst dockerfile ast
-  describe "parse ENV" $ do
-    it "parses unquoted pair" $ assertAst "ENV foo=bar" [Env [("foo", "bar")]]
-    it "parse with space between key and value" $
-      assertAst "ENV foo bar" [Env [("foo", "bar")]]
-    it "parse with more then one (white)space between key and value" $
-      let dockerfile = "ENV          NODE_VERSION  \t   v5.7.1"
-       in assertAst dockerfile [Env [("NODE_VERSION", "v5.7.1")]]
-    it "parse quoted value pair" $ assertAst "ENV foo=\"bar\"" [Env [("foo", "bar")]]
-    it "parse multiple unquoted pairs" $
-      assertAst "ENV foo=bar baz=foo" [Env [("foo", "bar"), ("baz", "foo")]]
-    it "parse multiple quoted pairs" $
-      assertAst "ENV foo=\"bar\" baz=\"foo\"" [Env [("foo", "bar"), ("baz", "foo")]]
-    it "env works before cmd" $
-      let dockerfile = "ENV PATH=\"/root\"\nCMD [\"hadolint\",\"-i\"]"
-          ast = [Env [("PATH", "/root")], Cmd ["hadolint", "-i"]]
-       in assertAst dockerfile ast
-    it "parse with two spaces between" $
-      let dockerfile = "ENV NODE_VERSION=v5.7.1  DEBIAN_FRONTEND=noninteractive"
-       in assertAst dockerfile [Env [("NODE_VERSION", "v5.7.1"), ("DEBIAN_FRONTEND", "noninteractive")]]
-    it "have envs on multiple lines" $
-      let dockerfile =
-            Text.unlines
-              [ "FROM busybox",
-                "ENV NODE_VERSION=v5.7.1 \\",
-                "DEBIAN_FRONTEND=noninteractive"
-              ]
-          ast =
-            [ From (untaggedImage "busybox"),
-              Env [("NODE_VERSION", "v5.7.1"), ("DEBIAN_FRONTEND", "noninteractive")]
-            ]
-       in assertAst dockerfile ast
-    it "parses long env over multiple lines" $
-      let dockerfile =
-            Text.unlines
-              [ "ENV LD_LIBRARY_PATH=\"/usr/lib/\" \\",
-                "APACHE_RUN_USER=\"www-data\" APACHE_RUN_GROUP=\"www-data\""
-              ]
-          ast =
-            [ Env
-                [ ("LD_LIBRARY_PATH", "/usr/lib/"),
-                  ("APACHE_RUN_USER", "www-data"),
-                  ("APACHE_RUN_GROUP", "www-data")
-                ]
-            ]
-       in assertAst dockerfile ast
-    it "parse single var list" $
-      assertAst "ENV foo val1 val2 val3 val4" [Env [("foo", "val1 val2 val3 val4")]]
-    it "parses many env lines with an equal sign in the value" $
-      let dockerfile =
-            Text.unlines
-              [ "ENV TOMCAT_VERSION 9.0.2",
-                "ENV TOMCAT_URL foo.com?q=1"
-              ]
-          ast =
-            [ Env [("TOMCAT_VERSION", "9.0.2")],
-              Env [("TOMCAT_URL", "foo.com?q=1")]
-            ]
-       in assertAst dockerfile ast
-    it "parses many env lines in mixed style" $
-      let dockerfile =
-            Text.unlines
-              [ "ENV myName=\"John Doe\" myDog=Rex\\ The\\ Dog \\",
-                "    myCat=fluffy"
-              ]
-          ast =
-            [ Env
-                [ ("myName", "John Doe"),
-                  ("myDog", "Rex The Dog"),
-                  ("myCat", "fluffy")
-                ]
-            ]
-       in assertAst dockerfile ast
-    it "parses many env with backslashes" $
-      let dockerfile =
-            Text.unlines
-              [ "ENV JAVA_HOME=C:\\\\jdk1.8.0_112"
-              ]
-          ast =
-            [ Env [("JAVA_HOME", "C:\\\\jdk1.8.0_112")]
-            ]
-       in assertAst dockerfile ast
-    it "parses env with % in them" $
-      let dockerfile =
-            Text.unlines
-              [ "ENV PHP_FPM_ACCESS_FORMAT=\"prefix \\\"quoted\\\" suffix\""
-              ]
-          ast =
-            [ Env [("PHP_FPM_ACCESS_FORMAT", "prefix \"quoted\" suffix")]
-            ]
-       in assertAst dockerfile ast
-    it "parses env with % in them" $
-      let dockerfile =
-            Text.unlines
-              [ "ENV PHP_FPM_ACCESS_FORMAT=\"%R - %u %t \\\"%m %r\\\" %s\""
-              ]
-          ast =
-            [ Env [("PHP_FPM_ACCESS_FORMAT", "%R - %u %t \"%m %r\" %s")]
-            ]
-       in assertAst dockerfile ast
   describe "parse CMD" $ do
     it "one line cmd" $ assertAst "CMD true" [Cmd "true"]
     it "cmd over several lines" $
@@ -265,8 +158,12 @@ spec = do
               ]
        in assertAst
             dockerfile
-            [ Env [("A", "a.sh"), ("B", "b.sh"), ("c", "true")]
-            ]
+              [ Env
+                  [ KeyEqValuePair ("A", "a.sh"),
+                    KeyEqValuePair ("B", "b.sh"),
+                    KeyEqValuePair ("c", "true")
+                  ]
+              ]
     it "accepts backslash inside string" $
       let dockerfile = "RUN grep 'foo \\.'"
        in assertAst dockerfile [Run $ RunArgs (ArgumentsText "grep 'foo \\.'") def]