packages feed

language-docker 15.0.0 → 16.0.0

raw patch · 12 files changed

+515/−104 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Language.Docker.PrettyPrint: prettyPrintLink :: Link -> Doc ann
- Language.Docker.Syntax: newtype TmpOpts
+ Language.Docker.Syntax: KeepGitDir :: !Bool -> KeepGitDir
+ Language.Docker.Syntax: NoKeepGitDir :: KeepGitDir
+ Language.Docker.Syntax: NoParents :: Parents
+ Language.Docker.Syntax: NoUnpack :: Unpack
+ Language.Docker.Syntax: Parents :: !Bool -> Parents
+ Language.Docker.Syntax: Unpack :: !Bool -> Unpack
+ Language.Docker.Syntax: [keepGitDirFlag] :: AddFlags -> !KeepGitDir
+ Language.Docker.Syntax: [parentsFlag] :: CopyFlags -> !Parents
+ Language.Docker.Syntax: [tSize] :: TmpOpts -> !Maybe Text
+ Language.Docker.Syntax: [unpackFlag] :: AddFlags -> !Unpack
+ Language.Docker.Syntax: data KeepGitDir
+ Language.Docker.Syntax: data Parents
+ Language.Docker.Syntax: data TmpOpts
+ Language.Docker.Syntax: data Unpack
+ Language.Docker.Syntax: instance GHC.Classes.Eq Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance GHC.Classes.Eq Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance GHC.Classes.Eq Language.Docker.Syntax.Unpack
+ Language.Docker.Syntax: instance GHC.Classes.Ord Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance GHC.Classes.Ord Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance GHC.Classes.Ord Language.Docker.Syntax.Unpack
+ Language.Docker.Syntax: instance GHC.Internal.Show.Show Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance GHC.Internal.Show.Show Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance GHC.Internal.Show.Show Language.Docker.Syntax.Unpack
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.Link
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.Unpack
- Language.Docker.Syntax: AddFlags :: !Checksum -> !Chown -> !Chmod -> !Link -> ![Exclude] -> AddFlags
+ Language.Docker.Syntax: AddFlags :: !Checksum -> !Chown -> !Chmod -> !Link -> !KeepGitDir -> !Unpack -> ![Exclude] -> AddFlags
- Language.Docker.Syntax: CopyFlags :: !Chown -> !Chmod -> !Link -> !CopySource -> ![Exclude] -> CopyFlags
+ Language.Docker.Syntax: CopyFlags :: !Chown -> !Chmod -> !Link -> !Parents -> !CopySource -> ![Exclude] -> CopyFlags
- Language.Docker.Syntax: Link :: Link
+ Language.Docker.Syntax: Link :: !Bool -> Link
- Language.Docker.Syntax: TmpOpts :: TargetPath -> TmpOpts
+ Language.Docker.Syntax: TmpOpts :: TargetPath -> !Maybe Text -> TmpOpts

Files

language-docker.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               language-docker-version:            15.0.0+version:            16.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.
src/Language/Docker/Parser.hs view
@@ -16,6 +16,21 @@ import Language.Docker.Parser.Prelude import Language.Docker.Syntax +bomUtf32LE :: B.ByteString+bomUtf32LE = "\255\254\NUL\NUL"++bomUtf32BE :: B.ByteString+bomUtf32BE = "\NUL\NUL\254\255"++bomUtf16LE :: B.ByteString+bomUtf16LE = "\255\254"++bomUtf16BE :: B.ByteString+bomUtf16BE = "\254\255"++bomUtf8 :: B.ByteString+bomUtf8 = "\239\187\191"+ contents :: Parser a -> Parser a contents p = do   void onlyWhitespaces@@ -63,23 +78,17 @@   let ?esc = findEscapePragma (T.lines src)    in parse (contents dockerfile) path src   where-    src =-      case B.take 4 txt of-        "\255\254\NUL\NUL" ->-          dos2unix (E.decodeUtf32LEWith E.lenientDecode $ B.drop 4 txt)-        "\NUL\NUL\254\255" ->-          dos2unix (E.decodeUtf32BEWith E.lenientDecode $ B.drop 4 txt)-        _ ->-          case B.take 2 txt of-            "\255\254" ->-              dos2unix (E.decodeUtf16LEWith E.lenientDecode $ B.drop 2 txt)-            "\254\255" ->-              dos2unix (E.decodeUtf16BEWith E.lenientDecode $ B.drop 2 txt)-            _ ->-              case B.take 3 txt of-                "\239\187\191" ->-                  dos2unix (E.decodeUtf8With E.lenientDecode $ B.drop 3 txt)-                _ -> dos2unix (E.decodeUtf8With E.lenientDecode txt)+    src = dos2unix $ decode txt++-- | Determine encoding from byte order mark and decode+decode :: B.ByteString -> T.Text+decode txt+  | bomUtf32LE `B.isPrefixOf` txt = E.decodeUtf32LEWith E.lenientDecode $ B.drop 4 txt+  | bomUtf32BE `B.isPrefixOf` txt = E.decodeUtf32BEWith E.lenientDecode $ B.drop 4 txt+  | bomUtf16LE `B.isPrefixOf` txt = E.decodeUtf16LEWith E.lenientDecode $ B.drop 2 txt+  | bomUtf16BE `B.isPrefixOf` txt = E.decodeUtf16BEWith E.lenientDecode $ B.drop 2 txt+  | bomUtf8    `B.isPrefixOf` txt = E.decodeUtf8With    E.lenientDecode $ B.drop 3 txt+  | otherwise                     = E.decodeUtf8With    E.lenientDecode txt  -- | Changes crlf line endings to simple line endings dos2unix :: T.Text -> T.Text
src/Language/Docker/Parser/Copy.hs view
@@ -14,6 +14,9 @@   | FlagChown Chown   | FlagChmod Chmod   | FlagLink Link+  | FlagKeepGitDir KeepGitDir+  | FlagParents Parents+  | FlagUnpack Unpack   | FlagSource CopySource   | FlagExclude Exclude   | FlagInvalid (Text, Text)@@ -25,16 +28,18 @@   let chownFlags = [c | FlagChown c <- flags]   let chmodFlags = [c | FlagChmod c <- flags]   let linkFlags = [l | FlagLink l <- flags]+  let parentsFlags = [p | FlagParents p <- 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, excludeFlags) of-    ((k, v) : _, _, _, _, _, _) -> unexpectedFlag k v-    (_, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--chown"-    (_, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--chmod"-    (_, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--link"-    (_, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--from"+  case (invalid, chownFlags, chmodFlags, linkFlags, parentsFlags, sourceFlags, excludeFlags) of+    ((k, v) : _, _, _, _, _, _, _) -> unexpectedFlag k v+    (_, _ : _ : _, _, _, _, _, _) -> customError $ DuplicateFlagError "--chown"+    (_, _, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--chmod"+    (_, _, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--link"+    (_, _, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--parents"+    (_, _, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--from"     _ -> do       let cho =             case chownFlags of@@ -48,12 +53,16 @@             case linkFlags of               [] -> NoLink               l : _ -> l+      let par =+            case parentsFlags of+              [] -> NoParents+              p : _ -> p       let fr =             case sourceFlags of               [] -> NoSource               f : _ -> f-      try (heredocList (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr excludeFlags)))-        <|> fileList "COPY" (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr excludeFlags))+      try (heredocList (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk par fr excludeFlags)))+        <|> fileList "COPY" (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk par fr excludeFlags))  parseAdd :: (?esc :: Char) => Parser (Instruction Text) parseAdd = do@@ -63,16 +72,20 @@   let chownFlags = [c | FlagChown c <- flags]   let chmodFlags = [c | FlagChmod c <- flags]   let linkFlags = [l | FlagLink l <- flags]+  let keepGitDirFlags = [k | FlagKeepGitDir k <- flags]+  let unpackFlags = [u | FlagUnpack u <- flags]   let excludeFlags = [e | FlagExclude e <- flags]   let invalidFlags = [i | FlagInvalid i <- flags]   notFollowedBy (string "--") <?>-    "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"+    "only the --checksum, --chown, --chmod, --link, --exclude, --keep-git-dir, --unpack flags or the src and dest paths"+  case (invalidFlags, checksumFlags, chownFlags, linkFlags, chmodFlags, keepGitDirFlags, unpackFlags, excludeFlags) of+    ((k, v) : _, _, _, _, _, _, _, _) -> unexpectedFlag k v+    (_, _ : _ : _, _, _, _, _, _, _) -> customError $ DuplicateFlagError "--checksum"+    (_, _, _ : _ : _, _, _, _, _, _) -> customError $ DuplicateFlagError "--chown"+    (_, _, _, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--chmod"+    (_, _, _, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--link"+    (_, _, _, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--keep-git-dir"+    (_, _, _, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--unpack"     _ -> do       let chk = case checksumFlags of                   [] -> NoChecksum@@ -86,7 +99,13 @@       let lnk = case linkFlags of                   [] -> NoLink                   l : _ -> l-      fileList "ADD" (\src dest -> Add (AddArgs src dest) (AddFlags chk cho chm lnk excludeFlags))+      let kgd = case keepGitDirFlags of+                  [] -> NoKeepGitDir+                  k : _ -> k+      let unp = case unpackFlags of+                  [] -> NoUnpack+                  u : _ -> u+      fileList "ADD" (\src dest -> Add (AddArgs src dest) (AddFlags chk cho chm lnk kgd unp excludeFlags))  heredocList :: (?esc :: Char) =>                (NonEmpty SourcePath -> TargetPath -> Instruction Text) ->@@ -119,13 +138,21 @@ unexpectedFlag name _ = customFailure $ InvalidFlagError (T.unpack name)  copyFlag :: (?esc :: Char) => Parser Flag-copyFlag = (FlagSource <$> try copySource <?> "only one --from") <|> addFlag+copyFlag = (FlagSource <$> try copySource <?> "only one --from")+  <|> (FlagChown <$> try chown <?> "--chown")+  <|> (FlagChmod <$> try chmod <?> "--chmod")+  <|> (FlagLink <$> try link <?> "--link")+  <|> (FlagParents <$> try parents <?> "--parents")+  <|> (FlagExclude <$> try exclude <?> "--exclude")+  <|> (FlagInvalid <$> try anyFlag <?> "other flag")  addFlag :: (?esc :: Char) => Parser Flag addFlag = (FlagChecksum <$> try checksum <?> "--checksum")   <|> (FlagChown <$> try chown <?> "--chown")   <|> (FlagChmod <$> try chmod <?> "--chmod")   <|> (FlagLink <$> try link <?> "--link")+  <|> (FlagKeepGitDir <$> try keepGitDir <?> "--keep-git-dir")+  <|> (FlagUnpack <$> try unpack <?> "--unpack")   <|> (FlagExclude <$> try exclude <?> "--exclude")   <|> (FlagInvalid <$> try anyFlag <?> "other flag") @@ -148,9 +175,52 @@   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")+  <|> ( try parentsImplicit <?> "implicit --parents")+  where+    parentsExplicit = do+      void $ string "--parents="+      val <- string "true" <|> string "false"+      return $ Parents (val == "true")+    parentsImplicit = do+      void $ string "--parents"+      return $ Parents True++keepGitDir :: Parser KeepGitDir+keepGitDir = ( try keepGitDirExplicit <?> "explicit --keep-git-dir" )+  <|> ( try keepGitDirImplicit <?> "implicit --keep-git-dir" )+  where+    keepGitDirExplicit = do+      void $ string "--keep-git-dir="+      val <- string "true" <|> string "false"+      return $ KeepGitDir (val == "true")+    keepGitDirImplicit = do+      void $ string "--keep-git-dir"+      return $ KeepGitDir True++unpack :: Parser Unpack+unpack = ( try unpackExplicit <?> "explicit --unpack" )+  <|> ( try unpackImplicit <?> "implicit --unpack" )+  where+    unpackExplicit = do+      void $ string "--unpack="+      val <- string "true" <|> string "false"+      return $ Unpack (val == "true")+    unpackImplicit = do+      void $ string "--unpack"+      return $ Unpack True  copySource :: (?esc :: Char) => Parser CopySource copySource = do
src/Language/Docker/Parser/From.hs view
@@ -9,9 +9,9 @@  parseRegistry :: (?esc :: Char) => Parser Registry parseRegistry = do-  domain <- someUnless "a domain name" (== '.')+  domain <- someUnlessExpanded "a domain name" (== '.')   void $ char '.'-  tld <- someUnless "a TLD" (== '/')+  tld <- someUnlessExpanded "a TLD" (== '/')   void $ char '/'   return $ Registry (domain <> "." <> tld) @@ -22,12 +22,44 @@   requiredWhitespace   return p +-- | Like someUnless, but a ${...} parameter expansion is opaque: a ':' or '@'+-- inside it (the :- :? :+ operators) is not read as the tag or digest+-- separator. One linear pass, bounded to the current line.+someUnlessExpanded :: (?esc :: Char) => String -> (Char -> Bool) -> Parser Text+someUnlessExpanded name predicate =+  mconcat <$> some (variableExpansion <|> literalRun) <?> name+  where+    literalRun = someUnless name (\c -> predicate c || c == '$')++-- | A '$' and, when it opens one, the balanced ${...} that follows. The scan+-- stops at whitespace, so an unterminated '${' stays literal text bounded like+-- any image reference (it cannot swallow a same-line 'AS' alias or a later+-- instruction, nor backtrack). Fragments are collected in a list and joined+-- once, so deep nesting stays linear.+variableExpansion :: Parser Text+variableExpansion = do+  void $ char '$'+  brace <- optional (char '{')+  case brace of+    Nothing -> return "$"+    Just _ -> ("${" <>) <$> braces [] (1 :: Int)+  where+    braces acc depth = do+      piece <- takeWhileP Nothing (\c -> c `notElem` ['{', '}', ' ', '\t', '\n'])+      next <- optional (char '{' <|> char '}')+      case next of+        Just '{' -> braces ("{" : piece : acc) $! depth + 1+        Just '}'+          | depth <= 1 -> return $ mconcat (reverse ("}" : piece : acc))+          | otherwise -> braces ("}" : piece : acc) $! depth - 1+        _ -> return $ mconcat (reverse (piece : acc))+ parseBaseImage :: (?esc :: Char) => (Text -> Parser (Maybe Tag)) -> Parser BaseImage parseBaseImage tagParser = do   maybePlatform <- (Just <$> try parsePlatform) <|> return Nothing   notFollowedBy (string "--")   regName <- (Just <$> try parseRegistry) <|> return Nothing-  name <- someUnless "the image name with a tag" (\c -> c == '@' || c == ':')+  name <- someUnlessExpanded "the image name with a tag" (\c -> c == '@' || c == ':')   maybeTag <- tagParser name <|> return Nothing   maybeDigest <- (Just <$> try parseDigest) <|> return Nothing   maybeAlias <- (Just <$> try (requiredWhitespace *> imageAlias)) <|> return Nothing@@ -38,7 +70,7 @@   where     tagParser _ = do       void $ char ':'-      t <- someUnless "the image tag" (\c -> c == '@' || c == ':')+      t <- someUnlessExpanded "the image tag" (\c -> c == '@' || c == ':')       return (Just . Tag $ t)  parseDigest :: (?esc :: Char) => Parser Digest
src/Language/Docker/Parser/Run.hs view
@@ -26,6 +26,7 @@   | MountArgReadOnly Bool   | MountArgRequired Bool   | MountArgSharing CacheSharing+  | MountArgSize Text   | MountArgSource SourcePath   | MountArgTarget TargetPath   | MountArgType MountType@@ -147,13 +148,15 @@  tmpfsMount :: [RunMountArg] -> Parser TmpOpts tmpfsMount args =-  case validArgs "tmpfs" required required args of+  case validArgs "tmpfs" allowed required args of     Left e -> customError e     Right as -> return $ foldr tmpOpts def as   where+    allowed = Set.fromList [ "target", "size" ]     required = Set.singleton "target"     tmpOpts :: RunMountArg -> TmpOpts -> TmpOpts     tmpOpts (MountArgTarget path) t = t {tTarget = path}+    tmpOpts (MountArgSize size) t = t {tSize = Just size}     tmpOpts invalid _ = error $ "unhandled " <> show invalid <> " please report this bug"  secretMount :: [RunMountArg] -> Parser SecretOpts@@ -209,6 +212,7 @@       mountArgRelabel,       mountArgRequired,       mountArgSharing,+      mountArgSize,       mountArgSource,       mountArgTarget,       mountArgType,@@ -295,6 +299,9 @@ mountArgSharing :: Parser RunMountArg mountArgSharing = MountArgSharing <$> key "sharing" cacheSharing +mountArgSize :: (?esc :: Char) => Parser RunMountArg+mountArgSize = MountArgSize <$> key "size" stringArg+ mountArgSource :: (?esc :: Char) => Parser RunMountArg mountArgSource = do   label "source=" $ choice [string "source=", string "src="]@@ -322,7 +329,13 @@ mountArgUid = MountArgUid <$> key "uid" stringArg  mountArgRelabel :: Parser RunMountArg-mountArgRelabel = MountArgRelabel <$> key "relabel" relabel+mountArgRelabel =+  MountArgRelabel+    <$> choice+          [ key "relabel" relabel,+            RelabelShared <$ string "z",+            RelabelPrivate <$ string "Z"+          ]  relabel :: Parser Relabel relabel = choice [RelabelShared <$ string "shared", RelabelPrivate <$ string "private"]@@ -336,6 +349,7 @@ toArgName (MountArgReadOnly _) = "ro" toArgName (MountArgRequired _) = "required" toArgName (MountArgSharing _) = "sharing"+toArgName (MountArgSize _) = "size" toArgName (MountArgSource _) = "source" toArgName (MountArgTarget _) = "target" toArgName (MountArgType _) = "type"
src/Language/Docker/PrettyPrint.hs view
@@ -154,12 +154,6 @@     Chmod c -> "--chmod=" <> pretty c     NoChmod -> mempty -prettyPrintLink :: Link -> Doc ann-prettyPrintLink link =-  case link of-    Link -> "--link"-    NoLink -> mempty- prettyPrintCopySource :: CopySource -> Doc ann prettyPrintCopySource source =   case source of@@ -218,7 +212,10 @@             <> maybe mempty printUid sUid             <> maybe mempty printGid sGid             <> maybe mempty printRequired sIsRequired-        TmpfsMount TmpOpts {..} -> "type=tmpfs" <> printTarget tTarget+        TmpfsMount TmpOpts {..} ->+          "type=tmpfs"+          <> printTarget tTarget+          <> maybe mempty printSize tSize     printQuotable str       | Text.any (== '"') str = doubleQoute str       | otherwise = pretty str@@ -242,6 +239,7 @@       <> case r of         RelabelShared -> printQuotable "shared"         RelabelPrivate -> printQuotable "private"+    printSize s = ",size=" <> pretty s  prettyPrintRunNetwork :: Maybe RunNetwork -> Doc ann prettyPrintRunNetwork Nothing = mempty@@ -293,11 +291,12 @@       prettyPrintArguments c     Copy       CopyArgs {sourcePaths, targetPath}-      CopyFlags {chmodFlag, chownFlag, linkFlag, sourceFlag, excludeFlags} -> do+      CopyFlags {chmodFlag, chownFlag, linkFlag, parentsFlag, sourceFlag, excludeFlags} -> do         "COPY"         prettyPrintChown chownFlag         prettyPrintChmod chmodFlag-        prettyPrintLink linkFlag+        pretty linkFlag+        pretty parentsFlag         prettyPrintCopySource sourceFlag         prettyPrintExcludes excludeFlags         prettyPrintFileList sourcePaths targetPath@@ -327,12 +326,14 @@       prettyPrintBaseImage b     Add       AddArgs {sourcePaths, targetPath}-      AddFlags {checksumFlag, chownFlag, chmodFlag, linkFlag, excludeFlags} -> do+      AddFlags {checksumFlag, chownFlag, chmodFlag, linkFlag, keepGitDirFlag, unpackFlag, excludeFlags} -> do         "ADD"         prettyPrintChecksum checksumFlag         prettyPrintChown chownFlag         prettyPrintChmod chmodFlag-        prettyPrintLink linkFlag+        pretty linkFlag+        pretty keepGitDirFlag+        pretty unpackFlag         prettyPrintExcludes excludeFlags         prettyPrintFileList sourcePaths targetPath     Shell args -> do
src/Language/Docker/Syntax.hs view
@@ -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@@ -158,10 +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@@ -197,13 +232,14 @@       { chownFlag :: !Chown,         chmodFlag :: !Chmod,         linkFlag :: !Link,+        parentsFlag :: !Parents,         sourceFlag :: !CopySource,         excludeFlags :: ![Exclude]       }   deriving (Show, Eq, Ord)  instance Default CopyFlags where-  def = CopyFlags NoChown NoChmod NoLink NoSource []+  def = CopyFlags NoChown NoChmod NoLink NoParents NoSource []  data AddArgs   = AddArgs@@ -218,12 +254,14 @@         chownFlag :: !Chown,         chmodFlag :: !Chmod,         linkFlag :: !Link,+        keepGitDirFlag :: !KeepGitDir,+        unpackFlag :: !Unpack,         excludeFlags :: ![Exclude]       }   deriving (Show, Eq, Ord)  instance Default AddFlags where-  def = AddFlags NoChecksum NoChown NoChmod NoLink []+  def = AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack []  newtype Exclude   = Exclude@@ -301,10 +339,15 @@ instance Default CacheOpts where   def = CacheOpts "" Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -newtype TmpOpts = TmpOpts {tTarget :: TargetPath} deriving (Eq, Show, Ord)+data TmpOpts+  = TmpOpts+      { tTarget :: TargetPath,+        tSize :: !(Maybe Text)+      }+  deriving (Eq, Show, Ord)  instance Default TmpOpts where-  def = TmpOpts ""+  def = TmpOpts "" Nothing  data SecretOpts   = SecretOpts
test/Language/Docker/ParseAddSpec.hs view
@@ -47,7 +47,7 @@             file             [ Add                 ( AddArgs (fmap SourcePath ["http://www.example.com/foo"]) (TargetPath "bar") )-                ( AddFlags (Checksum "sha256:24454f830cdd") NoChown NoChmod NoLink [] )+                ( AddFlags (Checksum "sha256:24454f830cdd") NoChown NoChmod NoLink NoKeepGitDir NoUnpack [] )             ]     it "with chown flag" $       let file = Text.unlines ["ADD --chown=root:root foo bar"]@@ -55,7 +55,7 @@             file             [ Add                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )-                ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink [] )+                ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink NoKeepGitDir NoUnpack [] )             ]     it "with chmod flag" $       let file = Text.unlines ["ADD --chmod=640 foo bar"]@@ -63,23 +63,70 @@             file             [ Add                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )-                ( AddFlags NoChecksum NoChown (Chmod "640") NoLink [] )+                ( 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 [])+                ( 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+            file+            [ Add+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+                ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir True ) NoUnpack [] )+            ]++    it "with keep-git-dir flag explicit true" $+      let file = Text.unlines ["ADD --keep-git-dir=true foo bar"]+       in assertAst+            file+            [ Add+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+                ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir True ) NoUnpack [] )+            ]++    it "with keep-git-dir flag explicit false" $+      let file = Text.unlines ["ADD --keep-git-dir=false foo bar"]+       in assertAst+            file+            [ Add+                ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+                ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir False ) NoUnpack [] )+            ]+     it "with chown and chmod flag" $       let file = Text.unlines ["ADD --chown=root:root --chmod=640 foo bar"]        in assertAst             file             [ Add                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )-                ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink [] )+                ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink NoKeepGitDir NoUnpack [] )             ]     it "with chown and chmod flag other order" $       let file = Text.unlines ["ADD --chmod=640 --chown=root:root foo bar"]@@ -87,16 +134,24 @@             file             [ Add                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )-                ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink [] )+                ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink NoKeepGitDir NoUnpack [] )             ]     it "with all flags" $       let file =-            Text.unlines ["ADD --chmod=640 --chown=root:root --checksum=sha256:24454f830cdd --link 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 [] )+                ( AddFlags+                    ( Checksum "sha256:24454f830cdd" )+                    ( Chown "root:root" )+                    ( Chmod "640" )+                    ( Link True )+                    ( KeepGitDir True )+                    ( Unpack True )+                    []+                )             ]     it "list of quoted files and chown" $       let file =@@ -109,15 +164,39 @@                     (fmap SourcePath ["foo", "bar", "baz"])                     (TargetPath "/app")                 )-                ( AddFlags NoChecksum (Chown "user:group") NoChmod NoLink [] )+                ( AddFlags NoChecksum (Chown "user:group") NoChmod NoLink NoKeepGitDir NoUnpack [] )             ]+    it "with unpack flag" $+      let file = Text.unlines ["ADD --unpack http://www.example.com/archive.tar.gz /download"]+       in assertAst+            file+            [ Add+                ( AddArgs (fmap SourcePath ["http://www.example.com/archive.tar.gz"]) (TargetPath "/download") )+                ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack True) [] )+            ]+    it "with unpack flag explicit true" $+      let file = Text.unlines ["ADD --unpack=true http://www.example.com/archive.tar.gz /download"]+       in assertAst+            file+            [ Add+                ( AddArgs (fmap SourcePath ["http://www.example.com/archive.tar.gz"]) (TargetPath "/download") )+                ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack True) [] )+            ]+    it "with unpack flag explicit false" $+      let file = Text.unlines ["ADD --unpack=false my-archive.tar.gz ."]+       in assertAst+            file+            [ Add+                ( AddArgs (fmap SourcePath ["my-archive.tar.gz"]) (TargetPath ".") )+                ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack False) [] )+            ]     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"] )+                ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp"] )             ]     it "with multiple exclude flags" $       let file = Text.unlines ["ADD --exclude=*.tmp --exclude=*.log foo bar"]@@ -125,7 +204,7 @@             file             [ Add                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )-                ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp", Exclude "*.log"] )+                ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp", Exclude "*.log"] )             ]     it "with exclude and other flags" $       let file = Text.unlines ["ADD --chown=root:root --exclude=*.tmp foo bar"]@@ -133,5 +212,5 @@             file             [ Add                 ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )-                ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink [Exclude "*.tmp"] )+                ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp"] )             ]
test/Language/Docker/ParseCopySpec.hs view
@@ -68,7 +68,7 @@             file             [ Copy                 ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )-                ( CopyFlags ( Chown "user:group" ) NoChmod NoLink NoSource [])+                ( CopyFlags ( Chown "user:group" ) NoChmod NoLink NoParents NoSource [])             ]     it "with chmod flag" $       let file = Text.unlines ["COPY --chmod=777 foo bar"]@@ -76,28 +76,75 @@             file             [ Copy                 ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )-                ( CopyFlags NoChown ( Chmod "777" ) NoLink NoSource [])+                ( 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 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" $+      let file = Text.unlines [ "COPY --parents source /target" ]+       in assertAst+            file+            [ Copy+                ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+                ( CopyFlags NoChown NoChmod NoLink ( Parents True ) NoSource [])+            ]++    it "with parents flag explicit true" $+      let file = Text.unlines [ "COPY --parents=true source /target" ]+       in assertAst+            file+            [ Copy+                ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+                ( CopyFlags NoChown NoChmod NoLink ( Parents True ) NoSource [])+            ]++    it "with parents flag explicit false" $+      let file = Text.unlines [ "COPY --parents=false source /target" ]+       in assertAst+            file+            [ Copy+                ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+                ( CopyFlags NoChown NoChmod NoLink ( Parents False ) NoSource [])+            ]+     it "with from flag" $       let file = Text.unlines ["COPY --from=node foo bar"]        in assertAst             file             [ Copy                 ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )-                ( CopyFlags NoChown NoChmod NoLink ( CopySource "node" ) [])+                ( CopyFlags NoChown NoChmod NoLink NoParents ( CopySource "node" ) [])             ]     it "with all flags" $       let file =             Text.unlines-              [ "COPY --from=node --chmod=751 --link --chown=user:group foo bar" ]+              [ "COPY --from=node --chmod=751 --link --chown=user:group --parents foo bar" ]        in assertAst             file             [ Copy@@ -105,7 +152,8 @@                 ( CopyFlags                     (Chown "user:group")                     (Chmod "751")-                    Link+                    ( Link True )+                    ( Parents True )                     (CopySource "node")                     []                 )@@ -113,7 +161,7 @@     it "with all flags in different order" $       let file =             Text.unlines-              [ "COPY --link --chown=user:group --from=node --chmod=644 foo bar" ]+              [ "COPY --link --parents --chown=user:group --from=node --chmod=644 foo bar" ]        in assertAst             file             [ Copy@@ -121,7 +169,8 @@                 ( CopyFlags                     (Chown "user:group")                     (Chmod "644")-                    Link+                    ( Link True )+                    ( Parents True )                     (CopySource "node")                     []                 )@@ -132,7 +181,7 @@             file             [ Copy                 ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )-                ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp"] )+                ( CopyFlags NoChown NoChmod NoLink NoParents NoSource [Exclude "*.tmp"] )             ]     it "with multiple exclude flags" $       let file = Text.unlines ["COPY --exclude=*.tmp --exclude=*.log foo bar"]@@ -140,7 +189,7 @@             file             [ Copy                 ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )-                ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp", Exclude "*.log"] )+                ( CopyFlags NoChown NoChmod NoLink NoParents NoSource [Exclude "*.tmp", Exclude "*.log"] )             ]     it "with exclude and other flags" $       let file = Text.unlines ["COPY --chown=root:root --exclude=*.tmp foo bar"]@@ -148,7 +197,7 @@             file             [ Copy                 ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )-                ( CopyFlags (Chown "root:root") NoChmod NoLink NoSource [Exclude "*.tmp"] )+                ( CopyFlags (Chown "root:root") NoChmod NoLink NoParents NoSource [Exclude "*.tmp"] )             ]    describe "Copy with Heredocs" $ do
test/Language/Docker/ParseRunSpec.hs view
@@ -168,6 +168,11 @@             file             [ Run $ RunArgs (ArgumentsText "echo foo") flags             ]+    it "--mount=type=tmpfs,size=12G" $+      let file = Text.unlines ["RUN --mount=type=tmpfs,target=/foo,size=12G foo bar"]+          flags = def { mount = Set.singleton $ TmpfsMount (def {tTarget = "/foo", tSize = Just "12G"}) }+       in assertAst file [ Run $ RunArgs ( ArgumentsText "foo bar" ) flags ]+     it "--mount=type=ssh" $       let file = Text.unlines ["RUN --mount=type=ssh echo foo"]           flags = def {mount = Set.singleton $ SshMount def}@@ -733,4 +738,12 @@     it "RUN with --relabel=private" $       let file = Text.unlines             ["RUN --mount=type=bind,target=/bar,relabel=private echo foo"]+       in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelPrivate ]+    it "RUN with short SELinux relabel z" $+      let file = Text.unlines+            ["RUN --mount=type=bind,target=/bar,z echo foo"]+       in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelShared ]+    it "RUN with short SELinux relabel Z" $+      let file = Text.unlines+            ["RUN --mount=type=bind,target=/bar,Z echo foo"]        in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelPrivate ]
test/Language/Docker/ParserSpec.hs view
@@ -64,6 +64,32 @@       assertAst         "FROM myfolder/imagename:5.12-dev"         [From (taggedImage (Image Nothing "myfolder/imagename") "5.12-dev")]+  describe "parse FROM with variable expansion" $ do+    it "keeps ':' inside an expansion out of the tag" $+      assertAst+        "FROM ${IMAGE_PREFIX:?}${DISTRO:?}:${VERSION_DISTRO:?}"+        [From (taggedImage "${IMAGE_PREFIX:?}${DISTRO:?}" "${VERSION_DISTRO:?}")]+    it "handles :- and :+ operators" $+      assertAst+        "FROM ${BASE:-alpine}:${TAG:+edge}"+        [From (taggedImage "${BASE:-alpine}" "${TAG:+edge}")]+    it "handles a nested expansion" $+      assertAst "FROM ${BASE:-${DEFAULT}}" [From (untaggedImage "${BASE:-${DEFAULT}}")]+    it "keeps expansion with a slash in the registry" $+      assertAst+        "FROM ${REGISTRY:-docker.io/library}/myimage:tag"+        [From (taggedImage (Image Nothing "${REGISTRY:-docker.io/library}/myimage") "tag")]+    it "an unterminated ${ stays on its line" $+      assertAst+        "FROM ${BASE:x\nRUN y"+        [From (untaggedImage "${BASE:x"), Run "y"]+    it "an unterminated ${ keeps a following alias" $+      assertAst+        "FROM ${BASE AS build"+        [From (untaggedImage "${BASE" `withAlias` "build")]+    it "nested expansion with unterminated ${" $+      assertAst "FROM ${BASE:-${DEFAULT}" [From (untaggedImage "${BASE:-${DEFAULT}")]+   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")]]
test/Language/Docker/PrettyPrintSpec.hs view
@@ -4,6 +4,7 @@ module Language.Docker.PrettyPrintSpec where  import Data.Default+import qualified Data.Set as Set import qualified Data.Text as Text import Prettyprinter import Prettyprinter.Render.Text@@ -24,42 +25,77 @@     it "with just checksum" $ do       let add = Add                   ( AddArgs [SourcePath "http://www.example.com/foo"] (TargetPath "bar") )-                  ( AddFlags ( Checksum "sha256:24454f830cdd" ) NoChown NoChmod NoLink [])+                  ( AddFlags ( Checksum "sha256:24454f830cdd" ) NoChown NoChmod NoLink NoKeepGitDir NoUnpack [])        in assertPretty "ADD --checksum=sha256:24454f830cdd http://www.example.com/foo bar" add     it "with just chown" $ do       let add = Add                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )-                  ( AddFlags NoChecksum ( Chown "root:root" ) NoChmod NoLink [] )+                  ( AddFlags NoChecksum ( Chown "root:root" ) NoChmod NoLink NoKeepGitDir NoUnpack [] )        in assertPretty "ADD --chown=root:root foo bar" add     it "with just chmod" $ do       let add = Add                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )-                  ( AddFlags NoChecksum NoChown ( Chmod "751" ) NoLink [] )+                  ( 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 [] )+                  ( 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 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 [] )+                  ( 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 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 foo bar" add+    it "with unpack false" $ do+      let add = Add+                  ( AddArgs [SourcePath "foo"] (TargetPath "bar") )+                  ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack False) [] )+       in assertPretty "ADD --unpack=false foo bar" add     it "with just exclude" $ do       let add = Add                   ( AddArgs [SourcePath "foo"] (TargetPath "bar") )-                  ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp"] )+                  ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [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"] )+                  ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [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"] )+                  ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp"] )        in assertPretty "ADD --chown=root:root --exclude=*.tmp foo bar" add    describe "pretty print COPY" $ do@@ -71,32 +107,46 @@     it "with just chown" $ do       let copy = Copy                   ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )-                  ( CopyFlags ( Chown "root:root" ) NoChmod NoLink NoSource [] )+                  ( CopyFlags ( Chown "root:root" ) NoChmod NoLink NoParents NoSource [] )        in assertPretty "COPY --chown=root:root foo bar" copy     it "with just chmod" $ do       let copy = Copy                   ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )-                  ( CopyFlags NoChown ( Chmod "751" ) NoLink NoSource [] )+                  ( 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 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 foo bar" copy+     it "with source baseimage" $ do       let copy =             Copy               ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )-              ( CopyFlags NoChown NoChmod NoLink ( CopySource "baseimage" ) [])+              ( CopyFlags NoChown NoChmod NoLink NoParents ( CopySource "baseimage" ) [])        in assertPretty "COPY --from=baseimage foo bar" copy     it "with both chown and chmod" $ do       let copy =             Copy               ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )               ( CopyFlags-                  ( Chown "root:root" ) ( Chmod "751" ) NoLink NoSource []+                  ( Chown "root:root" ) ( Chmod "751" ) NoLink NoParents NoSource []               )        in assertPretty "COPY --chown=root:root --chmod=751 foo bar" copy+     it "with all flags" $ do       let copy =             Copy@@ -104,28 +154,53 @@               ( CopyFlags                   ( Chown "root:root")                   ( Chmod "751")-                  Link+                  ( Link True )+                  ( Parents True )                   ( CopySource "baseimage" )                   []               )        in assertPretty-            "COPY --chown=root:root --chmod=751 --link --from=baseimage foo bar"+            "COPY --chown=root:root --chmod=751 --link --parents --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"] )+                  ( CopyFlags NoChown NoChmod NoLink NoParents 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"] )+                  ( CopyFlags NoChown NoChmod NoLink NoParents 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"] )+                  ( CopyFlags (Chown "root:root") NoChmod NoLink NoParents NoSource [Exclude "*.tmp"] )        in assertPretty "COPY --chown=root:root --exclude=*.tmp foo bar" copy++  describe "pretty print RUN" $ do+    it "just a simple RUN" $ do+      let run = Run ( RunArgs ( ArgumentsText "foobar" ) def )+       in assertPretty "RUN foobar" run++    it "RUN in JSON format" $ do+      let run = Run ( RunArgs ( ArgumentsList "foobar barfoo" ) def )+       in assertPretty "RUN [\"foobar\", \"barfoo\"]" run++    it "RUN with --mount=type=tmpfs" $ do+      let run =+            Run+              ( RunArgs+                  ( ArgumentsText "foobar" )+                  ( RunFlags+                      { mount = Set.singleton ( TmpfsMount ( TmpOpts "/tgt" (Just "4G") ) ),+                        security = Nothing,+                        network = Nothing+                      }+                  )+              )+       in assertPretty "RUN --mount=type=tmpfs,target=/tgt,size=4G foobar" run    describe "pretty print # escape" $ do     it "# escape = \\" $ do