{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Docker.Parser.Prelude
  ( customError,
    comment,
    eol,
    reserved,
    natural,
    commaSep,
    stringLiteral,
    brackets,
    whitespace,
    requiredWhitespace,
    untilEol,
    symbol,
    caseInsensitiveString,
    stringWithEscaped,
    lexeme,
    isNl,
    isSpaceNl,
    anyUnless,
    someUnless,
    Parser,
    Error,
    DockerfileError (..),
    module Megaparsec,
    char,
    string,
    void,
    when,
    Text,
    module Data.Default.Class
  )
where

import Control.Monad (void, when)
import Data.Data
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Text.Megaparsec as Megaparsec hiding (Label)
import Text.Megaparsec.Char hiding (eol)
import qualified Text.Megaparsec.Char.Lexer as L
import Data.Default.Class (Default(def))

data DockerfileError
  = DuplicateFlagError String
  | NoValueFlagError String
  | InvalidFlagError String
  | FileListError String
  | MissingArgument [Text]
  | DuplicateArgument Text
  | UnexpectedArgument Text Text
  | QuoteError
      String
      String
  deriving (DockerfileError -> DockerfileError -> Bool
(DockerfileError -> DockerfileError -> Bool)
-> (DockerfileError -> DockerfileError -> Bool)
-> Eq DockerfileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DockerfileError -> DockerfileError -> Bool
$c/= :: DockerfileError -> DockerfileError -> Bool
== :: DockerfileError -> DockerfileError -> Bool
$c== :: DockerfileError -> DockerfileError -> Bool
Eq, Typeable DockerfileError
DataType
Constr
Typeable DockerfileError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DockerfileError -> c DockerfileError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DockerfileError)
-> (DockerfileError -> Constr)
-> (DockerfileError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DockerfileError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DockerfileError))
-> ((forall b. Data b => b -> b)
    -> DockerfileError -> DockerfileError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DockerfileError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DockerfileError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DockerfileError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DockerfileError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DockerfileError -> m DockerfileError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DockerfileError -> m DockerfileError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DockerfileError -> m DockerfileError)
-> Data DockerfileError
DockerfileError -> DataType
DockerfileError -> Constr
(forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
forall u. (forall d. Data d => d -> u) -> DockerfileError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
$cQuoteError :: Constr
$cUnexpectedArgument :: Constr
$cDuplicateArgument :: Constr
$cMissingArgument :: Constr
$cFileListError :: Constr
$cInvalidFlagError :: Constr
$cNoValueFlagError :: Constr
$cDuplicateFlagError :: Constr
$tDockerfileError :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
gmapMp :: (forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
gmapM :: (forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
gmapQi :: Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
gmapQ :: (forall d. Data d => d -> u) -> DockerfileError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DockerfileError -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
gmapT :: (forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
$cgmapT :: (forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
dataTypeOf :: DockerfileError -> DataType
$cdataTypeOf :: DockerfileError -> DataType
toConstr :: DockerfileError -> Constr
$ctoConstr :: DockerfileError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
$cp1Data :: Typeable DockerfileError
Data, Typeable, Eq DockerfileError
Eq DockerfileError
-> (DockerfileError -> DockerfileError -> Ordering)
-> (DockerfileError -> DockerfileError -> Bool)
-> (DockerfileError -> DockerfileError -> Bool)
-> (DockerfileError -> DockerfileError -> Bool)
-> (DockerfileError -> DockerfileError -> Bool)
-> (DockerfileError -> DockerfileError -> DockerfileError)
-> (DockerfileError -> DockerfileError -> DockerfileError)
-> Ord DockerfileError
DockerfileError -> DockerfileError -> Bool
DockerfileError -> DockerfileError -> Ordering
DockerfileError -> DockerfileError -> DockerfileError
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 :: DockerfileError -> DockerfileError -> DockerfileError
$cmin :: DockerfileError -> DockerfileError -> DockerfileError
max :: DockerfileError -> DockerfileError -> DockerfileError
$cmax :: DockerfileError -> DockerfileError -> DockerfileError
>= :: DockerfileError -> DockerfileError -> Bool
$c>= :: DockerfileError -> DockerfileError -> Bool
> :: DockerfileError -> DockerfileError -> Bool
$c> :: DockerfileError -> DockerfileError -> Bool
<= :: DockerfileError -> DockerfileError -> Bool
$c<= :: DockerfileError -> DockerfileError -> Bool
< :: DockerfileError -> DockerfileError -> Bool
$c< :: DockerfileError -> DockerfileError -> Bool
compare :: DockerfileError -> DockerfileError -> Ordering
$ccompare :: DockerfileError -> DockerfileError -> Ordering
$cp1Ord :: Eq DockerfileError
Ord, ReadPrec [DockerfileError]
ReadPrec DockerfileError
Int -> ReadS DockerfileError
ReadS [DockerfileError]
(Int -> ReadS DockerfileError)
-> ReadS [DockerfileError]
-> ReadPrec DockerfileError
-> ReadPrec [DockerfileError]
-> Read DockerfileError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DockerfileError]
$creadListPrec :: ReadPrec [DockerfileError]
readPrec :: ReadPrec DockerfileError
$creadPrec :: ReadPrec DockerfileError
readList :: ReadS [DockerfileError]
$creadList :: ReadS [DockerfileError]
readsPrec :: Int -> ReadS DockerfileError
$creadsPrec :: Int -> ReadS DockerfileError
Read, Int -> DockerfileError -> ShowS
[DockerfileError] -> ShowS
DockerfileError -> String
(Int -> DockerfileError -> ShowS)
-> (DockerfileError -> String)
-> ([DockerfileError] -> ShowS)
-> Show DockerfileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockerfileError] -> ShowS
$cshowList :: [DockerfileError] -> ShowS
show :: DockerfileError -> String
$cshow :: DockerfileError -> String
showsPrec :: Int -> DockerfileError -> ShowS
$cshowsPrec :: Int -> DockerfileError -> ShowS
Show)

type Parser = Parsec DockerfileError Text

type Error = ParseErrorBundle Text DockerfileError

instance ShowErrorComponent DockerfileError where
  showErrorComponent :: DockerfileError -> String
showErrorComponent (DuplicateFlagError String
f) = String
"duplicate flag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
  showErrorComponent (FileListError String
f) =
    String
"unexpected end of line. At least two arguments are required for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
  showErrorComponent (NoValueFlagError String
f) = String
"unexpected flag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with no value"
  showErrorComponent (InvalidFlagError String
f) = String
"invalid flag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
  showErrorComponent (MissingArgument [Text]
f) = String
"missing required argument(s) for mount flag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
f
  showErrorComponent (DuplicateArgument Text
f) = String
"duplicate argument for mount flag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
f
  showErrorComponent (UnexpectedArgument Text
a Text
b) = String
"unexpected argument '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' for mount of type '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
  showErrorComponent (QuoteError String
t String
str) =
    String
"unexpected end of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" quoted string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (unmatched quote)"

-- Spaces are sometimes significant information in a dockerfile, this type records
-- thee presence of lack of such whitespace in certain lines.
data FoundWhitespace
  = FoundWhitespace
  | MissingWhitespace
  deriving (FoundWhitespace -> FoundWhitespace -> Bool
(FoundWhitespace -> FoundWhitespace -> Bool)
-> (FoundWhitespace -> FoundWhitespace -> Bool)
-> Eq FoundWhitespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FoundWhitespace -> FoundWhitespace -> Bool
$c/= :: FoundWhitespace -> FoundWhitespace -> Bool
== :: FoundWhitespace -> FoundWhitespace -> Bool
$c== :: FoundWhitespace -> FoundWhitespace -> Bool
Eq, Int -> FoundWhitespace -> ShowS
[FoundWhitespace] -> ShowS
FoundWhitespace -> String
(Int -> FoundWhitespace -> ShowS)
-> (FoundWhitespace -> String)
-> ([FoundWhitespace] -> ShowS)
-> Show FoundWhitespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FoundWhitespace] -> ShowS
$cshowList :: [FoundWhitespace] -> ShowS
show :: FoundWhitespace -> String
$cshow :: FoundWhitespace -> String
showsPrec :: Int -> FoundWhitespace -> ShowS
$cshowsPrec :: Int -> FoundWhitespace -> ShowS
Show)

-- There is no need to remember how many spaces we found in a line, so we can
-- cheaply remmeber that we already whitenessed some significant whitespace while
-- parsing an expression by concatenating smaller results
instance Semigroup FoundWhitespace where
  FoundWhitespace
FoundWhitespace <> :: FoundWhitespace -> FoundWhitespace -> FoundWhitespace
<> FoundWhitespace
_ = FoundWhitespace
FoundWhitespace
  FoundWhitespace
_ <> FoundWhitespace
a = FoundWhitespace
a

instance Monoid FoundWhitespace where
  mempty :: FoundWhitespace
mempty = FoundWhitespace
MissingWhitespace

------------------------------------
-- Utilities
------------------------------------

-- | End parsing signaling a “conversion error”.
customError :: DockerfileError -> Parser a
customError :: DockerfileError -> Parser a
customError = Set (ErrorFancy DockerfileError) -> Parser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (Set (ErrorFancy DockerfileError) -> Parser a)
-> (DockerfileError -> Set (ErrorFancy DockerfileError))
-> DockerfileError
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy DockerfileError -> Set (ErrorFancy DockerfileError)
forall a. a -> Set a
S.singleton (ErrorFancy DockerfileError -> Set (ErrorFancy DockerfileError))
-> (DockerfileError -> ErrorFancy DockerfileError)
-> DockerfileError
-> Set (ErrorFancy DockerfileError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DockerfileError -> ErrorFancy DockerfileError
forall e. e -> ErrorFancy e
ErrorCustom

castToSpace :: FoundWhitespace -> Text
castToSpace :: FoundWhitespace -> Text
castToSpace FoundWhitespace
FoundWhitespace = Text
" "
castToSpace FoundWhitespace
MissingWhitespace = Text
""

eol :: Parser ()
eol :: Parser ()
eol = ParsecT DockerfileError Text Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT DockerfileError Text Identity [()]
ws Parser () -> String -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"end of line"
  where
    ws :: ParsecT DockerfileError Text Identity [()]
ws =
      Parser () -> ParsecT DockerfileError Text Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Parser () -> ParsecT DockerfileError Text Identity [()])
-> Parser () -> ParsecT DockerfileError Text Identity [()]
forall a b. (a -> b) -> a -> b
$
        [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT DockerfileError Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT DockerfileError Text Identity Text
onlySpaces1, ParsecT DockerfileError Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity Text -> Parser ())
-> ParsecT DockerfileError Text Identity Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'), ParsecT DockerfileError Text Identity FoundWhitespace -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks]

reserved :: Text -> Parser ()
reserved :: Text -> Parser ()
reserved Text
name = ParsecT DockerfileError Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall a. Parser a -> Parser a
lexeme (Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Text
Tokens Text
name) ParsecT DockerfileError Text Identity Text
-> String -> ParsecT DockerfileError Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> Text -> String
T.unpack Text
name)

natural :: Parser Integer
natural :: Parser Integer
natural = Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal Parser Integer -> String -> Parser Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"positive number"

commaSep :: Parser a -> Parser [a]
commaSep :: Parser a -> Parser [a]
commaSep Parser a
p = Parser a
-> ParsecT DockerfileError Text Identity Text -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (Parser a
p Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace) (Text -> ParsecT DockerfileError Text Identity Text
symbol Text
",")

stringLiteral :: Parser Text
stringLiteral :: ParsecT DockerfileError Text Identity Text
stringLiteral = do
  ParsecT DockerfileError Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'"')
  String
lit <- ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT DockerfileError Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (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 -> ParsecT DockerfileError Text Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
lit)

brackets :: Parser a -> Parser a
brackets :: Parser a -> Parser a
brackets = Parser ()
-> ParsecT DockerfileError Text Identity Text
-> Parser a
-> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT DockerfileError Text Identity Text
symbol Text
"[" ParsecT DockerfileError Text Identity Text
-> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) (Parser ()
whitespace Parser ()
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT DockerfileError Text Identity Text
symbol Text
"]")

onlySpaces :: Parser Text
onlySpaces :: ParsecT DockerfileError Text Identity Text
onlySpaces = Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"spaces") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

onlySpaces1 :: Parser Text
onlySpaces1 :: ParsecT DockerfileError Text Identity Text
onlySpaces1 = Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"at least one space") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

escapedLineBreaks :: Parser FoundWhitespace
escapedLineBreaks :: ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks = [FoundWhitespace] -> FoundWhitespace
forall a. Monoid a => [a] -> a
mconcat ([FoundWhitespace] -> FoundWhitespace)
-> ParsecT DockerfileError Text Identity [FoundWhitespace]
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [FoundWhitespace]
breaks
  where
    breaks :: ParsecT DockerfileError Text Identity [FoundWhitespace]
breaks =
      ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity [FoundWhitespace]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT DockerfileError Text Identity FoundWhitespace
 -> ParsecT DockerfileError Text Identity [FoundWhitespace])
-> ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity [FoundWhitespace]
forall a b. (a -> b) -> a -> b
$ do
        ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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
'\\' ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity Text
onlySpaces ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity (Tokens Text)
newlines)
        ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ())
-> (ParsecT DockerfileError Text Identity (Tokens Text)
    -> ParsecT DockerfileError Text Identity (Tokens Text))
-> ParsecT DockerfileError Text Identity (Tokens Text)
-> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ())
-> ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT DockerfileError Text Identity Text
onlySpaces ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity Text
comment ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity (Tokens Text)
newlines
        -- Spaces before the next '\' have a special significance
        -- so we remembeer the fact that we found some
        FoundWhitespace
FoundWhitespace FoundWhitespace
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT DockerfileError Text Identity Text
onlySpaces1 ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FoundWhitespace
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall (f :: * -> *) a. Applicative f => a -> f a
pure FoundWhitespace
MissingWhitespace
    newlines :: ParsecT DockerfileError Text Identity (Tokens Text)
newlines = Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isNl

foundWhitespace :: Parser FoundWhitespace
foundWhitespace :: ParsecT DockerfileError Text Identity FoundWhitespace
foundWhitespace = [FoundWhitespace] -> FoundWhitespace
forall a. Monoid a => [a] -> a
mconcat ([FoundWhitespace] -> FoundWhitespace)
-> ParsecT DockerfileError Text Identity [FoundWhitespace]
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [FoundWhitespace]
found
  where
    found :: ParsecT DockerfileError Text Identity [FoundWhitespace]
found = ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity [FoundWhitespace]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT DockerfileError Text Identity FoundWhitespace
 -> ParsecT DockerfileError Text Identity [FoundWhitespace])
-> ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity [FoundWhitespace]
forall a b. (a -> b) -> a -> b
$ [ParsecT DockerfileError Text Identity FoundWhitespace]
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [FoundWhitespace
FoundWhitespace FoundWhitespace
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT DockerfileError Text Identity Text
onlySpaces1, ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks]

whitespace :: Parser ()
whitespace :: Parser ()
whitespace = ParsecT DockerfileError Text Identity FoundWhitespace -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT DockerfileError Text Identity FoundWhitespace
foundWhitespace

requiredWhitespace :: Parser ()
requiredWhitespace :: Parser ()
requiredWhitespace = do
  FoundWhitespace
ws <- ParsecT DockerfileError Text Identity FoundWhitespace
foundWhitespace
  case FoundWhitespace
ws of
    FoundWhitespace
FoundWhitespace -> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FoundWhitespace
MissingWhitespace -> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing whitespace"

-- Parse value until end of line is reached
-- after consuming all escaped newlines
untilEol :: String -> Parser Text
untilEol :: String -> ParsecT DockerfileError Text Identity Text
untilEol String
name = do
  Text
res <- [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ParsecT DockerfileError Text Identity [Text]
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [Text]
predicate
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
res Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expecting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name)
  Text -> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
res
  where
    predicate :: ParsecT DockerfileError Text Identity [Text]
predicate =
      ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT DockerfileError Text Identity Text
 -> ParsecT DockerfileError Text Identity [Text])
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall a b. (a -> b) -> a -> b
$
        [ParsecT DockerfileError Text Identity Text]
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ FoundWhitespace -> Text
castToSpace (FoundWhitespace -> Text)
-> ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks,
            Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
name) (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\'),
            Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') ParsecT DockerfileError Text Identity Text
-> Parser () -> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT DockerfileError Text Identity Char -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (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
'\n')
          ]

symbol :: Text -> Parser Text
symbol :: Text -> ParsecT DockerfileError Text Identity Text
symbol Text
name = do
  Text
x <- Tokens Text -> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
name
  Parser ()
whitespace
  Text -> ParsecT DockerfileError Text Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x

caseInsensitiveString :: Text -> Parser Text
caseInsensitiveString :: Text -> ParsecT DockerfileError Text Identity Text
caseInsensitiveString = Text -> ParsecT DockerfileError Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string'

stringWithEscaped :: [Char] -> Maybe (Char -> Bool) -> Parser Text
stringWithEscaped :: String
-> Maybe (Char -> Bool)
-> ParsecT DockerfileError Text Identity Text
stringWithEscaped String
quoteChars Maybe (Char -> Bool)
maybeAcceptCondition = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ParsecT DockerfileError Text Identity [Text]
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [Text]
sequences
  where
    sequences :: ParsecT DockerfileError Text Identity [Text]
sequences =
      ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT DockerfileError Text Identity Text
 -> ParsecT DockerfileError Text Identity [Text])
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall a b. (a -> b) -> a -> b
$
        [ParsecT DockerfileError Text Identity Text]
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ParsecT DockerfileError Text Identity [Text]
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [Text]
inner,
            ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT DockerfileError Text Identity Text
 -> ParsecT DockerfileError Text Identity Text)
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') ParsecT DockerfileError Text Identity Text
-> Parser () -> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT DockerfileError Text Identity Text -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT DockerfileError Text Identity Text
quoteParser,
            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 Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity Text
quoteParser
          ]
    inner :: ParsecT DockerfileError Text Identity [Text]
inner =
      ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT DockerfileError Text Identity Text
 -> ParsecT DockerfileError Text Identity [Text])
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall a b. (a -> b) -> a -> b
$
        [ParsecT DockerfileError Text Identity Text]
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ FoundWhitespace -> Text
castToSpace (FoundWhitespace -> Text)
-> ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks,
            Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
              Maybe String
forall a. Maybe a
Nothing
              (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
quoteChars Bool -> Bool -> Bool
&& Char -> Bool
acceptCondition Char
Token Text
c)
          ]
    quoteParser :: ParsecT DockerfileError Text Identity Text
quoteParser = Char -> Text
T.singleton (Char -> Text)
-> ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT DockerfileError Text Identity Char]
-> ParsecT DockerfileError Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Char -> ParsecT DockerfileError Text Identity Char)
-> String -> [ParsecT DockerfileError Text Identity Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> ParsecT DockerfileError Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char String
quoteChars)
    acceptCondition :: Char -> Bool
acceptCondition = (Char -> Bool) -> Maybe (Char -> Bool) -> Char -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe (Char -> Bool)
maybeAcceptCondition

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme Parser a
p = do
  a
x <- Parser a
p
  Parser ()
requiredWhitespace
  a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

isNl :: Char -> Bool
isNl :: Char -> Bool
isNl Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'

isSpaceNl :: Char -> Bool
isSpaceNl :: Char -> Bool
isSpaceNl 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
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'

anyUnless :: (Char -> Bool) -> Parser Text
anyUnless :: (Char -> Bool) -> ParsecT DockerfileError Text Identity Text
anyUnless Char -> Bool
predicate = String
-> (Char -> Bool) -> ParsecT DockerfileError Text Identity Text
someUnless String
"" Char -> Bool
predicate ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

someUnless :: String -> (Char -> Bool) -> Parser Text
someUnless :: String
-> (Char -> Bool) -> ParsecT DockerfileError Text Identity Text
someUnless String
name Char -> Bool
predicate = do
  [Text]
res <- ParsecT DockerfileError Text Identity [Text]
applyPredicate
  case [Text]
res of
    [] -> String -> ParsecT DockerfileError Text Identity Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expecting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name)
    [Text]
_ -> Text -> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
res)
  where
    applyPredicate :: ParsecT DockerfileError Text Identity [Text]
applyPredicate =
      ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT DockerfileError Text Identity Text
 -> ParsecT DockerfileError Text Identity [Text])
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall a b. (a -> b) -> a -> b
$
        [ParsecT DockerfileError Text Identity Text]
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ FoundWhitespace -> Text
castToSpace (FoundWhitespace -> Text)
-> ParsecT DockerfileError Text Identity FoundWhitespace
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks,
            Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
name) (\Token Text
c -> Bool -> Bool
not (Char -> Bool
isSpaceNl Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
predicate Char
Token Text
c)),
            Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
predicate Char
Token Text
c))
              ParsecT DockerfileError Text Identity Text
-> Parser () -> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT DockerfileError Text Identity Char -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (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
'\n')
          ]

comment :: Parser Text
comment :: ParsecT DockerfileError Text Identity Text
comment = 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
$ 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
'#'
  Maybe String
-> (Token Text -> Bool)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNl)