module Language.Docker.Parser.From
  ( parseFrom,
  )
where

import qualified Data.Text as T
import Language.Docker.Parser.Prelude
import Language.Docker.Syntax

parseRegistry :: (?esc :: Char) => Parser Registry
parseRegistry :: (?esc::Char) => Parser Registry
parseRegistry = do
  domain <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
"a domain name" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
  void $ char '.'
  tld <- someUnless "a TLD" (== '/')
  void $ char '/'
  return $ Registry (domain <> "." <> tld)

parsePlatform :: (?esc :: Char) => Parser Platform
parsePlatform :: (?esc::Char) => Parser Text
parsePlatform = do
  ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity (Tokens Text)
 -> ParsecT DockerfileError Text Identity ())
-> ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--platform="
  p <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
"the platform for the FROM image" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
  requiredWhitespace
  return p

parseBaseImage :: (?esc :: Char) => (Text -> Parser (Maybe Tag)) -> Parser BaseImage
parseBaseImage :: (?esc::Char) => (Text -> Parser (Maybe Tag)) -> Parser BaseImage
parseBaseImage Text -> Parser (Maybe Tag)
tagParser = do
  maybePlatform <- (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Parser Text
-> ParsecT DockerfileError Text Identity (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Text
(?esc::Char) => Parser Text
parsePlatform) ParsecT DockerfileError Text Identity (Maybe Text)
-> ParsecT DockerfileError Text Identity (Maybe Text)
-> ParsecT DockerfileError Text Identity (Maybe Text)
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> ParsecT DockerfileError Text Identity (Maybe Text)
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
  notFollowedBy (string "--")
  regName <- (Just <$> try parseRegistry) <|> return Nothing
  name <- someUnless "the image name with a tag" (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')
  maybeTag <- tagParser name <|> return Nothing
  maybeDigest <- (Just <$> try parseDigest) <|> return Nothing
  maybeAlias <- (Just <$> try (requiredWhitespace *> imageAlias)) <|> return Nothing
  return $ BaseImage (Image regName name) maybeTag maybeDigest maybeAlias maybePlatform

taggedImage :: (?esc :: Char) => Parser BaseImage
taggedImage :: (?esc::Char) => Parser BaseImage
taggedImage = (?esc::Char) => (Text -> Parser (Maybe Tag)) -> Parser BaseImage
(Text -> Parser (Maybe Tag)) -> Parser BaseImage
parseBaseImage Text -> Parser (Maybe Tag)
forall {p}. (?esc::Char) => p -> Parser (Maybe Tag)
tagParser
  where
    tagParser :: p -> Parser (Maybe Tag)
tagParser p
_ = do
      ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity Char
 -> ParsecT DockerfileError Text Identity ())
-> ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity ()
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
':'
      t <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
"the image tag" (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')
      return (Just . Tag $ t)

parseDigest :: (?esc :: Char) => Parser Digest
parseDigest :: (?esc::Char) => ParsecT DockerfileError Text Identity Digest
parseDigest = do
  ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity Char
 -> ParsecT DockerfileError Text Identity ())
-> ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity ()
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
'@'
  d <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
"the image digest" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@')
  return $ Digest d

untaggedImage :: (?esc :: Char) => Parser BaseImage
untaggedImage :: (?esc::Char) => Parser BaseImage
untaggedImage = (?esc::Char) => (Text -> Parser (Maybe Tag)) -> Parser BaseImage
(Text -> Parser (Maybe Tag)) -> Parser BaseImage
parseBaseImage Text -> Parser (Maybe Tag)
notInvalidTag
  where
    notInvalidTag :: Text -> Parser (Maybe Tag)
    notInvalidTag :: Text -> Parser (Maybe Tag)
notInvalidTag Text
name = do
      ParsecT DockerfileError Text Identity ()
-> ParsecT DockerfileError Text Identity ()
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity ()
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT DockerfileError Text Identity (Tokens Text)
 -> ParsecT DockerfileError Text Identity ())
-> ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":") ParsecT DockerfileError Text Identity ()
-> String -> ParsecT DockerfileError Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"no ':' or a valid image tag string (example: "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":valid-tag)"
      Maybe Tag -> Parser (Maybe Tag)
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Tag
forall a. Maybe a
Nothing

imageAlias :: (?esc :: Char) => Parser ImageAlias
imageAlias :: (?esc::Char) => ParsecT DockerfileError Text Identity ImageAlias
imageAlias = do
  ParsecT DockerfileError Text Identity ()
-> ParsecT DockerfileError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity ()
-> ParsecT DockerfileError Text Identity ()
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((?esc::Char) => Text -> ParsecT DockerfileError Text Identity ()
Text -> ParsecT DockerfileError Text Identity ()
reserved Text
"AS") ParsecT DockerfileError Text Identity ()
-> String -> ParsecT DockerfileError Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"'AS' followed by the image alias")
  aka <- (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
"the image alias" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
  return $ ImageAlias aka

baseImage :: (?esc :: Char) => Parser BaseImage
baseImage :: (?esc::Char) => Parser BaseImage
baseImage = Parser BaseImage -> Parser BaseImage
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser BaseImage
(?esc::Char) => Parser BaseImage
taggedImage Parser BaseImage -> Parser BaseImage -> Parser BaseImage
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser BaseImage
(?esc::Char) => Parser BaseImage
untaggedImage

parseFrom :: (?esc :: Char) => Parser (Instruction Text)
parseFrom :: (?esc::Char) => Parser (Instruction Text)
parseFrom = do
  (?esc::Char) => Text -> ParsecT DockerfileError Text Identity ()
Text -> ParsecT DockerfileError Text Identity ()
reserved Text
"FROM"
  BaseImage -> Instruction Text
forall args. BaseImage -> Instruction args
From (BaseImage -> Instruction Text)
-> Parser BaseImage -> Parser (Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BaseImage
(?esc::Char) => Parser BaseImage
baseImage