module Language.Docker.Parser.Instruction
  ( parseArg,
    parseComment,
    parseEntryPoint,
    parseEscapePragma,
    parseInstruction,
    parseMaintainer,
    parseOnbuild,
    parsePragma,
    parseShell,
    parseStopSignal,
    parseSyntaxPragma,
    parseUser,
    parseVolume,
    parseWorkdir,
  )
where

import Language.Docker.Parser.Arguments (arguments)
import Language.Docker.Parser.Cmd (parseCmd)
import Language.Docker.Parser.Copy (parseAdd, parseCopy)
import Language.Docker.Parser.Expose (parseExpose)
import Language.Docker.Parser.From (parseFrom)
import Language.Docker.Parser.Healthcheck (parseHealthcheck)
import Language.Docker.Parser.Pairs (parseEnv, parseLabel)
import Language.Docker.Parser.Prelude
import Language.Docker.Parser.Run (parseRun)
import Language.Docker.Syntax

parseShell :: (?esc :: Char) => Parser (Instruction Text)
parseShell :: Parser (Instruction Text)
parseShell = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"SHELL"
  Arguments Text -> Instruction Text
forall args. Arguments args -> Instruction args
Shell (Arguments Text -> Instruction Text)
-> ParsecT DockerfileError Text Identity (Arguments Text)
-> Parser (Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity (Arguments Text)
(?esc::Char) =>
ParsecT DockerfileError Text Identity (Arguments Text)
arguments

parseStopSignal :: (?esc :: Char) => Parser (Instruction Text)
parseStopSignal :: Parser (Instruction Text)
parseStopSignal = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"STOPSIGNAL"
  Text
args <- (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the stop signal"
  Instruction Text -> Parser (Instruction Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction Text -> Parser (Instruction Text))
-> Instruction Text -> Parser (Instruction Text)
forall a b. (a -> b) -> a -> b
$ Text -> Instruction Text
forall args. Text -> Instruction args
Stopsignal Text
args

parseArg :: (?esc :: Char) => Parser (Instruction Text)
parseArg :: Parser (Instruction Text)
parseArg = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"ARG"
  (Parser (Instruction Text) -> Parser (Instruction Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Instruction Text)
forall args.
ParsecT DockerfileError Text Identity (Instruction args)
nameWithDefault Parser (Instruction Text) -> String -> Parser (Instruction Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"the arg name")
    Parser (Instruction Text)
-> Parser (Instruction Text) -> Parser (Instruction Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser (Instruction Text) -> Parser (Instruction Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Instruction Text)
forall args.
ParsecT DockerfileError Text Identity (Instruction args)
nameWithoutDefault Parser (Instruction Text) -> String -> Parser (Instruction Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"the arg name")
    Parser (Instruction Text)
-> Parser (Instruction Text) -> Parser (Instruction Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text -> Instruction Text
forall args. Text -> Maybe Text -> Instruction args
Arg (Text -> Maybe Text -> Instruction Text)
-> Parser Text
-> ParsecT
     DockerfileError Text Identity (Maybe Text -> Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the argument name" ParsecT
  DockerfileError Text Identity (Maybe Text -> Instruction Text)
-> ParsecT DockerfileError Text Identity (Maybe Text)
-> Parser (Instruction Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> ParsecT DockerfileError Text Identity (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
  where
    nameWithoutDefault :: ParsecT DockerfileError Text Identity (Instruction args)
nameWithoutDefault = do
      Text
name <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
"the argument name" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=')
      Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the rest"
      Instruction args
-> ParsecT DockerfileError Text Identity (Instruction args)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction args
 -> ParsecT DockerfileError Text Identity (Instruction args))
-> Instruction args
-> ParsecT DockerfileError Text Identity (Instruction args)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Instruction args
forall args. Text -> Maybe Text -> Instruction args
Arg Text
name Maybe Text
forall a. Maybe a
Nothing
    nameWithDefault :: ParsecT DockerfileError Text Identity (Instruction args)
nameWithDefault = do
      Text
name <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
"the argument name" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=')
      ParsecT DockerfileError Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity Char -> Parser ())
-> ParsecT DockerfileError Text Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT DockerfileError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
      Text
df <- (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the argument value"
      Instruction args
-> ParsecT DockerfileError Text Identity (Instruction args)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction args
 -> ParsecT DockerfileError Text Identity (Instruction args))
-> Instruction args
-> ParsecT DockerfileError Text Identity (Instruction args)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Instruction args
forall args. Text -> Maybe Text -> Instruction args
Arg Text
name (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
df)

parseUser :: (?esc :: Char) => Parser (Instruction Text)
parseUser :: Parser (Instruction Text)
parseUser = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"USER"
  Text
username <- (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the user"
  Instruction Text -> Parser (Instruction Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction Text -> Parser (Instruction Text))
-> Instruction Text -> Parser (Instruction Text)
forall a b. (a -> b) -> a -> b
$ Text -> Instruction Text
forall args. Text -> Instruction args
User Text
username

parseWorkdir :: (?esc :: Char) => Parser (Instruction Text)
parseWorkdir :: Parser (Instruction Text)
parseWorkdir = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"WORKDIR"
  Text
directory <- (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the workdir path"
  Instruction Text -> Parser (Instruction Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction Text -> Parser (Instruction Text))
-> Instruction Text -> Parser (Instruction Text)
forall a b. (a -> b) -> a -> b
$ Text -> Instruction Text
forall args. Text -> Instruction args
Workdir Text
directory

parseVolume :: (?esc :: Char) => Parser (Instruction Text)
parseVolume :: Parser (Instruction Text)
parseVolume = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"VOLUME"
  Text
directory <- (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the volume path"
  Instruction Text -> Parser (Instruction Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction Text -> Parser (Instruction Text))
-> Instruction Text -> Parser (Instruction Text)
forall a b. (a -> b) -> a -> b
$ Text -> Instruction Text
forall args. Text -> Instruction args
Volume Text
directory

parseMaintainer :: (?esc :: Char) => Parser (Instruction Text)
parseMaintainer :: Parser (Instruction Text)
parseMaintainer = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"MAINTAINER"
  Text
name <- (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the maintainer name"
  Instruction Text -> Parser (Instruction Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction Text -> Parser (Instruction Text))
-> Instruction Text -> Parser (Instruction Text)
forall a b. (a -> b) -> a -> b
$ Text -> Instruction Text
forall args. Text -> Instruction args
Maintainer Text
name

parseEntryPoint :: (?esc :: Char) => Parser (Instruction Text)
parseEntryPoint :: Parser (Instruction Text)
parseEntryPoint = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"ENTRYPOINT"
  Arguments Text -> Instruction Text
forall args. Arguments args -> Instruction args
Entrypoint (Arguments Text -> Instruction Text)
-> ParsecT DockerfileError Text Identity (Arguments Text)
-> Parser (Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity (Arguments Text)
(?esc::Char) =>
ParsecT DockerfileError Text Identity (Arguments Text)
arguments

parseOnbuild :: (?esc :: Char) => Parser (Instruction Text)
parseOnbuild :: Parser (Instruction Text)
parseOnbuild = do
  (?esc::Char) => Text -> Parser ()
Text -> Parser ()
reserved Text
"ONBUILD"
  Instruction Text -> Instruction Text
forall args. Instruction args -> Instruction args
OnBuild (Instruction Text -> Instruction Text)
-> Parser (Instruction Text) -> Parser (Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseInstruction

parsePragma :: (?esc :: Char) => Parser (Instruction Text)
parsePragma :: Parser (Instruction Text)
parsePragma = do
  ParsecT DockerfileError Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity Char -> Parser ())
-> ParsecT DockerfileError Text Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Char
forall a. Parser a -> Parser a
lexeme' (Token Text -> ParsecT DockerfileError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#')
  [Parser (Instruction Text)] -> Parser (Instruction Text)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser (Instruction Text)
parseEscapePragma Parser (Instruction Text) -> String -> Parser (Instruction Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"an escape",
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseSyntaxPragma Parser (Instruction Text) -> String -> Parser (Instruction Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"a syntax"
    ]

parseEscapePragma :: Parser (Instruction Text)
parseEscapePragma :: Parser (Instruction Text)
parseEscapePragma = do
  Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' (Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"escape")
  Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' (Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"=")
  PragmaDirective -> Instruction Text
forall args. PragmaDirective -> Instruction args
Pragma (PragmaDirective -> Instruction Text)
-> (Char -> PragmaDirective) -> Char -> Instruction Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EscapeChar -> PragmaDirective
Escape (EscapeChar -> PragmaDirective)
-> (Char -> EscapeChar) -> Char -> PragmaDirective
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> EscapeChar
EscapeChar (Char -> Instruction Text)
-> ParsecT DockerfileError Text Identity Char
-> Parser (Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
charLiteral

parseSyntaxPragma :: (?esc :: Char) => Parser (Instruction Text)
parseSyntaxPragma :: Parser (Instruction Text)
parseSyntaxPragma = do
  Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' (Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"syntax")
  Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' (Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"=")
  Text
img <- (?esc::Char) => String -> Parser Text
String -> Parser Text
untilEol String
"the syntax"
  Instruction Text -> Parser (Instruction Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction Text -> Parser (Instruction Text))
-> Instruction Text -> Parser (Instruction Text)
forall a b. (a -> b) -> a -> b
$ PragmaDirective -> Instruction Text
forall args. PragmaDirective -> Instruction args
Pragma
      ( SyntaxImage -> PragmaDirective
Syntax
          ( Image -> SyntaxImage
SyntaxImage
              ( Image :: Maybe Registry -> Text -> Image
Image
                  { $sel:registryName:Image :: Maybe Registry
registryName = Maybe Registry
forall a. Maybe a
Nothing,
                    $sel:imageName:Image :: Text
imageName = Text
img
                  }
              )
          )
      )

parseComment :: (?esc :: Char) => Parser (Instruction Text)
parseComment :: Parser (Instruction Text)
parseComment = (Parser (Instruction Text) -> Parser (Instruction Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parsePragma Parser (Instruction Text) -> String -> Parser (Instruction Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"a pragma") Parser (Instruction Text)
-> Parser (Instruction Text) -> Parser (Instruction Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Instruction Text
forall args. Text -> Instruction args
Comment (Text -> Instruction Text)
-> Parser Text -> Parser (Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
comment

parseInstruction :: (?esc :: Char) => Parser (Instruction Text)
parseInstruction :: Parser (Instruction Text)
parseInstruction =
  [Parser (Instruction Text)] -> Parser (Instruction Text)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseOnbuild,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseFrom,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseCopy,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseRun,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseWorkdir,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseEntryPoint,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseVolume,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseExpose,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseEnv,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseArg,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseUser,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseLabel,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseStopSignal,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseCmd,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseShell,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseMaintainer,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseAdd,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseComment,
      Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseHealthcheck
    ]