Add support for the --exclude flag

src/Language/Docker/Parser/Copy.hs

@@ -15,26 +15,29 @@
   | FlagChmod Chmod
   | FlagLink Link
   | FlagSource CopySource
+  | FlagExclude Exclude
   | FlagInvalid (Text, Text)
 
 parseCopy :: (?esc :: Char) => Parser (Instruction Text)
 parseCopy = do
   reserved "COPY"
   flags <- copyFlag `sepEndBy` requiredWhitespace
   let chownFlags = [c | FlagChown c <- flags]
   let chmodFlags = [c | FlagChmod c <- flags]
   let linkFlags = [l | FlagLink l <- flags]
   let sourceFlags = [f | FlagSource f <- flags]
+  let excludeFlags = [e | FlagExclude e <- flags]
   let invalid = [i | FlagInvalid i <- flags]
   -- Let's do some validation on the flags
-  case (invalid, chownFlags, chmodFlags, linkFlags, sourceFlags) of
-    ((k, v) : _, _, _, _, _) -> unexpectedFlag k v
-    (_, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--chown"
-    (_, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--chmod"
-    (_, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--link"
-    (_, _, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--from"
+  case (invalid, chownFlags, chmodFlags, linkFlags, sourceFlags, excludeFlags) of
+    ((k, v) : _, _, _, _, _, _) -> unexpectedFlag k v
+    (_, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--chown"
+    (_, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--chmod"
+    (_, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--link"
+    (_, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--from"
+    (_, _, _, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--exclude"
     _ -> do
       let cho =
             case chownFlags of
               [] -> NoChown
               c : _ -> c
@@ -50,8 +53,12 @@
             case sourceFlags of
               [] -> NoSource
               f : _ -> f
-      try (heredocList (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr)))
-        <|> fileList "COPY" (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr))
+      let exc =
+            case excludeFlags of
+              [] -> NoExclude
+              e : _ -> e
+      try (heredocList (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr exc)))
+        <|> fileList "COPY" (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr exc))
 
 parseAdd :: (?esc :: Char) => Parser (Instruction Text)
 parseAdd = do
@@ -61,15 +68,17 @@
   let chownFlags = [c | FlagChown c <- flags]
   let chmodFlags = [c | FlagChmod c <- flags]
   let linkFlags = [l | FlagLink l <- flags]
+  let excludeFlags = [e | FlagExclude e <- flags]
   let invalidFlags = [i | FlagInvalid i <- flags]
   notFollowedBy (string "--") <?>
-    "only the --checksum, --chown, --chmod, --link flags or the src and dest paths"
-  case (invalidFlags, checksumFlags, chownFlags, linkFlags, chmodFlags) of
-    ((k, v) : _, _, _, _, _) -> unexpectedFlag k v
-    (_, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--checksum"
-    (_, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--chown"
-    (_, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--chmod"
-    (_, _, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--link"
+    "only the --checksum, --chown, --chmod, --link, --exclude flags or the src and dest paths"
+  case (invalidFlags, checksumFlags, chownFlags, linkFlags, chmodFlags, excludeFlags) of
+    ((k, v) : _, _, _, _, _, _) -> unexpectedFlag k v
+    (_, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--checksum"
+    (_, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--chown"
+    (_, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--chmod"
+    (_, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--link"
+    (_, _, _, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--exclude"
     _ -> do
       let chk = case checksumFlags of
                   [] -> NoChecksum
@@ -80,11 +89,13 @@
       let chm = case chmodFlags of
                   [] -> NoChmod
                   c : _ -> c
-      let lnk =
-            case linkFlags of
-              [] -> NoLink
-              l : _ -> l
-      fileList "ADD" (\src dest -> Add (AddArgs src dest) (AddFlags chk cho chm lnk))
+      let lnk = case linkFlags of
+                  [] -> NoLink
+                  l : _ -> l
+      let exc = case excludeFlags of
+                  [] -> NoExclude
+                  e : _ -> e
+      fileList "ADD" (\src dest -> Add (AddArgs src dest) (AddFlags chk cho chm lnk exc))
 
 heredocList :: (?esc :: Char) =>
                (NonEmpty SourcePath -> TargetPath -> Instruction Text) ->
@@ -124,6 +135,7 @@
   <|> (FlagChown <$> try chown <?> "--chown")
   <|> (FlagChmod <$> try chmod <?> "--chmod")
   <|> (FlagLink <$> try link <?> "--link")
+  <|> (FlagExclude <$> try exclude <?> "--exclude")
   <|> (FlagInvalid <$> try anyFlag <?> "other flag")
 
 checksum :: (?esc :: Char) => Parser Checksum
@@ -155,6 +167,12 @@
   src <- someUnless "the copy source path" isNl
   return $ CopySource src
 
+exclude :: (?esc :: Char) => Parser Exclude
+exclude = do
+  void $ string "--exclude="
+  exc <- someUnless "the exclude pattern" (== ' ')
+  return $ Exclude exc
+
 anyFlag :: (?esc :: Char) => Parser (Text, Text)
 anyFlag = do
   void $ string "--"

src/Language/Docker/PrettyPrint.hs

@@ -288,12 +288,13 @@
       prettyPrintArguments c
     Copy
       CopyArgs {sourcePaths, targetPath}
-      CopyFlags {chmodFlag, chownFlag, linkFlag, sourceFlag} -> do
+      CopyFlags {chmodFlag, chownFlag, linkFlag, sourceFlag, excludeFlags} -> do
         "COPY"
         prettyPrintChown chownFlag
         prettyPrintChmod chmodFlag
         prettyPrintLink linkFlag
         prettyPrintCopySource sourceFlag
+        prettyPrintExcludes excludeFlags
         prettyPrintFileList sourcePaths targetPath
     Cmd c -> do
       "CMD"
@@ -321,12 +322,13 @@
       prettyPrintBaseImage b
     Add
       AddArgs {sourcePaths, targetPath}
-      AddFlags {checksumFlag, chownFlag, chmodFlag, linkFlag} -> do
+      AddFlags {checksumFlag, chownFlag, chmodFlag, linkFlag, excludeFlags} -> do
         "ADD"
         prettyPrintChecksum checksumFlag
         prettyPrintChown chownFlag
         prettyPrintChmod chmodFlag
         prettyPrintLink linkFlag
+        prettyPrintExcludes excludeFlags
         prettyPrintFileList sourcePaths targetPath
     Shell args -> do
       "SHELL"
@@ -343,6 +345,12 @@
   where
     (>>) = spaceCat
 
+prettyPrintExcludes :: [Exclude] -> Doc ann
+prettyPrintExcludes excludes = hsep (fmap prettyPrintExclude excludes)
+
+prettyPrintExclude :: Exclude -> Doc ann
+prettyPrintExclude (Exclude e) = "--exclude=" <> pretty e
+
 spaceCat :: Doc ann -> Doc ann -> Doc ann
 spaceCat a Empty = a
 spaceCat Empty b = b

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)
 
@@ -192,12 +192,13 @@
       { chownFlag :: !Chown,
         chmodFlag :: !Chmod,
         linkFlag :: !Link,
-        sourceFlag :: !CopySource
+        sourceFlag :: !CopySource,
+        excludeFlags :: ![Exclude]
       }
   deriving (Show, Eq, Ord)
 
 instance Default CopyFlags where
-  def = CopyFlags NoChown NoChmod NoLink NoSource
+  def = CopyFlags NoChown NoChmod NoLink NoSource []
 
 data AddArgs
   = AddArgs
@@ -211,12 +212,19 @@
       { checksumFlag :: !Checksum,
         chownFlag :: !Chown,
         chmodFlag :: !Chmod,
-        linkFlag :: !Link
+        linkFlag :: !Link,
+        excludeFlags :: ![Exclude]
       }
   deriving (Show, Eq, Ord)
 
 instance Default AddFlags where
-  def = AddFlags NoChecksum NoChown NoChmod NoLink
+  def = AddFlags NoChecksum NoChown NoChmod NoLink []
+
+newtype Exclude
+  = Exclude
+      { unExclude :: Text
+      }
+  deriving (Show, Eq, Ord, IsString)
 
 data Check args
   = Check !(CheckArgs args)

test/Language/Docker/ParseAddSpec.hs

@@ -111,3 +111,27 @@ spec = do
                 )
                 ( AddFlags NoChecksum (Chown "user:group") NoChmod NoLink )
             ]
+    it "with exclude flag" $
+      let file = Text.unlines ["ADD --exclude=*.tmp foo bar"]
+       in assertAst
+            file
+            [ Add
+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
+                ( AddFlags NoChecksum NoChown NoChmod NoLink (Exclude "*.tmp") )
+            ]
+    it "with multiple exclude flags" $
+      let file = Text.unlines ["ADD --exclude=*.tmp --exclude=*.log foo bar"]
+       in assertAst
+            file
+            [ Add
+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
+                ( AddFlags NoChecksum NoChown NoChmod NoLink (Exclude "*.tmp") (Exclude "*.log") )
+            ]
+    it "with exclude and other flags" $
+      let file = Text.unlines ["ADD --chown=root:root --exclude=*.tmp foo bar"]
+       in assertAst
+            file
+            [ Add
+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
+                ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink (Exclude "*.tmp") )
+            ]

test/Language/Docker/ParseCopySpec.hs

@@ -124,6 +124,30 @@ spec = do
                     (CopySource "node")
                 )
             ]
+    it "with exclude flag" $
+      let file = Text.unlines ["COPY --exclude=*.tmp foo bar"]
+       in assertAst
+            file
+            [ Copy
+                ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )
+                ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp"] )
+            ]
+    it "with multiple exclude flags" $
+      let file = Text.unlines ["COPY --exclude=*.tmp --exclude=*.log foo bar"]
+       in assertAst
+            file
+            [ Copy
+                ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )
+                ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp", Exclude "*.log"] )
+            ]
+    it "with exclude and other flags" $
+      let file = Text.unlines ["COPY --chown=root:root --exclude=*.tmp foo bar"]
+       in assertAst
+            file
+            [ Copy
+                ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )
+                ( CopyFlags (Chown "root:root") NoChmod NoLink NoSource [Exclude "*.tmp"] )
+            ]
 
   describe "Copy with Heredocs" $ do
     it "empty heredoc" $

test/Language/Docker/PrettyPrintSpec.hs

@@ -46,6 +46,21 @@ spec = do
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
                   ( AddFlags NoChecksum ( Chown "root:root" ) ( Chmod "751" ) Link )
        in assertPretty "ADD --chown=root:root --chmod=751 --link foo bar" add
+    it "with just exclude" $ do
+      let add = Add
+                  ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp"] )
+       in assertPretty "ADD --exclude=*.tmp foo bar" add
+    it "with multiple exclude flags" $ do
+      let add = Add
+                  ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp", Exclude "*.log"] )
+       in assertPretty "ADD --exclude=*.tmp --exclude=*.log foo bar" add
+    it "with exclude and other flags" $ do
+      let add = Add
+                  ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink [Exclude "*.tmp"] )
+       in assertPretty "ADD --chown=root:root --exclude=*.tmp foo bar" add
 
   describe "pretty print COPY" $ do
     it "with just copy" $ do
@@ -95,6 +110,21 @@ spec = do
        in assertPretty
             "COPY --chown=root:root --chmod=751 --link --from=baseimage foo bar"
             copy
+    it "with just exclude" $ do
+      let copy = Copy
+                  ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp"] )
+       in assertPretty "COPY --exclude=*.tmp foo bar" copy
+    it "with multiple exclude flags" $ do
+      let copy = Copy
+                  ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp", Exclude "*.log"] )
+       in assertPretty "COPY --exclude=*.tmp --exclude=*.log foo bar" copy
+    it "with exclude and other flags" $ do
+      let copy = Copy
+                  ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( CopyFlags (Chown "root:root") NoChmod NoLink NoSource [Exclude "*.tmp"] )
+       in assertPretty "COPY --chown=root:root --exclude=*.tmp foo bar" copy
 
   describe "pretty print # escape" $ do
     it "# escape = \\" $ do