language-docker-8.0.2: Dockerfile parser, pretty-printer and embedded DSL

Safe HaskellNone
LanguageHaskell2010

Language.Docker

Contents

Synopsis

Documentation

type Dockerfile = [InstructionPos Text] Source #

Type of the Dockerfile AST

Parsing Dockerfiles (Language.Docker.Syntax and Language.Docker.Parser)

parseStdin :: IO (Either Error Dockerfile) Source #

Reads the standard input until the end and parses the contents as a Dockerfile

Re-exports from megaparsec

parseErrorPretty #

Arguments

:: (Stream s, ShowErrorComponent e) 
=> ParseError s e

Parse error to render

-> String

Result of rendering

Pretty-print a ParseError. The rendered String always ends with a newline.

Since: megaparsec-5.0.0

errorBundlePretty #

Arguments

:: (Stream s, ShowErrorComponent e) 
=> ParseErrorBundle s e

Parse error bundle to display

-> String

Textual rendition of the bundle

Pretty-print a ParseErrorBundle. All ParseErrors in the bundle will be pretty-printed in order together with the corresponding offending lines by doing a single efficient pass over the input stream. The rendered String always ends with a newline.

Since: megaparsec-7.0.0

Pretty-printing Dockerfiles (Language.Docker.PrettyPrint)

prettyPrint :: Dockerfile -> Text Source #

Pretty print a Dockerfile to a Text

Writting Dockerfiles (Language.Docker.EDSL)

toDockerfileText :: EDockerfileM a -> Text Source #

runs the Dockerfile EDSL and returns a Lazy using PrettyPrint

import Language.Docker

main :: IO ()
main = print $ toDockerfileText $ do
    from (tagged "fpco/stack-build" "lts-6.9")
    add ["."] "applanguage-docker"
    workdir "applanguage-docker"
    run "stack build --test --only-dependencies"
    cmd "stack test"

toDockerfile :: EDockerfileM a -> Dockerfile Source #

Runs the Dockerfile EDSL and returns a Dockerfile you can pretty print or manipulate

putDockerfileStr :: EDockerfileM a -> IO () Source #

Prints the dockerfile to stdout. Mainly used for debugging purposes

import Language.Docker

main :: IO ()
main = putDockerfileStr $ do
    from (tagged "fpco/stack-build" "lts-6.9")
    add ["."] "applanguage-docker"
    workdir "applanguage-docker"
    run "stack build --test --only-dependencies"
    cmd "stack test"

writeDockerFile :: Text -> Dockerfile -> IO () Source #

Writes the dockerfile to the given file path after pretty-printing it

import Language.Docker

main :: IO ()
main = writeDockerFile "build.Dockerfile" $ toDockerfile $ do
    from (tagged "fpco/stack-build" "lts-6.9")
    add ["."] "applanguage-docker"
    workdir "applanguage-docker"
    run "stack build --test --only-dependencies"
    cmd "stack test"

toDockerfileTextIO :: MonadIO m => EDockerfileTM m t -> m Text Source #

A version of toDockerfileText which allows IO actions

toDockerfileIO :: MonadIO m => EDockerfileTM m t -> m Dockerfile Source #

A version of toDockerfile which allows IO actions

runDockerfileIO :: MonadIO m => EDockerfileTM m t -> m (t, Dockerfile) Source #

Just runs the EDSL's writer monad

runDockerfileTextIO :: MonadIO m => EDockerfileTM m t -> m (t, Text) Source #

Runs the EDSL's writer monad and pretty-prints the result

liftIO :: MonadIO m => IO a -> m a #

Lift a computation from the IO monad.

from :: forall m. MonadFree EInstruction m => EBaseImage -> m () Source #

Constructing base images

tagged :: Image -> Tag -> EBaseImage Source #

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"

untagged :: Text -> EBaseImage Source #

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"

digested :: EBaseImage -> Digest -> EBaseImage Source #

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"

aliased :: EBaseImage -> ImageAlias -> EBaseImage Source #

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"

Syntax

add :: MonadFree EInstruction m => NonEmpty SourcePath -> TargetPath -> m () Source #

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"] "."

user :: forall m. MonadFree EInstruction m => Text -> m () Source #

label :: forall m. MonadFree EInstruction m => Pairs -> m () Source #

stopSignal :: forall m. MonadFree EInstruction m => Text -> m () Source #

copy :: MonadFree EInstruction m => CopyArgs -> m () Source #

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 "somepath" fromStage "builder"

copyFromStage :: MonadFree EInstruction m => CopySource -> NonEmpty SourcePath -> TargetPath -> m () Source #

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"] "."

to :: NonEmpty SourcePath -> TargetPath -> CopyArgs Source #

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

fromStage :: CopyArgs -> CopySource -> CopyArgs Source #

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"

ownedBy :: CopyArgs -> Chown -> CopyArgs Source #

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"

toSources :: NonEmpty Text -> NonEmpty SourcePath Source #

Converts a NonEmpty list of strings to a NonEmpty list of 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 "."

toTarget :: Text -> TargetPath Source #

Converts a Text into a 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)

run :: MonadFree EInstruction m => Arguments Text -> m () Source #

Create a RUN instruction with the given arguments.

run "apt-get install wget"

runArgs :: forall m. MonadFree EInstruction m => Arguments Text -> m () Source #

cmd :: MonadFree EInstruction m => Arguments Text -> m () Source #

Create a CMD instruction with the given arguments.

cmd "my-program --some-flag"

cmdArgs :: forall m. MonadFree EInstruction m => Arguments Text -> m () Source #

healthcheck :: forall m. MonadFree EInstruction m => Check Text -> m () Source #

check :: Arguments args -> Check args Source #

interval :: Check args -> Integer -> Check args Source #

timeout :: Check args -> Integer -> Check args Source #

startPeriod :: Check args -> Integer -> Check args Source #

retries :: Check args -> Integer -> Check args Source #

workdir :: forall m. MonadFree EInstruction m => Directory -> m () Source #

expose :: forall m. MonadFree EInstruction m => Ports -> m () Source #

volume :: forall m. MonadFree EInstruction m => Text -> m () Source #

entrypoint :: MonadFree EInstruction m => Arguments Text -> m () Source #

Create an ENTRYPOINT instruction with the given arguments.

entrypoint "usrlocalbinprogram --some-flag"

maintainer :: forall m. MonadFree EInstruction m => Text -> m () Source #

env :: forall m. MonadFree EInstruction m => Pairs -> m () Source #

arg :: forall m. MonadFree EInstruction m => Text -> Maybe Text -> m () Source #

comment :: forall m. MonadFree EInstruction m => Text -> m () Source #

onBuild :: MonadFree EInstruction m => EDockerfileM a -> m () Source #

ONBUILD Dockerfile instruction

Each nested instruction gets emitted as a separate ONBUILD block

toDockerfile $ do
    from "node"
    run "apt-get update"
    onBuild $ do
        run "echo more-stuff"
        run "echo here"

embed :: forall m. MonadFree EInstruction m => [InstructionPos Text] -> m () Source #

edockerfile :: QuasiQuoter Source #

Quasiquoter for embedding dockerfiles on the EDSL

putStr $ toDockerfile $ do
    from "node"
    run "apt-get update"
    [edockerfile|
    RUN apt-get update
    CMD node something.js
    |]

Support types for the EDSL

type EDockerfileM = Free EInstruction Source #

The type of Identity based EDSL blocks

type EDockerfileTM = FreeT EInstruction Source #

The type of free monad EDSL blocks

QuasiQuoter (Language.Docker.EDSL.Quasi)

Types (Language.Docker.Syntax)

data Instruction args Source #

All commands available in Dockerfiles

Instances
Functor Instruction Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fmap :: (a -> b) -> Instruction a -> Instruction b #

(<$) :: a -> Instruction b -> Instruction a #

Eq args => Eq (Instruction args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Instruction args -> Instruction args -> Bool #

(/=) :: Instruction args -> Instruction args -> Bool #

Ord args => Ord (Instruction args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: Instruction args -> Instruction args -> Ordering #

(<) :: Instruction args -> Instruction args -> Bool #

(<=) :: Instruction args -> Instruction args -> Bool #

(>) :: Instruction args -> Instruction args -> Bool #

(>=) :: Instruction args -> Instruction args -> Bool #

max :: Instruction args -> Instruction args -> Instruction args #

min :: Instruction args -> Instruction args -> Instruction args #

Show args => Show (Instruction args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> Instruction args -> ShowS #

show :: Instruction args -> String #

showList :: [Instruction args] -> ShowS #

Lift args => Lift (Instruction args) Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Instruction args -> Q Exp #

data InstructionPos args Source #

Instruction with additional location information required for creating good check messages

Instances
Functor InstructionPos Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fmap :: (a -> b) -> InstructionPos a -> InstructionPos b #

(<$) :: a -> InstructionPos b -> InstructionPos a #

Eq args => Eq (InstructionPos args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: InstructionPos args -> InstructionPos args -> Bool #

(/=) :: InstructionPos args -> InstructionPos args -> Bool #

Ord args => Ord (InstructionPos args) Source # 
Instance details

Defined in Language.Docker.Syntax

Show args => Show (InstructionPos args) Source # 
Instance details

Defined in Language.Docker.Syntax

Lift args => Lift (InstructionPos args) Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: InstructionPos args -> Q Exp #

data Chown Source #

Constructors

Chown !Text 
NoChown 
Instances
Eq Chown Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Chown -> Chown -> Bool #

(/=) :: Chown -> Chown -> Bool #

Ord Chown Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: Chown -> Chown -> Ordering #

(<) :: Chown -> Chown -> Bool #

(<=) :: Chown -> Chown -> Bool #

(>) :: Chown -> Chown -> Bool #

(>=) :: Chown -> Chown -> Bool #

max :: Chown -> Chown -> Chown #

min :: Chown -> Chown -> Chown #

Show Chown Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> Chown -> ShowS #

show :: Chown -> String #

showList :: [Chown] -> ShowS #

IsString Chown Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fromString :: String -> Chown #

Lift Chown Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Chown -> Q Exp #

data AddArgs Source #

Instances
Eq AddArgs Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: AddArgs -> AddArgs -> Bool #

(/=) :: AddArgs -> AddArgs -> Bool #

Ord AddArgs Source # 
Instance details

Defined in Language.Docker.Syntax

Show AddArgs Source # 
Instance details

Defined in Language.Docker.Syntax

Lift AddArgs Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: AddArgs -> Q Exp #

data Check args Source #

Constructors

Check !(CheckArgs args) 
NoCheck 
Instances
Functor Check Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fmap :: (a -> b) -> Check a -> Check b #

(<$) :: a -> Check b -> Check a #

Eq args => Eq (Check args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Check args -> Check args -> Bool #

(/=) :: Check args -> Check args -> Bool #

Ord args => Ord (Check args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: Check args -> Check args -> Ordering #

(<) :: Check args -> Check args -> Bool #

(<=) :: Check args -> Check args -> Bool #

(>) :: Check args -> Check args -> Bool #

(>=) :: Check args -> Check args -> Bool #

max :: Check args -> Check args -> Check args #

min :: Check args -> Check args -> Check args #

Show args => Show (Check args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> Check args -> ShowS #

show :: Check args -> String #

showList :: [Check args] -> ShowS #

Lift args => Lift (Check args) Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Check args -> Q Exp #

data CheckArgs args Source #

Instances
Functor CheckArgs Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fmap :: (a -> b) -> CheckArgs a -> CheckArgs b #

(<$) :: a -> CheckArgs b -> CheckArgs a #

Eq args => Eq (CheckArgs args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: CheckArgs args -> CheckArgs args -> Bool #

(/=) :: CheckArgs args -> CheckArgs args -> Bool #

Ord args => Ord (CheckArgs args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: CheckArgs args -> CheckArgs args -> Ordering #

(<) :: CheckArgs args -> CheckArgs args -> Bool #

(<=) :: CheckArgs args -> CheckArgs args -> Bool #

(>) :: CheckArgs args -> CheckArgs args -> Bool #

(>=) :: CheckArgs args -> CheckArgs args -> Bool #

max :: CheckArgs args -> CheckArgs args -> CheckArgs args #

min :: CheckArgs args -> CheckArgs args -> CheckArgs args #

Show args => Show (CheckArgs args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> CheckArgs args -> ShowS #

show :: CheckArgs args -> String #

showList :: [CheckArgs args] -> ShowS #

Lift args => Lift (CheckArgs args) Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: CheckArgs args -> Q Exp #

data Image Source #

Constructors

Image 
Instances
Eq Image Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Image -> Image -> Bool #

(/=) :: Image -> Image -> Bool #

Ord Image Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: Image -> Image -> Ordering #

(<) :: Image -> Image -> Bool #

(<=) :: Image -> Image -> Bool #

(>) :: Image -> Image -> Bool #

(>=) :: Image -> Image -> Bool #

max :: Image -> Image -> Image #

min :: Image -> Image -> Image #

Show Image Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> Image -> ShowS #

show :: Image -> String #

showList :: [Image] -> ShowS #

IsString Image Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fromString :: String -> Image #

Lift Image Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Image -> Q Exp #

newtype Registry Source #

Constructors

Registry 

Fields

Instances
Eq Registry Source # 
Instance details

Defined in Language.Docker.Syntax

Ord Registry Source # 
Instance details

Defined in Language.Docker.Syntax

Show Registry Source # 
Instance details

Defined in Language.Docker.Syntax

IsString Registry Source # 
Instance details

Defined in Language.Docker.Syntax

Lift Registry Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Registry -> Q Exp #

newtype Tag Source #

Constructors

Tag 

Fields

Instances
Eq Tag Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Tag -> Tag -> Bool #

(/=) :: Tag -> Tag -> Bool #

Ord Tag Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: Tag -> Tag -> Ordering #

(<) :: Tag -> Tag -> Bool #

(<=) :: Tag -> Tag -> Bool #

(>) :: Tag -> Tag -> Bool #

(>=) :: Tag -> Tag -> Bool #

max :: Tag -> Tag -> Tag #

min :: Tag -> Tag -> Tag #

Show Tag Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> Tag -> ShowS #

show :: Tag -> String #

showList :: [Tag] -> ShowS #

IsString Tag Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fromString :: String -> Tag #

Lift Tag Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Tag -> Q Exp #

newtype Digest Source #

Constructors

Digest 

Fields

Instances
Eq Digest Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Digest -> Digest -> Bool #

(/=) :: Digest -> Digest -> Bool #

Ord Digest Source # 
Instance details

Defined in Language.Docker.Syntax

Show Digest Source # 
Instance details

Defined in Language.Docker.Syntax

IsString Digest Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fromString :: String -> Digest #

Lift Digest Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Digest -> Q Exp #

data Ports Source #

Instances
IsList Ports Source # 
Instance details

Defined in Language.Docker.Syntax

Associated Types

type Item Ports :: Type #

Eq Ports Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Ports -> Ports -> Bool #

(/=) :: Ports -> Ports -> Bool #

Ord Ports Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: Ports -> Ports -> Ordering #

(<) :: Ports -> Ports -> Bool #

(<=) :: Ports -> Ports -> Bool #

(>) :: Ports -> Ports -> Bool #

(>=) :: Ports -> Ports -> Bool #

max :: Ports -> Ports -> Ports #

min :: Ports -> Ports -> Ports #

Show Ports Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> Ports -> ShowS #

show :: Ports -> String #

showList :: [Ports] -> ShowS #

Lift Ports Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Ports -> Q Exp #

type Item Ports Source # 
Instance details

Defined in Language.Docker.Syntax

type Item Ports = Port

data Arguments args Source #

Instances
Functor Arguments Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

fmap :: (a -> b) -> Arguments a -> Arguments b #

(<$) :: a -> Arguments b -> Arguments a #

IsList (Arguments Text) Source # 
Instance details

Defined in Language.Docker.Syntax

Associated Types

type Item (Arguments Text) :: Type #

Eq args => Eq (Arguments args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

(==) :: Arguments args -> Arguments args -> Bool #

(/=) :: Arguments args -> Arguments args -> Bool #

Ord args => Ord (Arguments args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

compare :: Arguments args -> Arguments args -> Ordering #

(<) :: Arguments args -> Arguments args -> Bool #

(<=) :: Arguments args -> Arguments args -> Bool #

(>) :: Arguments args -> Arguments args -> Bool #

(>=) :: Arguments args -> Arguments args -> Bool #

max :: Arguments args -> Arguments args -> Arguments args #

min :: Arguments args -> Arguments args -> Arguments args #

Show args => Show (Arguments args) Source # 
Instance details

Defined in Language.Docker.Syntax

Methods

showsPrec :: Int -> Arguments args -> ShowS #

show :: Arguments args -> String #

showList :: [Arguments args] -> ShowS #

IsString (Arguments Text) Source # 
Instance details

Defined in Language.Docker.Syntax

Lift args => Lift (Arguments args) Source # 
Instance details

Defined in Language.Docker.Syntax.Lift

Methods

lift :: Arguments args -> Q Exp #

Pretty (Arguments Text) Source # 
Instance details

Defined in Language.Docker.PrettyPrint

Methods

pretty :: Arguments Text -> Doc ann #

prettyList :: [Arguments Text] -> Doc ann #

type Item (Arguments Text) Source # 
Instance details

Defined in Language.Docker.Syntax

type Pairs = [(Text, Text)] Source #

Instruction and InstructionPos helpers