{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Language.Docker.Syntax where

import Data.Default.Class (Default (..))
import Data.List (intercalate, isInfixOf)
import Data.List.NonEmpty (NonEmpty)
import Data.List.Split (endBy)
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time.Clock (DiffTime)
import GHC.Exts (IsList (..))

data Image
  = Image
      { Image -> Maybe Registry
registryName :: !(Maybe Registry),
        Image -> Text
imageName :: !Text
      }
  deriving (Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Eq Image
Eq Image
-> (Image -> Image -> Ordering)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Bool)
-> (Image -> Image -> Image)
-> (Image -> Image -> Image)
-> Ord Image
Image -> Image -> Bool
Image -> Image -> Ordering
Image -> Image -> Image
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Image -> Image -> Image
$cmin :: Image -> Image -> Image
max :: Image -> Image -> Image
$cmax :: Image -> Image -> Image
>= :: Image -> Image -> Bool
$c>= :: Image -> Image -> Bool
> :: Image -> Image -> Bool
$c> :: Image -> Image -> Bool
<= :: Image -> Image -> Bool
$c<= :: Image -> Image -> Bool
< :: Image -> Image -> Bool
$c< :: Image -> Image -> Bool
compare :: Image -> Image -> Ordering
$ccompare :: Image -> Image -> Ordering
$cp1Ord :: Eq Image
Ord)

instance IsString Image where
  fromString :: String -> Image
fromString String
img =
    if String
"/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
img
      then
        let parts :: [String]
parts = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
endBy String
"/" String
img
         in if String
"." String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [String] -> String
forall a. [a] -> a
head [String]
parts
              then
                Maybe Registry -> Text -> Image
Image
                  (Registry -> Maybe Registry
forall a. a -> Maybe a
Just (Text -> Registry
Registry (String -> Text
Text.pack ([String] -> String
forall a. [a] -> a
head [String]
parts))))
                  (String -> Text
Text.pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> Text) -> [String] -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
tail [String]
parts)
              else Maybe Registry -> Text -> Image
Image Maybe Registry
forall a. Maybe a
Nothing (String -> Text
Text.pack String
img)
      else Maybe Registry -> Text -> Image
Image Maybe Registry
forall a. Maybe a
Nothing (String -> Text
Text.pack String
img)

newtype Registry
  = Registry
      { Registry -> Text
unRegistry :: Text
      }
  deriving (Int -> Registry -> ShowS
[Registry] -> ShowS
Registry -> String
(Int -> Registry -> ShowS)
-> (Registry -> String) -> ([Registry] -> ShowS) -> Show Registry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Registry] -> ShowS
$cshowList :: [Registry] -> ShowS
show :: Registry -> String
$cshow :: Registry -> String
showsPrec :: Int -> Registry -> ShowS
$cshowsPrec :: Int -> Registry -> ShowS
Show, Registry -> Registry -> Bool
(Registry -> Registry -> Bool)
-> (Registry -> Registry -> Bool) -> Eq Registry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Registry -> Registry -> Bool
$c/= :: Registry -> Registry -> Bool
== :: Registry -> Registry -> Bool
$c== :: Registry -> Registry -> Bool
Eq, Eq Registry
Eq Registry
-> (Registry -> Registry -> Ordering)
-> (Registry -> Registry -> Bool)
-> (Registry -> Registry -> Bool)
-> (Registry -> Registry -> Bool)
-> (Registry -> Registry -> Bool)
-> (Registry -> Registry -> Registry)
-> (Registry -> Registry -> Registry)
-> Ord Registry
Registry -> Registry -> Bool
Registry -> Registry -> Ordering
Registry -> Registry -> Registry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Registry -> Registry -> Registry
$cmin :: Registry -> Registry -> Registry
max :: Registry -> Registry -> Registry
$cmax :: Registry -> Registry -> Registry
>= :: Registry -> Registry -> Bool
$c>= :: Registry -> Registry -> Bool
> :: Registry -> Registry -> Bool
$c> :: Registry -> Registry -> Bool
<= :: Registry -> Registry -> Bool
$c<= :: Registry -> Registry -> Bool
< :: Registry -> Registry -> Bool
$c< :: Registry -> Registry -> Bool
compare :: Registry -> Registry -> Ordering
$ccompare :: Registry -> Registry -> Ordering
$cp1Ord :: Eq Registry
Ord, String -> Registry
(String -> Registry) -> IsString Registry
forall a. (String -> a) -> IsString a
fromString :: String -> Registry
$cfromString :: String -> Registry
IsString)

newtype Tag
  = Tag
      { Tag -> Text
unTag :: Text
      }
  deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Eq Tag
Eq Tag
-> (Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
$cp1Ord :: Eq Tag
Ord, String -> Tag
(String -> Tag) -> IsString Tag
forall a. (String -> a) -> IsString a
fromString :: String -> Tag
$cfromString :: String -> Tag
IsString)

newtype Digest
  = Digest
      { Digest -> Text
unDigest :: Text
      }
  deriving (Int -> Digest -> ShowS
[Digest] -> ShowS
Digest -> String
(Int -> Digest -> ShowS)
-> (Digest -> String) -> ([Digest] -> ShowS) -> Show Digest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Digest] -> ShowS
$cshowList :: [Digest] -> ShowS
show :: Digest -> String
$cshow :: Digest -> String
showsPrec :: Int -> Digest -> ShowS
$cshowsPrec :: Int -> Digest -> ShowS
Show, Digest -> Digest -> Bool
(Digest -> Digest -> Bool)
-> (Digest -> Digest -> Bool) -> Eq Digest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Digest -> Digest -> Bool
$c/= :: Digest -> Digest -> Bool
== :: Digest -> Digest -> Bool
$c== :: Digest -> Digest -> Bool
Eq, Eq Digest
Eq Digest
-> (Digest -> Digest -> Ordering)
-> (Digest -> Digest -> Bool)
-> (Digest -> Digest -> Bool)
-> (Digest -> Digest -> Bool)
-> (Digest -> Digest -> Bool)
-> (Digest -> Digest -> Digest)
-> (Digest -> Digest -> Digest)
-> Ord Digest
Digest -> Digest -> Bool
Digest -> Digest -> Ordering
Digest -> Digest -> Digest
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Digest -> Digest -> Digest
$cmin :: Digest -> Digest -> Digest
max :: Digest -> Digest -> Digest
$cmax :: Digest -> Digest -> Digest
>= :: Digest -> Digest -> Bool
$c>= :: Digest -> Digest -> Bool
> :: Digest -> Digest -> Bool
$c> :: Digest -> Digest -> Bool
<= :: Digest -> Digest -> Bool
$c<= :: Digest -> Digest -> Bool
< :: Digest -> Digest -> Bool
$c< :: Digest -> Digest -> Bool
compare :: Digest -> Digest -> Ordering
$ccompare :: Digest -> Digest -> Ordering
$cp1Ord :: Eq Digest
Ord, String -> Digest
(String -> Digest) -> IsString Digest
forall a. (String -> a) -> IsString a
fromString :: String -> Digest
$cfromString :: String -> Digest
IsString)

data Protocol
  = TCP
  | UDP
  deriving (Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show, Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq, Eq Protocol
Eq Protocol
-> (Protocol -> Protocol -> Ordering)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Protocol)
-> (Protocol -> Protocol -> Protocol)
-> Ord Protocol
Protocol -> Protocol -> Bool
Protocol -> Protocol -> Ordering
Protocol -> Protocol -> Protocol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Protocol -> Protocol -> Protocol
$cmin :: Protocol -> Protocol -> Protocol
max :: Protocol -> Protocol -> Protocol
$cmax :: Protocol -> Protocol -> Protocol
>= :: Protocol -> Protocol -> Bool
$c>= :: Protocol -> Protocol -> Bool
> :: Protocol -> Protocol -> Bool
$c> :: Protocol -> Protocol -> Bool
<= :: Protocol -> Protocol -> Bool
$c<= :: Protocol -> Protocol -> Bool
< :: Protocol -> Protocol -> Bool
$c< :: Protocol -> Protocol -> Bool
compare :: Protocol -> Protocol -> Ordering
$ccompare :: Protocol -> Protocol -> Ordering
$cp1Ord :: Eq Protocol
Ord)

data Port
  = Port
      !Int
      !Protocol
  | PortStr !Text
  | PortRange
      !Int
      !Int
      !Protocol
  deriving (Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show, Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq Port
Eq Port
-> (Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
$cp1Ord :: Eq Port
Ord)

newtype Ports
  = Ports
      { Ports -> [Port]
unPorts :: [Port]
      }
  deriving (Int -> Ports -> ShowS
[Ports] -> ShowS
Ports -> String
(Int -> Ports -> ShowS)
-> (Ports -> String) -> ([Ports] -> ShowS) -> Show Ports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ports] -> ShowS
$cshowList :: [Ports] -> ShowS
show :: Ports -> String
$cshow :: Ports -> String
showsPrec :: Int -> Ports -> ShowS
$cshowsPrec :: Int -> Ports -> ShowS
Show, Ports -> Ports -> Bool
(Ports -> Ports -> Bool) -> (Ports -> Ports -> Bool) -> Eq Ports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ports -> Ports -> Bool
$c/= :: Ports -> Ports -> Bool
== :: Ports -> Ports -> Bool
$c== :: Ports -> Ports -> Bool
Eq, Eq Ports
Eq Ports
-> (Ports -> Ports -> Ordering)
-> (Ports -> Ports -> Bool)
-> (Ports -> Ports -> Bool)
-> (Ports -> Ports -> Bool)
-> (Ports -> Ports -> Bool)
-> (Ports -> Ports -> Ports)
-> (Ports -> Ports -> Ports)
-> Ord Ports
Ports -> Ports -> Bool
Ports -> Ports -> Ordering
Ports -> Ports -> Ports
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ports -> Ports -> Ports
$cmin :: Ports -> Ports -> Ports
max :: Ports -> Ports -> Ports
$cmax :: Ports -> Ports -> Ports
>= :: Ports -> Ports -> Bool
$c>= :: Ports -> Ports -> Bool
> :: Ports -> Ports -> Bool
$c> :: Ports -> Ports -> Bool
<= :: Ports -> Ports -> Bool
$c<= :: Ports -> Ports -> Bool
< :: Ports -> Ports -> Bool
$c< :: Ports -> Ports -> Bool
compare :: Ports -> Ports -> Ordering
$ccompare :: Ports -> Ports -> Ordering
$cp1Ord :: Eq Ports
Ord)

instance IsList Ports where
  type Item Ports = Port
  fromList :: [Item Ports] -> Ports
fromList = [Item Ports] -> Ports
[Port] -> Ports
Ports
  toList :: Ports -> [Item Ports]
toList (Ports [Port]
ps) = [Item Ports]
[Port]
ps

type Directory = Text

type Platform = Text

newtype ImageAlias
  = ImageAlias
      { ImageAlias -> Text
unImageAlias :: Text
      }
  deriving (Int -> ImageAlias -> ShowS
[ImageAlias] -> ShowS
ImageAlias -> String
(Int -> ImageAlias -> ShowS)
-> (ImageAlias -> String)
-> ([ImageAlias] -> ShowS)
-> Show ImageAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageAlias] -> ShowS
$cshowList :: [ImageAlias] -> ShowS
show :: ImageAlias -> String
$cshow :: ImageAlias -> String
showsPrec :: Int -> ImageAlias -> ShowS
$cshowsPrec :: Int -> ImageAlias -> ShowS
Show, ImageAlias -> ImageAlias -> Bool
(ImageAlias -> ImageAlias -> Bool)
-> (ImageAlias -> ImageAlias -> Bool) -> Eq ImageAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageAlias -> ImageAlias -> Bool
$c/= :: ImageAlias -> ImageAlias -> Bool
== :: ImageAlias -> ImageAlias -> Bool
$c== :: ImageAlias -> ImageAlias -> Bool
Eq, Eq ImageAlias
Eq ImageAlias
-> (ImageAlias -> ImageAlias -> Ordering)
-> (ImageAlias -> ImageAlias -> Bool)
-> (ImageAlias -> ImageAlias -> Bool)
-> (ImageAlias -> ImageAlias -> Bool)
-> (ImageAlias -> ImageAlias -> Bool)
-> (ImageAlias -> ImageAlias -> ImageAlias)
-> (ImageAlias -> ImageAlias -> ImageAlias)
-> Ord ImageAlias
ImageAlias -> ImageAlias -> Bool
ImageAlias -> ImageAlias -> Ordering
ImageAlias -> ImageAlias -> ImageAlias
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ImageAlias -> ImageAlias -> ImageAlias
$cmin :: ImageAlias -> ImageAlias -> ImageAlias
max :: ImageAlias -> ImageAlias -> ImageAlias
$cmax :: ImageAlias -> ImageAlias -> ImageAlias
>= :: ImageAlias -> ImageAlias -> Bool
$c>= :: ImageAlias -> ImageAlias -> Bool
> :: ImageAlias -> ImageAlias -> Bool
$c> :: ImageAlias -> ImageAlias -> Bool
<= :: ImageAlias -> ImageAlias -> Bool
$c<= :: ImageAlias -> ImageAlias -> Bool
< :: ImageAlias -> ImageAlias -> Bool
$c< :: ImageAlias -> ImageAlias -> Bool
compare :: ImageAlias -> ImageAlias -> Ordering
$ccompare :: ImageAlias -> ImageAlias -> Ordering
$cp1Ord :: Eq ImageAlias
Ord, String -> ImageAlias
(String -> ImageAlias) -> IsString ImageAlias
forall a. (String -> a) -> IsString a
fromString :: String -> ImageAlias
$cfromString :: String -> ImageAlias
IsString)

data BaseImage
  = BaseImage
      { BaseImage -> Image
image :: !Image,
        BaseImage -> Maybe Tag
tag :: !(Maybe Tag),
        BaseImage -> Maybe Digest
digest :: !(Maybe Digest),
        BaseImage -> Maybe ImageAlias
alias :: !(Maybe ImageAlias),
        BaseImage -> Maybe Text
platform :: !(Maybe Platform)
      }
  deriving (BaseImage -> BaseImage -> Bool
(BaseImage -> BaseImage -> Bool)
-> (BaseImage -> BaseImage -> Bool) -> Eq BaseImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseImage -> BaseImage -> Bool
$c/= :: BaseImage -> BaseImage -> Bool
== :: BaseImage -> BaseImage -> Bool
$c== :: BaseImage -> BaseImage -> Bool
Eq, Eq BaseImage
Eq BaseImage
-> (BaseImage -> BaseImage -> Ordering)
-> (BaseImage -> BaseImage -> Bool)
-> (BaseImage -> BaseImage -> Bool)
-> (BaseImage -> BaseImage -> Bool)
-> (BaseImage -> BaseImage -> Bool)
-> (BaseImage -> BaseImage -> BaseImage)
-> (BaseImage -> BaseImage -> BaseImage)
-> Ord BaseImage
BaseImage -> BaseImage -> Bool
BaseImage -> BaseImage -> Ordering
BaseImage -> BaseImage -> BaseImage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BaseImage -> BaseImage -> BaseImage
$cmin :: BaseImage -> BaseImage -> BaseImage
max :: BaseImage -> BaseImage -> BaseImage
$cmax :: BaseImage -> BaseImage -> BaseImage
>= :: BaseImage -> BaseImage -> Bool
$c>= :: BaseImage -> BaseImage -> Bool
> :: BaseImage -> BaseImage -> Bool
$c> :: BaseImage -> BaseImage -> Bool
<= :: BaseImage -> BaseImage -> Bool
$c<= :: BaseImage -> BaseImage -> Bool
< :: BaseImage -> BaseImage -> Bool
$c< :: BaseImage -> BaseImage -> Bool
compare :: BaseImage -> BaseImage -> Ordering
$ccompare :: BaseImage -> BaseImage -> Ordering
$cp1Ord :: Eq BaseImage
Ord, Int -> BaseImage -> ShowS
[BaseImage] -> ShowS
BaseImage -> String
(Int -> BaseImage -> ShowS)
-> (BaseImage -> String)
-> ([BaseImage] -> ShowS)
-> Show BaseImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseImage] -> ShowS
$cshowList :: [BaseImage] -> ShowS
show :: BaseImage -> String
$cshow :: BaseImage -> String
showsPrec :: Int -> BaseImage -> ShowS
$cshowsPrec :: Int -> BaseImage -> ShowS
Show)

-- | Type of the Dockerfile AST
type Dockerfile = [InstructionPos Text]

newtype SourcePath
  = SourcePath
      { SourcePath -> Text
unSourcePath :: Text
      }
  deriving (Int -> SourcePath -> ShowS
[SourcePath] -> ShowS
SourcePath -> String
(Int -> SourcePath -> ShowS)
-> (SourcePath -> String)
-> ([SourcePath] -> ShowS)
-> Show SourcePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourcePath] -> ShowS
$cshowList :: [SourcePath] -> ShowS
show :: SourcePath -> String
$cshow :: SourcePath -> String
showsPrec :: Int -> SourcePath -> ShowS
$cshowsPrec :: Int -> SourcePath -> ShowS
Show, SourcePath -> SourcePath -> Bool
(SourcePath -> SourcePath -> Bool)
-> (SourcePath -> SourcePath -> Bool) -> Eq SourcePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePath -> SourcePath -> Bool
$c/= :: SourcePath -> SourcePath -> Bool
== :: SourcePath -> SourcePath -> Bool
$c== :: SourcePath -> SourcePath -> Bool
Eq, Eq SourcePath
Eq SourcePath
-> (SourcePath -> SourcePath -> Ordering)
-> (SourcePath -> SourcePath -> Bool)
-> (SourcePath -> SourcePath -> Bool)
-> (SourcePath -> SourcePath -> Bool)
-> (SourcePath -> SourcePath -> Bool)
-> (SourcePath -> SourcePath -> SourcePath)
-> (SourcePath -> SourcePath -> SourcePath)
-> Ord SourcePath
SourcePath -> SourcePath -> Bool
SourcePath -> SourcePath -> Ordering
SourcePath -> SourcePath -> SourcePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourcePath -> SourcePath -> SourcePath
$cmin :: SourcePath -> SourcePath -> SourcePath
max :: SourcePath -> SourcePath -> SourcePath
$cmax :: SourcePath -> SourcePath -> SourcePath
>= :: SourcePath -> SourcePath -> Bool
$c>= :: SourcePath -> SourcePath -> Bool
> :: SourcePath -> SourcePath -> Bool
$c> :: SourcePath -> SourcePath -> Bool
<= :: SourcePath -> SourcePath -> Bool
$c<= :: SourcePath -> SourcePath -> Bool
< :: SourcePath -> SourcePath -> Bool
$c< :: SourcePath -> SourcePath -> Bool
compare :: SourcePath -> SourcePath -> Ordering
$ccompare :: SourcePath -> SourcePath -> Ordering
$cp1Ord :: Eq SourcePath
Ord, String -> SourcePath
(String -> SourcePath) -> IsString SourcePath
forall a. (String -> a) -> IsString a
fromString :: String -> SourcePath
$cfromString :: String -> SourcePath
IsString)

newtype TargetPath
  = TargetPath
      { TargetPath -> Text
unTargetPath :: Text
      }
  deriving (Int -> TargetPath -> ShowS
[TargetPath] -> ShowS
TargetPath -> String
(Int -> TargetPath -> ShowS)
-> (TargetPath -> String)
-> ([TargetPath] -> ShowS)
-> Show TargetPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetPath] -> ShowS
$cshowList :: [TargetPath] -> ShowS
show :: TargetPath -> String
$cshow :: TargetPath -> String
showsPrec :: Int -> TargetPath -> ShowS
$cshowsPrec :: Int -> TargetPath -> ShowS
Show, TargetPath -> TargetPath -> Bool
(TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool) -> Eq TargetPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetPath -> TargetPath -> Bool
$c/= :: TargetPath -> TargetPath -> Bool
== :: TargetPath -> TargetPath -> Bool
$c== :: TargetPath -> TargetPath -> Bool
Eq, Eq TargetPath
Eq TargetPath
-> (TargetPath -> TargetPath -> Ordering)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> TargetPath)
-> (TargetPath -> TargetPath -> TargetPath)
-> Ord TargetPath
TargetPath -> TargetPath -> Bool
TargetPath -> TargetPath -> Ordering
TargetPath -> TargetPath -> TargetPath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TargetPath -> TargetPath -> TargetPath
$cmin :: TargetPath -> TargetPath -> TargetPath
max :: TargetPath -> TargetPath -> TargetPath
$cmax :: TargetPath -> TargetPath -> TargetPath
>= :: TargetPath -> TargetPath -> Bool
$c>= :: TargetPath -> TargetPath -> Bool
> :: TargetPath -> TargetPath -> Bool
$c> :: TargetPath -> TargetPath -> Bool
<= :: TargetPath -> TargetPath -> Bool
$c<= :: TargetPath -> TargetPath -> Bool
< :: TargetPath -> TargetPath -> Bool
$c< :: TargetPath -> TargetPath -> Bool
compare :: TargetPath -> TargetPath -> Ordering
$ccompare :: TargetPath -> TargetPath -> Ordering
$cp1Ord :: Eq TargetPath
Ord, String -> TargetPath
(String -> TargetPath) -> IsString TargetPath
forall a. (String -> a) -> IsString a
fromString :: String -> TargetPath
$cfromString :: String -> TargetPath
IsString)

data Chown
  = Chown !Text
  | NoChown
  deriving (Int -> Chown -> ShowS
[Chown] -> ShowS
Chown -> String
(Int -> Chown -> ShowS)
-> (Chown -> String) -> ([Chown] -> ShowS) -> Show Chown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chown] -> ShowS
$cshowList :: [Chown] -> ShowS
show :: Chown -> String
$cshow :: Chown -> String
showsPrec :: Int -> Chown -> ShowS
$cshowsPrec :: Int -> Chown -> ShowS
Show, Chown -> Chown -> Bool
(Chown -> Chown -> Bool) -> (Chown -> Chown -> Bool) -> Eq Chown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chown -> Chown -> Bool
$c/= :: Chown -> Chown -> Bool
== :: Chown -> Chown -> Bool
$c== :: Chown -> Chown -> Bool
Eq, Eq Chown
Eq Chown
-> (Chown -> Chown -> Ordering)
-> (Chown -> Chown -> Bool)
-> (Chown -> Chown -> Bool)
-> (Chown -> Chown -> Bool)
-> (Chown -> Chown -> Bool)
-> (Chown -> Chown -> Chown)
-> (Chown -> Chown -> Chown)
-> Ord Chown
Chown -> Chown -> Bool
Chown -> Chown -> Ordering
Chown -> Chown -> Chown
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Chown -> Chown -> Chown
$cmin :: Chown -> Chown -> Chown
max :: Chown -> Chown -> Chown
$cmax :: Chown -> Chown -> Chown
>= :: Chown -> Chown -> Bool
$c>= :: Chown -> Chown -> Bool
> :: Chown -> Chown -> Bool
$c> :: Chown -> Chown -> Bool
<= :: Chown -> Chown -> Bool
$c<= :: Chown -> Chown -> Bool
< :: Chown -> Chown -> Bool
$c< :: Chown -> Chown -> Bool
compare :: Chown -> Chown -> Ordering
$ccompare :: Chown -> Chown -> Ordering
$cp1Ord :: Eq Chown
Ord)

instance IsString Chown where
  fromString :: String -> Chown
fromString String
ch =
    case String
ch of
      String
"" -> Chown
NoChown
      String
_ -> Text -> Chown
Chown (String -> Text
Text.pack String
ch)

data CopySource
  = CopySource !Text
  | NoSource
  deriving (Int -> CopySource -> ShowS
[CopySource] -> ShowS
CopySource -> String
(Int -> CopySource -> ShowS)
-> (CopySource -> String)
-> ([CopySource] -> ShowS)
-> Show CopySource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopySource] -> ShowS
$cshowList :: [CopySource] -> ShowS
show :: CopySource -> String
$cshow :: CopySource -> String
showsPrec :: Int -> CopySource -> ShowS
$cshowsPrec :: Int -> CopySource -> ShowS
Show, CopySource -> CopySource -> Bool
(CopySource -> CopySource -> Bool)
-> (CopySource -> CopySource -> Bool) -> Eq CopySource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopySource -> CopySource -> Bool
$c/= :: CopySource -> CopySource -> Bool
== :: CopySource -> CopySource -> Bool
$c== :: CopySource -> CopySource -> Bool
Eq, Eq CopySource
Eq CopySource
-> (CopySource -> CopySource -> Ordering)
-> (CopySource -> CopySource -> Bool)
-> (CopySource -> CopySource -> Bool)
-> (CopySource -> CopySource -> Bool)
-> (CopySource -> CopySource -> Bool)
-> (CopySource -> CopySource -> CopySource)
-> (CopySource -> CopySource -> CopySource)
-> Ord CopySource
CopySource -> CopySource -> Bool
CopySource -> CopySource -> Ordering
CopySource -> CopySource -> CopySource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CopySource -> CopySource -> CopySource
$cmin :: CopySource -> CopySource -> CopySource
max :: CopySource -> CopySource -> CopySource
$cmax :: CopySource -> CopySource -> CopySource
>= :: CopySource -> CopySource -> Bool
$c>= :: CopySource -> CopySource -> Bool
> :: CopySource -> CopySource -> Bool
$c> :: CopySource -> CopySource -> Bool
<= :: CopySource -> CopySource -> Bool
$c<= :: CopySource -> CopySource -> Bool
< :: CopySource -> CopySource -> Bool
$c< :: CopySource -> CopySource -> Bool
compare :: CopySource -> CopySource -> Ordering
$ccompare :: CopySource -> CopySource -> Ordering
$cp1Ord :: Eq CopySource
Ord)

instance IsString CopySource where
  fromString :: String -> CopySource
fromString String
src =
    case String
src of
      String
"" -> CopySource
NoSource
      String
_ -> Text -> CopySource
CopySource (String -> Text
Text.pack String
src)

newtype Duration
  = Duration
      { Duration -> DiffTime
durationTime :: DiffTime
      }
  deriving (Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show, Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq, Eq Duration
Eq Duration
-> (Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmax :: Duration -> Duration -> Duration
>= :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c< :: Duration -> Duration -> Bool
compare :: Duration -> Duration -> Ordering
$ccompare :: Duration -> Duration -> Ordering
$cp1Ord :: Eq Duration
Ord, Integer -> Duration
Duration -> Duration
Duration -> Duration -> Duration
(Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Integer -> Duration)
-> Num Duration
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Duration
$cfromInteger :: Integer -> Duration
signum :: Duration -> Duration
$csignum :: Duration -> Duration
abs :: Duration -> Duration
$cabs :: Duration -> Duration
negate :: Duration -> Duration
$cnegate :: Duration -> Duration
* :: Duration -> Duration -> Duration
$c* :: Duration -> Duration -> Duration
- :: Duration -> Duration -> Duration
$c- :: Duration -> Duration -> Duration
+ :: Duration -> Duration -> Duration
$c+ :: Duration -> Duration -> Duration
Num)

newtype Retries
  = Retries
      { Retries -> Int
times :: Int
      }
  deriving (Int -> Retries -> ShowS
[Retries] -> ShowS
Retries -> String
(Int -> Retries -> ShowS)
-> (Retries -> String) -> ([Retries] -> ShowS) -> Show Retries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Retries] -> ShowS
$cshowList :: [Retries] -> ShowS
show :: Retries -> String
$cshow :: Retries -> String
showsPrec :: Int -> Retries -> ShowS
$cshowsPrec :: Int -> Retries -> ShowS
Show, Retries -> Retries -> Bool
(Retries -> Retries -> Bool)
-> (Retries -> Retries -> Bool) -> Eq Retries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Retries -> Retries -> Bool
$c/= :: Retries -> Retries -> Bool
== :: Retries -> Retries -> Bool
$c== :: Retries -> Retries -> Bool
Eq, Eq Retries
Eq Retries
-> (Retries -> Retries -> Ordering)
-> (Retries -> Retries -> Bool)
-> (Retries -> Retries -> Bool)
-> (Retries -> Retries -> Bool)
-> (Retries -> Retries -> Bool)
-> (Retries -> Retries -> Retries)
-> (Retries -> Retries -> Retries)
-> Ord Retries
Retries -> Retries -> Bool
Retries -> Retries -> Ordering
Retries -> Retries -> Retries
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Retries -> Retries -> Retries
$cmin :: Retries -> Retries -> Retries
max :: Retries -> Retries -> Retries
$cmax :: Retries -> Retries -> Retries
>= :: Retries -> Retries -> Bool
$c>= :: Retries -> Retries -> Bool
> :: Retries -> Retries -> Bool
$c> :: Retries -> Retries -> Bool
<= :: Retries -> Retries -> Bool
$c<= :: Retries -> Retries -> Bool
< :: Retries -> Retries -> Bool
$c< :: Retries -> Retries -> Bool
compare :: Retries -> Retries -> Ordering
$ccompare :: Retries -> Retries -> Ordering
$cp1Ord :: Eq Retries
Ord, Integer -> Retries
Retries -> Retries
Retries -> Retries -> Retries
(Retries -> Retries -> Retries)
-> (Retries -> Retries -> Retries)
-> (Retries -> Retries -> Retries)
-> (Retries -> Retries)
-> (Retries -> Retries)
-> (Retries -> Retries)
-> (Integer -> Retries)
-> Num Retries
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Retries
$cfromInteger :: Integer -> Retries
signum :: Retries -> Retries
$csignum :: Retries -> Retries
abs :: Retries -> Retries
$cabs :: Retries -> Retries
negate :: Retries -> Retries
$cnegate :: Retries -> Retries
* :: Retries -> Retries -> Retries
$c* :: Retries -> Retries -> Retries
- :: Retries -> Retries -> Retries
$c- :: Retries -> Retries -> Retries
+ :: Retries -> Retries -> Retries
$c+ :: Retries -> Retries -> Retries
Num)

data CopyArgs
  = CopyArgs
      { CopyArgs -> NonEmpty SourcePath
sourcePaths :: NonEmpty SourcePath,
        CopyArgs -> TargetPath
targetPath :: !TargetPath,
        CopyArgs -> Chown
chownFlag :: !Chown,
        CopyArgs -> CopySource
sourceFlag :: !CopySource
      }
  deriving (Int -> CopyArgs -> ShowS
[CopyArgs] -> ShowS
CopyArgs -> String
(Int -> CopyArgs -> ShowS)
-> (CopyArgs -> String) -> ([CopyArgs] -> ShowS) -> Show CopyArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyArgs] -> ShowS
$cshowList :: [CopyArgs] -> ShowS
show :: CopyArgs -> String
$cshow :: CopyArgs -> String
showsPrec :: Int -> CopyArgs -> ShowS
$cshowsPrec :: Int -> CopyArgs -> ShowS
Show, CopyArgs -> CopyArgs -> Bool
(CopyArgs -> CopyArgs -> Bool)
-> (CopyArgs -> CopyArgs -> Bool) -> Eq CopyArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyArgs -> CopyArgs -> Bool
$c/= :: CopyArgs -> CopyArgs -> Bool
== :: CopyArgs -> CopyArgs -> Bool
$c== :: CopyArgs -> CopyArgs -> Bool
Eq, Eq CopyArgs
Eq CopyArgs
-> (CopyArgs -> CopyArgs -> Ordering)
-> (CopyArgs -> CopyArgs -> Bool)
-> (CopyArgs -> CopyArgs -> Bool)
-> (CopyArgs -> CopyArgs -> Bool)
-> (CopyArgs -> CopyArgs -> Bool)
-> (CopyArgs -> CopyArgs -> CopyArgs)
-> (CopyArgs -> CopyArgs -> CopyArgs)
-> Ord CopyArgs
CopyArgs -> CopyArgs -> Bool
CopyArgs -> CopyArgs -> Ordering
CopyArgs -> CopyArgs -> CopyArgs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CopyArgs -> CopyArgs -> CopyArgs
$cmin :: CopyArgs -> CopyArgs -> CopyArgs
max :: CopyArgs -> CopyArgs -> CopyArgs
$cmax :: CopyArgs -> CopyArgs -> CopyArgs
>= :: CopyArgs -> CopyArgs -> Bool
$c>= :: CopyArgs -> CopyArgs -> Bool
> :: CopyArgs -> CopyArgs -> Bool
$c> :: CopyArgs -> CopyArgs -> Bool
<= :: CopyArgs -> CopyArgs -> Bool
$c<= :: CopyArgs -> CopyArgs -> Bool
< :: CopyArgs -> CopyArgs -> Bool
$c< :: CopyArgs -> CopyArgs -> Bool
compare :: CopyArgs -> CopyArgs -> Ordering
$ccompare :: CopyArgs -> CopyArgs -> Ordering
$cp1Ord :: Eq CopyArgs
Ord)

data AddArgs
  = AddArgs
      { AddArgs -> NonEmpty SourcePath
sourcePaths :: NonEmpty SourcePath,
        AddArgs -> TargetPath
targetPath :: !TargetPath,
        AddArgs -> Chown
chownFlag :: !Chown
      }
  deriving (Int -> AddArgs -> ShowS
[AddArgs] -> ShowS
AddArgs -> String
(Int -> AddArgs -> ShowS)
-> (AddArgs -> String) -> ([AddArgs] -> ShowS) -> Show AddArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddArgs] -> ShowS
$cshowList :: [AddArgs] -> ShowS
show :: AddArgs -> String
$cshow :: AddArgs -> String
showsPrec :: Int -> AddArgs -> ShowS
$cshowsPrec :: Int -> AddArgs -> ShowS
Show, AddArgs -> AddArgs -> Bool
(AddArgs -> AddArgs -> Bool)
-> (AddArgs -> AddArgs -> Bool) -> Eq AddArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddArgs -> AddArgs -> Bool
$c/= :: AddArgs -> AddArgs -> Bool
== :: AddArgs -> AddArgs -> Bool
$c== :: AddArgs -> AddArgs -> Bool
Eq, Eq AddArgs
Eq AddArgs
-> (AddArgs -> AddArgs -> Ordering)
-> (AddArgs -> AddArgs -> Bool)
-> (AddArgs -> AddArgs -> Bool)
-> (AddArgs -> AddArgs -> Bool)
-> (AddArgs -> AddArgs -> Bool)
-> (AddArgs -> AddArgs -> AddArgs)
-> (AddArgs -> AddArgs -> AddArgs)
-> Ord AddArgs
AddArgs -> AddArgs -> Bool
AddArgs -> AddArgs -> Ordering
AddArgs -> AddArgs -> AddArgs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AddArgs -> AddArgs -> AddArgs
$cmin :: AddArgs -> AddArgs -> AddArgs
max :: AddArgs -> AddArgs -> AddArgs
$cmax :: AddArgs -> AddArgs -> AddArgs
>= :: AddArgs -> AddArgs -> Bool
$c>= :: AddArgs -> AddArgs -> Bool
> :: AddArgs -> AddArgs -> Bool
$c> :: AddArgs -> AddArgs -> Bool
<= :: AddArgs -> AddArgs -> Bool
$c<= :: AddArgs -> AddArgs -> Bool
< :: AddArgs -> AddArgs -> Bool
$c< :: AddArgs -> AddArgs -> Bool
compare :: AddArgs -> AddArgs -> Ordering
$ccompare :: AddArgs -> AddArgs -> Ordering
$cp1Ord :: Eq AddArgs
Ord)

data Check args
  = Check !(CheckArgs args)
  | NoCheck
  deriving (Int -> Check args -> ShowS
[Check args] -> ShowS
Check args -> String
(Int -> Check args -> ShowS)
-> (Check args -> String)
-> ([Check args] -> ShowS)
-> Show (Check args)
forall args. Show args => Int -> Check args -> ShowS
forall args. Show args => [Check args] -> ShowS
forall args. Show args => Check args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Check args] -> ShowS
$cshowList :: forall args. Show args => [Check args] -> ShowS
show :: Check args -> String
$cshow :: forall args. Show args => Check args -> String
showsPrec :: Int -> Check args -> ShowS
$cshowsPrec :: forall args. Show args => Int -> Check args -> ShowS
Show, Check args -> Check args -> Bool
(Check args -> Check args -> Bool)
-> (Check args -> Check args -> Bool) -> Eq (Check args)
forall args. Eq args => Check args -> Check args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Check args -> Check args -> Bool
$c/= :: forall args. Eq args => Check args -> Check args -> Bool
== :: Check args -> Check args -> Bool
$c== :: forall args. Eq args => Check args -> Check args -> Bool
Eq, Eq (Check args)
Eq (Check args)
-> (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)
-> (Check args -> Check args -> Check args)
-> (Check args -> Check args -> Check args)
-> Ord (Check args)
Check args -> Check args -> Bool
Check args -> Check args -> Ordering
Check args -> Check args -> Check args
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall args. Ord args => Eq (Check args)
forall args. Ord args => Check args -> Check args -> Bool
forall args. Ord args => Check args -> Check args -> Ordering
forall args. Ord args => Check args -> Check args -> Check args
min :: Check args -> Check args -> Check args
$cmin :: forall args. Ord args => Check args -> Check args -> Check args
max :: Check args -> Check args -> Check args
$cmax :: forall args. Ord args => Check args -> Check args -> Check args
>= :: Check args -> Check args -> Bool
$c>= :: forall args. Ord args => Check args -> Check args -> Bool
> :: Check args -> Check args -> Bool
$c> :: forall args. Ord args => Check args -> Check args -> Bool
<= :: Check args -> Check args -> Bool
$c<= :: forall args. Ord args => Check args -> Check args -> Bool
< :: Check args -> Check args -> Bool
$c< :: forall args. Ord args => Check args -> Check args -> Bool
compare :: Check args -> Check args -> Ordering
$ccompare :: forall args. Ord args => Check args -> Check args -> Ordering
$cp1Ord :: forall args. Ord args => Eq (Check args)
Ord, a -> Check b -> Check a
(a -> b) -> Check a -> Check b
(forall a b. (a -> b) -> Check a -> Check b)
-> (forall a b. a -> Check b -> Check a) -> Functor Check
forall a b. a -> Check b -> Check a
forall a b. (a -> b) -> Check a -> Check b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Check b -> Check a
$c<$ :: forall a b. a -> Check b -> Check a
fmap :: (a -> b) -> Check a -> Check b
$cfmap :: forall a b. (a -> b) -> Check a -> Check b
Functor)

data Arguments args
  = ArgumentsText args
  | ArgumentsList args
  deriving (Int -> Arguments args -> ShowS
[Arguments args] -> ShowS
Arguments args -> String
(Int -> Arguments args -> ShowS)
-> (Arguments args -> String)
-> ([Arguments args] -> ShowS)
-> Show (Arguments args)
forall args. Show args => Int -> Arguments args -> ShowS
forall args. Show args => [Arguments args] -> ShowS
forall args. Show args => Arguments args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arguments args] -> ShowS
$cshowList :: forall args. Show args => [Arguments args] -> ShowS
show :: Arguments args -> String
$cshow :: forall args. Show args => Arguments args -> String
showsPrec :: Int -> Arguments args -> ShowS
$cshowsPrec :: forall args. Show args => Int -> Arguments args -> ShowS
Show, Arguments args -> Arguments args -> Bool
(Arguments args -> Arguments args -> Bool)
-> (Arguments args -> Arguments args -> Bool)
-> Eq (Arguments args)
forall args. Eq args => Arguments args -> Arguments args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arguments args -> Arguments args -> Bool
$c/= :: forall args. Eq args => Arguments args -> Arguments args -> Bool
== :: Arguments args -> Arguments args -> Bool
$c== :: forall args. Eq args => Arguments args -> Arguments args -> Bool
Eq, Eq (Arguments args)
Eq (Arguments args)
-> (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)
-> (Arguments args -> Arguments args -> Arguments args)
-> (Arguments args -> Arguments args -> Arguments args)
-> Ord (Arguments args)
Arguments args -> Arguments args -> Bool
Arguments args -> Arguments args -> Ordering
Arguments args -> Arguments args -> Arguments args
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall args. Ord args => Eq (Arguments args)
forall args. Ord args => Arguments args -> Arguments args -> Bool
forall args.
Ord args =>
Arguments args -> Arguments args -> Ordering
forall args.
Ord args =>
Arguments args -> Arguments args -> Arguments args
min :: Arguments args -> Arguments args -> Arguments args
$cmin :: forall args.
Ord args =>
Arguments args -> Arguments args -> Arguments args
max :: Arguments args -> Arguments args -> Arguments args
$cmax :: forall args.
Ord args =>
Arguments args -> Arguments args -> Arguments args
>= :: Arguments args -> Arguments args -> Bool
$c>= :: forall args. Ord args => Arguments args -> Arguments args -> Bool
> :: Arguments args -> Arguments args -> Bool
$c> :: forall args. Ord args => Arguments args -> Arguments args -> Bool
<= :: Arguments args -> Arguments args -> Bool
$c<= :: forall args. Ord args => Arguments args -> Arguments args -> Bool
< :: Arguments args -> Arguments args -> Bool
$c< :: forall args. Ord args => Arguments args -> Arguments args -> Bool
compare :: Arguments args -> Arguments args -> Ordering
$ccompare :: forall args.
Ord args =>
Arguments args -> Arguments args -> Ordering
$cp1Ord :: forall args. Ord args => Eq (Arguments args)
Ord, a -> Arguments b -> Arguments a
(a -> b) -> Arguments a -> Arguments b
(forall a b. (a -> b) -> Arguments a -> Arguments b)
-> (forall a b. a -> Arguments b -> Arguments a)
-> Functor Arguments
forall a b. a -> Arguments b -> Arguments a
forall a b. (a -> b) -> Arguments a -> Arguments b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Arguments b -> Arguments a
$c<$ :: forall a b. a -> Arguments b -> Arguments a
fmap :: (a -> b) -> Arguments a -> Arguments b
$cfmap :: forall a b. (a -> b) -> Arguments a -> Arguments b
Functor)

instance IsString (Arguments Text) where
  fromString :: String -> Arguments Text
fromString = Text -> Arguments Text
forall args. args -> Arguments args
ArgumentsText (Text -> Arguments Text)
-> (String -> Text) -> String -> Arguments Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance IsList (Arguments Text) where
  type Item (Arguments Text) = Text
  fromList :: [Item (Arguments Text)] -> Arguments Text
fromList = Text -> Arguments Text
forall args. args -> Arguments args
ArgumentsList (Text -> Arguments Text)
-> ([Text] -> Text) -> [Text] -> Arguments Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unwords
  toList :: Arguments Text -> [Item (Arguments Text)]
toList (ArgumentsText Text
ps) = Text -> [Text]
Text.words Text
ps
  toList (ArgumentsList Text
ps) = Text -> [Text]
Text.words Text
ps

data CheckArgs args
  = CheckArgs
      { CheckArgs args -> Arguments args
checkCommand :: !(Arguments args),
        CheckArgs args -> Maybe Duration
interval :: !(Maybe Duration),
        CheckArgs args -> Maybe Duration
timeout :: !(Maybe Duration),
        CheckArgs args -> Maybe Duration
startPeriod :: !(Maybe Duration),
        CheckArgs args -> Maybe Retries
retries :: !(Maybe Retries)
      }
  deriving (Int -> CheckArgs args -> ShowS
[CheckArgs args] -> ShowS
CheckArgs args -> String
(Int -> CheckArgs args -> ShowS)
-> (CheckArgs args -> String)
-> ([CheckArgs args] -> ShowS)
-> Show (CheckArgs args)
forall args. Show args => Int -> CheckArgs args -> ShowS
forall args. Show args => [CheckArgs args] -> ShowS
forall args. Show args => CheckArgs args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckArgs args] -> ShowS
$cshowList :: forall args. Show args => [CheckArgs args] -> ShowS
show :: CheckArgs args -> String
$cshow :: forall args. Show args => CheckArgs args -> String
showsPrec :: Int -> CheckArgs args -> ShowS
$cshowsPrec :: forall args. Show args => Int -> CheckArgs args -> ShowS
Show, CheckArgs args -> CheckArgs args -> Bool
(CheckArgs args -> CheckArgs args -> Bool)
-> (CheckArgs args -> CheckArgs args -> Bool)
-> Eq (CheckArgs args)
forall args. Eq args => CheckArgs args -> CheckArgs args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckArgs args -> CheckArgs args -> Bool
$c/= :: forall args. Eq args => CheckArgs args -> CheckArgs args -> Bool
== :: CheckArgs args -> CheckArgs args -> Bool
$c== :: forall args. Eq args => CheckArgs args -> CheckArgs args -> Bool
Eq, Eq (CheckArgs args)
Eq (CheckArgs args)
-> (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)
-> (CheckArgs args -> CheckArgs args -> CheckArgs args)
-> (CheckArgs args -> CheckArgs args -> CheckArgs args)
-> Ord (CheckArgs args)
CheckArgs args -> CheckArgs args -> Bool
CheckArgs args -> CheckArgs args -> Ordering
CheckArgs args -> CheckArgs args -> CheckArgs args
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall args. Ord args => Eq (CheckArgs args)
forall args. Ord args => CheckArgs args -> CheckArgs args -> Bool
forall args.
Ord args =>
CheckArgs args -> CheckArgs args -> Ordering
forall args.
Ord args =>
CheckArgs args -> CheckArgs args -> CheckArgs args
min :: CheckArgs args -> CheckArgs args -> CheckArgs args
$cmin :: forall args.
Ord args =>
CheckArgs args -> CheckArgs args -> CheckArgs args
max :: CheckArgs args -> CheckArgs args -> CheckArgs args
$cmax :: forall args.
Ord args =>
CheckArgs args -> CheckArgs args -> CheckArgs args
>= :: CheckArgs args -> CheckArgs args -> Bool
$c>= :: forall args. Ord args => CheckArgs args -> CheckArgs args -> Bool
> :: CheckArgs args -> CheckArgs args -> Bool
$c> :: forall args. Ord args => CheckArgs args -> CheckArgs args -> Bool
<= :: CheckArgs args -> CheckArgs args -> Bool
$c<= :: forall args. Ord args => CheckArgs args -> CheckArgs args -> Bool
< :: CheckArgs args -> CheckArgs args -> Bool
$c< :: forall args. Ord args => CheckArgs args -> CheckArgs args -> Bool
compare :: CheckArgs args -> CheckArgs args -> Ordering
$ccompare :: forall args.
Ord args =>
CheckArgs args -> CheckArgs args -> Ordering
$cp1Ord :: forall args. Ord args => Eq (CheckArgs args)
Ord, a -> CheckArgs b -> CheckArgs a
(a -> b) -> CheckArgs a -> CheckArgs b
(forall a b. (a -> b) -> CheckArgs a -> CheckArgs b)
-> (forall a b. a -> CheckArgs b -> CheckArgs a)
-> Functor CheckArgs
forall a b. a -> CheckArgs b -> CheckArgs a
forall a b. (a -> b) -> CheckArgs a -> CheckArgs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CheckArgs b -> CheckArgs a
$c<$ :: forall a b. a -> CheckArgs b -> CheckArgs a
fmap :: (a -> b) -> CheckArgs a -> CheckArgs b
$cfmap :: forall a b. (a -> b) -> CheckArgs a -> CheckArgs b
Functor)

type Pairs = [(Text, Text)]

data RunMount
  = BindMount !BindOpts
  | CacheMount !CacheOpts
  | TmpfsMount !TmpOpts
  | SecretMount !SecretOpts
  | SshMount !SecretOpts
  deriving (RunMount -> RunMount -> Bool
(RunMount -> RunMount -> Bool)
-> (RunMount -> RunMount -> Bool) -> Eq RunMount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunMount -> RunMount -> Bool
$c/= :: RunMount -> RunMount -> Bool
== :: RunMount -> RunMount -> Bool
$c== :: RunMount -> RunMount -> Bool
Eq, Int -> RunMount -> ShowS
[RunMount] -> ShowS
RunMount -> String
(Int -> RunMount -> ShowS)
-> (RunMount -> String) -> ([RunMount] -> ShowS) -> Show RunMount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunMount] -> ShowS
$cshowList :: [RunMount] -> ShowS
show :: RunMount -> String
$cshow :: RunMount -> String
showsPrec :: Int -> RunMount -> ShowS
$cshowsPrec :: Int -> RunMount -> ShowS
Show, Eq RunMount
Eq RunMount
-> (RunMount -> RunMount -> Ordering)
-> (RunMount -> RunMount -> Bool)
-> (RunMount -> RunMount -> Bool)
-> (RunMount -> RunMount -> Bool)
-> (RunMount -> RunMount -> Bool)
-> (RunMount -> RunMount -> RunMount)
-> (RunMount -> RunMount -> RunMount)
-> Ord RunMount
RunMount -> RunMount -> Bool
RunMount -> RunMount -> Ordering
RunMount -> RunMount -> RunMount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RunMount -> RunMount -> RunMount
$cmin :: RunMount -> RunMount -> RunMount
max :: RunMount -> RunMount -> RunMount
$cmax :: RunMount -> RunMount -> RunMount
>= :: RunMount -> RunMount -> Bool
$c>= :: RunMount -> RunMount -> Bool
> :: RunMount -> RunMount -> Bool
$c> :: RunMount -> RunMount -> Bool
<= :: RunMount -> RunMount -> Bool
$c<= :: RunMount -> RunMount -> Bool
< :: RunMount -> RunMount -> Bool
$c< :: RunMount -> RunMount -> Bool
compare :: RunMount -> RunMount -> Ordering
$ccompare :: RunMount -> RunMount -> Ordering
$cp1Ord :: Eq RunMount
Ord)

data BindOpts
  = BindOpts
      { BindOpts -> TargetPath
bTarget :: !TargetPath,
        BindOpts -> Maybe SourcePath
bSource :: !(Maybe SourcePath),
        BindOpts -> Maybe Text
bFromImage :: !(Maybe Text),
        BindOpts -> Maybe Bool
bReadOnly :: !(Maybe Bool)
      }
  deriving (Int -> BindOpts -> ShowS
[BindOpts] -> ShowS
BindOpts -> String
(Int -> BindOpts -> ShowS)
-> (BindOpts -> String) -> ([BindOpts] -> ShowS) -> Show BindOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindOpts] -> ShowS
$cshowList :: [BindOpts] -> ShowS
show :: BindOpts -> String
$cshow :: BindOpts -> String
showsPrec :: Int -> BindOpts -> ShowS
$cshowsPrec :: Int -> BindOpts -> ShowS
Show, BindOpts -> BindOpts -> Bool
(BindOpts -> BindOpts -> Bool)
-> (BindOpts -> BindOpts -> Bool) -> Eq BindOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindOpts -> BindOpts -> Bool
$c/= :: BindOpts -> BindOpts -> Bool
== :: BindOpts -> BindOpts -> Bool
$c== :: BindOpts -> BindOpts -> Bool
Eq, Eq BindOpts
Eq BindOpts
-> (BindOpts -> BindOpts -> Ordering)
-> (BindOpts -> BindOpts -> Bool)
-> (BindOpts -> BindOpts -> Bool)
-> (BindOpts -> BindOpts -> Bool)
-> (BindOpts -> BindOpts -> Bool)
-> (BindOpts -> BindOpts -> BindOpts)
-> (BindOpts -> BindOpts -> BindOpts)
-> Ord BindOpts
BindOpts -> BindOpts -> Bool
BindOpts -> BindOpts -> Ordering
BindOpts -> BindOpts -> BindOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BindOpts -> BindOpts -> BindOpts
$cmin :: BindOpts -> BindOpts -> BindOpts
max :: BindOpts -> BindOpts -> BindOpts
$cmax :: BindOpts -> BindOpts -> BindOpts
>= :: BindOpts -> BindOpts -> Bool
$c>= :: BindOpts -> BindOpts -> Bool
> :: BindOpts -> BindOpts -> Bool
$c> :: BindOpts -> BindOpts -> Bool
<= :: BindOpts -> BindOpts -> Bool
$c<= :: BindOpts -> BindOpts -> Bool
< :: BindOpts -> BindOpts -> Bool
$c< :: BindOpts -> BindOpts -> Bool
compare :: BindOpts -> BindOpts -> Ordering
$ccompare :: BindOpts -> BindOpts -> Ordering
$cp1Ord :: Eq BindOpts
Ord)

instance Default BindOpts where
  def :: BindOpts
def = TargetPath
-> Maybe SourcePath -> Maybe Text -> Maybe Bool -> BindOpts
BindOpts TargetPath
"" Maybe SourcePath
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

data CacheOpts
  = CacheOpts
      { CacheOpts -> TargetPath
cTarget :: !TargetPath,
        CacheOpts -> Maybe CacheSharing
cSharing :: !(Maybe CacheSharing),
        CacheOpts -> Maybe Text
cCacheId :: !(Maybe Text),
        CacheOpts -> Maybe Bool
cReadOnly :: !(Maybe Bool),
        CacheOpts -> Maybe Text
cFromImage :: !(Maybe Text),
        CacheOpts -> Maybe SourcePath
cSource :: !(Maybe SourcePath),
        CacheOpts -> Maybe Text
cMode :: !(Maybe Text),
        CacheOpts -> Maybe Integer
cUid :: !(Maybe Integer),
        CacheOpts -> Maybe Integer
cGid :: !(Maybe Integer)
      }
  deriving (Int -> CacheOpts -> ShowS
[CacheOpts] -> ShowS
CacheOpts -> String
(Int -> CacheOpts -> ShowS)
-> (CacheOpts -> String)
-> ([CacheOpts] -> ShowS)
-> Show CacheOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheOpts] -> ShowS
$cshowList :: [CacheOpts] -> ShowS
show :: CacheOpts -> String
$cshow :: CacheOpts -> String
showsPrec :: Int -> CacheOpts -> ShowS
$cshowsPrec :: Int -> CacheOpts -> ShowS
Show, CacheOpts -> CacheOpts -> Bool
(CacheOpts -> CacheOpts -> Bool)
-> (CacheOpts -> CacheOpts -> Bool) -> Eq CacheOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheOpts -> CacheOpts -> Bool
$c/= :: CacheOpts -> CacheOpts -> Bool
== :: CacheOpts -> CacheOpts -> Bool
$c== :: CacheOpts -> CacheOpts -> Bool
Eq, Eq CacheOpts
Eq CacheOpts
-> (CacheOpts -> CacheOpts -> Ordering)
-> (CacheOpts -> CacheOpts -> Bool)
-> (CacheOpts -> CacheOpts -> Bool)
-> (CacheOpts -> CacheOpts -> Bool)
-> (CacheOpts -> CacheOpts -> Bool)
-> (CacheOpts -> CacheOpts -> CacheOpts)
-> (CacheOpts -> CacheOpts -> CacheOpts)
-> Ord CacheOpts
CacheOpts -> CacheOpts -> Bool
CacheOpts -> CacheOpts -> Ordering
CacheOpts -> CacheOpts -> CacheOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CacheOpts -> CacheOpts -> CacheOpts
$cmin :: CacheOpts -> CacheOpts -> CacheOpts
max :: CacheOpts -> CacheOpts -> CacheOpts
$cmax :: CacheOpts -> CacheOpts -> CacheOpts
>= :: CacheOpts -> CacheOpts -> Bool
$c>= :: CacheOpts -> CacheOpts -> Bool
> :: CacheOpts -> CacheOpts -> Bool
$c> :: CacheOpts -> CacheOpts -> Bool
<= :: CacheOpts -> CacheOpts -> Bool
$c<= :: CacheOpts -> CacheOpts -> Bool
< :: CacheOpts -> CacheOpts -> Bool
$c< :: CacheOpts -> CacheOpts -> Bool
compare :: CacheOpts -> CacheOpts -> Ordering
$ccompare :: CacheOpts -> CacheOpts -> Ordering
$cp1Ord :: Eq CacheOpts
Ord)

instance Default CacheOpts where
  def :: CacheOpts
def = TargetPath
-> Maybe CacheSharing
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe SourcePath
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> CacheOpts
CacheOpts TargetPath
"" Maybe CacheSharing
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe SourcePath
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

newtype TmpOpts = TmpOpts {TmpOpts -> TargetPath
tTarget :: TargetPath} deriving (TmpOpts -> TmpOpts -> Bool
(TmpOpts -> TmpOpts -> Bool)
-> (TmpOpts -> TmpOpts -> Bool) -> Eq TmpOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TmpOpts -> TmpOpts -> Bool
$c/= :: TmpOpts -> TmpOpts -> Bool
== :: TmpOpts -> TmpOpts -> Bool
$c== :: TmpOpts -> TmpOpts -> Bool
Eq, Int -> TmpOpts -> ShowS
[TmpOpts] -> ShowS
TmpOpts -> String
(Int -> TmpOpts -> ShowS)
-> (TmpOpts -> String) -> ([TmpOpts] -> ShowS) -> Show TmpOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TmpOpts] -> ShowS
$cshowList :: [TmpOpts] -> ShowS
show :: TmpOpts -> String
$cshow :: TmpOpts -> String
showsPrec :: Int -> TmpOpts -> ShowS
$cshowsPrec :: Int -> TmpOpts -> ShowS
Show, Eq TmpOpts
Eq TmpOpts
-> (TmpOpts -> TmpOpts -> Ordering)
-> (TmpOpts -> TmpOpts -> Bool)
-> (TmpOpts -> TmpOpts -> Bool)
-> (TmpOpts -> TmpOpts -> Bool)
-> (TmpOpts -> TmpOpts -> Bool)
-> (TmpOpts -> TmpOpts -> TmpOpts)
-> (TmpOpts -> TmpOpts -> TmpOpts)
-> Ord TmpOpts
TmpOpts -> TmpOpts -> Bool
TmpOpts -> TmpOpts -> Ordering
TmpOpts -> TmpOpts -> TmpOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TmpOpts -> TmpOpts -> TmpOpts
$cmin :: TmpOpts -> TmpOpts -> TmpOpts
max :: TmpOpts -> TmpOpts -> TmpOpts
$cmax :: TmpOpts -> TmpOpts -> TmpOpts
>= :: TmpOpts -> TmpOpts -> Bool
$c>= :: TmpOpts -> TmpOpts -> Bool
> :: TmpOpts -> TmpOpts -> Bool
$c> :: TmpOpts -> TmpOpts -> Bool
<= :: TmpOpts -> TmpOpts -> Bool
$c<= :: TmpOpts -> TmpOpts -> Bool
< :: TmpOpts -> TmpOpts -> Bool
$c< :: TmpOpts -> TmpOpts -> Bool
compare :: TmpOpts -> TmpOpts -> Ordering
$ccompare :: TmpOpts -> TmpOpts -> Ordering
$cp1Ord :: Eq TmpOpts
Ord)

instance Default TmpOpts where
  def :: TmpOpts
def = TargetPath -> TmpOpts
TmpOpts TargetPath
""

data SecretOpts
  = SecretOpts
      { SecretOpts -> Maybe TargetPath
sTarget :: !(Maybe TargetPath),
        SecretOpts -> Maybe Text
sCacheId :: !(Maybe Text),
        SecretOpts -> Maybe Bool
sIsRequired :: !(Maybe Bool),
        SecretOpts -> Maybe SourcePath
sSource :: !(Maybe SourcePath),
        SecretOpts -> Maybe Text
sMode :: !(Maybe Text),
        SecretOpts -> Maybe Integer
sUid :: !(Maybe Integer),
        SecretOpts -> Maybe Integer
sGid :: !(Maybe Integer)
      }
  deriving (SecretOpts -> SecretOpts -> Bool
(SecretOpts -> SecretOpts -> Bool)
-> (SecretOpts -> SecretOpts -> Bool) -> Eq SecretOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretOpts -> SecretOpts -> Bool
$c/= :: SecretOpts -> SecretOpts -> Bool
== :: SecretOpts -> SecretOpts -> Bool
$c== :: SecretOpts -> SecretOpts -> Bool
Eq, Int -> SecretOpts -> ShowS
[SecretOpts] -> ShowS
SecretOpts -> String
(Int -> SecretOpts -> ShowS)
-> (SecretOpts -> String)
-> ([SecretOpts] -> ShowS)
-> Show SecretOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretOpts] -> ShowS
$cshowList :: [SecretOpts] -> ShowS
show :: SecretOpts -> String
$cshow :: SecretOpts -> String
showsPrec :: Int -> SecretOpts -> ShowS
$cshowsPrec :: Int -> SecretOpts -> ShowS
Show, Eq SecretOpts
Eq SecretOpts
-> (SecretOpts -> SecretOpts -> Ordering)
-> (SecretOpts -> SecretOpts -> Bool)
-> (SecretOpts -> SecretOpts -> Bool)
-> (SecretOpts -> SecretOpts -> Bool)
-> (SecretOpts -> SecretOpts -> Bool)
-> (SecretOpts -> SecretOpts -> SecretOpts)
-> (SecretOpts -> SecretOpts -> SecretOpts)
-> Ord SecretOpts
SecretOpts -> SecretOpts -> Bool
SecretOpts -> SecretOpts -> Ordering
SecretOpts -> SecretOpts -> SecretOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SecretOpts -> SecretOpts -> SecretOpts
$cmin :: SecretOpts -> SecretOpts -> SecretOpts
max :: SecretOpts -> SecretOpts -> SecretOpts
$cmax :: SecretOpts -> SecretOpts -> SecretOpts
>= :: SecretOpts -> SecretOpts -> Bool
$c>= :: SecretOpts -> SecretOpts -> Bool
> :: SecretOpts -> SecretOpts -> Bool
$c> :: SecretOpts -> SecretOpts -> Bool
<= :: SecretOpts -> SecretOpts -> Bool
$c<= :: SecretOpts -> SecretOpts -> Bool
< :: SecretOpts -> SecretOpts -> Bool
$c< :: SecretOpts -> SecretOpts -> Bool
compare :: SecretOpts -> SecretOpts -> Ordering
$ccompare :: SecretOpts -> SecretOpts -> Ordering
$cp1Ord :: Eq SecretOpts
Ord)

instance Default SecretOpts where
  def :: SecretOpts
def = Maybe TargetPath
-> Maybe Text
-> Maybe Bool
-> Maybe SourcePath
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> SecretOpts
SecretOpts Maybe TargetPath
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe SourcePath
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

data CacheSharing
  = Shared
  | Private
  | Locked
  deriving (Int -> CacheSharing -> ShowS
[CacheSharing] -> ShowS
CacheSharing -> String
(Int -> CacheSharing -> ShowS)
-> (CacheSharing -> String)
-> ([CacheSharing] -> ShowS)
-> Show CacheSharing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheSharing] -> ShowS
$cshowList :: [CacheSharing] -> ShowS
show :: CacheSharing -> String
$cshow :: CacheSharing -> String
showsPrec :: Int -> CacheSharing -> ShowS
$cshowsPrec :: Int -> CacheSharing -> ShowS
Show, CacheSharing -> CacheSharing -> Bool
(CacheSharing -> CacheSharing -> Bool)
-> (CacheSharing -> CacheSharing -> Bool) -> Eq CacheSharing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheSharing -> CacheSharing -> Bool
$c/= :: CacheSharing -> CacheSharing -> Bool
== :: CacheSharing -> CacheSharing -> Bool
$c== :: CacheSharing -> CacheSharing -> Bool
Eq, Eq CacheSharing
Eq CacheSharing
-> (CacheSharing -> CacheSharing -> Ordering)
-> (CacheSharing -> CacheSharing -> Bool)
-> (CacheSharing -> CacheSharing -> Bool)
-> (CacheSharing -> CacheSharing -> Bool)
-> (CacheSharing -> CacheSharing -> Bool)
-> (CacheSharing -> CacheSharing -> CacheSharing)
-> (CacheSharing -> CacheSharing -> CacheSharing)
-> Ord CacheSharing
CacheSharing -> CacheSharing -> Bool
CacheSharing -> CacheSharing -> Ordering
CacheSharing -> CacheSharing -> CacheSharing
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CacheSharing -> CacheSharing -> CacheSharing
$cmin :: CacheSharing -> CacheSharing -> CacheSharing
max :: CacheSharing -> CacheSharing -> CacheSharing
$cmax :: CacheSharing -> CacheSharing -> CacheSharing
>= :: CacheSharing -> CacheSharing -> Bool
$c>= :: CacheSharing -> CacheSharing -> Bool
> :: CacheSharing -> CacheSharing -> Bool
$c> :: CacheSharing -> CacheSharing -> Bool
<= :: CacheSharing -> CacheSharing -> Bool
$c<= :: CacheSharing -> CacheSharing -> Bool
< :: CacheSharing -> CacheSharing -> Bool
$c< :: CacheSharing -> CacheSharing -> Bool
compare :: CacheSharing -> CacheSharing -> Ordering
$ccompare :: CacheSharing -> CacheSharing -> Ordering
$cp1Ord :: Eq CacheSharing
Ord)

data RunSecurity
  = Insecure
  | Sandbox
  deriving (Int -> RunSecurity -> ShowS
[RunSecurity] -> ShowS
RunSecurity -> String
(Int -> RunSecurity -> ShowS)
-> (RunSecurity -> String)
-> ([RunSecurity] -> ShowS)
-> Show RunSecurity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunSecurity] -> ShowS
$cshowList :: [RunSecurity] -> ShowS
show :: RunSecurity -> String
$cshow :: RunSecurity -> String
showsPrec :: Int -> RunSecurity -> ShowS
$cshowsPrec :: Int -> RunSecurity -> ShowS
Show, RunSecurity -> RunSecurity -> Bool
(RunSecurity -> RunSecurity -> Bool)
-> (RunSecurity -> RunSecurity -> Bool) -> Eq RunSecurity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunSecurity -> RunSecurity -> Bool
$c/= :: RunSecurity -> RunSecurity -> Bool
== :: RunSecurity -> RunSecurity -> Bool
$c== :: RunSecurity -> RunSecurity -> Bool
Eq, Eq RunSecurity
Eq RunSecurity
-> (RunSecurity -> RunSecurity -> Ordering)
-> (RunSecurity -> RunSecurity -> Bool)
-> (RunSecurity -> RunSecurity -> Bool)
-> (RunSecurity -> RunSecurity -> Bool)
-> (RunSecurity -> RunSecurity -> Bool)
-> (RunSecurity -> RunSecurity -> RunSecurity)
-> (RunSecurity -> RunSecurity -> RunSecurity)
-> Ord RunSecurity
RunSecurity -> RunSecurity -> Bool
RunSecurity -> RunSecurity -> Ordering
RunSecurity -> RunSecurity -> RunSecurity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RunSecurity -> RunSecurity -> RunSecurity
$cmin :: RunSecurity -> RunSecurity -> RunSecurity
max :: RunSecurity -> RunSecurity -> RunSecurity
$cmax :: RunSecurity -> RunSecurity -> RunSecurity
>= :: RunSecurity -> RunSecurity -> Bool
$c>= :: RunSecurity -> RunSecurity -> Bool
> :: RunSecurity -> RunSecurity -> Bool
$c> :: RunSecurity -> RunSecurity -> Bool
<= :: RunSecurity -> RunSecurity -> Bool
$c<= :: RunSecurity -> RunSecurity -> Bool
< :: RunSecurity -> RunSecurity -> Bool
$c< :: RunSecurity -> RunSecurity -> Bool
compare :: RunSecurity -> RunSecurity -> Ordering
$ccompare :: RunSecurity -> RunSecurity -> Ordering
$cp1Ord :: Eq RunSecurity
Ord)

data RunNetwork
  = NetworkNone
  | NetworkHost
  | NetworkDefault
  deriving (Int -> RunNetwork -> ShowS
[RunNetwork] -> ShowS
RunNetwork -> String
(Int -> RunNetwork -> ShowS)
-> (RunNetwork -> String)
-> ([RunNetwork] -> ShowS)
-> Show RunNetwork
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunNetwork] -> ShowS
$cshowList :: [RunNetwork] -> ShowS
show :: RunNetwork -> String
$cshow :: RunNetwork -> String
showsPrec :: Int -> RunNetwork -> ShowS
$cshowsPrec :: Int -> RunNetwork -> ShowS
Show, RunNetwork -> RunNetwork -> Bool
(RunNetwork -> RunNetwork -> Bool)
-> (RunNetwork -> RunNetwork -> Bool) -> Eq RunNetwork
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunNetwork -> RunNetwork -> Bool
$c/= :: RunNetwork -> RunNetwork -> Bool
== :: RunNetwork -> RunNetwork -> Bool
$c== :: RunNetwork -> RunNetwork -> Bool
Eq, Eq RunNetwork
Eq RunNetwork
-> (RunNetwork -> RunNetwork -> Ordering)
-> (RunNetwork -> RunNetwork -> Bool)
-> (RunNetwork -> RunNetwork -> Bool)
-> (RunNetwork -> RunNetwork -> Bool)
-> (RunNetwork -> RunNetwork -> Bool)
-> (RunNetwork -> RunNetwork -> RunNetwork)
-> (RunNetwork -> RunNetwork -> RunNetwork)
-> Ord RunNetwork
RunNetwork -> RunNetwork -> Bool
RunNetwork -> RunNetwork -> Ordering
RunNetwork -> RunNetwork -> RunNetwork
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RunNetwork -> RunNetwork -> RunNetwork
$cmin :: RunNetwork -> RunNetwork -> RunNetwork
max :: RunNetwork -> RunNetwork -> RunNetwork
$cmax :: RunNetwork -> RunNetwork -> RunNetwork
>= :: RunNetwork -> RunNetwork -> Bool
$c>= :: RunNetwork -> RunNetwork -> Bool
> :: RunNetwork -> RunNetwork -> Bool
$c> :: RunNetwork -> RunNetwork -> Bool
<= :: RunNetwork -> RunNetwork -> Bool
$c<= :: RunNetwork -> RunNetwork -> Bool
< :: RunNetwork -> RunNetwork -> Bool
$c< :: RunNetwork -> RunNetwork -> Bool
compare :: RunNetwork -> RunNetwork -> Ordering
$ccompare :: RunNetwork -> RunNetwork -> Ordering
$cp1Ord :: Eq RunNetwork
Ord)

data RunFlags
  = RunFlags
      { RunFlags -> Maybe RunMount
mount :: !(Maybe RunMount),
        RunFlags -> Maybe RunSecurity
security :: !(Maybe RunSecurity),
        RunFlags -> Maybe RunNetwork
network :: !(Maybe RunNetwork)
      }
  deriving (Int -> RunFlags -> ShowS
[RunFlags] -> ShowS
RunFlags -> String
(Int -> RunFlags -> ShowS)
-> (RunFlags -> String) -> ([RunFlags] -> ShowS) -> Show RunFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunFlags] -> ShowS
$cshowList :: [RunFlags] -> ShowS
show :: RunFlags -> String
$cshow :: RunFlags -> String
showsPrec :: Int -> RunFlags -> ShowS
$cshowsPrec :: Int -> RunFlags -> ShowS
Show, RunFlags -> RunFlags -> Bool
(RunFlags -> RunFlags -> Bool)
-> (RunFlags -> RunFlags -> Bool) -> Eq RunFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunFlags -> RunFlags -> Bool
$c/= :: RunFlags -> RunFlags -> Bool
== :: RunFlags -> RunFlags -> Bool
$c== :: RunFlags -> RunFlags -> Bool
Eq, Eq RunFlags
Eq RunFlags
-> (RunFlags -> RunFlags -> Ordering)
-> (RunFlags -> RunFlags -> Bool)
-> (RunFlags -> RunFlags -> Bool)
-> (RunFlags -> RunFlags -> Bool)
-> (RunFlags -> RunFlags -> Bool)
-> (RunFlags -> RunFlags -> RunFlags)
-> (RunFlags -> RunFlags -> RunFlags)
-> Ord RunFlags
RunFlags -> RunFlags -> Bool
RunFlags -> RunFlags -> Ordering
RunFlags -> RunFlags -> RunFlags
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RunFlags -> RunFlags -> RunFlags
$cmin :: RunFlags -> RunFlags -> RunFlags
max :: RunFlags -> RunFlags -> RunFlags
$cmax :: RunFlags -> RunFlags -> RunFlags
>= :: RunFlags -> RunFlags -> Bool
$c>= :: RunFlags -> RunFlags -> Bool
> :: RunFlags -> RunFlags -> Bool
$c> :: RunFlags -> RunFlags -> Bool
<= :: RunFlags -> RunFlags -> Bool
$c<= :: RunFlags -> RunFlags -> Bool
< :: RunFlags -> RunFlags -> Bool
$c< :: RunFlags -> RunFlags -> Bool
compare :: RunFlags -> RunFlags -> Ordering
$ccompare :: RunFlags -> RunFlags -> Ordering
$cp1Ord :: Eq RunFlags
Ord)

instance Default RunFlags where
  def :: RunFlags
def = Maybe RunMount -> Maybe RunSecurity -> Maybe RunNetwork -> RunFlags
RunFlags Maybe RunMount
forall a. Maybe a
Nothing Maybe RunSecurity
forall a. Maybe a
Nothing Maybe RunNetwork
forall a. Maybe a
Nothing

data RunArgs args = RunArgs (Arguments args) RunFlags
  deriving (Int -> RunArgs args -> ShowS
[RunArgs args] -> ShowS
RunArgs args -> String
(Int -> RunArgs args -> ShowS)
-> (RunArgs args -> String)
-> ([RunArgs args] -> ShowS)
-> Show (RunArgs args)
forall args. Show args => Int -> RunArgs args -> ShowS
forall args. Show args => [RunArgs args] -> ShowS
forall args. Show args => RunArgs args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunArgs args] -> ShowS
$cshowList :: forall args. Show args => [RunArgs args] -> ShowS
show :: RunArgs args -> String
$cshow :: forall args. Show args => RunArgs args -> String
showsPrec :: Int -> RunArgs args -> ShowS
$cshowsPrec :: forall args. Show args => Int -> RunArgs args -> ShowS
Show, RunArgs args -> RunArgs args -> Bool
(RunArgs args -> RunArgs args -> Bool)
-> (RunArgs args -> RunArgs args -> Bool) -> Eq (RunArgs args)
forall args. Eq args => RunArgs args -> RunArgs args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunArgs args -> RunArgs args -> Bool
$c/= :: forall args. Eq args => RunArgs args -> RunArgs args -> Bool
== :: RunArgs args -> RunArgs args -> Bool
$c== :: forall args. Eq args => RunArgs args -> RunArgs args -> Bool
Eq, Eq (RunArgs args)
Eq (RunArgs args)
-> (RunArgs args -> RunArgs args -> Ordering)
-> (RunArgs args -> RunArgs args -> Bool)
-> (RunArgs args -> RunArgs args -> Bool)
-> (RunArgs args -> RunArgs args -> Bool)
-> (RunArgs args -> RunArgs args -> Bool)
-> (RunArgs args -> RunArgs args -> RunArgs args)
-> (RunArgs args -> RunArgs args -> RunArgs args)
-> Ord (RunArgs args)
RunArgs args -> RunArgs args -> Bool
RunArgs args -> RunArgs args -> Ordering
RunArgs args -> RunArgs args -> RunArgs args
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall args. Ord args => Eq (RunArgs args)
forall args. Ord args => RunArgs args -> RunArgs args -> Bool
forall args. Ord args => RunArgs args -> RunArgs args -> Ordering
forall args.
Ord args =>
RunArgs args -> RunArgs args -> RunArgs args
min :: RunArgs args -> RunArgs args -> RunArgs args
$cmin :: forall args.
Ord args =>
RunArgs args -> RunArgs args -> RunArgs args
max :: RunArgs args -> RunArgs args -> RunArgs args
$cmax :: forall args.
Ord args =>
RunArgs args -> RunArgs args -> RunArgs args
>= :: RunArgs args -> RunArgs args -> Bool
$c>= :: forall args. Ord args => RunArgs args -> RunArgs args -> Bool
> :: RunArgs args -> RunArgs args -> Bool
$c> :: forall args. Ord args => RunArgs args -> RunArgs args -> Bool
<= :: RunArgs args -> RunArgs args -> Bool
$c<= :: forall args. Ord args => RunArgs args -> RunArgs args -> Bool
< :: RunArgs args -> RunArgs args -> Bool
$c< :: forall args. Ord args => RunArgs args -> RunArgs args -> Bool
compare :: RunArgs args -> RunArgs args -> Ordering
$ccompare :: forall args. Ord args => RunArgs args -> RunArgs args -> Ordering
$cp1Ord :: forall args. Ord args => Eq (RunArgs args)
Ord, a -> RunArgs b -> RunArgs a
(a -> b) -> RunArgs a -> RunArgs b
(forall a b. (a -> b) -> RunArgs a -> RunArgs b)
-> (forall a b. a -> RunArgs b -> RunArgs a) -> Functor RunArgs
forall a b. a -> RunArgs b -> RunArgs a
forall a b. (a -> b) -> RunArgs a -> RunArgs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RunArgs b -> RunArgs a
$c<$ :: forall a b. a -> RunArgs b -> RunArgs a
fmap :: (a -> b) -> RunArgs a -> RunArgs b
$cfmap :: forall a b. (a -> b) -> RunArgs a -> RunArgs b
Functor)

instance IsString (RunArgs Text) where
  fromString :: String -> RunArgs Text
fromString String
s =
    Arguments Text -> RunFlags -> RunArgs Text
forall args. Arguments args -> RunFlags -> RunArgs args
RunArgs
      (Text -> Arguments Text
forall args. args -> Arguments args
ArgumentsText (Text -> Arguments Text)
-> (String -> Text) -> String -> Arguments Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Arguments Text) -> String -> Arguments Text
forall a b. (a -> b) -> a -> b
$ String
s)
      RunFlags :: Maybe RunMount -> Maybe RunSecurity -> Maybe RunNetwork -> RunFlags
RunFlags
        { $sel:security:RunFlags :: Maybe RunSecurity
security = Maybe RunSecurity
forall a. Maybe a
Nothing,
          $sel:network:RunFlags :: Maybe RunNetwork
network = Maybe RunNetwork
forall a. Maybe a
Nothing,
          $sel:mount:RunFlags :: Maybe RunMount
mount = Maybe RunMount
forall a. Maybe a
Nothing
        }

-- | All commands available in Dockerfiles
data Instruction args
  = From !BaseImage
  | Add !AddArgs
  | User !Text
  | Label !Pairs
  | Stopsignal !Text
  | Copy !CopyArgs
  | Run !(RunArgs args)
  | Cmd !(Arguments args)
  | Shell !(Arguments args)
  | Workdir !Directory
  | Expose !Ports
  | Volume !Text
  | Entrypoint !(Arguments args)
  | Maintainer !Text
  | Env !Pairs
  | Arg
      !Text
      !(Maybe Text)
  | Healthcheck !(Check args)
  | Comment !Text
  | OnBuild !(Instruction args)
  deriving (Instruction args -> Instruction args -> Bool
(Instruction args -> Instruction args -> Bool)
-> (Instruction args -> Instruction args -> Bool)
-> Eq (Instruction args)
forall args.
Eq args =>
Instruction args -> Instruction args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instruction args -> Instruction args -> Bool
$c/= :: forall args.
Eq args =>
Instruction args -> Instruction args -> Bool
== :: Instruction args -> Instruction args -> Bool
$c== :: forall args.
Eq args =>
Instruction args -> Instruction args -> Bool
Eq, Eq (Instruction args)
Eq (Instruction args)
-> (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)
-> (Instruction args -> Instruction args -> Instruction args)
-> (Instruction args -> Instruction args -> Instruction args)
-> Ord (Instruction args)
Instruction args -> Instruction args -> Bool
Instruction args -> Instruction args -> Ordering
Instruction args -> Instruction args -> Instruction args
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall args. Ord args => Eq (Instruction args)
forall args.
Ord args =>
Instruction args -> Instruction args -> Bool
forall args.
Ord args =>
Instruction args -> Instruction args -> Ordering
forall args.
Ord args =>
Instruction args -> Instruction args -> Instruction args
min :: Instruction args -> Instruction args -> Instruction args
$cmin :: forall args.
Ord args =>
Instruction args -> Instruction args -> Instruction args
max :: Instruction args -> Instruction args -> Instruction args
$cmax :: forall args.
Ord args =>
Instruction args -> Instruction args -> Instruction args
>= :: Instruction args -> Instruction args -> Bool
$c>= :: forall args.
Ord args =>
Instruction args -> Instruction args -> Bool
> :: Instruction args -> Instruction args -> Bool
$c> :: forall args.
Ord args =>
Instruction args -> Instruction args -> Bool
<= :: Instruction args -> Instruction args -> Bool
$c<= :: forall args.
Ord args =>
Instruction args -> Instruction args -> Bool
< :: Instruction args -> Instruction args -> Bool
$c< :: forall args.
Ord args =>
Instruction args -> Instruction args -> Bool
compare :: Instruction args -> Instruction args -> Ordering
$ccompare :: forall args.
Ord args =>
Instruction args -> Instruction args -> Ordering
$cp1Ord :: forall args. Ord args => Eq (Instruction args)
Ord, Int -> Instruction args -> ShowS
[Instruction args] -> ShowS
Instruction args -> String
(Int -> Instruction args -> ShowS)
-> (Instruction args -> String)
-> ([Instruction args] -> ShowS)
-> Show (Instruction args)
forall args. Show args => Int -> Instruction args -> ShowS
forall args. Show args => [Instruction args] -> ShowS
forall args. Show args => Instruction args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instruction args] -> ShowS
$cshowList :: forall args. Show args => [Instruction args] -> ShowS
show :: Instruction args -> String
$cshow :: forall args. Show args => Instruction args -> String
showsPrec :: Int -> Instruction args -> ShowS
$cshowsPrec :: forall args. Show args => Int -> Instruction args -> ShowS
Show, a -> Instruction b -> Instruction a
(a -> b) -> Instruction a -> Instruction b
(forall a b. (a -> b) -> Instruction a -> Instruction b)
-> (forall a b. a -> Instruction b -> Instruction a)
-> Functor Instruction
forall a b. a -> Instruction b -> Instruction a
forall a b. (a -> b) -> Instruction a -> Instruction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Instruction b -> Instruction a
$c<$ :: forall a b. a -> Instruction b -> Instruction a
fmap :: (a -> b) -> Instruction a -> Instruction b
$cfmap :: forall a b. (a -> b) -> Instruction a -> Instruction b
Functor)

type Filename = Text

type Linenumber = Int

-- | 'Instruction' with additional location information required for creating
-- good check messages
data InstructionPos args
  = InstructionPos
      { InstructionPos args -> Instruction args
instruction :: !(Instruction args),
        InstructionPos args -> Text
sourcename :: !Filename,
        InstructionPos args -> Int
lineNumber :: !Linenumber
      }
  deriving (InstructionPos args -> InstructionPos args -> Bool
(InstructionPos args -> InstructionPos args -> Bool)
-> (InstructionPos args -> InstructionPos args -> Bool)
-> Eq (InstructionPos args)
forall args.
Eq args =>
InstructionPos args -> InstructionPos args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstructionPos args -> InstructionPos args -> Bool
$c/= :: forall args.
Eq args =>
InstructionPos args -> InstructionPos args -> Bool
== :: InstructionPos args -> InstructionPos args -> Bool
$c== :: forall args.
Eq args =>
InstructionPos args -> InstructionPos args -> Bool
Eq, Eq (InstructionPos args)
Eq (InstructionPos args)
-> (InstructionPos args -> InstructionPos args -> Ordering)
-> (InstructionPos args -> InstructionPos args -> Bool)
-> (InstructionPos args -> InstructionPos args -> Bool)
-> (InstructionPos args -> InstructionPos args -> Bool)
-> (InstructionPos args -> InstructionPos args -> Bool)
-> (InstructionPos args
    -> InstructionPos args -> InstructionPos args)
-> (InstructionPos args
    -> InstructionPos args -> InstructionPos args)
-> Ord (InstructionPos args)
InstructionPos args -> InstructionPos args -> Bool
InstructionPos args -> InstructionPos args -> Ordering
InstructionPos args -> InstructionPos args -> InstructionPos args
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall args. Ord args => Eq (InstructionPos args)
forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> Bool
forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> Ordering
forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> InstructionPos args
min :: InstructionPos args -> InstructionPos args -> InstructionPos args
$cmin :: forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> InstructionPos args
max :: InstructionPos args -> InstructionPos args -> InstructionPos args
$cmax :: forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> InstructionPos args
>= :: InstructionPos args -> InstructionPos args -> Bool
$c>= :: forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> Bool
> :: InstructionPos args -> InstructionPos args -> Bool
$c> :: forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> Bool
<= :: InstructionPos args -> InstructionPos args -> Bool
$c<= :: forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> Bool
< :: InstructionPos args -> InstructionPos args -> Bool
$c< :: forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> Bool
compare :: InstructionPos args -> InstructionPos args -> Ordering
$ccompare :: forall args.
Ord args =>
InstructionPos args -> InstructionPos args -> Ordering
$cp1Ord :: forall args. Ord args => Eq (InstructionPos args)
Ord, Int -> InstructionPos args -> ShowS
[InstructionPos args] -> ShowS
InstructionPos args -> String
(Int -> InstructionPos args -> ShowS)
-> (InstructionPos args -> String)
-> ([InstructionPos args] -> ShowS)
-> Show (InstructionPos args)
forall args. Show args => Int -> InstructionPos args -> ShowS
forall args. Show args => [InstructionPos args] -> ShowS
forall args. Show args => InstructionPos args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstructionPos args] -> ShowS
$cshowList :: forall args. Show args => [InstructionPos args] -> ShowS
show :: InstructionPos args -> String
$cshow :: forall args. Show args => InstructionPos args -> String
showsPrec :: Int -> InstructionPos args -> ShowS
$cshowsPrec :: forall args. Show args => Int -> InstructionPos args -> ShowS
Show, a -> InstructionPos b -> InstructionPos a
(a -> b) -> InstructionPos a -> InstructionPos b
(forall a b. (a -> b) -> InstructionPos a -> InstructionPos b)
-> (forall a b. a -> InstructionPos b -> InstructionPos a)
-> Functor InstructionPos
forall a b. a -> InstructionPos b -> InstructionPos a
forall a b. (a -> b) -> InstructionPos a -> InstructionPos b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> InstructionPos b -> InstructionPos a
$c<$ :: forall a b. a -> InstructionPos b -> InstructionPos a
fmap :: (a -> b) -> InstructionPos a -> InstructionPos b
$cfmap :: forall a b. (a -> b) -> InstructionPos a -> InstructionPos b
Functor)