language-docker 7.0.0 → 8.0.0
raw patch · 11 files changed
+125/−92 lines, 11 filesdep ~megaparsec
Dependency ranges changed: megaparsec
Files
- language-docker.cabal +4/−4
- src/Language/Docker.hs +2/−0
- src/Language/Docker/EDSL.hs +5/−14
- src/Language/Docker/EDSL/Quasi.hs +3/−3
- src/Language/Docker/EDSL/Types.hs +6/−9
- src/Language/Docker/Parser.hs +31/−21
- src/Language/Docker/PrettyPrint.hs +15/−13
- src/Language/Docker/Syntax.hs +9/−9
- test/Language/Docker/EDSL/QuasiSpec.hs +8/−2
- test/Language/Docker/EDSLSpec.hs +3/−1
- test/Language/Docker/ParserSpec.hs +39/−16
language-docker.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ec17b57a0353ccb2f2acde00b3f39a8983c7b388e00b574ee76db0cc11c206f7+-- hash: e70e395205673f99130496542ebb35f3353a9d6568091de10c1457576d58a1ac name: language-docker-version: 7.0.0+version: 8.0.0 synopsis: Dockerfile parser, pretty-printer and embedded DSL description: All functions for parsing, printing and writting Dockerfiles are exported through @Language.Docker@. For more fine-grained operations look for specific modules that implement a certain functionality. See the <https://github.com/hadolint/language-docker GitHub project> for the source-code and examples.@@ -52,7 +52,7 @@ , bytestring >=0.10 , containers , free- , megaparsec >=6.4+ , megaparsec >=7.0 , mtl , prettyprinter , split >=0.2@@ -85,7 +85,7 @@ , free , hspec , language-docker- , megaparsec >=6.4+ , megaparsec >=7.0 , mtl , prettyprinter , process
src/Language/Docker.hs view
@@ -5,6 +5,7 @@ , parseStdin -- * Re-exports from @megaparsec@ , Text.Megaparsec.parseErrorPretty+ , Text.Megaparsec.errorBundlePretty -- * Pretty-printing Dockerfiles (@Language.Docker.PrettyPrint@) , prettyPrint , prettyPrintDockerfile@@ -93,6 +94,7 @@ , Language.Docker.Syntax.Arguments , Language.Docker.Syntax.Pairs , Language.Docker.Syntax.Filename+ , Language.Docker.Syntax.Platform , Language.Docker.Syntax.Linenumber -- * Instruction and InstructionPos helpers , Language.Docker.EDSL.instructionPos
src/Language/Docker/EDSL.hs view
@@ -53,10 +53,7 @@ runDef2 f a b n = tell [f a b] >> n runD :: MonadWriter [Syntax.Instruction Text] m => EInstruction (m b) -> m b-runD (From bi n) =- case bi of- EUntaggedImage bi' md alias -> runDef Syntax.From (Syntax.UntaggedImage bi' md alias) n- ETaggedImage bi' tg md alias -> runDef Syntax.From (Syntax.TaggedImage bi' tg md alias) n+runD (From (EBaseImage name t d a p) n) = runDef Syntax.From (Syntax.BaseImage name t d a p) n runD (CmdArgs as n) = runDef Syntax.Cmd as n runD (Shell as n) = runDef Syntax.Shell as n runD (AddArgs s d c n) = runDef Syntax.Add (Syntax.AddArgs s d c) n@@ -153,7 +150,7 @@ -- from "fpco/stack-build" -- @ untagged :: Text -> EBaseImage-untagged s = EUntaggedImage (fromString . Text.unpack $ s) Nothing Nothing+untagged s = EBaseImage (fromString . Text.unpack $ s) Nothing Nothing Nothing Nothing -- | Use a specific tag for a docker image. This function is meant -- to be used as an infix operator.@@ -162,7 +159,7 @@ -- from $ "fpco/stack-build" `tagged` "lts-10.3" -- @ tagged :: Syntax.Image -> Syntax.Tag -> EBaseImage-tagged imageName tag = ETaggedImage imageName tag Nothing Nothing+tagged imageName tag = EBaseImage imageName (Just tag) Nothing Nothing Nothing -- | Adds a digest checksum so a FROM instruction -- This function is meant to be used as an infix operator.@@ -171,10 +168,7 @@ -- from $ "fpco/stack-build" `digested` "sha256:abcdef123" -- @ digested :: EBaseImage -> Syntax.Digest -> EBaseImage-digested image d =- case image of- EUntaggedImage n _ alias -> EUntaggedImage n (Just d) alias- ETaggedImage n t _ alias -> ETaggedImage n t (Just d) alias+digested (EBaseImage n t _ a p) d = EBaseImage n t (Just d) a p -- | Alias a FROM instruction to be used as a build stage. -- This function is meant to be used as an infix operator.@@ -183,10 +177,7 @@ -- from $ "fpco/stack-build" `aliased` "builder" -- @ aliased :: EBaseImage -> Syntax.ImageAlias -> EBaseImage-aliased image alias =- case image of- EUntaggedImage n d _ -> EUntaggedImage n d (Just alias)- ETaggedImage n t d _ -> ETaggedImage n t d (Just alias)+aliased (EBaseImage n t d _ p) a = EBaseImage n t d (Just a) p -- | Create a RUN instruction with the given arguments. --
src/Language/Docker/EDSL/Quasi.hs view
@@ -11,7 +11,7 @@ import Language.Docker.EDSL import qualified Language.Docker.Parser as Parser import Language.Docker.Syntax.Lift ()-import Text.Megaparsec (parseErrorPretty)+import Text.Megaparsec (errorBundlePretty) -- | Quasiquoter for embedding dockerfiles on the EDSL --@@ -30,7 +30,7 @@ edockerfileE :: String -> ExpQ edockerfileE e = case Parser.parseText (Text.pack e) of- Left err -> fail (parseErrorPretty err)+ Left err -> fail (errorBundlePretty err) Right d -> [|embed d|] dockerfile :: QuasiQuoter@@ -45,5 +45,5 @@ dockerfileE :: String -> ExpQ dockerfileE e = case Parser.parseText (Text.pack e) of- Left err -> fail (parseErrorPretty err)+ Left err -> fail (errorBundlePretty err) Right d -> lift d
src/Language/Docker/EDSL/Types.hs view
@@ -7,18 +7,15 @@ import Data.Text (Text) import qualified Language.Docker.Syntax as Syntax -data EBaseImage- = EUntaggedImage Syntax.Image- (Maybe Syntax.Digest)- (Maybe Syntax.ImageAlias)- | ETaggedImage Syntax.Image- Syntax.Tag- (Maybe Syntax.Digest)- (Maybe Syntax.ImageAlias)+data EBaseImage = EBaseImage Syntax.Image+ (Maybe Syntax.Tag)+ (Maybe Syntax.Digest)+ (Maybe Syntax.ImageAlias)+ (Maybe Syntax.Platform) deriving (Show, Eq, Ord) instance IsString EBaseImage where- fromString s = EUntaggedImage (fromString s) Nothing Nothing+ fromString s = EBaseImage (fromString s) Nothing Nothing Nothing Nothing data EInstruction next = From EBaseImage
src/Language/Docker/Parser.hs view
@@ -41,7 +41,7 @@ type Parser = Parsec DockerfileError Text -type Error = ParseError Char DockerfileError+type Error = ParseErrorBundle Text DockerfileError type Instr = Instruction Text @@ -159,35 +159,45 @@ void $ char '/' return $ Registry (domain <> "." <> tld) -taggedImage :: Parser BaseImage-taggedImage = do+parsePlatform :: Parser Platform+parsePlatform = do+ void $ string "--platform="+ p <- someUnless "the platform for the FROM image" (== ' ')+ spaces1+ return p++parseBaseImage :: (Text -> Parser (Maybe Tag)) -> Parser BaseImage+parseBaseImage tagParser = do+ maybePlatform <- (Just <$> try parsePlatform) <|> return Nothing+ notFollowedBy (string "--") registryName <- (Just <$> try parseRegistry) <|> return Nothing name <- someUnless "the image name with a tag" (\c -> c == '@' || c == ':')- void $ char ':'- tag <- someUnless "the image tag" (\c -> c == '@' || c == ':')- maybeDigest <- (Just <$> try digest) <|> return Nothing+ maybeTag <- tagParser name+ maybeDigest <- (Just <$> try parseDigest) <|> return Nothing maybeAlias <- maybeImageAlias- return $ TaggedImage (Image registryName name) (Tag tag) maybeDigest maybeAlias+ return $ BaseImage (Image registryName name) maybeTag maybeDigest maybeAlias maybePlatform -digest :: Parser Digest-digest = do+taggedImage :: Parser BaseImage+taggedImage = parseBaseImage tagParser+ where+ tagParser _ = do+ void $ char ':'+ tag <- someUnless "the image tag" (\c -> c == '@' || c == ':')+ return (Just . Tag $ tag)++parseDigest :: Parser Digest+parseDigest = do void $ char '@' d <- someUnless "the image digest" (== '@') return $ Digest d untaggedImage :: Parser BaseImage-untaggedImage = do- registryName <- (Just <$> try parseRegistry) <|> return Nothing- name <- someUnless "just the image name" (\c -> c == '@' || c == ':')- notInvalidTag name- maybeDigest <- (Just <$> try digest) <|> return Nothing- maybeAlias <- maybeImageAlias- return $ UntaggedImage (Image registryName name) maybeDigest maybeAlias+untaggedImage = parseBaseImage notInvalidTag where- notInvalidTag :: Text -> Parser ()- notInvalidTag name =- try (notFollowedBy $ string ":") <?> "no ':' or a valid image tag string (example: " ++- T.unpack name ++ ":valid-tag)"+ notInvalidTag :: Text -> Parser (Maybe Tag)+ notInvalidTag name = do+ try (notFollowedBy $ string ":") <?> "no ':' or a valid image tag string (example: " ++ T.unpack name ++ ":valid-tag)"+ return Nothing maybeImageAlias :: Parser (Maybe ImageAlias) maybeImageAlias = Just <$> (spaces1 >> imageAlias) <|> return Nothing@@ -582,7 +592,7 @@ dockerfile :: Parser Dockerfile dockerfile = many $ do- pos <- getPosition+ pos <- getSourcePos i <- parseInstruction eol <|> eof <?> "a new line followed by the next instruction" return $ InstructionPos i (T.pack . sourceName $ pos) (unPos . sourceLine $ pos)
src/Language/Docker/PrettyPrint.hs view
@@ -53,25 +53,27 @@ prettyPrintImage (Image (Just (Registry reg)) name) = pretty reg <> "/" <> pretty name prettyPrintBaseImage :: BaseImage -> Doc ann-prettyPrintBaseImage b =- case b of- UntaggedImage img digest alias -> do- prettyPrintImage img- prettyDigest digest- prettyAlias alias- TaggedImage img (Tag tag) digest alias -> do- prettyPrintImage img- pretty ':'- pretty tag- prettyDigest digest- prettyAlias alias+prettyPrintBaseImage BaseImage{..} = do+ prettyPlatform platform+ prettyPrintImage image+ prettyTag tag+ prettyDigest digest+ prettyAlias alias where (>>) = (<>) return = (mempty <>)+ prettyPlatform maybePlatform =+ case maybePlatform of+ Nothing -> mempty+ Just p -> "--platform=" <> pretty p <> " "+ prettyTag maybeTag =+ case maybeTag of+ Nothing -> mempty+ Just (Tag p) -> ":" <> pretty p prettyAlias maybeAlias = case maybeAlias of Nothing -> mempty- Just (ImageAlias alias) -> " AS " <> pretty alias+ Just (ImageAlias a) -> " AS " <> pretty a prettyDigest maybeDigest = case maybeDigest of Nothing -> mempty
src/Language/Docker/Syntax.hs view
@@ -65,19 +65,19 @@ type Directory = Text +type Platform = Text+ newtype ImageAlias = ImageAlias { unImageAlias :: Text } deriving (Show, Eq, Ord, IsString) -data BaseImage- = UntaggedImage !Image- !(Maybe Digest)- !(Maybe ImageAlias)- | TaggedImage !Image- !Tag- !(Maybe Digest)- !(Maybe ImageAlias)- deriving (Eq, Ord, Show)+data BaseImage = BaseImage+ { image :: !Image+ , tag :: !(Maybe Tag)+ , digest :: !(Maybe Digest)+ , alias :: !(Maybe ImageAlias)+ , platform :: !(Maybe Platform)+ } deriving (Eq, Ord, Show) -- | Type of the Dockerfile AST type Dockerfile = [InstructionPos Text]
test/Language/Docker/EDSL/QuasiSpec.hs view
@@ -18,7 +18,7 @@ RUN apt-get update CMD ["node", "something.js"] |]- df `shouldBe` [ From (UntaggedImage "node" Nothing Nothing)+ df `shouldBe` [ From (BaseImage "node" Nothing Nothing Nothing Nothing) , Run "apt-get update" , Cmd ["node", "something.js"] ]@@ -33,7 +33,13 @@ CMD node something.js |] df = map instruction (toDockerfile d)- df `shouldBe` [ From (UntaggedImage "node" Nothing (Just "node-build"))+ df `shouldBe` [ From (BaseImage+ { image = "node"+ , alias = Just "node-build"+ , tag = Nothing+ , digest = Nothing+ , platform = Nothing}+ ) , Expose (Ports [Port 8080 TCP, PortStr "$PORT"]) , Run "apt-get update" , Cmd "node something.js"
test/Language/Docker/EDSLSpec.hs view
@@ -26,7 +26,9 @@ from "node" cmdArgs ["node", "-e", "'console.log(\'hey\')'"]) r `shouldBe` [ Syntax.From $- Syntax.UntaggedImage "node"+ Syntax.BaseImage "node"+ Nothing+ Nothing Nothing Nothing , Syntax.Cmd ["node", "-e", "'console.log(\'hey\')'"]
test/Language/Docker/ParserSpec.hs view
@@ -12,6 +12,22 @@ import Text.Megaparsec hiding (Label) import qualified Data.Text as Text +untaggedImage :: Image -> BaseImage+untaggedImage n = BaseImage n Nothing Nothing Nothing Nothing++taggedImage :: Image -> Tag -> BaseImage+taggedImage n t = BaseImage n (Just t) Nothing Nothing Nothing++withDigest :: BaseImage -> Digest -> BaseImage+withDigest i d = i { digest = Just d }++withAlias :: BaseImage -> ImageAlias -> BaseImage+withAlias i a = i { alias = Just a }++withPlatform :: BaseImage -> Platform -> BaseImage+withPlatform i p = i { platform = Just p }++ spec :: Spec spec = do describe "parse ARG" $ do@@ -22,43 +38,50 @@ describe "parse FROM" $ do it "parse untagged image" $- assertAst "FROM busybox" [From (UntaggedImage "busybox" Nothing Nothing)]+ assertAst "FROM busybox" [From (untaggedImage "busybox")] it "parse tagged image" $ assertAst "FROM busybox:5.12-dev"- [From (TaggedImage "busybox" "5.12-dev" Nothing Nothing)]+ [From (taggedImage "busybox" "5.12-dev")] it "parse digested image" $ assertAst "FROM ubuntu@sha256:0ef2e08ed3fab"- [From (UntaggedImage "ubuntu" (Just "sha256:0ef2e08ed3fab") Nothing)]+ [From (untaggedImage "ubuntu" `withDigest` "sha256:0ef2e08ed3fab")] it "parse digested image with tag" $ assertAst "FROM ubuntu:14.04@sha256:0ef2e08ed3fab"- [From (TaggedImage "ubuntu" "14.04" (Just "sha256:0ef2e08ed3fab") Nothing)]+ [From (taggedImage "ubuntu" "14.04" `withDigest` "sha256:0ef2e08ed3fab")] describe "parse aliased FROM" $ do it "parse untagged image" $- assertAst "FROM busybox as foo" [From (UntaggedImage "busybox" Nothing (Just "foo"))]+ assertAst "FROM busybox as foo" [From (untaggedImage "busybox" `withAlias` "foo")] it "parse tagged image" $ assertAst "FROM busybox:5.12-dev AS foo-bar"- [ From (TaggedImage "busybox" "5.12-dev" Nothing (Just "foo-bar"))+ [ From (taggedImage "busybox" "5.12-dev" `withAlias` "foo-bar") ] it "parse diggested image" $ assertAst "FROM ubuntu@sha256:0ef2e08ed3fab AS foo"- [ From (UntaggedImage "ubuntu" (Just "sha256:0ef2e08ed3fab") (Just "foo"))+ [ From (untaggedImage "ubuntu" `withDigest` "sha256:0ef2e08ed3fab" `withAlias` "foo") ] + describe "parse FROM with platform" $ do+ it "parse untagged image with platform" $+ assertAst "FROM --platform=linux busybox" [From (untaggedImage "busybox" `withPlatform` "linux")]++ it "parse tagged image with platform" $+ assertAst "FROM --platform=linux busybox:foo" [From (taggedImage "busybox" "foo" `withPlatform` "linux")]+ describe "parse FROM with registry" $ do it "registry without port" $- assertAst "FROM foo.com/node" [From (UntaggedImage (Image (Just "foo.com") "node") Nothing Nothing)]+ assertAst "FROM foo.com/node" [From (untaggedImage (Image (Just "foo.com") "node"))] it "parse with port and tag" $ assertAst "FROM myregistry.com:5000/imagename:5.12-dev"- [From (TaggedImage (Image (Just "myregistry.com:5000") "imagename") "5.12-dev" Nothing Nothing)]+ [From (taggedImage (Image (Just "myregistry.com:5000") "imagename") "5.12-dev")] it "Not a registry if no TLD" $ assertAst "FROM myfolder/imagename:5.12-dev"- [From (TaggedImage (Image Nothing "myfolder/imagename") "5.12-dev" Nothing Nothing)]+ [From (taggedImage (Image Nothing "myfolder/imagename") "5.12-dev")] describe "parse LABEL" $ do it "parse label" $ assertAst "LABEL foo=bar" [Label[("foo", "bar")]]@@ -93,7 +116,7 @@ , "ENV NODE_VERSION=v5.7.1 \\" , "DEBIAN_FRONTEND=noninteractive" ]- ast = [ From (UntaggedImage "busybox" Nothing Nothing)+ ast = [ From (untaggedImage "busybox") , Env[("NODE_VERSION", "v5.7.1"), ("DEBIAN_FRONTEND", "noninteractive")] ] in assertAst dockerfile ast@@ -221,12 +244,12 @@ it "maintainer of untagged scratch image" $ assertAst "FROM scratch\nMAINTAINER hudu@mail.com"- [From (UntaggedImage "scratch" Nothing Nothing), Maintainer "hudu@mail.com"]+ [From (untaggedImage "scratch"), Maintainer "hudu@mail.com"] it "maintainer with mail" $ assertAst "MAINTAINER hudu@mail.com" [Maintainer "hudu@mail.com"] it "maintainer only mail after from" $ let maintainerFromProg = "FROM busybox\nMAINTAINER hudu@mail.com"- maintainerFromAst = [From (UntaggedImage "busybox" Nothing Nothing), Maintainer "hudu@mail.com"]+ maintainerFromAst = [From (untaggedImage "busybox"), Maintainer "hudu@mail.com"] in assertAst maintainerFromProg maintainerFromAst describe "parse # comment " $ do it "multiple comments before run" $@@ -286,7 +309,7 @@ , "RUN echo\\ " , " hello" ]- in assertAst dockerfile [ From (UntaggedImage "busybox" Nothing Nothing)+ in assertAst dockerfile [ From (untaggedImage "busybox") , Run "echo hello" ] describe "expose" $ do@@ -325,7 +348,7 @@ describe "syntax" $ do it "should handle lowercase instructions (#7 - https://github.com/beijaflor-io/haskell-language-dockerfile/issues/7)" $ let content = "from ubuntu"- in assertAst content [From (UntaggedImage "ubuntu" Nothing Nothing)]+ in assertAst content [From (untaggedImage "ubuntu")] describe "ADD" $ do it "simple ADD" $@@ -389,5 +412,5 @@ assertAst :: HasCallStack => Text.Text -> [Instruction Text.Text] -> Assertion assertAst s ast = case parseText s of- Left err -> assertFailure $ parseErrorPretty err+ Left err -> assertFailure $ errorBundlePretty err Right dockerfile -> assertEqual "ASTs are not equal" ast $ map instruction dockerfile