diff --git a/src/Language/Docker/Parser/Copy.hs b/src/Language/Docker/Parser/Copy.hs index c4f1ee8..f2aeff5 100644 --- a/src/Language/Docker/Parser/Copy.hs +++ b/src/Language/Docker/Parser/Copy.hs @@ -175,9 +175,16 @@ chmod = do 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") diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs index e618919..7433e5f 100644 --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -154,33 +154,6 @@ prettyPrintChmod chmod = 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 @@ -318,8 +291,8 @@ prettyPrintInstruction i = "COPY" prettyPrintChown chownFlag prettyPrintChmod chmodFlag - prettyPrintLink linkFlag - prettyPrintParents parentsFlag + pretty linkFlag + pretty parentsFlag prettyPrintCopySource sourceFlag prettyPrintExcludes excludeFlags prettyPrintFileList sourcePaths targetPath @@ -354,9 +327,9 @@ prettyPrintInstruction i = 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 diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs index 2b45ffe..9452c01 100644 --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -22,9 +22,9 @@ import Data.Set (Set) 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,25 +158,45 @@ instance IsString Chmod where _ -> 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 diff --git a/test/Language/Docker/ParseAddSpec.hs b/test/Language/Docker/ParseAddSpec.hs index 6ecce69..f1e1c5e 100644 --- a/test/Language/Docker/ParseAddSpec.hs +++ b/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 = diff --git a/test/Language/Docker/ParseCopySpec.hs b/test/Language/Docker/ParseCopySpec.hs index f90487a..25aeb49 100644 --- a/test/Language/Docker/ParseCopySpec.hs +++ b/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") [] diff --git a/test/Language/Docker/PrettyPrintSpec.hs b/test/Language/Docker/PrettyPrintSpec.hs index 18f855b..d1ca5f5 100644 --- a/test/Language/Docker/PrettyPrintSpec.hs +++ b/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