COPY/ADD --link add explicit forms

src/Language/Docker/Parser/Copy.hs

@@ -25,7 +25,7 @@
 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 parentsFlags = [p | FlagParents p <- flags]
@@ -41,7 +41,7 @@
     (_, _, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--parents"
     (_, _, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--from"
     _ -> do
       let cho =
             case chownFlags of
               [] -> NoChown
               c : _ -> c
@@ -175,9 +175,16 @@
   return $ Chmod chm
 
 link :: Parser Link
-link = do
-  void $ string "--link"
-  return Link
+link = ( try linkExplicit <?> "explicit --link" )
+  <|> ( try linkImplicit <?> "implicit --link" )
+  where
+    linkExplicit = do
+      void $ string "--link="
+      val <- string "true" <|> string "false"
+      return $ Link ( val == "true" )
+    linkImplicit =  do
+      void $ string "--link"
+      return $ Link True
 
 parents :: Parser Parents
 parents = ( try parentsExplicit <?> "explicit --parents")

src/Language/Docker/PrettyPrint.hs

@@ -154,33 +154,6 @@
     Chmod c -> "--chmod=" <> pretty c
     NoChmod -> mempty
 
-prettyPrintLink :: Link -> Doc ann
-prettyPrintLink link =
-  case link of
-    Link -> "--link"
-    NoLink -> mempty
-
-prettyPrintKeepGitDir :: KeepGitDir -> Doc ann
-prettyPrintKeepGitDir keepGitDir =
-  case keepGitDir of
-    KeepGitDir True -> "--keep-git-dir=true"
-    KeepGitDir False -> "--keep-git-dir=false"
-    NoKeepGitDir -> mempty
-
-prettyPrintParents :: Parents -> Doc ann
-prettyPrintParents parents =
-  case parents of
-    Parents True -> "--parents=true"
-    Parents False -> "--parents=false"
-    NoParents -> mempty
-
-prettyPrintUnpack :: Unpack -> Doc ann
-prettyPrintUnpack unpack =
-  case unpack of
-    Unpack True -> "--unpack=true"
-    Unpack False -> "--unpack=false"
-    NoUnpack -> mempty
-
 prettyPrintCopySource :: CopySource -> Doc ann
 prettyPrintCopySource source =
   case source of
@@ -316,10 +289,10 @@
       CopyArgs {sourcePaths, targetPath}
       CopyFlags {chmodFlag, chownFlag, linkFlag, parentsFlag, sourceFlag, excludeFlags} -> do
         "COPY"
         prettyPrintChown chownFlag
         prettyPrintChmod chmodFlag
-        prettyPrintLink linkFlag
-        prettyPrintParents parentsFlag
+        pretty linkFlag
+        pretty parentsFlag
         prettyPrintCopySource sourceFlag
         prettyPrintExcludes excludeFlags
         prettyPrintFileList sourcePaths targetPath
@@ -354,9 +327,9 @@
         prettyPrintChecksum checksumFlag
         prettyPrintChown chownFlag
         prettyPrintChmod chmodFlag
-        prettyPrintLink linkFlag
-        prettyPrintKeepGitDir keepGitDirFlag
-        prettyPrintUnpack unpackFlag
+        pretty linkFlag
+        pretty keepGitDirFlag
+        pretty unpackFlag
         prettyPrintExcludes excludeFlags
         prettyPrintFileList sourcePaths targetPath
     Shell args -> do

src/Language/Docker/Syntax.hs

@@ -22,9 +22,9 @@
 import qualified Data.Text as Text
 import Data.Time.Clock (DiffTime)
 import GHC.Exts (IsList (..))
+import Prettyprinter
 import Text.Printf
 
-
 import Language.Docker.Syntax.Port
 import Language.Docker.Syntax.PortRange
 import Language.Docker.Syntax.Protocol
@@ -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)
 
@@ -158,25 +158,45 @@
       _ -> Chmod (Text.pack ch)
 
 data Link
-  = Link
+  = Link !Bool
   | NoLink
   deriving (Show, Eq, Ord)
 
+instance Pretty Link where
+  pretty ( Link True ) = "--link"
+  pretty ( Link False ) = "--link=false"
+  pretty NoLink = ""
+
 data KeepGitDir
   = KeepGitDir !Bool
   | NoKeepGitDir
   deriving (Show, Eq, Ord)
 
+instance Pretty KeepGitDir where
+  pretty ( KeepGitDir True ) = "--keep-git-dir"
+  pretty ( KeepGitDir False ) = "--keep-git-dir=false"
+  pretty NoKeepGitDir = ""
+
 data Parents
   = Parents !Bool
   | NoParents
   deriving (Show, Eq, Ord)
 
+instance Pretty Parents where
+  pretty ( Parents True ) = "--parents"
+  pretty ( Parents False ) = "--parents=false"
+  pretty NoParents = ""
+
 data Unpack
   = Unpack !Bool
   | NoUnpack
   deriving (Show, Eq, Ord)
 
+instance Pretty Unpack where
+  pretty ( Unpack True ) = "--unpack"
+  pretty ( Unpack False ) = "--unpack=false"
+  pretty NoUnpack = ""
+
 data CopySource
   = CopySource !Text
   | NoSource

test/Language/Docker/ParseAddSpec.hs

@@ -65,14 +65,34 @@ spec = do
                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
                 ( AddFlags NoChecksum NoChown (Chmod "640") NoLink NoKeepGitDir NoUnpack [] )
             ]
+
     it "with link flag" $
       let file = Text.unlines ["ADD --link foo bar"]
        in assertAst
             file
             [ Add
                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
-                ( AddFlags NoChecksum NoChown NoChmod Link NoKeepGitDir NoUnpack [] )
+                ( AddFlags NoChecksum NoChown NoChmod ( Link True ) NoKeepGitDir NoUnpack [] )
+            ]
+
+    it "with link flag explicit true" $
+      let file = Text.unlines ["ADD --link=true foo bar"]
+       in assertAst
+            file
+            [ Add
+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
+                ( AddFlags NoChecksum NoChown NoChmod ( Link True ) NoKeepGitDir NoUnpack [] )
             ]
+
+    it "with link flag explicit false" $
+      let file = Text.unlines ["ADD --link=false foo bar"]
+       in assertAst
+            file
+            [ Add
+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
+                ( AddFlags NoChecksum NoChown NoChmod ( Link False ) NoKeepGitDir NoUnpack [] )
+            ]
+
     it "with keep-git-dir flag" $
       let file = Text.unlines ["ADD --keep-git-dir foo bar"]
        in assertAst
@@ -118,12 +138,20 @@ spec = do
             ]
     it "with all flags" $
       let file =
-            Text.unlines ["ADD --chmod=640 --chown=root:root --checksum=sha256:24454f830cdd --link --unpack foo bar"]
+            Text.unlines ["ADD --chmod=640 --chown=root:root --checksum=sha256:24454f830cdd --link --keep-git-dir --unpack foo bar"]
        in assertAst
             file
             [ Add
                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )
-                ( AddFlags (Checksum "sha256:24454f830cdd") (Chown "root:root") (Chmod "640") Link NoKeepGitDir (Unpack True) [] )
+                ( AddFlags
+                    ( Checksum "sha256:24454f830cdd" )
+                    ( Chown "root:root" )
+                    ( Chmod "640" )
+                    ( Link True )
+                    ( KeepGitDir True )
+                    ( Unpack True )
+                    []
+                )
             ]
     it "list of quoted files and chown" $
       let file =

test/Language/Docker/ParseCopySpec.hs

@@ -78,13 +78,32 @@ spec = do
                 ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )
                 ( CopyFlags NoChown ( Chmod "777" ) NoLink NoParents NoSource [])
             ]
+
     it "with link flag" $
       let file = Text.unlines [ "COPY --link source /target" ]
        in assertAst
             file
             [ Copy
                 ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )
-                ( CopyFlags NoChown NoChmod Link NoParents NoSource [])
+                ( CopyFlags NoChown NoChmod ( Link True ) NoParents NoSource [])
+            ]
+
+    it "with link flag explicit true" $
+      let file = Text.unlines [ "COPY --link=true source /target" ]
+       in assertAst
+            file
+            [ Copy
+                ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )
+                ( CopyFlags NoChown NoChmod ( Link True ) NoParents NoSource [])
+            ]
+
+    it "with link flag explicit false" $
+      let file = Text.unlines [ "COPY --link=false source /target" ]
+       in assertAst
+            file
+            [ Copy
+                ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )
+                ( CopyFlags NoChown NoChmod ( Link False ) NoParents NoSource [])
             ]
 
     it "with parents flag" $
@@ -133,7 +152,7 @@ spec = do
                 ( CopyFlags
                     (Chown "user:group")
                     (Chmod "751")
-                    Link
+                    ( Link True )
                     ( Parents True )
                     (CopySource "node")
                     []
@@ -150,7 +169,7 @@ spec = do
                 ( CopyFlags
                     (Chown "user:group")
                     (Chmod "644")
-                    Link
+                    ( Link True )
                     ( Parents True )
                     (CopySource "node")
                     []

test/Language/Docker/PrettyPrintSpec.hs

@@ -36,32 +36,46 @@ spec = do
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
                   ( AddFlags NoChecksum NoChown ( Chmod "751" ) NoLink NoKeepGitDir NoUnpack [] )
        in assertPretty "ADD --chmod=751 foo bar" add
-    it "with just link" $ do
+    it "with just link (true)" $ do
       let add = Add
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
-                  ( AddFlags NoChecksum NoChown NoChmod Link NoKeepGitDir NoUnpack [] )
+                  ( AddFlags NoChecksum NoChown NoChmod ( Link True ) NoKeepGitDir NoUnpack [] )
        in assertPretty "ADD --link foo bar" add
 
+    it "with just link (false)" $ do
+      let add = Add
+                  ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( AddFlags NoChecksum NoChown NoChmod ( Link False ) NoKeepGitDir NoUnpack [] )
+       in assertPretty "ADD --link=false foo bar" add
+
     it "with just keep-git-dir" $ do
       let add = Add
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
                   ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir True ) NoUnpack [] )
-       in assertPretty "ADD --keep-git-dir=true foo bar" add
+       in assertPretty "ADD --keep-git-dir foo bar" add
     it "with chown, chmod and link" $ do
       let add = Add
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
-                  ( AddFlags NoChecksum ( Chown "root:root" ) ( Chmod "751" ) Link NoKeepGitDir NoUnpack [] )
+                  ( AddFlags NoChecksum ( Chown "root:root" ) ( Chmod "751" ) ( Link True ) NoKeepGitDir NoUnpack [] )
        in assertPretty "ADD --chown=root:root --chmod=751 --link foo bar" add
     it "with all flags" $ do
       let add = Add
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
-                  ( AddFlags ( Checksum "sha256:24454f830cdd" ) ( Chown "root:root" ) ( Chmod "751" ) Link NoKeepGitDir (Unpack True) [] )
-       in assertPretty "ADD --checksum=sha256:24454f830cdd --chown=root:root --chmod=751 --link --unpack=true foo bar" add
+                  ( AddFlags
+                      ( Checksum "sha256:24454f830cdd" )
+                      ( Chown "root:root" )
+                      ( Chmod "751" )
+                      ( Link True )
+                      ( KeepGitDir True )
+                      ( Unpack True )
+                      []
+                  )
+       in assertPretty "ADD --checksum=sha256:24454f830cdd --chown=root:root --chmod=751 --link --keep-git-dir --unpack foo bar" add
     it "with unpack true" $ do
       let add = Add
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
                   ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack True) [] )
-       in assertPretty "ADD --unpack=true foo bar" add
+       in assertPretty "ADD --unpack foo bar" add
     it "with unpack false" $ do
       let add = Add
                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )
@@ -99,17 +113,23 @@ spec = do
                   ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )
                   ( CopyFlags NoChown ( Chmod "751" ) NoLink NoParents NoSource [] )
        in assertPretty "COPY --chmod=751 foo bar" copy
-    it "with just link" $ do
+    it "with just link (true)" $ do
       let copy = Copy
                   ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )
-                  ( CopyFlags NoChown NoChmod Link NoParents NoSource [] )
+                  ( CopyFlags NoChown NoChmod ( Link True ) NoParents NoSource [] )
        in assertPretty "COPY --link foo bar" copy
 
+    it "with just link (false)" $ do
+      let copy = Copy
+                  ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )
+                  ( CopyFlags NoChown NoChmod ( Link False ) NoParents NoSource [] )
+       in assertPretty "COPY --link=false foo bar" copy
+
     it "with just parents" $ do
       let copy = Copy
                   ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )
                   ( CopyFlags NoChown NoChmod NoLink ( Parents True ) NoSource [] )
-       in assertPretty "COPY --parents=true foo bar" copy
+       in assertPretty "COPY --parents foo bar" copy
 
     it "with source baseimage" $ do
       let copy =
@@ -133,13 +153,13 @@ spec = do
               ( CopyFlags
                   ( Chown "root:root")
                   ( Chmod "751")
-                  Link
+                  ( Link True )
                   ( Parents True )
                   ( CopySource "baseimage" )
                   []
               )
        in assertPretty
-            "COPY --chown=root:root --chmod=751 --link --parents=true --from=baseimage foo bar"
+            "COPY --chown=root:root --chmod=751 --link --parents --from=baseimage foo bar"
             copy
 
     it "with just exclude" $ do