From 7eb24de295359400dfbb127587e3d637f039c82a Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Sun, 11 Mar 2018 10:19:33 -0400 Subject: [PATCH 1/3] Improved the edsl for copy and entrypoint This is a breaking change, but improves the usability of copy and entrypoint functions. Also adds the possibility to specify a from stage and permissions for the copy argument closes #21 and #22 --- src/Language/Docker.hs | 4 +++ src/Language/Docker/EDSL.hs | 45 ++++++++++++++++++-------- src/Language/Docker/Parser.hs | 6 ++-- src/Language/Docker/PrettyPrint.hs | 13 +++++--- src/Language/Docker/Syntax.hs | 24 +++++++++++++- src/Language/Docker/Syntax/Lift.hs | 2 ++ test/Language/Docker/EDSL/QuasiSpec.hs | 3 +- test/Language/Docker/EDSLSpec.hs | 18 ++++++++++- test/Language/Docker/ParserSpec.hs | 12 +++---- 9 files changed, 99 insertions(+), 28 deletions(-) diff --git a/src/Language/Docker.hs b/src/Language/Docker.hs index 5c5beda..c0bc648 100644 --- a/src/Language/Docker.hs +++ b/src/Language/Docker.hs @@ -25,6 +25,10 @@ module Language.Docker , Language.Docker.EDSL.label , Language.Docker.EDSL.stopSignal , Language.Docker.EDSL.copy + , Language.Docker.EDSL.copyFromStage + , Language.Docker.EDSL.to + , Language.Docker.EDSL.fromStage + , Language.Docker.EDSL.ownedBy , Language.Docker.EDSL.run , Language.Docker.EDSL.runArgs , Language.Docker.EDSL.cmd diff --git a/src/Language/Docker/EDSL.hs b/src/Language/Docker/EDSL.hs index 09c90a5..9609fba 100644 --- a/src/Language/Docker/EDSL.hs +++ b/src/Language/Docker/EDSL.hs @@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE TemplateHaskell #-} module Language.Docker.EDSL where @@ -87,15 +89,15 @@ toDockerfile e = -- 'Language.Docker.PrettyPrint' -- -- @ --- import Language.Docker +-- import Language.Docker -- -- main :: IO () -- main = writeFile "something.dockerfile" $ toDockerfileStr $ do -- from (tagged "fpco/stack-build" "lts-6.9") -- add ["."] "/app/language-docker" -- workdir "/app/language-docker" --- run (words "stack build --test --only-dependencies") --- cmd (words "stack test") +-- run "stack build --test --only-dependencies" +-- cmd "stack test" -- @ toDockerfileStr :: EDockerfileM a -> String toDockerfileStr = PrettyPrint.prettyPrint . toDockerfile @@ -131,26 +133,43 @@ variablePort varName = Syntax.PortStr ('$' : varName) portRange :: Integer -> Integer -> Syntax.Port portRange = Syntax.PortRange -run :: MonadFree EInstruction m => String -> m () -run = runArgs . words +run :: MonadFree EInstruction m => Syntax.Arguments -> m () +run = runArgs -entrypoint :: MonadFree EInstruction m => String -> m () -entrypoint = entrypointArgs . words +entrypoint :: MonadFree EInstruction m => Syntax.Arguments -> m () +entrypoint = entrypointArgs -cmd :: MonadFree EInstruction m => String -> m () -cmd = cmdArgs . words +cmd :: MonadFree EInstruction m => Syntax.Arguments -> m () +cmd = cmdArgs -copy :: MonadFree EInstruction m => NonEmpty Syntax.SourcePath -> Syntax.TargetPath -> m () -copy sources dest = copyArgs sources dest Syntax.NoChown Syntax.NoSource +copy :: MonadFree EInstruction m => Syntax.CopyArgs -> m () +copy (Syntax.CopyArgs sources dest ch src) = copyArgs sources dest ch src + +copyFromStage :: + MonadFree EInstruction m + => Syntax.CopySource + -> NonEmpty Syntax.SourcePath + -> Syntax.TargetPath + -> m () +copyFromStage stage source dest = copy $ Syntax.CopyArgs source dest Syntax.NoChown stage add :: MonadFree EInstruction m => NonEmpty Syntax.SourcePath -> Syntax.TargetPath -> m () add sources dest = addArgs sources dest Syntax.NoChown -check :: String -> Syntax.Check +fromStage :: Syntax.CopyArgs -> Syntax.CopySource -> Syntax.CopyArgs +fromStage args src = args {Syntax.sourceFlag = src} + +ownedBy :: Syntax.CopyArgs -> Syntax.Chown -> Syntax.CopyArgs +ownedBy args owner = args {Syntax.chownFlag = owner} + +to :: NonEmpty Syntax.SourcePath -> Syntax.TargetPath -> Syntax.CopyArgs +to sources dest = Syntax.CopyArgs sources dest Syntax.NoChown Syntax.NoSource + +check :: Syntax.Arguments -> Syntax.Check check command = Syntax.Check Syntax.CheckArgs - { Syntax.checkCommand = words command + { Syntax.checkCommand = command , Syntax.interval = Nothing , Syntax.timeout = Nothing , Syntax.startPeriod = Nothing diff --git a/src/Language/Docker/Parser.hs b/src/Language/Docker/Parser.hs index fa7909a..f292ad9 100644 --- a/src/Language/Docker/Parser.hs +++ b/src/Language/Docker/Parser.hs @@ -335,13 +335,15 @@ maintainer = do -- Parse arguments of a command in the exec form argumentsExec :: Parser Arguments -argumentsExec = brackets $ commaSep stringLiteral +argumentsExec = do + args <- brackets $ commaSep stringLiteral + return $ Arguments args -- Parse arguments of a command in the shell form argumentsShell :: Parser Arguments argumentsShell = do args <- untilEol - return $ words args + return $ Arguments (words args) arguments :: Parser Arguments arguments = try argumentsExec <|> try argumentsShell diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs index 2e6bfc2..2d22bc5 100644 --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -8,7 +8,7 @@ module Language.Docker.PrettyPrint where import qualified Data.ByteString.Char8 as ByteString (unpack) import Data.List (foldl', intersperse) -import Data.List.NonEmpty (NonEmpty, toList) +import Data.List.NonEmpty as NonEmpty (NonEmpty(..), toList) import Data.String import Language.Docker.Syntax import Prelude hiding ((>>), (>>=), return) @@ -64,13 +64,13 @@ prettyPrintPair :: (String, String) -> Doc prettyPrintPair (k, v) = text k <> char '=' <> text (show v) prettyPrintArguments :: Arguments -> Doc -prettyPrintArguments as = text (unwords (map helper as)) +prettyPrintArguments (Arguments as) = text (unwords (map helper as)) where helper "&&" = "\\\n &&" helper a = a prettyPrintJSON :: Arguments -> Doc -prettyPrintJSON as = brackets $ hsep $ intersperse comma $ map (doubleQuotes . text) as +prettyPrintJSON (Arguments as) = brackets $ hsep $ intersperse comma $ map (doubleQuotes . text) as prettyPrintPort :: Port -> Doc prettyPrintPort (PortStr str) = text str @@ -80,7 +80,12 @@ prettyPrintPort (Port num UDP) = integer num <> char '/' <> text "udp" prettyPrintFileList :: NonEmpty SourcePath -> TargetPath -> Doc prettyPrintFileList sources (TargetPath dest) = - hsep $ [text s | SourcePath s <- toList sources] ++ [text dest] + let ending = + case (reverse dest, sources) of + ('/':_, _) -> "" -- If the target ends with / then no extra ending is needed + (_, _fst :| _snd:_) -> "/" -- More than one source means that the target should end in / + _ -> "" + in hsep $ [text s | SourcePath s <- toList sources] ++ [text dest <> text ending] prettyPrintChown :: Chown -> Doc prettyPrintChown chown = diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs index f531613..da6dd13 100644 --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -86,11 +86,23 @@ data Chown | NoChown deriving (Show, Eq, Ord) +instance IsString Chown where + fromString ch = + case ch of + "" -> NoChown + _ -> Chown ch + data CopySource = CopySource String | NoSource deriving (Show, Eq, Ord) +instance IsString CopySource where + fromString src = + case src of + "" -> NoSource + _ -> CopySource src + newtype Duration = Duration { durationTime :: DiffTime } deriving (Show, Eq, Ord, Num) @@ -117,6 +129,13 @@ data Check | NoCheck deriving (Show, Eq, Ord) +newtype Arguments = + Arguments [String] + deriving (Show, Eq, Ord) + +instance IsString Arguments where + fromString = Arguments . words + data CheckArgs = CheckArgs { checkCommand :: Arguments , interval :: Maybe Duration @@ -125,7 +144,10 @@ data CheckArgs = CheckArgs , retries :: Maybe Retries } deriving (Show, Eq, Ord) -type Arguments = [String] +instance IsList Arguments where + type Item Arguments = String + fromList = Arguments + toList (Arguments ps) = ps type Pairs = [(String, String)] diff --git a/src/Language/Docker/Syntax/Lift.hs b/src/Language/Docker/Syntax/Lift.hs index b73b2a8..65d4430 100644 --- a/src/Language/Docker/Syntax/Lift.hs +++ b/src/Language/Docker/Syntax/Lift.hs @@ -31,6 +31,8 @@ deriveLift ''ImageAlias deriveLift ''BaseImage +deriveLift ''Arguments + deriveLift ''Instruction deriveLift ''InstructionPos diff --git a/test/Language/Docker/EDSL/QuasiSpec.hs b/test/Language/Docker/EDSL/QuasiSpec.hs index f59e777..cc255d7 100644 --- a/test/Language/Docker/EDSL/QuasiSpec.hs +++ b/test/Language/Docker/EDSL/QuasiSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE QuasiQuotes #-} module Language.Docker.EDSL.QuasiSpec where diff --git a/test/Language/Docker/EDSLSpec.hs b/test/Language/Docker/EDSLSpec.hs index f24d0ae..e08d10b 100644 --- a/test/Language/Docker/EDSLSpec.hs +++ b/test/Language/Docker/EDSLSpec.hs @@ -60,12 +60,28 @@ spec = do it "parses and prints from aliases correctly" $ do let r = prettyPrint $ toDockerfile $ do - from ("node" `tagged` "10.1" `aliased` "node-build") + from $ "node" `tagged` "10.1" `aliased` "node-build" run "echo foo" r `shouldBe` unlines [ "FROM node:10.1 AS node-build" , "RUN echo foo" ] + it "parses and prints copy instructions" $ do + let r = prettyPrint $ toDockerfile $ do + from "scratch" + copy $ ["foo.js"] `to` "bar.js" + copy $ ["foo.js", "bar.js"] `to` "." + copy $ ["foo.js", "bar.js"] `to` "baz/" + copy $ ["something"] `to` "crazy" `fromStage` "builder" + copy $ ["this"] `to` "that" `fromStage` "builder" `ownedBy` "www-data" + r `shouldBe` unlines [ "FROM scratch" + , "COPY foo.js bar.js" + , "COPY foo.js bar.js ./" + , "COPY foo.js bar.js baz/" + , "COPY --from=builder something crazy" + , "COPY --chown=www-data --from=builder this that" + ] + describe "toDockerfileStrIO" $ it "let's us run in the IO monad" $ do -- TODO - "glob" is a really useful combinator diff --git a/test/Language/Docker/ParserSpec.hs b/test/Language/Docker/ParserSpec.hs index 971d973..933b00f 100644 --- a/test/Language/Docker/ParserSpec.hs +++ b/test/Language/Docker/ParserSpec.hs @@ -145,7 +145,7 @@ spec = do "HEALTHCHECK --interval=5m \\\nCMD curl -f http://localhost/" [Healthcheck $ Check $ - CheckArgs (words "curl -f http://localhost/") (Just 300) Nothing Nothing Nothing + CheckArgs "curl -f http://localhost/" (Just 300) Nothing Nothing Nothing ] it "parse healthcheck with retries" $ @@ -153,7 +153,7 @@ spec = do "HEALTHCHECK --retries=10 CMD curl -f http://localhost/" [Healthcheck $ Check $ - CheckArgs (words "curl -f http://localhost/") Nothing Nothing Nothing (Just $ Retries 10) + CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing (Just $ Retries 10) ] it "parse healthcheck with timeout" $ @@ -161,7 +161,7 @@ spec = do "HEALTHCHECK --timeout=10s CMD curl -f http://localhost/" [Healthcheck $ Check $ - CheckArgs (words "curl -f http://localhost/") Nothing (Just 10) Nothing Nothing + CheckArgs "curl -f http://localhost/" Nothing (Just 10) Nothing Nothing ] it "parse healthcheck with start-period" $ @@ -169,7 +169,7 @@ spec = do "HEALTHCHECK --start-period=2m CMD curl -f http://localhost/" [Healthcheck $ Check $ - CheckArgs (words "curl -f http://localhost/") Nothing Nothing (Just 120) Nothing + CheckArgs "curl -f http://localhost/" Nothing Nothing (Just 120) Nothing ] it "parse healthcheck with all flags" $ @@ -178,7 +178,7 @@ spec = do [Healthcheck $ Check $ CheckArgs - (words "curl -f http://localhost/") + "curl -f http://localhost/" (Just 5) (Just 60) (Just 2) @@ -190,7 +190,7 @@ spec = do "HEALTHCHECK CMD curl -f http://localhost/" [Healthcheck $ Check $ - CheckArgs (words "curl -f http://localhost/") Nothing Nothing Nothing Nothing + CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing Nothing ] describe "parse MAINTAINER" $ do From 7d4f872834e3083d6e38b7932e503bd618a5d71e Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Sun, 11 Mar 2018 12:20:20 -0400 Subject: [PATCH 2/3] Adding a couple helper functions to work with file sources --- README.md | 8 +++++--- src/Language/Docker.hs | 2 ++ src/Language/Docker/EDSL.hs | 14 ++++++++++---- 3 files changed, 17 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 84385b3..8262da9 100644 --- a/README.md +++ b/README.md @@ -110,15 +110,17 @@ import Language.Docker import qualified System.Directory as Directory import qualified System.FilePath as FilePath import qualified System.FilePath.Glob as Glob -import Data.String (fromString) +import Data.List.NonEmpty (fromList) + main = do str <- toDockerfileStrIO $ do fs <- liftIO $ do cwd <- Directory.getCurrentDirectory fs <- Glob.glob "./test/*.hs" - return (map (FilePath.makeRelative cwd) fs) + let relativeFiles = map (FilePath.makeRelative cwd) fs + return (fromList relativeFiles) from "ubuntu" - mapM_ (\f -> add [fromString f] (fromString $ "/app/" ++ takeFileName f)) fs + copy $ (toSources fs) `to` "/app/" putStr str ``` diff --git a/src/Language/Docker.hs b/src/Language/Docker.hs index c0bc648..957055b 100644 --- a/src/Language/Docker.hs +++ b/src/Language/Docker.hs @@ -29,6 +29,8 @@ module Language.Docker , Language.Docker.EDSL.to , Language.Docker.EDSL.fromStage , Language.Docker.EDSL.ownedBy + , Language.Docker.EDSL.toSources + , Language.Docker.EDSL.toTarget , Language.Docker.EDSL.run , Language.Docker.EDSL.runArgs , Language.Docker.EDSL.cmd diff --git a/src/Language/Docker/EDSL.hs b/src/Language/Docker/EDSL.hs index 9609fba..a710d19 100644 --- a/src/Language/Docker/EDSL.hs +++ b/src/Language/Docker/EDSL.hs @@ -105,11 +105,11 @@ toDockerfileStr = PrettyPrint.prettyPrint . toDockerfile untagged :: String -> EBaseImage untagged = flip EUntaggedImage Nothing . fromString -tagged :: String -> String -> EBaseImage -tagged imageName tag = ETaggedImage (fromString imageName) tag Nothing +tagged :: Syntax.Image -> String -> EBaseImage +tagged imageName tag = ETaggedImage imageName tag Nothing -digested :: String -> ByteString -> EBaseImage -digested imageName hash = EDigestedImage (fromString imageName) hash Nothing +digested :: Syntax.Image -> ByteString -> EBaseImage +digested imageName hash = EDigestedImage imageName hash Nothing aliased :: EBaseImage -> String -> EBaseImage aliased image alias = @@ -156,6 +156,12 @@ copyFromStage stage source dest = copy $ Syntax.CopyArgs source dest Syntax.NoCh add :: MonadFree EInstruction m => NonEmpty Syntax.SourcePath -> Syntax.TargetPath -> m () add sources dest = addArgs sources dest Syntax.NoChown +toSources :: NonEmpty String -> NonEmpty Syntax.SourcePath +toSources = fmap Syntax.SourcePath + +toTarget :: String -> Syntax.TargetPath +toTarget = Syntax.TargetPath + fromStage :: Syntax.CopyArgs -> Syntax.CopySource -> Syntax.CopyArgs fromStage args src = args {Syntax.sourceFlag = src} From 1dec54babb696b73f1be666c709fea2f50e9d46a Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Sun, 11 Mar 2018 23:34:37 -0400 Subject: [PATCH 3/3] Adding docblocks --- src/Language/Docker/EDSL.hs | 129 ++++++++++++++++++++++++++++++---- src/Language/Docker/Syntax.hs | 9 +-- 2 files changed, 119 insertions(+), 19 deletions(-) diff --git a/src/Language/Docker/EDSL.hs b/src/Language/Docker/EDSL.hs index a710d19..c40ee01 100644 --- a/src/Language/Docker/EDSL.hs +++ b/src/Language/Docker/EDSL.hs @@ -102,15 +102,40 @@ toDockerfile e = toDockerfileStr :: EDockerfileM a -> String toDockerfileStr = PrettyPrint.prettyPrint . toDockerfile +-- | Use a docker image in a FROM instruction without a tag +-- +-- The following two examples are equivalent +-- +-- @ +-- from $ untagged "fpco/stack-build" +-- @ +-- +-- Is equivalent to, when having OverloadedStrings: +-- +-- @ +-- from "fpco/stack-build" +-- @ untagged :: String -> EBaseImage untagged = flip EUntaggedImage Nothing . fromString +-- | Use a specific tag for a docker image. This function is meant +-- to be used as an infix operator. +-- +-- @ +-- from $ "fpco/stack-build" `tagged` "lts-10.3" +-- @ tagged :: Syntax.Image -> String -> EBaseImage tagged imageName tag = ETaggedImage imageName tag Nothing digested :: Syntax.Image -> ByteString -> EBaseImage digested imageName hash = EDigestedImage imageName hash Nothing +-- | Alias a FROM instruction to be used as a build stage. +-- This function is meant to be used as an infix operator. +-- +-- @ +-- from $ "fpco/stack-build" `aliased` "builder" +-- @ aliased :: EBaseImage -> String -> EBaseImage aliased image alias = case image of @@ -118,33 +143,46 @@ aliased image alias = ETaggedImage n t _ -> ETaggedImage n t (Just $ Syntax.ImageAlias alias) EDigestedImage n h _ -> EDigestedImage n h (Just $ Syntax.ImageAlias alias) -ports :: [Syntax.Port] -> Syntax.Ports -ports = Syntax.Ports - -tcpPort :: Integer -> Syntax.Port -tcpPort = flip Syntax.Port Syntax.TCP - -udpPort :: Integer -> Syntax.Port -udpPort = flip Syntax.Port Syntax.UDP - -variablePort :: String -> Syntax.Port -variablePort varName = Syntax.PortStr ('$' : varName) - -portRange :: Integer -> Integer -> Syntax.Port -portRange = Syntax.PortRange - +-- | Create a RUN instruction with the given arguments. +-- +-- @ +-- run "apt-get install wget" +-- @ run :: MonadFree EInstruction m => Syntax.Arguments -> m () run = runArgs +-- | Create an ENTRYPOINT instruction with the given arguments. +-- +-- @ +-- entrypoint "/usr/local/bin/program --some-flag" +-- @ entrypoint :: MonadFree EInstruction m => Syntax.Arguments -> m () entrypoint = entrypointArgs +-- | Create a CMD instruction with the given arguments. +-- +-- @ +-- cmd "my-program --some-flag" +-- @ cmd :: MonadFree EInstruction m => Syntax.Arguments -> m () cmd = cmdArgs +-- | Create a COPY instruction. This function is meant to be +-- used with the compinators 'to', 'fromStage' and 'ownedBy' +-- +-- @ +-- copy $ ["foo.js", "bar.js"] `to` "." +-- copy $ ["some_file"] `to` "/some/path" `fromStage` "builder" +-- @ copy :: MonadFree EInstruction m => Syntax.CopyArgs -> m () copy (Syntax.CopyArgs sources dest ch src) = copyArgs sources dest ch src +-- | Create a COPY instruction from a given build stage. +-- This is a shorthand version of using 'copy' with combinators. +-- +-- @ +-- copyFromStage "builder" ["foo.js", "bar.js"] "." +-- @ copyFromStage :: MonadFree EInstruction m => Syntax.CopySource @@ -153,24 +191,85 @@ copyFromStage :: -> m () copyFromStage stage source dest = copy $ Syntax.CopyArgs source dest Syntax.NoChown stage +-- | Create an ADD instruction. This is often used as a shorthand version +-- of copy when no extra options are needed. Currently there is no way to +-- pass extra options to ADD, so you are encouraged to use 'copy' instead. +-- +-- @ +-- add ["foo.js", "bar.js"] "." +-- @ add :: MonadFree EInstruction m => NonEmpty Syntax.SourcePath -> Syntax.TargetPath -> m () add sources dest = addArgs sources dest Syntax.NoChown +-- | Converts a NonEmpty list of strings to a NonEmpty list of 'Syntax.SourcePath' +-- +-- This is a convenience function when you need to pass a non-static list of +-- strings that you build somewhere as an argument for 'copy' or 'add' +-- +-- @ +-- someFiles <- glob "*.js" +-- copy $ (toSources someFiles) `to` "." +-- @ toSources :: NonEmpty String -> NonEmpty Syntax.SourcePath toSources = fmap Syntax.SourcePath +-- | Converts a String into a 'Syntax.TargetPath' +-- +-- This is a convenience function when you need to pass a string variable +-- as an argument for 'copy' or 'add' +-- +-- @ +-- let destination = buildSomePath pwd +-- add ["foo.js"] (toTarget destination) +-- @ toTarget :: String -> Syntax.TargetPath toTarget = Syntax.TargetPath +-- | Adds the --from= option to a COPY instruction. +-- +-- This function is meant to be used as an infix operator: +-- +-- @ +-- copy $ ["foo.js"] `to` "." `fromStage` "builder" +-- @ fromStage :: Syntax.CopyArgs -> Syntax.CopySource -> Syntax.CopyArgs fromStage args src = args {Syntax.sourceFlag = src} +-- | Adds the --chown= option to a COPY instruction. +-- +-- This function is meant to be used as an infix operator: +-- +-- @ +-- copy $ ["foo.js"] `to` "." `ownedBy` "www-data:www-data" +-- @ ownedBy :: Syntax.CopyArgs -> Syntax.Chown -> Syntax.CopyArgs ownedBy args owner = args {Syntax.chownFlag = owner} +-- | Usedto join source paths with atarget path as an arguments for 'copy' +-- +-- This function is meant to be used as an infix operator: +-- +-- @ +-- copy $ ["foo.js"] `to` "." `ownedBy` +-- @ to :: NonEmpty Syntax.SourcePath -> Syntax.TargetPath -> Syntax.CopyArgs to sources dest = Syntax.CopyArgs sources dest Syntax.NoChown Syntax.NoSource +ports :: [Syntax.Port] -> Syntax.Ports +ports = Syntax.Ports + +tcpPort :: Integer -> Syntax.Port +tcpPort = flip Syntax.Port Syntax.TCP + +udpPort :: Integer -> Syntax.Port +udpPort = flip Syntax.Port Syntax.UDP + +variablePort :: String -> Syntax.Port +variablePort varName = Syntax.PortStr ('$' : varName) + +portRange :: Integer -> Integer -> Syntax.Port +portRange = Syntax.PortRange + check :: Syntax.Arguments -> Syntax.Check check command = Syntax.Check diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs index da6dd13..1e55ed0 100644 --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -136,6 +136,11 @@ newtype Arguments = instance IsString Arguments where fromString = Arguments . words +instance IsList Arguments where + type Item Arguments = String + fromList = Arguments + toList (Arguments ps) = ps + data CheckArgs = CheckArgs { checkCommand :: Arguments , interval :: Maybe Duration @@ -144,10 +149,6 @@ data CheckArgs = CheckArgs , retries :: Maybe Retries } deriving (Show, Eq, Ord) -instance IsList Arguments where - type Item Arguments = String - fromList = Arguments - toList (Arguments ps) = ps type Pairs = [(String, String)]