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
someUnlessExpanded String
"a domain name" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
  void $ char '.'
  tld <- someUnlessExpanded "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

-- | Like someUnless, but a ${...} parameter expansion is opaque: a ':' or '@'
-- inside it (the :- :? :+ operators) is not read as the tag or digest
-- separator. One linear pass, bounded to the current line.
someUnlessExpanded :: (?esc :: Char) => String -> (Char -> Bool) -> Parser Text
someUnlessExpanded :: (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnlessExpanded String
name Char -> Bool
predicate =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ParsecT DockerfileError Text Identity [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT DockerfileError Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Parser Text
variableExpansion Parser Text -> Parser Text -> Parser 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
<|> Parser Text
literalRun) Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
name
  where
    literalRun :: Parser Text
literalRun = (?esc::Char) => String -> (Char -> Bool) -> Parser Text
String -> (Char -> Bool) -> Parser Text
someUnless String
name (\Char
c -> Char -> Bool
predicate Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$')

-- | A '$' and, when it opens one, the balanced ${...} that follows. The scan
-- stops at whitespace, so an unterminated '${' stays literal text bounded like
-- any image reference (it cannot swallow a same-line 'AS' alias or a later
-- instruction, nor backtrack). Fragments are collected in a list and joined
-- once, so deep nesting stays linear.
variableExpansion :: Parser Text
variableExpansion :: Parser Text
variableExpansion = 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
'$'
  brace <- ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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
'{')
  case brace of
    Maybe Char
Nothing -> Text -> Parser Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"$"
    Just Char
_ -> (Text
"${" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tokens Text]
-> Int -> ParsecT DockerfileError Text Identity (Tokens Text)
forall {s} {m :: * -> *} {e} {a}.
(Token s ~ Char, MonadParsec e s m, IsString (Tokens s), Num a,
 Monoid (Tokens s), Ord a) =>
[Tokens s] -> a -> m (Tokens s)
braces [] (Int
1 :: Int)
  where
    braces :: [Tokens s] -> a -> m (Tokens s)
braces [Tokens s]
acc a
depth = do
      piece <- Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token s
c -> Char
Token s
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'{', Char
'}', Char
' ', Char
'\t', Char
'\n'])
      next <- optional (char '{' <|> char '}')
      case next of
        Just Char
'{' -> [Tokens s] -> a -> m (Tokens s)
braces (Tokens s
"{" Tokens s -> [Tokens s] -> [Tokens s]
forall a. a -> [a] -> [a]
: Tokens s
piece Tokens s -> [Tokens s] -> [Tokens s]
forall a. a -> [a] -> [a]
: [Tokens s]
acc) (a -> m (Tokens s)) -> a -> m (Tokens s)
forall a b. (a -> b) -> a -> b
$! a
depth a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
        Just Char
'}'
          | a
depth a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1 -> Tokens s -> m (Tokens s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tokens s -> m (Tokens s)) -> Tokens s -> m (Tokens s)
forall a b. (a -> b) -> a -> b
$ [Tokens s] -> Tokens s
forall a. Monoid a => [a] -> a
mconcat ([Tokens s] -> [Tokens s]
forall a. [a] -> [a]
reverse (Tokens s
"}" Tokens s -> [Tokens s] -> [Tokens s]
forall a. a -> [a] -> [a]
: Tokens s
piece Tokens s -> [Tokens s] -> [Tokens s]
forall a. a -> [a] -> [a]
: [Tokens s]
acc))
          | Bool
otherwise -> [Tokens s] -> a -> m (Tokens s)
braces (Tokens s
"}" Tokens s -> [Tokens s] -> [Tokens s]
forall a. a -> [a] -> [a]
: Tokens s
piece Tokens s -> [Tokens s] -> [Tokens s]
forall a. a -> [a] -> [a]
: [Tokens s]
acc) (a -> m (Tokens s)) -> a -> m (Tokens s)
forall a b. (a -> b) -> a -> b
$! a
depth a -> a -> a
forall a. Num a => a -> a -> a
- a
1
        Maybe Char
_ -> Tokens s -> m (Tokens s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tokens s -> m (Tokens s)) -> Tokens s -> m (Tokens s)
forall a b. (a -> b) -> a -> b
$ [Tokens s] -> Tokens s
forall a. Monoid a => [a] -> a
mconcat ([Tokens s] -> [Tokens s]
forall a. [a] -> [a]
reverse (Tokens s
piece Tokens s -> [Tokens s] -> [Tokens s]
forall a. a -> [a] -> [a]
: [Tokens s]
acc))

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 <- someUnlessExpanded "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
someUnlessExpanded 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