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

module Language.Docker.Syntax
  ( module Language.Docker.Syntax,
    module Language.Docker.Syntax.Port,
    module Language.Docker.Syntax.PortRange,
    module Language.Docker.Syntax.Protocol
  )
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 Data.Set (Set)
import qualified Data.Text as Text
import Data.Time.Clock (DiffTime)
import GHC.Exts (IsList (..))
import Text.Printf


import Language.Docker.Syntax.Port
import Language.Docker.Syntax.PortRange
import Language.Docker.Syntax.Protocol


data Image
  = Image
      { Image -> Maybe Registry
registryName :: !(Maybe Registry),
        Image -> Text
imageName :: !Text
      }
  deriving (Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
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
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
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
Ord)

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

data PortSpec
  = PortSpec !Port
  | PortRangeSpec !PortRange
  deriving (Int -> PortSpec -> ShowS
[PortSpec] -> ShowS
PortSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortSpec] -> ShowS
$cshowList :: [PortSpec] -> ShowS
show :: PortSpec -> String
$cshow :: PortSpec -> String
showsPrec :: Int -> PortSpec -> ShowS
$cshowsPrec :: Int -> PortSpec -> ShowS
Show, PortSpec -> PortSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortSpec -> PortSpec -> Bool
$c/= :: PortSpec -> PortSpec -> Bool
== :: PortSpec -> PortSpec -> Bool
$c== :: PortSpec -> PortSpec -> Bool
Eq, Eq PortSpec
PortSpec -> PortSpec -> Bool
PortSpec -> PortSpec -> Ordering
PortSpec -> PortSpec -> PortSpec
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 :: PortSpec -> PortSpec -> PortSpec
$cmin :: PortSpec -> PortSpec -> PortSpec
max :: PortSpec -> PortSpec -> PortSpec
$cmax :: PortSpec -> PortSpec -> PortSpec
>= :: PortSpec -> PortSpec -> Bool
$c>= :: PortSpec -> PortSpec -> Bool
> :: PortSpec -> PortSpec -> Bool
$c> :: PortSpec -> PortSpec -> Bool
<= :: PortSpec -> PortSpec -> Bool
$c<= :: PortSpec -> PortSpec -> Bool
< :: PortSpec -> PortSpec -> Bool
$c< :: PortSpec -> PortSpec -> Bool
compare :: PortSpec -> PortSpec -> Ordering
$ccompare :: PortSpec -> PortSpec -> Ordering
Ord)

newtype Ports
  = Ports
      { Ports -> [PortSpec]
unPorts :: [PortSpec]
      }
  deriving (Int -> Ports -> ShowS
[Ports] -> ShowS
Ports -> String
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
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
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
Ord)

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

type Directory = Text

type Platform = Text

newtype ImageAlias
  = ImageAlias
      { ImageAlias -> Text
unImageAlias :: Text
      }
  deriving (Int -> ImageAlias -> ShowS
[ImageAlias] -> ShowS
ImageAlias -> String
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
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
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
Ord, String -> 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
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
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
Ord, Int -> BaseImage -> ShowS
[BaseImage] -> ShowS
BaseImage -> String
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
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
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
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
Ord, String -> 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
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
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
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
Ord, String -> 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
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
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
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
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 Chmod
  = Chmod !Text
  | NoChmod
  deriving (Int -> Chmod -> ShowS
[Chmod] -> ShowS
Chmod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chmod] -> ShowS
$cshowList :: [Chmod] -> ShowS
show :: Chmod -> String
$cshow :: Chmod -> String
showsPrec :: Int -> Chmod -> ShowS
$cshowsPrec :: Int -> Chmod -> ShowS
Show, Chmod -> Chmod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chmod -> Chmod -> Bool
$c/= :: Chmod -> Chmod -> Bool
== :: Chmod -> Chmod -> Bool
$c== :: Chmod -> Chmod -> Bool
Eq, Eq Chmod
Chmod -> Chmod -> Bool
Chmod -> Chmod -> Ordering
Chmod -> Chmod -> Chmod
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 :: Chmod -> Chmod -> Chmod
$cmin :: Chmod -> Chmod -> Chmod
max :: Chmod -> Chmod -> Chmod
$cmax :: Chmod -> Chmod -> Chmod
>= :: Chmod -> Chmod -> Bool
$c>= :: Chmod -> Chmod -> Bool
> :: Chmod -> Chmod -> Bool
$c> :: Chmod -> Chmod -> Bool
<= :: Chmod -> Chmod -> Bool
$c<= :: Chmod -> Chmod -> Bool
< :: Chmod -> Chmod -> Bool
$c< :: Chmod -> Chmod -> Bool
compare :: Chmod -> Chmod -> Ordering
$ccompare :: Chmod -> Chmod -> Ordering
Ord)

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

data Link
  = Link
  | NoLink
  deriving (Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show, Link -> Link -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
Eq, Eq Link
Link -> Link -> Bool
Link -> Link -> Ordering
Link -> Link -> Link
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 :: Link -> Link -> Link
$cmin :: Link -> Link -> Link
max :: Link -> Link -> Link
$cmax :: Link -> Link -> Link
>= :: Link -> Link -> Bool
$c>= :: Link -> Link -> Bool
> :: Link -> Link -> Bool
$c> :: Link -> Link -> Bool
<= :: Link -> Link -> Bool
$c<= :: Link -> Link -> Bool
< :: Link -> Link -> Bool
$c< :: Link -> Link -> Bool
compare :: Link -> Link -> Ordering
$ccompare :: Link -> Link -> Ordering
Ord)

data CopySource
  = CopySource !Text
  | NoSource
  deriving (Int -> CopySource -> ShowS
[CopySource] -> ShowS
CopySource -> String
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
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
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
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
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
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
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
Ord, Integer -> Duration
Duration -> Duration
Duration -> Duration -> 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, Num Duration
Rational -> Duration
Duration -> Duration
Duration -> Duration -> Duration
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Duration
$cfromRational :: Rational -> Duration
recip :: Duration -> Duration
$crecip :: Duration -> Duration
/ :: Duration -> Duration -> Duration
$c/ :: Duration -> Duration -> Duration
Fractional)

newtype Retries
  = Retries
      { Retries -> Int
times :: Int
      }
  deriving (Int -> Retries -> ShowS
[Retries] -> ShowS
Retries -> String
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
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
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
Ord, Integer -> Retries
Retries -> Retries
Retries -> Retries -> 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
      }
  deriving (Int -> CopyArgs -> ShowS
[CopyArgs] -> ShowS
CopyArgs -> String
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
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
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
Ord)

data CopyFlags
  = CopyFlags
      { CopyFlags -> Chown
chownFlag :: !Chown,
        CopyFlags -> Chmod
chmodFlag :: !Chmod,
        CopyFlags -> Link
linkFlag :: !Link,
        CopyFlags -> CopySource
sourceFlag :: !CopySource
      }
  deriving (Int -> CopyFlags -> ShowS
[CopyFlags] -> ShowS
CopyFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyFlags] -> ShowS
$cshowList :: [CopyFlags] -> ShowS
show :: CopyFlags -> String
$cshow :: CopyFlags -> String
showsPrec :: Int -> CopyFlags -> ShowS
$cshowsPrec :: Int -> CopyFlags -> ShowS
Show, CopyFlags -> CopyFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyFlags -> CopyFlags -> Bool
$c/= :: CopyFlags -> CopyFlags -> Bool
== :: CopyFlags -> CopyFlags -> Bool
$c== :: CopyFlags -> CopyFlags -> Bool
Eq, Eq CopyFlags
CopyFlags -> CopyFlags -> Bool
CopyFlags -> CopyFlags -> Ordering
CopyFlags -> CopyFlags -> CopyFlags
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 :: CopyFlags -> CopyFlags -> CopyFlags
$cmin :: CopyFlags -> CopyFlags -> CopyFlags
max :: CopyFlags -> CopyFlags -> CopyFlags
$cmax :: CopyFlags -> CopyFlags -> CopyFlags
>= :: CopyFlags -> CopyFlags -> Bool
$c>= :: CopyFlags -> CopyFlags -> Bool
> :: CopyFlags -> CopyFlags -> Bool
$c> :: CopyFlags -> CopyFlags -> Bool
<= :: CopyFlags -> CopyFlags -> Bool
$c<= :: CopyFlags -> CopyFlags -> Bool
< :: CopyFlags -> CopyFlags -> Bool
$c< :: CopyFlags -> CopyFlags -> Bool
compare :: CopyFlags -> CopyFlags -> Ordering
$ccompare :: CopyFlags -> CopyFlags -> Ordering
Ord)

instance Default CopyFlags where
  def :: CopyFlags
def = Chown -> Chmod -> Link -> CopySource -> CopyFlags
CopyFlags Chown
NoChown Chmod
NoChmod Link
NoLink CopySource
NoSource

data AddArgs
  = AddArgs
      { AddArgs -> NonEmpty SourcePath
sourcePaths :: NonEmpty SourcePath,
        AddArgs -> TargetPath
targetPath :: !TargetPath
      }
  deriving (Int -> AddArgs -> ShowS
[AddArgs] -> ShowS
AddArgs -> String
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
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
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
Ord)

data AddFlags
  = AddFlags
      { AddFlags -> Chown
chownFlag :: !Chown,
        AddFlags -> Chmod
chmodFlag :: !Chmod,
        AddFlags -> Link
linkFlag :: !Link
      }
  deriving (Int -> AddFlags -> ShowS
[AddFlags] -> ShowS
AddFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddFlags] -> ShowS
$cshowList :: [AddFlags] -> ShowS
show :: AddFlags -> String
$cshow :: AddFlags -> String
showsPrec :: Int -> AddFlags -> ShowS
$cshowsPrec :: Int -> AddFlags -> ShowS
Show, AddFlags -> AddFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddFlags -> AddFlags -> Bool
$c/= :: AddFlags -> AddFlags -> Bool
== :: AddFlags -> AddFlags -> Bool
$c== :: AddFlags -> AddFlags -> Bool
Eq, Eq AddFlags
AddFlags -> AddFlags -> Bool
AddFlags -> AddFlags -> Ordering
AddFlags -> AddFlags -> AddFlags
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 :: AddFlags -> AddFlags -> AddFlags
$cmin :: AddFlags -> AddFlags -> AddFlags
max :: AddFlags -> AddFlags -> AddFlags
$cmax :: AddFlags -> AddFlags -> AddFlags
>= :: AddFlags -> AddFlags -> Bool
$c>= :: AddFlags -> AddFlags -> Bool
> :: AddFlags -> AddFlags -> Bool
$c> :: AddFlags -> AddFlags -> Bool
<= :: AddFlags -> AddFlags -> Bool
$c<= :: AddFlags -> AddFlags -> Bool
< :: AddFlags -> AddFlags -> Bool
$c< :: AddFlags -> AddFlags -> Bool
compare :: AddFlags -> AddFlags -> Ordering
$ccompare :: AddFlags -> AddFlags -> Ordering
Ord)

instance Default AddFlags where
  def :: AddFlags
def = Chown -> Chmod -> Link -> AddFlags
AddFlags Chown
NoChown Chmod
NoChmod Link
NoLink

data Check args
  = Check !(CheckArgs args)
  | NoCheck
  deriving (Int -> Check args -> ShowS
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
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, Check args -> Check args -> Bool
Check args -> Check args -> Ordering
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
Ord, 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
<$ :: forall a b. a -> Check b -> Check a
$c<$ :: forall a b. a -> Check b -> Check a
fmap :: forall a b. (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
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
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, Arguments args -> Arguments args -> Bool
Arguments args -> Arguments args -> Ordering
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
Ord, 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
<$ :: forall a b. a -> Arguments b -> Arguments a
$c<$ :: forall a b. a -> Arguments b -> Arguments a
fmap :: forall a b. (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 = forall args. args -> Arguments args
ArgumentsText 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 = forall args. args -> Arguments args
ArgumentsList 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
      { forall args. CheckArgs args -> Arguments args
checkCommand :: !(Arguments args),
        forall args. CheckArgs args -> Maybe Duration
interval :: !(Maybe Duration),
        forall args. CheckArgs args -> Maybe Duration
timeout :: !(Maybe Duration),
        forall args. CheckArgs args -> Maybe Duration
startPeriod :: !(Maybe Duration),
        forall args. CheckArgs args -> Maybe Retries
retries :: !(Maybe Retries)
      }
  deriving (Int -> CheckArgs args -> ShowS
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
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, CheckArgs args -> CheckArgs args -> Bool
CheckArgs args -> CheckArgs args -> Ordering
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
Ord, 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
<$ :: forall a b. a -> CheckArgs b -> CheckArgs a
$c<$ :: forall a b. a -> CheckArgs b -> CheckArgs a
fmap :: forall a b. (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
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
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
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
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
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
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
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
Ord)

instance Default BindOpts where
  def :: BindOpts
def = TargetPath
-> Maybe SourcePath -> Maybe Text -> Maybe Bool -> BindOpts
BindOpts TargetPath
"" forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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 Text
cUid :: !(Maybe Text),
        CacheOpts -> Maybe Text
cGid :: !(Maybe Text)
      }
  deriving (Int -> CacheOpts -> ShowS
[CacheOpts] -> ShowS
CacheOpts -> String
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
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
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
Ord)

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

newtype TmpOpts = TmpOpts {TmpOpts -> TargetPath
tTarget :: TargetPath} deriving (TmpOpts -> TmpOpts -> Bool
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
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
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
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 Text
sUid :: !(Maybe Text),
        SecretOpts -> Maybe Text
sGid :: !(Maybe Text)
      }
  deriving (SecretOpts -> SecretOpts -> Bool
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
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
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
Ord)

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

data CacheSharing
  = Shared
  | Private
  | Locked
  deriving (Int -> CacheSharing -> ShowS
[CacheSharing] -> ShowS
CacheSharing -> String
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
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
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
Ord)

data RunSecurity
  = Insecure
  | Sandbox
  deriving (Int -> RunSecurity -> ShowS
[RunSecurity] -> ShowS
RunSecurity -> String
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
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
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
Ord)

data RunNetwork
  = NetworkNone
  | NetworkHost
  | NetworkDefault
  deriving (Int -> RunNetwork -> ShowS
[RunNetwork] -> ShowS
RunNetwork -> String
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
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
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
Ord)

data RunFlags
  = RunFlags
      { RunFlags -> Set RunMount
mount :: !(Set RunMount),
        RunFlags -> Maybe RunSecurity
security :: !(Maybe RunSecurity),
        RunFlags -> Maybe RunNetwork
network :: !(Maybe RunNetwork)
      }
  deriving (Int -> RunFlags -> ShowS
[RunFlags] -> ShowS
RunFlags -> String
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
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
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
Ord)

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

data RunArgs args = RunArgs (Arguments args) RunFlags
  deriving (Int -> RunArgs args -> ShowS
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
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, RunArgs args -> RunArgs args -> Bool
RunArgs args -> RunArgs args -> Ordering
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
Ord, 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
<$ :: forall a b. a -> RunArgs b -> RunArgs a
$c<$ :: forall a b. a -> RunArgs b -> RunArgs a
fmap :: forall a b. (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 =
    forall args. Arguments args -> RunFlags -> RunArgs args
RunArgs
      (forall args. args -> Arguments args
ArgumentsText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
s)
      RunFlags
        { $sel:mount:RunFlags :: Set RunMount
mount = forall a. Monoid a => a
mempty,
          $sel:security:RunFlags :: Maybe RunSecurity
security = forall a. Maybe a
Nothing,
          $sel:network:RunFlags :: Maybe RunNetwork
network = forall a. Maybe a
Nothing
        }

newtype EscapeChar
  = EscapeChar
      { EscapeChar -> Char
escape :: Char
      }
  deriving (Int -> EscapeChar -> ShowS
[EscapeChar] -> ShowS
EscapeChar -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapeChar] -> ShowS
$cshowList :: [EscapeChar] -> ShowS
show :: EscapeChar -> String
$cshow :: EscapeChar -> String
showsPrec :: Int -> EscapeChar -> ShowS
$cshowsPrec :: Int -> EscapeChar -> ShowS
Show, EscapeChar -> EscapeChar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapeChar -> EscapeChar -> Bool
$c/= :: EscapeChar -> EscapeChar -> Bool
== :: EscapeChar -> EscapeChar -> Bool
$c== :: EscapeChar -> EscapeChar -> Bool
Eq, Eq EscapeChar
EscapeChar -> EscapeChar -> Bool
EscapeChar -> EscapeChar -> Ordering
EscapeChar -> EscapeChar -> EscapeChar
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 :: EscapeChar -> EscapeChar -> EscapeChar
$cmin :: EscapeChar -> EscapeChar -> EscapeChar
max :: EscapeChar -> EscapeChar -> EscapeChar
$cmax :: EscapeChar -> EscapeChar -> EscapeChar
>= :: EscapeChar -> EscapeChar -> Bool
$c>= :: EscapeChar -> EscapeChar -> Bool
> :: EscapeChar -> EscapeChar -> Bool
$c> :: EscapeChar -> EscapeChar -> Bool
<= :: EscapeChar -> EscapeChar -> Bool
$c<= :: EscapeChar -> EscapeChar -> Bool
< :: EscapeChar -> EscapeChar -> Bool
$c< :: EscapeChar -> EscapeChar -> Bool
compare :: EscapeChar -> EscapeChar -> Ordering
$ccompare :: EscapeChar -> EscapeChar -> Ordering
Ord)

instance IsChar EscapeChar where
  fromChar :: Char -> EscapeChar
fromChar Char
c =
    EscapeChar {$sel:escape:EscapeChar :: Char
escape = Char
c}
  toChar :: EscapeChar -> Char
toChar EscapeChar
e = EscapeChar -> Char
escape EscapeChar
e

newtype SyntaxImage
  = SyntaxImage
      { SyntaxImage -> Image
syntax :: Image
      }
  deriving (Int -> SyntaxImage -> ShowS
[SyntaxImage] -> ShowS
SyntaxImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SyntaxImage] -> ShowS
$cshowList :: [SyntaxImage] -> ShowS
show :: SyntaxImage -> String
$cshow :: SyntaxImage -> String
showsPrec :: Int -> SyntaxImage -> ShowS
$cshowsPrec :: Int -> SyntaxImage -> ShowS
Show, SyntaxImage -> SyntaxImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SyntaxImage -> SyntaxImage -> Bool
$c/= :: SyntaxImage -> SyntaxImage -> Bool
== :: SyntaxImage -> SyntaxImage -> Bool
$c== :: SyntaxImage -> SyntaxImage -> Bool
Eq, Eq SyntaxImage
SyntaxImage -> SyntaxImage -> Bool
SyntaxImage -> SyntaxImage -> Ordering
SyntaxImage -> SyntaxImage -> SyntaxImage
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 :: SyntaxImage -> SyntaxImage -> SyntaxImage
$cmin :: SyntaxImage -> SyntaxImage -> SyntaxImage
max :: SyntaxImage -> SyntaxImage -> SyntaxImage
$cmax :: SyntaxImage -> SyntaxImage -> SyntaxImage
>= :: SyntaxImage -> SyntaxImage -> Bool
$c>= :: SyntaxImage -> SyntaxImage -> Bool
> :: SyntaxImage -> SyntaxImage -> Bool
$c> :: SyntaxImage -> SyntaxImage -> Bool
<= :: SyntaxImage -> SyntaxImage -> Bool
$c<= :: SyntaxImage -> SyntaxImage -> Bool
< :: SyntaxImage -> SyntaxImage -> Bool
$c< :: SyntaxImage -> SyntaxImage -> Bool
compare :: SyntaxImage -> SyntaxImage -> Ordering
$ccompare :: SyntaxImage -> SyntaxImage -> Ordering
Ord)

data PragmaDirective
  = Escape !EscapeChar
  | Syntax !SyntaxImage
  deriving (Int -> PragmaDirective -> ShowS
[PragmaDirective] -> ShowS
PragmaDirective -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PragmaDirective] -> ShowS
$cshowList :: [PragmaDirective] -> ShowS
show :: PragmaDirective -> String
$cshow :: PragmaDirective -> String
showsPrec :: Int -> PragmaDirective -> ShowS
$cshowsPrec :: Int -> PragmaDirective -> ShowS
Show, PragmaDirective -> PragmaDirective -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PragmaDirective -> PragmaDirective -> Bool
$c/= :: PragmaDirective -> PragmaDirective -> Bool
== :: PragmaDirective -> PragmaDirective -> Bool
$c== :: PragmaDirective -> PragmaDirective -> Bool
Eq, Eq PragmaDirective
PragmaDirective -> PragmaDirective -> Bool
PragmaDirective -> PragmaDirective -> Ordering
PragmaDirective -> PragmaDirective -> PragmaDirective
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 :: PragmaDirective -> PragmaDirective -> PragmaDirective
$cmin :: PragmaDirective -> PragmaDirective -> PragmaDirective
max :: PragmaDirective -> PragmaDirective -> PragmaDirective
$cmax :: PragmaDirective -> PragmaDirective -> PragmaDirective
>= :: PragmaDirective -> PragmaDirective -> Bool
$c>= :: PragmaDirective -> PragmaDirective -> Bool
> :: PragmaDirective -> PragmaDirective -> Bool
$c> :: PragmaDirective -> PragmaDirective -> Bool
<= :: PragmaDirective -> PragmaDirective -> Bool
$c<= :: PragmaDirective -> PragmaDirective -> Bool
< :: PragmaDirective -> PragmaDirective -> Bool
$c< :: PragmaDirective -> PragmaDirective -> Bool
compare :: PragmaDirective -> PragmaDirective -> Ordering
$ccompare :: PragmaDirective -> PragmaDirective -> Ordering
Ord)

-- | All commands available in Dockerfiles
data Instruction args
  = From !BaseImage
  | Add !AddArgs !AddFlags
  | User !Text
  | Label !Pairs
  | Stopsignal !Text
  | Copy !CopyArgs !CopyFlags
  | 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)
  | Pragma !PragmaDirective
  | Comment !Text
  | OnBuild !(Instruction args)
  deriving (Instruction args -> Instruction args -> Bool
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, Instruction args -> Instruction args -> Ordering
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
Ord, Int -> Instruction args -> ShowS
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, 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
<$ :: forall a b. a -> Instruction b -> Instruction a
$c<$ :: forall a b. a -> Instruction b -> Instruction a
fmap :: forall a b. (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
      { forall args. InstructionPos args -> Instruction args
instruction :: !(Instruction args),
        forall args. InstructionPos args -> Text
sourcename :: !Filename,
        forall args. InstructionPos args -> Int
lineNumber :: !Linenumber
      }
  deriving (InstructionPos args -> InstructionPos args -> Bool
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, InstructionPos args -> InstructionPos args -> Bool
InstructionPos args -> InstructionPos args -> Ordering
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
Ord, Int -> InstructionPos args -> ShowS
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, 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
<$ :: forall a b. a -> InstructionPos b -> InstructionPos a
$c<$ :: forall a b. a -> InstructionPos b -> InstructionPos a
fmap :: forall a b. (a -> b) -> InstructionPos a -> InstructionPos b
$cfmap :: forall a b. (a -> b) -> InstructionPos a -> InstructionPos b
Functor)

defaultEsc :: Char
defaultEsc :: Char
defaultEsc = Char
'\\'