{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Language.Docker.PrettyPrint where

import Data.List.NonEmpty as NonEmpty (NonEmpty (..), toList)
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Internal (Doc (Empty))
import Data.Text.Prettyprint.Doc.Render.Text (renderLazy)
import Language.Docker.Syntax
import Prelude hiding ((<>), (>>))

data EscapeAccum
  = EscapeAccum
      { EscapeAccum -> Builder
buffer :: !B.Builder,
        EscapeAccum -> Int
count :: !Int,
        EscapeAccum -> Bool
escaping :: !Bool
      }

instance Pretty (Arguments Text) where
  pretty :: Arguments Text -> Doc ann
pretty = Arguments Text -> Doc ann
forall ann. Arguments Text -> Doc ann
prettyPrintArguments

-- | Pretty print a 'Dockerfile' to a 'Text'
prettyPrint :: Dockerfile -> L.Text
prettyPrint :: Dockerfile -> Text
prettyPrint = SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (SimpleDocStream Any -> Text)
-> (Dockerfile -> SimpleDocStream Any) -> Dockerfile -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
opts (Doc Any -> SimpleDocStream Any)
-> (Dockerfile -> Doc Any) -> Dockerfile -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dockerfile -> Doc Any
forall args ann.
Pretty (Arguments args) =>
[InstructionPos args] -> Doc ann
prettyPrintDockerfile
  where
    opts :: LayoutOptions
opts = PageWidth -> LayoutOptions
LayoutOptions PageWidth
Unbounded

prettyPrintDockerfile :: Pretty (Arguments args) => [InstructionPos args] -> Doc ann
prettyPrintDockerfile :: [InstructionPos args] -> Doc ann
prettyPrintDockerfile instr :: [InstructionPos args]
instr = [InstructionPos args] -> Doc ann
forall args ann.
Pretty (Arguments args) =>
[InstructionPos args] -> Doc ann
doPrint [InstructionPos args]
instr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "\n"
  where
    doPrint :: [InstructionPos args] -> Doc ann
doPrint = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann)
-> ([InstructionPos args] -> [Doc ann])
-> [InstructionPos args]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstructionPos args -> Doc ann)
-> [InstructionPos args] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InstructionPos args -> Doc ann
forall args ann.
Pretty (Arguments args) =>
InstructionPos args -> Doc ann
prettyPrintInstructionPos

-- | Pretty print a 'InstructionPos' to a 'Doc'
prettyPrintInstructionPos :: Pretty (Arguments args) => InstructionPos args -> Doc ann
prettyPrintInstructionPos :: InstructionPos args -> Doc ann
prettyPrintInstructionPos (InstructionPos i :: Instruction args
i _ _) = Instruction args -> Doc ann
forall args ann.
Pretty (Arguments args) =>
Instruction args -> Doc ann
prettyPrintInstruction Instruction args
i

prettyPrintImage :: Image -> Doc ann
prettyPrintImage :: Image -> Doc ann
prettyPrintImage (Image Nothing name :: Text
name) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
name
prettyPrintImage (Image (Just (Registry reg :: Text
reg)) name :: Text
name) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
reg Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "/" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
name

prettyPrintBaseImage :: BaseImage -> Doc ann
prettyPrintBaseImage :: BaseImage -> Doc ann
prettyPrintBaseImage BaseImage {..} = do
  Maybe Text -> Doc ann
forall a ann. Pretty a => Maybe a -> Doc ann
prettyPlatform Maybe Text
platform
  Image -> Doc ann
forall ann. Image -> Doc ann
prettyPrintImage Image
image
  Maybe Tag -> Doc ann
forall ann. Maybe Tag -> Doc ann
prettyTag Maybe Tag
tag
  Maybe Digest -> Doc ann
forall ann. Maybe Digest -> Doc ann
prettyDigest Maybe Digest
digest
  Maybe ImageAlias -> Doc ann
forall ann. Maybe ImageAlias -> Doc ann
prettyAlias Maybe ImageAlias
alias
  where
    >> :: a -> a -> a
(>>) = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
    prettyPlatform :: Maybe a -> Doc ann
prettyPlatform maybePlatform :: Maybe a
maybePlatform =
      case Maybe a
maybePlatform of
        Nothing -> Doc ann
forall a. Monoid a => a
mempty
        Just p :: a
p -> "--platform=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> " "
    prettyTag :: Maybe Tag -> Doc ann
prettyTag maybeTag :: Maybe Tag
maybeTag =
      case Maybe Tag
maybeTag of
        Nothing -> Doc ann
forall a. Monoid a => a
mempty
        Just (Tag p :: Text
p) -> ":" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
p
    prettyAlias :: Maybe ImageAlias -> Doc ann
prettyAlias maybeAlias :: Maybe ImageAlias
maybeAlias =
      case Maybe ImageAlias
maybeAlias of
        Nothing -> Doc ann
forall a. Monoid a => a
mempty
        Just (ImageAlias a :: Text
a) -> " AS " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
a
    prettyDigest :: Maybe Digest -> Doc ann
prettyDigest maybeDigest :: Maybe Digest
maybeDigest =
      case Maybe Digest
maybeDigest of
        Nothing -> Doc ann
forall a. Monoid a => a
mempty
        Just (Digest d :: Text
d) -> "@" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
d

prettyPrintPairs :: Pairs -> Doc ann
prettyPrintPairs :: Pairs -> Doc ann
prettyPrintPairs ps :: Pairs
ps = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall (t :: * -> *) ann. Foldable t => t (Doc ann) -> Doc ann
sepLine ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Doc ann) -> Pairs -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> Doc ann
forall ann. (Text, Text) -> Doc ann
prettyPrintPair Pairs
ps
  where
    sepLine :: t (Doc ann) -> Doc ann
sepLine = (Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\x :: Doc ann
x y :: Doc ann
y -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> " \\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y)

prettyPrintPair :: (Text, Text) -> Doc ann
prettyPrintPair :: (Text, Text) -> Doc ann
prettyPrintPair (k :: Text
k, v :: Text
v) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty '=' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
doubleQoute Text
v

prettyPrintArguments :: Arguments Text -> Doc ann
prettyPrintArguments :: Arguments Text -> Doc ann
prettyPrintArguments (ArgumentsList as :: Text
as) = [Text] -> Doc ann
forall ann. [Text] -> Doc ann
prettyPrintJSON (Text -> [Text]
Text.words Text
as)
prettyPrintArguments (ArgumentsText as :: Text
as) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc ann
forall a ann. (Eq a, IsString a, Pretty a) => a -> Doc ann
helper (Text -> [Text]
Text.words Text
as))
  where
    helper :: a -> Doc ann
helper "&&" = "\\\n &&"
    helper a :: a
a = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
a

prettyPrintJSON :: [Text] -> Doc ann
prettyPrintJSON :: [Text] -> Doc ann
prettyPrintJSON args :: [Text]
args = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc ann
forall ann. Text -> Doc ann
doubleQoute [Text]
args)

doubleQoute :: Text -> Doc ann
doubleQoute :: Text -> Doc ann
doubleQoute w :: Text
w = Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose Doc ann
forall ann. Doc ann
dquote Doc ann
forall ann. Doc ann
dquote (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Text
escapeQuotes Text
w))

escapeQuotes :: Text -> L.Text
escapeQuotes :: Text -> Text
escapeQuotes text :: Text
text =
  case (Char -> EscapeAccum -> EscapeAccum)
-> EscapeAccum -> Text -> EscapeAccum
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr Char -> EscapeAccum -> EscapeAccum
accumulate (Builder -> Int -> Bool -> EscapeAccum
EscapeAccum Builder
forall a. Monoid a => a
mempty 0 Bool
False) Text
text of
    EscapeAccum buffer :: Builder
buffer _ False -> Builder -> Text
B.toLazyText Builder
buffer
    EscapeAccum buffer :: Builder
buffer count :: Int
count True ->
      case Int
count Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 2 of
        0 -> Builder -> Text
B.toLazyText (Char -> Builder
B.singleton '\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
buffer)
        _ -> Builder -> Text
B.toLazyText Builder
buffer
  where
    accumulate :: Char -> EscapeAccum -> EscapeAccum
accumulate '"' EscapeAccum {Builder
buffer :: Builder
$sel:buffer:EscapeAccum :: EscapeAccum -> Builder
buffer, $sel:escaping:EscapeAccum :: EscapeAccum -> Bool
escaping = Bool
False} =
      Builder -> Int -> Bool -> EscapeAccum
EscapeAccum (Char -> Builder
B.singleton '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
buffer) 0 Bool
True
    accumulate '\\' EscapeAccum {Builder
buffer :: Builder
$sel:buffer:EscapeAccum :: EscapeAccum -> Builder
buffer, $sel:escaping:EscapeAccum :: EscapeAccum -> Bool
escaping = Bool
True, Int
count :: Int
$sel:count:EscapeAccum :: EscapeAccum -> Int
count} =
      Builder -> Int -> Bool -> EscapeAccum
EscapeAccum (Char -> Builder
B.singleton '\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
buffer) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Bool
True
    accumulate c :: Char
c EscapeAccum {Builder
buffer :: Builder
$sel:buffer:EscapeAccum :: EscapeAccum -> Builder
buffer, $sel:escaping:EscapeAccum :: EscapeAccum -> Bool
escaping = Bool
True, Int
count :: Int
$sel:count:EscapeAccum :: EscapeAccum -> Int
count}
      | Int
count Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Builder -> Int -> Bool -> EscapeAccum
EscapeAccum (Char -> Builder
B.singleton Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.singleton '\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
buffer) 0 Bool
False
      | Bool
otherwise = Builder -> Int -> Bool -> EscapeAccum
EscapeAccum (Char -> Builder
B.singleton Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
buffer) 0 Bool
False -- It was already escaped
    accumulate c :: Char
c EscapeAccum {Builder
buffer :: Builder
$sel:buffer:EscapeAccum :: EscapeAccum -> Builder
buffer, $sel:escaping:EscapeAccum :: EscapeAccum -> Bool
escaping = Bool
False} =
      Builder -> Int -> Bool -> EscapeAccum
EscapeAccum (Char -> Builder
B.singleton Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
buffer) 0 Bool
False

prettyPrintPort :: Port -> Doc ann
prettyPrintPort :: Port -> Doc ann
prettyPrintPort (PortStr str :: Text
str) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
str
prettyPrintPort (PortRange start :: Int
start stop :: Int
stop TCP) = Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
start Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
stop
prettyPrintPort (PortRange start :: Int
start stop :: Int
stop UDP) = Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
start Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
stop Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "/udp"
prettyPrintPort (Port num :: Int
num TCP) = Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
num Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "/tcp"
prettyPrintPort (Port num :: Int
num UDP) = Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
num Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "/udp"

prettyPrintFileList :: NonEmpty SourcePath -> TargetPath -> Doc ann
prettyPrintFileList :: NonEmpty SourcePath -> TargetPath -> Doc ann
prettyPrintFileList sources :: NonEmpty SourcePath
sources (TargetPath dest :: Text
dest) =
  let ending :: p
ending =
        case (Text -> Text -> Bool
Text.isSuffixOf "/" Text
dest, NonEmpty SourcePath
sources) of
          (True, _) -> "" -- If the target ends with / then no extra ending is needed
          (_, _fst :: SourcePath
_fst :| _snd :: SourcePath
_snd : _) -> "/" -- More than one source means that the target should end in /
          _ -> ""
   in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s | SourcePath s :: Text
s <- NonEmpty SourcePath -> [SourcePath]
forall a. NonEmpty a -> [a]
toList NonEmpty SourcePath
sources] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
dest Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall p. IsString p => p
ending]

prettyPrintChown :: Chown -> Doc ann
prettyPrintChown :: Chown -> Doc ann
prettyPrintChown chown :: Chown
chown =
  case Chown
chown of
    Chown c :: Text
c -> "--chown=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
c
    NoChown -> Doc ann
forall a. Monoid a => a
mempty

prettyPrintCopySource :: CopySource -> Doc ann
prettyPrintCopySource :: CopySource -> Doc ann
prettyPrintCopySource source :: CopySource
source =
  case CopySource
source of
    CopySource c :: Text
c -> "--from=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
c
    NoSource -> Doc ann
forall a. Monoid a => a
mempty

prettyPrintDuration :: Text -> Maybe Duration -> Doc ann
prettyPrintDuration :: Text -> Maybe Duration -> Doc ann
prettyPrintDuration flagName :: Text
flagName = Doc ann -> (Duration -> Doc ann) -> Maybe Duration -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Duration -> Doc ann
forall ann. Duration -> Doc ann
pp
  where
    pp :: Duration -> Doc ann
pp (Duration d :: DiffTime
d) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
flagName Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (DiffTime -> String
forall a. Show a => a -> String
show DiffTime
d)

prettyPrintRetries :: Maybe Retries -> Doc ann
prettyPrintRetries :: Maybe Retries -> Doc ann
prettyPrintRetries = Doc ann -> (Retries -> Doc ann) -> Maybe Retries -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Retries -> Doc ann
forall ann. Retries -> Doc ann
pp
  where
    pp :: Retries -> Doc ann
pp (Retries r :: Int
r) = "--retries=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
r

prettyPrintRunMount :: Maybe RunMount -> Doc ann
prettyPrintRunMount :: Maybe RunMount -> Doc ann
prettyPrintRunMount Nothing = Doc ann
forall a. Monoid a => a
mempty
prettyPrintRunMount (Just mount :: RunMount
mount) = "--mount="
  Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> case RunMount
mount of
    BindMount BindOpts {..} ->
      "type=bind"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TargetPath -> Doc ann
forall ann. TargetPath -> Doc ann
printTarget TargetPath
bTarget
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (SourcePath -> Doc ann) -> Maybe SourcePath -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty SourcePath -> Doc ann
forall ann. SourcePath -> Doc ann
printSource Maybe SourcePath
bSource
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall ann. Text -> Doc ann
printFromImage Maybe Text
bFromImage
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Bool -> Doc ann) -> Maybe Bool -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Bool -> Doc ann
forall p. IsString p => Bool -> p
printReadOnly Maybe Bool
bReadOnly
    CacheMount CacheOpts {..} ->
      "type=cache"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TargetPath -> Doc ann
forall ann. TargetPath -> Doc ann
printTarget TargetPath
cTarget
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
-> (CacheSharing -> Doc ann) -> Maybe CacheSharing -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty CacheSharing -> Doc ann
forall a. (Semigroup a, IsString a) => CacheSharing -> a
printSharing Maybe CacheSharing
cSharing
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall ann. Text -> Doc ann
printId Maybe Text
cCacheId
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall ann. Text -> Doc ann
printFromImage Maybe Text
cFromImage
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (SourcePath -> Doc ann) -> Maybe SourcePath -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty SourcePath -> Doc ann
forall ann. SourcePath -> Doc ann
printSource Maybe SourcePath
cSource
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printMode Maybe Text
cMode
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Integer -> Doc ann) -> Maybe Integer -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printUid Maybe Integer
cUid
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Integer -> Doc ann) -> Maybe Integer -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printGid Maybe Integer
cGid
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Bool -> Doc ann) -> Maybe Bool -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Bool -> Doc ann
forall p. IsString p => Bool -> p
printReadOnly Maybe Bool
cReadOnly
    SshMount SecretOpts {..} ->
      "type=ssh"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (TargetPath -> Doc ann) -> Maybe TargetPath -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty TargetPath -> Doc ann
forall ann. TargetPath -> Doc ann
printTarget Maybe TargetPath
sTarget
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall ann. Text -> Doc ann
printId Maybe Text
sCacheId
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (SourcePath -> Doc ann) -> Maybe SourcePath -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty SourcePath -> Doc ann
forall ann. SourcePath -> Doc ann
printSource Maybe SourcePath
sSource
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printMode Maybe Text
sMode
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Integer -> Doc ann) -> Maybe Integer -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printUid Maybe Integer
sUid
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Integer -> Doc ann) -> Maybe Integer -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printGid Maybe Integer
sGid
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Bool -> Doc ann) -> Maybe Bool -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Bool -> Doc ann
forall p. (IsString p, Monoid p) => Bool -> p
printRequired Maybe Bool
sIsRequired
    SecretMount SecretOpts {..} ->
      "type=secret"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (TargetPath -> Doc ann) -> Maybe TargetPath -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty TargetPath -> Doc ann
forall ann. TargetPath -> Doc ann
printTarget Maybe TargetPath
sTarget
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall ann. Text -> Doc ann
printId Maybe Text
sCacheId
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (SourcePath -> Doc ann) -> Maybe SourcePath -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty SourcePath -> Doc ann
forall ann. SourcePath -> Doc ann
printSource Maybe SourcePath
sSource
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printMode Maybe Text
sMode
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Integer -> Doc ann) -> Maybe Integer -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printUid Maybe Integer
sUid
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Integer -> Doc ann) -> Maybe Integer -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
printGid Maybe Integer
sGid
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Bool -> Doc ann) -> Maybe Bool -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Bool -> Doc ann
forall p. (IsString p, Monoid p) => Bool -> p
printRequired Maybe Bool
sIsRequired
    TmpfsMount TmpOpts {..} -> "type=tmpfs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TargetPath -> Doc ann
forall ann. TargetPath -> Doc ann
printTarget TargetPath
tTarget
  where
    printQuotable :: Text -> Doc ann
printQuotable str :: Text
str
      | (Char -> Bool) -> Text -> Bool
Text.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"') Text
str = Text -> Doc ann
forall ann. Text -> Doc ann
doubleQoute Text
str
      | Bool
otherwise = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
str
    printTarget :: TargetPath -> Doc ann
printTarget (TargetPath t :: Text
t) = ",target=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
printQuotable Text
t
    printSource :: SourcePath -> Doc ann
printSource (SourcePath s :: Text
s) = ",source=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
printQuotable Text
s
    printFromImage :: Text -> Doc ann
printFromImage f :: Text
f = ",from=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
printQuotable Text
f
    printSharing :: CacheSharing -> a
printSharing sharing :: CacheSharing
sharing = ",sharing="
      a -> a -> a
forall a. Semigroup a => a -> a -> a
<> case CacheSharing
sharing of
        Shared -> "shared"
        Private -> "private"
        Locked -> "locked"
    printId :: Text -> Doc ann
printId i :: Text
i = ",id=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
printQuotable Text
i
    printMode :: a -> Doc ann
printMode m :: a
m = ",mode=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
m
    printUid :: a -> Doc ann
printUid uid :: a
uid = ",uid=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
uid
    printGid :: a -> Doc ann
printGid gid :: a
gid = ",gid=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
gid
    printReadOnly :: Bool -> p
printReadOnly True = ",ro"
    printReadOnly False = ",rw"
    printRequired :: Bool -> p
printRequired True = ",required"
    printRequired False = p
forall a. Monoid a => a
mempty

prettyPrintRunNetwork :: Maybe RunNetwork -> Doc ann
prettyPrintRunNetwork :: Maybe RunNetwork -> Doc ann
prettyPrintRunNetwork Nothing = Doc ann
forall a. Monoid a => a
mempty
prettyPrintRunNetwork (Just NetworkHost) = "--network=host"
prettyPrintRunNetwork (Just NetworkNone) = "--network=none"
prettyPrintRunNetwork (Just NetworkDefault) = "--network=default"

prettyPrintRunSecurity :: Maybe RunSecurity -> Doc ann
prettyPrintRunSecurity :: Maybe RunSecurity -> Doc ann
prettyPrintRunSecurity Nothing = Doc ann
forall a. Monoid a => a
mempty
prettyPrintRunSecurity (Just Sandbox) = "--security=sandbox"
prettyPrintRunSecurity (Just Insecure) = "--security=insecure"

prettyPrintInstruction :: Pretty (Arguments args) => Instruction args -> Doc ann
prettyPrintInstruction :: Instruction args -> Doc ann
prettyPrintInstruction i :: Instruction args
i =
  case Instruction args
i of
    Maintainer m :: Text
m -> do
      "MAINTAINER"
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
m
    Arg a :: Text
a Nothing -> do
      "ARG"
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
a
    Arg k :: Text
k (Just v :: Text
v) -> do
      "ARG"
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
v
    Entrypoint e :: Arguments args
e -> do
      "ENTRYPOINT"
      Arguments args -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Arguments args
e
    Stopsignal s :: Text
s -> do
      "STOPSIGNAL"
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s
    Workdir w :: Text
w -> do
      "WORKDIR"
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
w
    Expose (Ports ps :: [Port]
ps) -> do
      "EXPOSE"
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((Port -> Doc ann) -> [Port] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Port -> Doc ann
forall ann. Port -> Doc ann
prettyPrintPort [Port]
ps)
    Volume dir :: Text
dir -> do
      "VOLUME"
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
dir
    Run (RunArgs c :: Arguments args
c RunFlags {Maybe RunMount
$sel:mount:RunFlags :: RunFlags -> Maybe RunMount
mount :: Maybe RunMount
mount, Maybe RunNetwork
$sel:network:RunFlags :: RunFlags -> Maybe RunNetwork
network :: Maybe RunNetwork
network, Maybe RunSecurity
$sel:security:RunFlags :: RunFlags -> Maybe RunSecurity
security :: Maybe RunSecurity
security}) -> do
      "RUN"
      Maybe RunMount -> Doc ann
forall ann. Maybe RunMount -> Doc ann
prettyPrintRunMount Maybe RunMount
mount
      Maybe RunNetwork -> Doc ann
forall ann. Maybe RunNetwork -> Doc ann
prettyPrintRunNetwork Maybe RunNetwork
network
      Maybe RunSecurity -> Doc ann
forall ann. Maybe RunSecurity -> Doc ann
prettyPrintRunSecurity Maybe RunSecurity
security
      Arguments args -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Arguments args
c
    Copy CopyArgs {NonEmpty SourcePath
$sel:sourcePaths:CopyArgs :: CopyArgs -> NonEmpty SourcePath
sourcePaths :: NonEmpty SourcePath
sourcePaths, TargetPath
$sel:targetPath:CopyArgs :: CopyArgs -> TargetPath
targetPath :: TargetPath
targetPath, Chown
$sel:chownFlag:CopyArgs :: CopyArgs -> Chown
chownFlag :: Chown
chownFlag, CopySource
$sel:sourceFlag:CopyArgs :: CopyArgs -> CopySource
sourceFlag :: CopySource
sourceFlag} -> do
      "COPY"
      Chown -> Doc ann
forall ann. Chown -> Doc ann
prettyPrintChown Chown
chownFlag
      CopySource -> Doc ann
forall ann. CopySource -> Doc ann
prettyPrintCopySource CopySource
sourceFlag
      NonEmpty SourcePath -> TargetPath -> Doc ann
forall ann. NonEmpty SourcePath -> TargetPath -> Doc ann
prettyPrintFileList NonEmpty SourcePath
sourcePaths TargetPath
targetPath
    Cmd c :: Arguments args
c -> do
      "CMD"
      Arguments args -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Arguments args
c
    Label l :: Pairs
l -> do
      "LABEL"
      Pairs -> Doc ann
forall ann. Pairs -> Doc ann
prettyPrintPairs Pairs
l
    Env ps :: Pairs
ps -> do
      "ENV"
      Pairs -> Doc ann
forall ann. Pairs -> Doc ann
prettyPrintPairs Pairs
ps
    User u :: Text
u -> do
      "USER"
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
u
    Comment s :: Text
s -> do
      Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty '#'
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s
    OnBuild i' :: Instruction args
i' -> do
      "ONBUILD"
      Instruction args -> Doc ann
forall args ann.
Pretty (Arguments args) =>
Instruction args -> Doc ann
prettyPrintInstruction Instruction args
i'
    From b :: BaseImage
b -> do
      "FROM"
      BaseImage -> Doc ann
forall ann. BaseImage -> Doc ann
prettyPrintBaseImage BaseImage
b
    Add AddArgs {NonEmpty SourcePath
$sel:sourcePaths:AddArgs :: AddArgs -> NonEmpty SourcePath
sourcePaths :: NonEmpty SourcePath
sourcePaths, TargetPath
$sel:targetPath:AddArgs :: AddArgs -> TargetPath
targetPath :: TargetPath
targetPath, Chown
$sel:chownFlag:AddArgs :: AddArgs -> Chown
chownFlag :: Chown
chownFlag} -> do
      "ADD"
      Chown -> Doc ann
forall ann. Chown -> Doc ann
prettyPrintChown Chown
chownFlag
      NonEmpty SourcePath -> TargetPath -> Doc ann
forall ann. NonEmpty SourcePath -> TargetPath -> Doc ann
prettyPrintFileList NonEmpty SourcePath
sourcePaths TargetPath
targetPath
    Shell args :: Arguments args
args -> do
      "SHELL"
      Arguments args -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Arguments args
args
    Healthcheck NoCheck -> "HEALTHCHECK NONE"
    Healthcheck (Check CheckArgs {..}) -> do
      "HEALTHCHECK"
      Text -> Maybe Duration -> Doc ann
forall ann. Text -> Maybe Duration -> Doc ann
prettyPrintDuration "--interval=" Maybe Duration
interval
      Text -> Maybe Duration -> Doc ann
forall ann. Text -> Maybe Duration -> Doc ann
prettyPrintDuration "--timeout=" Maybe Duration
timeout
      Text -> Maybe Duration -> Doc ann
forall ann. Text -> Maybe Duration -> Doc ann
prettyPrintDuration "--start-period=" Maybe Duration
startPeriod
      Maybe Retries -> Doc ann
forall ann. Maybe Retries -> Doc ann
prettyPrintRetries Maybe Retries
retries
      "CMD"
      Arguments args -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Arguments args
checkCommand
  where
    >> :: Doc ann -> Doc ann -> Doc ann
(>>) = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
spaceCat

spaceCat :: Doc ann -> Doc ann -> Doc ann
spaceCat :: Doc ann -> Doc ann -> Doc ann
spaceCat a :: Doc ann
a Empty = Doc ann
a
spaceCat Empty b :: Doc ann
b = Doc ann
b
spaceCat a :: Doc ann
a b :: Doc ann
b = Doc ann
a Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
b