language-docker 6.0.4 → 7.0.0
raw patch · 11 files changed
+104/−65 lines, 11 files
Files
- language-docker.cabal +5/−4
- src/Language/Docker.hs +2/−0
- src/Language/Docker/EDSL.hs +18/−11
- src/Language/Docker/EDSL/Types.hs +3/−4
- src/Language/Docker/Parser.hs +19/−19
- src/Language/Docker/PrettyPrint.hs +11/−8
- src/Language/Docker/Syntax.hs +6/−3
- src/Language/Docker/Syntax/Lift.hs +2/−0
- test/Language/Docker/EDSL/QuasiSpec.hs +2/−2
- test/Language/Docker/EDSLSpec.hs +1/−0
- test/Language/Docker/ParserSpec.hs +35/−14
language-docker.cabal view
@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack ----- hash: 64e893f351e7689307e2cbe6595ac2c624f727f4e02b9ff0aae6ec166f4cf5d4+-- hash: ec17b57a0353ccb2f2acde00b3f39a8983c7b388e00b574ee76db0cc11c206f7 name: language-docker-version: 6.0.4+version: 7.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.@@ -22,7 +24,6 @@ license: GPL-3 license-file: LICENSE build-type: Simple-cabal-version: >= 1.10 extra-source-files: README.md
src/Language/Docker.hs view
@@ -2,6 +2,7 @@ ( Language.Docker.Syntax.Dockerfile -- * Parsing Dockerfiles (@Language.Docker.Syntax@ and @Language.Docker.Parser@) , parseText , parseFile+ , parseStdin -- * Re-exports from @megaparsec@ , Text.Megaparsec.parseErrorPretty -- * Pretty-printing Dockerfiles (@Language.Docker.PrettyPrint@)@@ -86,6 +87,7 @@ , Language.Docker.Syntax.Registry(..) , Language.Docker.Syntax.ImageAlias(..) , Language.Docker.Syntax.Tag(..)+ , Language.Docker.Syntax.Digest(..) , Language.Docker.Syntax.Ports , Language.Docker.Syntax.Directory , Language.Docker.Syntax.Arguments
src/Language/Docker/EDSL.hs view
@@ -55,9 +55,8 @@ runD :: MonadWriter [Syntax.Instruction Text] m => EInstruction (m b) -> m b runD (From bi n) = case bi of- EUntaggedImage bi' alias -> runDef Syntax.From (Syntax.UntaggedImage bi' alias) n- ETaggedImage bi' tg alias -> runDef Syntax.From (Syntax.TaggedImage bi' tg alias) n- EDigestedImage bi' d alias -> runDef Syntax.From (Syntax.DigestedImage bi' d alias) n+ 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 (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@@ -154,7 +153,7 @@ -- from "fpco/stack-build" -- @ untagged :: Text -> EBaseImage-untagged = flip EUntaggedImage Nothing . fromString . Text.unpack+untagged s = EUntaggedImage (fromString . Text.unpack $ s) Nothing Nothing -- | Use a specific tag for a docker image. This function is meant -- to be used as an infix operator.@@ -163,10 +162,19 @@ -- from $ "fpco/stack-build" `tagged` "lts-10.3" -- @ tagged :: Syntax.Image -> Syntax.Tag -> EBaseImage-tagged imageName tag = ETaggedImage imageName tag Nothing+tagged imageName tag = ETaggedImage imageName tag Nothing Nothing -digested :: Syntax.Image -> Text -> EBaseImage-digested imageName hash = EDigestedImage imageName hash Nothing+-- | Adds a digest checksum so a FROM instruction+-- This function is meant to be used as an infix operator.+--+-- @+-- 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 -- | Alias a FROM instruction to be used as a build stage. -- This function is meant to be used as an infix operator.@@ -174,12 +182,11 @@ -- @ -- from $ "fpco/stack-build" `aliased` "builder" -- @-aliased :: EBaseImage -> Text -> EBaseImage+aliased :: EBaseImage -> Syntax.ImageAlias -> EBaseImage aliased image alias = case image of- EUntaggedImage n _ -> EUntaggedImage n (Just $ Syntax.ImageAlias alias)- ETaggedImage n t _ -> ETaggedImage n t (Just $ Syntax.ImageAlias alias)- EDigestedImage n h _ -> EDigestedImage n h (Just $ Syntax.ImageAlias alias)+ EUntaggedImage n d _ -> EUntaggedImage n d (Just alias)+ ETaggedImage n t d _ -> ETaggedImage n t d (Just alias) -- | Create a RUN instruction with the given arguments. --
src/Language/Docker/EDSL/Types.hs view
@@ -9,17 +9,16 @@ data EBaseImage = EUntaggedImage Syntax.Image+ (Maybe Syntax.Digest) (Maybe Syntax.ImageAlias) | ETaggedImage Syntax.Image Syntax.Tag+ (Maybe Syntax.Digest) (Maybe Syntax.ImageAlias)- | EDigestedImage Syntax.Image- Text- (Maybe Syntax.ImageAlias) deriving (Show, Eq, Ord) instance IsString EBaseImage where- fromString = flip EUntaggedImage Nothing . fromString+ fromString s = EUntaggedImage (fromString s) Nothing Nothing data EInstruction next = From EBaseImage
src/Language/Docker/Parser.hs view
@@ -5,6 +5,7 @@ module Language.Docker.Parser ( parseText , parseFile+ , parseStdin , Parser , Error , DockerfileError(..)@@ -163,35 +164,30 @@ registryName <- (Just <$> try parseRegistry) <|> return Nothing name <- someUnless "the image name with a tag" (\c -> c == '@' || c == ':') void $ char ':'- tag <- someUnless "the image tag" (== ':')+ tag <- someUnless "the image tag" (\c -> c == '@' || c == ':')+ maybeDigest <- (Just <$> try digest) <|> return Nothing maybeAlias <- maybeImageAlias- return $ TaggedImage (Image registryName name) (Tag tag) maybeAlias+ return $ TaggedImage (Image registryName name) (Tag tag) maybeDigest maybeAlias -digestedImage :: Parser BaseImage-digestedImage = do- name <- someUnless "the image name with a digest" (\c -> c == '@' || c == ':')+digest :: Parser Digest+digest = do void $ char '@'- digest <- someUnless "the image digest" (== '@')- maybeAlias <- maybeImageAlias- return $ DigestedImage (Image Nothing name) digest maybeAlias+ 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- notInvalidDigest name+ maybeDigest <- (Just <$> try digest) <|> return Nothing maybeAlias <- maybeImageAlias- return $ UntaggedImage (Image registryName name) maybeAlias+ return $ UntaggedImage (Image registryName name) maybeDigest maybeAlias where notInvalidTag :: Text -> Parser () notInvalidTag name = try (notFollowedBy $ string ":") <?> "no ':' or a valid image tag string (example: " ++ T.unpack name ++ ":valid-tag)"- notInvalidDigest :: Text -> Parser ()- notInvalidDigest name =- try (notFollowedBy $ string "@") <?> "no '@' or a valid digest hash (example: " ++- T.unpack name ++ "@a3f42f2de)" maybeImageAlias :: Parser (Maybe ImageAlias) maybeImageAlias = Just <$> (spaces1 >> imageAlias) <|> return Nothing@@ -203,10 +199,7 @@ return $ ImageAlias alias baseImage :: Parser BaseImage-baseImage =- try digestedImage <|> -- Let's try each version- try taggedImage <|>- untaggedImage+baseImage = try taggedImage <|> untaggedImage from :: Parser Instr from = do@@ -398,7 +391,7 @@ (try portInt <?> "a valid port number") ports :: Parser Ports-ports = Ports <$> port `sepEndBy1` (char ' ' <|> char '\t')+ports = Ports <$> port `sepEndBy` spaces1 portRange :: Parser Port portRange = do@@ -602,3 +595,10 @@ where doParse = parse (contents dockerfile) file . normalizeEscapedLines . E.decodeUtf8With E.lenientDecode++-- | Reads the standard input until the end and parses the contents as a Dockerfile+parseStdin :: IO (Either Error Dockerfile)+parseStdin = doParse <$> B.getContents+ where+ doParse =+ parse (contents dockerfile) "/dev/stdin" . normalizeEscapedLines . E.decodeUtf8With E.lenientDecode
src/Language/Docker/PrettyPrint.hs view
@@ -55,18 +55,15 @@ prettyPrintBaseImage :: BaseImage -> Doc ann prettyPrintBaseImage b = case b of- DigestedImage img digest alias -> do- prettyPrintImage img- pretty '@'- pretty digest- prettyAlias alias- UntaggedImage img alias -> do+ UntaggedImage img digest alias -> do prettyPrintImage img+ prettyDigest digest prettyAlias alias- TaggedImage img (Tag tag) alias -> do+ TaggedImage img (Tag tag) digest alias -> do prettyPrintImage img pretty ':' pretty tag+ prettyDigest digest prettyAlias alias where (>>) = (<>)@@ -75,9 +72,15 @@ case maybeAlias of Nothing -> mempty Just (ImageAlias alias) -> " AS " <> pretty alias+ prettyDigest maybeDigest =+ case maybeDigest of+ Nothing -> mempty+ Just (Digest d) -> "@" <> pretty d prettyPrintPairs :: Pairs -> Doc ann-prettyPrintPairs ps = hsep $ fmap prettyPrintPair ps+prettyPrintPairs ps = align $ sepLine $ fmap prettyPrintPair ps+ where+ sepLine = concatWith (\x y -> x <> " \\" <> line <> y) prettyPrintPair :: (Text, Text) -> Doc ann prettyPrintPair (k, v) = pretty k <> pretty '=' <> doubleQoute v
src/Language/Docker/Syntax.hs view
@@ -36,6 +36,10 @@ { unTag :: Text } deriving (Show, Eq, Ord, IsString) +newtype Digest = Digest+ { unDigest :: Text+ } deriving (Show, Eq, Ord, IsString)+ data Protocol = TCP | UDP@@ -67,13 +71,12 @@ data BaseImage = UntaggedImage !Image+ !(Maybe Digest) !(Maybe ImageAlias) | TaggedImage !Image !Tag+ !(Maybe Digest) !(Maybe ImageAlias)- | DigestedImage !Image- !Text- !(Maybe ImageAlias) deriving (Eq, Ord, Show) -- | Type of the Dockerfile AST
src/Language/Docker/Syntax/Lift.hs view
@@ -38,6 +38,8 @@ deriveLift ''Tag +deriveLift ''Digest+ deriveLift ''BaseImage deriveLift ''Arguments
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)+ df `shouldBe` [ From (UntaggedImage "node" Nothing Nothing) , Run "apt-get update" , Cmd ["node", "something.js"] ]@@ -33,7 +33,7 @@ CMD node something.js |] df = map instruction (toDockerfile d)- df `shouldBe` [ From (UntaggedImage "node" (Just $ ImageAlias "node-build"))+ df `shouldBe` [ From (UntaggedImage "node" Nothing (Just "node-build")) , Expose (Ports [Port 8080 TCP, PortStr "$PORT"]) , Run "apt-get update" , Cmd "node something.js"
test/Language/Docker/EDSLSpec.hs view
@@ -28,6 +28,7 @@ r `shouldBe` [ Syntax.From $ Syntax.UntaggedImage "node" Nothing+ Nothing , Syntax.Cmd ["node", "-e", "'console.log(\'hey\')'"] ]
test/Language/Docker/ParserSpec.hs view
@@ -22,35 +22,43 @@ describe "parse FROM" $ do it "parse untagged image" $- assertAst "FROM busybox" [From (UntaggedImage "busybox" Nothing)]+ assertAst "FROM busybox" [From (UntaggedImage "busybox" Nothing Nothing)] it "parse tagged image" $ assertAst "FROM busybox:5.12-dev"- [From (TaggedImage "busybox" "5.12-dev" Nothing)]+ [From (TaggedImage "busybox" "5.12-dev" Nothing Nothing)] it "parse digested image" $ assertAst "FROM ubuntu@sha256:0ef2e08ed3fab"- [From (DigestedImage "ubuntu" "sha256:0ef2e08ed3fab" Nothing)]+ [From (UntaggedImage "ubuntu" (Just "sha256:0ef2e08ed3fab") Nothing)]+ it "parse digested image with tag" $+ assertAst+ "FROM ubuntu:14.04@sha256:0ef2e08ed3fab"+ [From (TaggedImage "ubuntu" "14.04" (Just "sha256:0ef2e08ed3fab") Nothing)] describe "parse aliased FROM" $ do it "parse untagged image" $- assertAst "FROM busybox as foo" [From (UntaggedImage "busybox" (Just $ ImageAlias "foo"))]+ assertAst "FROM busybox as foo" [From (UntaggedImage "busybox" Nothing (Just "foo"))] it "parse tagged image" $- assertAst "FROM busybox:5.12-dev AS foo-bar" [From (TaggedImage "busybox" "5.12-dev" (Just $ ImageAlias "foo-bar"))]+ assertAst "FROM busybox:5.12-dev AS foo-bar"+ [ From (TaggedImage "busybox" "5.12-dev" Nothing (Just "foo-bar"))+ ] it "parse diggested image" $- assertAst "FROM ubuntu@sha256:0ef2e08ed3fab AS foo" [From (DigestedImage "ubuntu" "sha256:0ef2e08ed3fab" (Just $ ImageAlias "foo"))]+ assertAst "FROM ubuntu@sha256:0ef2e08ed3fab AS foo"+ [ From (UntaggedImage "ubuntu" (Just "sha256:0ef2e08ed3fab") (Just "foo"))+ ] describe "parse FROM with registry" $ do it "registry without port" $- assertAst "FROM foo.com/node" [From (UntaggedImage (Image (Just "foo.com") "node") Nothing)]+ assertAst "FROM foo.com/node" [From (UntaggedImage (Image (Just "foo.com") "node") Nothing Nothing)] 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)]+ [From (TaggedImage (Image (Just "myregistry.com:5000") "imagename") "5.12-dev" Nothing Nothing)] it "Not a registry if no TLD" $ assertAst "FROM myfolder/imagename:5.12-dev"- [From (TaggedImage (Image Nothing "myfolder/imagename") "5.12-dev" Nothing)]+ [From (TaggedImage (Image Nothing "myfolder/imagename") "5.12-dev" Nothing Nothing)] describe "parse LABEL" $ do it "parse label" $ assertAst "LABEL foo=bar" [Label[("foo", "bar")]]@@ -85,7 +93,7 @@ , "ENV NODE_VERSION=v5.7.1 \\" , "DEBIAN_FRONTEND=noninteractive" ]- ast = [ From (UntaggedImage "busybox" Nothing)+ ast = [ From (UntaggedImage "busybox" Nothing Nothing) , Env[("NODE_VERSION", "v5.7.1"), ("DEBIAN_FRONTEND", "noninteractive")] ] in assertAst dockerfile ast@@ -213,12 +221,12 @@ it "maintainer of untagged scratch image" $ assertAst "FROM scratch\nMAINTAINER hudu@mail.com"- [From (UntaggedImage "scratch" Nothing), Maintainer "hudu@mail.com"]+ [From (UntaggedImage "scratch" Nothing Nothing), 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), Maintainer "hudu@mail.com"]+ maintainerFromAst = [From (UntaggedImage "busybox" Nothing Nothing), Maintainer "hudu@mail.com"] in assertAst maintainerFromProg maintainerFromAst describe "parse # comment " $ do it "multiple comments before run" $@@ -278,7 +286,7 @@ , "RUN echo\\ " , " hello" ]- in assertAst dockerfile [ From (UntaggedImage "busybox" Nothing)+ in assertAst dockerfile [ From (UntaggedImage "busybox" Nothing Nothing) , Run "echo hello" ] describe "expose" $ do@@ -300,11 +308,24 @@ it "should handle udp port ranges" $ let content = "EXPOSE 80 81 8080-8085/udp" in assertAst content [Expose (Ports [Port 80 TCP, Port 81 TCP, PortRange 8080 8085 UDP])]+ it "should handle multiline variables" $+ let content = "EXPOSE ${PORT} ${PORT_SSL} \\\n\+ \ ${PORT_HTTP} ${PORT_HTTPS} \\\n\+ \ ${PORT_REP} \\\n\+ \ ${PORT_ADMIN} ${PORT_ADMIN_HTTP}"+ in assertAst content [ Expose (Ports [ PortStr "${PORT}"+ , PortStr "${PORT_SSL}"+ , PortStr "${PORT_HTTP}"+ , PortStr "${PORT_HTTPS}"+ , PortStr "${PORT_REP}"+ , PortStr "${PORT_ADMIN}"+ , PortStr "${PORT_ADMIN_HTTP}"])+ ] 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)]+ in assertAst content [From (UntaggedImage "ubuntu" Nothing Nothing)] describe "ADD" $ do it "simple ADD" $