From 1dec54babb696b73f1be666c709fea2f50e9d46a Mon Sep 17 00:00:00 2001 From: Jose Lorenzo Rodriguez Date: Sun, 11 Mar 2018 23:34:37 -0400 Subject: [PATCH] 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)]