module Language.Docker.Parser.Copy
  ( parseCopy,
    parseAdd,
  )
where

import Data.List.NonEmpty (NonEmpty, fromList)
import qualified Data.Text as T
import Language.Docker.Parser.Prelude
import Language.Docker.Syntax

data Flag
  = FlagChown Chown
  | FlagChmod Chmod
  | FlagLink Link
  | FlagSource CopySource
  | FlagInvalid (Text, Text)

parseCopy :: (?esc :: Char) => Parser (Instruction Text)
parseCopy :: (?esc::Char) => Parser (Instruction Text)
parseCopy = do
  (?esc::Char) => Text -> Parser ()
reserved Text
"COPY"
  [Flag]
flags <- (?esc::Char) => Parser Flag
copyFlag forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` (?esc::Char) => Parser ()
requiredWhitespace
  let chownFlags :: [Chown]
chownFlags = [Chown
c | FlagChown Chown
c <- [Flag]
flags]
  let chmodFlags :: [Chmod]
chmodFlags = [Chmod
c | FlagChmod Chmod
c <- [Flag]
flags]
  let linkFlags :: [Link]
linkFlags = [Link
l | FlagLink Link
l <- [Flag]
flags]
  let sourceFlags :: [CopySource]
sourceFlags = [CopySource
f | FlagSource CopySource
f <- [Flag]
flags]
  let invalid :: [(Text, Text)]
invalid = [(Text, Text)
i | FlagInvalid (Text, Text)
i <- [Flag]
flags]
  -- Let's do some validation on the flags
  case ([(Text, Text)]
invalid, [Chown]
chownFlags, [Chmod]
chmodFlags, [Link]
linkFlags, [CopySource]
sourceFlags) of
    ((Text
k, Text
v) : [(Text, Text)]
_, [Chown]
_, [Chmod]
_, [Link]
_, [CopySource]
_) -> forall a. Text -> Text -> Parser a
unexpectedFlag Text
k Text
v
    ([(Text, Text)]
_, Chown
_ : Chown
_ : [Chown]
_, [Chmod]
_, [Link]
_, [CopySource]
_) -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
DuplicateFlagError String
"--chown"
    ([(Text, Text)]
_, [Chown]
_, Chmod
_ : Chmod
_ : [Chmod]
_, [Link]
_, [CopySource]
_) -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
DuplicateFlagError String
"--chmod"
    ([(Text, Text)]
_, [Chown]
_, [Chmod]
_, Link
_ : Link
_ : [Link]
_, [CopySource]
_) -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
DuplicateFlagError String
"--link"
    ([(Text, Text)]
_, [Chown]
_, [Chmod]
_, [Link]
_, CopySource
_ : CopySource
_ : [CopySource]
_) -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
DuplicateFlagError String
"--from"
    ([(Text, Text)], [Chown], [Chmod], [Link], [CopySource])
_ -> do
      let cho :: Chown
cho =
            case [Chown]
chownFlags of
              [] -> Chown
NoChown
              Chown
c : [Chown]
_ -> Chown
c
      let chm :: Chmod
chm =
            case [Chmod]
chmodFlags of
              [] -> Chmod
NoChmod
              Chmod
c : [Chmod]
_ -> Chmod
c
      let lnk :: Link
lnk =
            case [Link]
linkFlags of
              [] -> Link
NoLink
              Link
l : [Link]
_ -> Link
l
      let fr :: CopySource
fr =
            case [CopySource]
sourceFlags of
              [] -> CopySource
NoSource
              CopySource
f : [CopySource]
_ -> CopySource
f
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((?esc::Char) =>
(NonEmpty SourcePath -> TargetPath -> Instruction Text)
-> Parser (Instruction Text)
heredocList (\NonEmpty SourcePath
src TargetPath
dest -> forall args. CopyArgs -> CopyFlags -> Instruction args
Copy (NonEmpty SourcePath -> TargetPath -> CopyArgs
CopyArgs NonEmpty SourcePath
src TargetPath
dest) (Chown -> Chmod -> Link -> CopySource -> CopyFlags
CopyFlags Chown
cho Chmod
chm Link
lnk CopySource
fr)))
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (?esc::Char) =>
Text
-> (NonEmpty SourcePath -> TargetPath -> Instruction Text)
-> Parser (Instruction Text)
fileList Text
"COPY" (\NonEmpty SourcePath
src TargetPath
dest -> forall args. CopyArgs -> CopyFlags -> Instruction args
Copy (NonEmpty SourcePath -> TargetPath -> CopyArgs
CopyArgs NonEmpty SourcePath
src TargetPath
dest) (Chown -> Chmod -> Link -> CopySource -> CopyFlags
CopyFlags Chown
cho Chmod
chm Link
lnk CopySource
fr))

parseAdd :: (?esc :: Char) => Parser (Instruction Text)
parseAdd :: (?esc::Char) => Parser (Instruction Text)
parseAdd = do
  (?esc::Char) => Text -> Parser ()
reserved Text
"ADD"
  [Flag]
flags <- (?esc::Char) => Parser Flag
addFlag forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` (?esc::Char) => Parser ()
requiredWhitespace
  let chownFlags :: [Chown]
chownFlags = [Chown
c | FlagChown Chown
c <- [Flag]
flags]
  let chmodFlags :: [Chmod]
chmodFlags = [Chmod
c | FlagChmod Chmod
c <- [Flag]
flags]
  let linkFlags :: [Link]
linkFlags = [Link
l | FlagLink Link
l <- [Flag]
flags]
  let invalidFlags :: [(Text, Text)]
invalidFlags = [(Text, Text)
i | FlagInvalid (Text, Text)
i <- [Flag]
flags]
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--") forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?>
    String
"only the --chown flag, the --chmod flag or the src and dest paths"
  case ([(Text, Text)]
invalidFlags, [Chown]
chownFlags, [Link]
linkFlags, [Chmod]
chmodFlags) of
    ((Text
k, Text
v) : [(Text, Text)]
_, [Chown]
_, [Link]
_, [Chmod]
_) -> forall a. Text -> Text -> Parser a
unexpectedFlag Text
k Text
v
    ([(Text, Text)]
_, Chown
_ : Chown
_ : [Chown]
_, [Link]
_, [Chmod]
_) -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
DuplicateFlagError String
"--chown"
    ([(Text, Text)]
_, [Chown]
_, Link
_ : Link
_ : [Link]
_, [Chmod]
_) -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
DuplicateFlagError String
"--chmod"
    ([(Text, Text)]
_, [Chown]
_, [Link]
_, Chmod
_ : Chmod
_ : [Chmod]
_) -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
DuplicateFlagError String
"--link"
    ([(Text, Text)], [Chown], [Link], [Chmod])
_ -> do
      let cho :: Chown
cho = case [Chown]
chownFlags of
                  [] -> Chown
NoChown
                  Chown
c : [Chown]
_ -> Chown
c
      let chm :: Chmod
chm = case [Chmod]
chmodFlags of
                  [] -> Chmod
NoChmod
                  Chmod
c : [Chmod]
_ -> Chmod
c
      let lnk :: Link
lnk =
            case [Link]
linkFlags of
              [] -> Link
NoLink
              Link
l : [Link]
_ -> Link
l
      (?esc::Char) =>
Text
-> (NonEmpty SourcePath -> TargetPath -> Instruction Text)
-> Parser (Instruction Text)
fileList Text
"ADD" (\NonEmpty SourcePath
src TargetPath
dest -> forall args. AddArgs -> AddFlags -> Instruction args
Add (NonEmpty SourcePath -> TargetPath -> AddArgs
AddArgs NonEmpty SourcePath
src TargetPath
dest) (Chown -> Chmod -> Link -> AddFlags
AddFlags Chown
cho Chmod
chm Link
lnk))

heredocList :: (?esc :: Char) =>
               (NonEmpty SourcePath -> TargetPath -> Instruction Text) ->
               Parser (Instruction Text)
heredocList :: (?esc::Char) =>
(NonEmpty SourcePath -> TargetPath -> Instruction Text)
-> Parser (Instruction Text)
heredocList NonEmpty SourcePath -> TargetPath -> Instruction Text
constr = do
  [Text]
markers <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall a. Parser a -> Parser [a]
spaceSep1 (?esc::Char) => Parser Text
heredocMarker) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"a list of heredoc markers"
  Text
target <- (?esc::Char) => String -> Parser Text
untilEol String
"target path"
  case forall a. [a] -> [a]
reverse [Text]
markers of
    [] -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
FileListError String
"empty list of heredoc markers"
    Text
m:[Text]
_ -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
heredocContent Text
m
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NonEmpty SourcePath -> TargetPath -> Instruction Text
constr (Text -> SourcePath
SourcePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> NonEmpty a
fromList [Text]
markers) (Text -> TargetPath
TargetPath Text
target)

fileList :: (?esc :: Char) => Text ->
            (NonEmpty SourcePath -> TargetPath -> Instruction Text) ->
            Parser (Instruction Text)
fileList :: (?esc::Char) =>
Text
-> (NonEmpty SourcePath -> TargetPath -> Instruction Text)
-> Parser (Instruction Text)
fileList Text
name NonEmpty SourcePath -> TargetPath -> Instruction Text
constr = do
  [Text]
paths <-
    (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT DockerfileError Text Identity [Text]
stringList forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"an array of strings [\"src_file\", \"dest_file\"]")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT DockerfileError Text Identity [Text]
spaceSeparated forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"a space separated list of file paths")
  case [Text]
paths of
    [Text
_] -> forall a. DockerfileError -> Parser a
customError forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
FileListError (Text -> String
T.unpack Text
name)
    [Text]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NonEmpty SourcePath -> TargetPath -> Instruction Text
constr (Text -> SourcePath
SourcePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> NonEmpty a
fromList (forall a. [a] -> [a]
init [Text]
paths)) (Text -> TargetPath
TargetPath forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Text]
paths)
  where
    spaceSeparated :: ParsecT DockerfileError Text Identity [Text]
spaceSeparated =
      (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnless String
"a file" (forall a. Eq a => a -> a -> Bool
== Char
' ') forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy1` (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (?esc::Char) => Parser ()
requiredWhitespace forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"at least another file path")
    stringList :: ParsecT DockerfileError Text Identity [Text]
stringList = forall a. (?esc::Char) => Parser a -> Parser a
brackets forall a b. (a -> b) -> a -> b
$ forall a. (?esc::Char) => Parser a -> Parser [a]
commaSep Parser Text
doubleQuotedString

unexpectedFlag :: Text -> Text -> Parser a
unexpectedFlag :: forall a. Text -> Text -> Parser a
unexpectedFlag Text
name Text
"" = forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
NoValueFlagError (Text -> String
T.unpack Text
name)
unexpectedFlag Text
name Text
_ = forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ String -> DockerfileError
InvalidFlagError (Text -> String
T.unpack Text
name)

copyFlag :: (?esc :: Char) => Parser Flag
copyFlag :: (?esc::Char) => Parser Flag
copyFlag = (CopySource -> Flag
FlagSource forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (?esc::Char) => Parser CopySource
copySource forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"only one --from") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (?esc::Char) => Parser Flag
addFlag

addFlag :: (?esc :: Char) => Parser Flag
addFlag :: (?esc::Char) => Parser Flag
addFlag = (Chown -> Flag
FlagChown forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (?esc::Char) => Parser Chown
chown forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"--chown")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Chmod -> Flag
FlagChmod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (?esc::Char) => Parser Chmod
chmod forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"--chmod")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Link -> Flag
FlagLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Link
link forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"--link")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text, Text) -> Flag
FlagInvalid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (?esc::Char) => Parser (Text, Text)
anyFlag forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"other flag")

chown :: (?esc :: Char) => Parser Chown
chown :: (?esc::Char) => Parser Chown
chown = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--chown="
  Text
cho <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnless String
"the user and group for chown" (forall a. Eq a => a -> a -> Bool
== Char
' ')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Chown
Chown Text
cho

chmod :: (?esc :: Char) => Parser Chmod
chmod :: (?esc::Char) => Parser Chmod
chmod = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--chmod="
  Text
chm <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnless String
"the mode for chmod" (forall a. Eq a => a -> a -> Bool
== Char
' ')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Chmod
Chmod Text
chm

link :: Parser Link
link :: Parser Link
link = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--link"
  forall (m :: * -> *) a. Monad m => a -> m a
return Link
Link

copySource :: (?esc :: Char) => Parser CopySource
copySource :: (?esc::Char) => Parser CopySource
copySource = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--from="
  Text
src <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnless String
"the copy source path" Char -> Bool
isNl
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> CopySource
CopySource Text
src

anyFlag :: (?esc :: Char) => Parser (Text, Text)
anyFlag :: (?esc::Char) => Parser (Text, Text)
anyFlag = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--"
  Text
name <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnless String
"the flag value" (forall a. Eq a => a -> a -> Bool
== Char
'=')
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
  Text
val <- (?esc::Char) => (Char -> Bool) -> Parser Text
anyUnless (forall a. Eq a => a -> a -> Bool
== Char
' ')
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Text
T.append Text
"--" Text
name, Text
val)