{-# LANGUAGE DeriveDataTypeable #-}

module Language.Docker.Parser.Prelude
  (
    DockerfileError (..),
    Error,
    Parser,
    anyUnless,
    brackets,
    caseInsensitiveString,
    commaSep,
    comment,
    customError,
    doubleQuotedString,
    doubleQuotedStringEscaped,
    eol,
    escapedLineBreaks',
    fractional,
    heredoc,
    heredocContent,
    heredocMarker,
    isNl,
    isSpaceNl,
    lexeme',
    lexeme,
    natural,
    onlySpaces,
    onlyWhitespaces,
    requiredWhitespace,
    reserved,
    singleQuotedString,
    singleQuotedStringEscaped,
    someUnless,
    spaceSep1,
    stringWithEscaped,
    symbol,
    untilEol,
    untilHeredoc,
    whitespace,
    module Megaparsec,
    char,
    L.charLiteral,
    string,
    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
$c== :: DockerfileError -> DockerfileError -> Bool
== :: DockerfileError -> DockerfileError -> Bool
$c/= :: DockerfileError -> DockerfileError -> Bool
/= :: DockerfileError -> DockerfileError -> Bool
Eq, Typeable DockerfileError
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 -> Constr
DockerfileError -> DataType
(forall b. Data b => b -> b) -> DockerfileError -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
$ctoConstr :: DockerfileError -> Constr
toConstr :: DockerfileError -> Constr
$cdataTypeOf :: DockerfileError -> DataType
dataTypeOf :: DockerfileError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
$cgmapT :: (forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
gmapT :: (forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DockerfileError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DockerfileError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m 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
$ccompare :: DockerfileError -> DockerfileError -> Ordering
compare :: DockerfileError -> DockerfileError -> Ordering
$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
>= :: DockerfileError -> DockerfileError -> Bool
$cmax :: DockerfileError -> DockerfileError -> DockerfileError
max :: DockerfileError -> DockerfileError -> DockerfileError
$cmin :: DockerfileError -> DockerfileError -> DockerfileError
min :: DockerfileError -> DockerfileError -> 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
$creadsPrec :: Int -> ReadS DockerfileError
readsPrec :: Int -> ReadS DockerfileError
$creadList :: ReadS [DockerfileError]
readList :: ReadS [DockerfileError]
$creadPrec :: ReadPrec DockerfileError
readPrec :: ReadPrec DockerfileError
$creadListPrec :: ReadPrec [DockerfileError]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> DockerfileError -> ShowS
showsPrec :: Int -> DockerfileError -> ShowS
$cshow :: DockerfileError -> String
show :: DockerfileError -> String
$cshowList :: [DockerfileError] -> ShowS
showList :: [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
$c== :: FoundWhitespace -> FoundWhitespace -> Bool
== :: FoundWhitespace -> FoundWhitespace -> Bool
$c/= :: FoundWhitespace -> FoundWhitespace -> Bool
/= :: 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
$cshowsPrec :: Int -> FoundWhitespace -> ShowS
showsPrec :: Int -> FoundWhitespace -> ShowS
$cshow :: FoundWhitespace -> String
show :: FoundWhitespace -> String
$cshowList :: [FoundWhitespace] -> ShowS
showList :: [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 :: forall a. DockerfileError -> Parser a
customError = Set (ErrorFancy DockerfileError)
-> ParsecT DockerfileError Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (Set (ErrorFancy DockerfileError)
 -> ParsecT DockerfileError Text Identity a)
-> (DockerfileError -> Set (ErrorFancy DockerfileError))
-> DockerfileError
-> ParsecT DockerfileError Text Identity 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 :: (?esc :: Char) => Parser ()
eol :: (?esc::Char) => 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 (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ())
-> ParsecT DockerfileError Text Identity (Tokens 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 (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token Text
'\n'),
            ParsecT DockerfileError Text Identity FoundWhitespace -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT DockerfileError Text Identity FoundWhitespace
(?esc::Char) =>
ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks
          ]

reserved :: (?esc :: Char) => Text -> Parser ()
reserved :: (?esc::Char) => Text -> Parser ()
reserved Text
name = ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall a. (?esc::Char) => 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 (Tokens Text)
-> String -> ParsecT DockerfileError Text Identity (Tokens 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"

fractional :: Parser Float
fractional :: Parser Float
fractional = Parser Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float Parser Float -> String -> Parser Float
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"fractional number"

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

spaceSep1 :: Parser a -> Parser [a]
spaceSep1 :: forall a. Parser a -> Parser [a]
spaceSep1 Parser a
p = Parser a
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy1 Parser a
p ParsecT DockerfileError Text Identity Text
onlySpaces

singleQuotedString :: Parser Text
singleQuotedString :: ParsecT DockerfileError Text Identity Text
singleQuotedString = Char -> ParsecT DockerfileError Text Identity Text
quotedString Char
'\''

doubleQuotedString :: Parser Text
doubleQuotedString :: ParsecT DockerfileError Text Identity Text
doubleQuotedString = Char -> ParsecT DockerfileError Text Identity Text
quotedString Char
'\"'

-- | Special variants of the string parsers dealing with escaped line breaks
-- and escaped quote characters well.
singleQuotedStringEscaped :: (?esc :: Char) => Parser Text
singleQuotedStringEscaped :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
singleQuotedStringEscaped = (?esc::Char) => Char -> ParsecT DockerfileError Text Identity Text
Char -> ParsecT DockerfileError Text Identity Text
quotedStringEscaped Char
'\''

doubleQuotedStringEscaped :: (?esc :: Char) => Parser Text
doubleQuotedStringEscaped :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
doubleQuotedStringEscaped = (?esc::Char) => Char -> ParsecT DockerfileError Text Identity Text
Char -> ParsecT DockerfileError Text Identity Text
quotedStringEscaped Char
'\"'

quotedString :: Char -> Parser Text
quotedString :: Char -> ParsecT DockerfileError Text Identity Text
quotedString Char
c = do
  String
lit <- 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
c ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity String
-> ParsecT DockerfileError Text Identity String
forall a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
c)
  Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT DockerfileError Text Identity Text)
-> Text -> ParsecT DockerfileError Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
lit

quotedStringEscaped :: (?esc :: Char) => Char -> Parser Text
quotedStringEscaped :: (?esc::Char) => Char -> ParsecT DockerfileError Text Identity Text
quotedStringEscaped Char
q =
  ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (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
q) (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
q) (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
$ (?esc::Char) =>
String
-> Maybe (Char -> Bool)
-> ParsecT DockerfileError Text Identity Text
String
-> Maybe (Char -> Bool)
-> ParsecT DockerfileError Text Identity Text
stringWithEscaped [Char
q] Maybe (Char -> Bool)
forall a. Maybe a
Nothing

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

untilWS :: Parser Text
untilWS :: ParsecT DockerfileError Text Identity Text
untilWS = do
  String
s <- 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
ParsecT DockerfileError Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT DockerfileError Text Identity Char
ParsecT DockerfileError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
  Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT DockerfileError Text Identity Text)
-> Text -> ParsecT DockerfileError Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s

heredocMarker :: (?esc :: Char) => Parser Text
heredocMarker :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
heredocMarker = do
  ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ())
-> ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ()
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 (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity (Tokens Text) -> Parser ())
-> ParsecT DockerfileError Text Identity (Tokens 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)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"dash") (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token Text
'-')
  Text
m <- ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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 ParsecT DockerfileError Text Identity Text
doubleQuotedString ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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
<|> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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 ParsecT DockerfileError Text Identity Text
singleQuotedString ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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
<|> ParsecT DockerfileError Text Identity Text
untilWS
  ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT DockerfileError Text Identity Text
(?esc::Char) => ParsecT DockerfileError Text Identity Text
heredocRedirect
  Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
m

heredocRedirect :: (?esc :: Char) => Parser Text
heredocRedirect :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
heredocRedirect = do
  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
$ ( 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 (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens 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
<|> 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 (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens 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
<|> 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 (Tokens Text)
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity Text
onlySpaces
  (?esc::Char) =>
String -> ParsecT DockerfileError Text Identity Text
String -> ParsecT DockerfileError Text Identity Text
untilEol String
"heredoc path"

-- | This tries to parse everything until there is the just the heredoc marker
-- on its own on a line. Making provisions for the case that the marker is
-- followed by the end of the file rather than another newline.
heredocContent :: Text -> Parser Text
heredocContent :: Text -> ParsecT DockerfileError Text Identity Text
heredocContent Text
marker = do
  Either (ParseError Text DockerfileError) Text
emptyHeredoc <- ParsecT DockerfileError Text Identity Text
-> ParsecT
     DockerfileError
     Text
     Identity
     (Either (ParseError Text DockerfileError) Text)
forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT
     DockerfileError
     Text
     Identity
     (Either (ParseError Text DockerfileError) a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Either (ParseError s e) a)
observing ParsecT DockerfileError Text Identity Text
delimiter
  String
doc <- case Either (ParseError Text DockerfileError) Text
emptyHeredoc of
    Left ParseError Text DockerfileError
_ -> ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT DockerfileError Text Identity Char
ParsecT DockerfileError Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT DockerfileError Text Identity Text
termination
    Right Text
_ -> String -> ParsecT DockerfileError Text Identity String
forall a. a -> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
  Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT DockerfileError Text Identity Text)
-> Text -> ParsecT DockerfileError Text Identity Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
doc
  where
    termination :: Parser Text
    termination :: ParsecT DockerfileError Text Identity Text
termination = ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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 ParsecT DockerfileError Text Identity Text
terEOL ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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
<|> ParsecT DockerfileError Text Identity Text
terEOF

    terEOL :: Parser Text
    terEOL :: ParsecT DockerfileError Text Identity Text
terEOL = 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 (Tokens Text))
-> Tokens Text
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

    terEOF :: Parser Text
    terEOF :: ParsecT DockerfileError Text Identity Text
terEOF = do
      Text
t <- 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 (Tokens Text))
-> Tokens Text
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker
      Parser () -> Parser ()
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
hidden Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
      Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

    delimiter :: Parser Text
    delimiter :: ParsecT DockerfileError Text Identity Text
delimiter = ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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 ParsecT DockerfileError Text Identity Text
delEOL ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity 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
<|> ParsecT DockerfileError Text Identity Text
delEOF

    delEOL :: Parser Text
    delEOL :: ParsecT DockerfileError Text Identity Text
delEOL = 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 (Tokens Text))
-> Tokens Text
-> ParsecT DockerfileError Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

    delEOF :: Parser Text
    delEOF :: ParsecT DockerfileError Text Identity Text
delEOF = do
      Text
t <- 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
marker
      Parser () -> Parser ()
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
hidden Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
      Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

heredoc :: (?esc :: Char) => Parser Text
heredoc :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
heredoc = do
  Text
m <- ParsecT DockerfileError Text Identity Text
(?esc::Char) => ParsecT DockerfileError Text Identity Text
heredocMarker
  Text -> ParsecT DockerfileError Text Identity Text
heredocContent Text
m

-- | Parses text until a heredoc or newline is found. Will also consume the
-- heredoc. It will however respect escaped newlines.
untilHeredoc :: (?esc :: Char) => Parser Text
untilHeredoc :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
untilHeredoc = do
  [Text]
txt <- ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT DockerfileError Text Identity Text
chars ParsecT DockerfileError Text Identity Text
(?esc::Char) => ParsecT DockerfileError Text Identity Text
heredoc
  Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT DockerfileError Text Identity Text)
-> Text -> ParsecT DockerfileError Text Identity Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
txt
  where
    chars :: ParsecT DockerfileError Text Identity Text
chars =
      [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
(?esc::Char) =>
ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks,
          Char -> Text
charToTxt (Char -> Text)
-> ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT DockerfileError Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
anySingleBut Char
Token Text
'\n'
        ]
    charToTxt :: Char -> Text
charToTxt Char
c = String -> Text
T.pack [Char
c]

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')

onlyWhitespaces :: Parser Text
onlyWhitespaces :: ParsecT DockerfileError Text Identity Text
onlyWhitespaces = 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
"whitespaces")
    (\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' 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 -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r')

escapedLineBreaks :: (?esc :: Char) => Parser FoundWhitespace
escapedLineBreaks :: (?esc::Char) =>
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 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 (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 ?esc::Char
Char
Token Text
?esc ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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 a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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 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) -> 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 a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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 a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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 a b.
a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity a
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 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
<|> FoundWhitespace
-> ParsecT DockerfileError Text Identity FoundWhitespace
forall a. a -> ParsecT DockerfileError Text Identity a
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

-- | This converts escaped line breaks, but keeps _all_ spaces before and after
escapedLineBreaks' :: (?esc :: Char) => Parser Text
escapedLineBreaks' :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
escapedLineBreaks' = [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]
breaks
  where
    breaks :: ParsecT DockerfileError Text Identity [Text]
breaks =
      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
$ do
        ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity (Tokens 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 ( 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 ?esc::Char
Char
Token Text
?esc ParsecT DockerfileError Text Identity Char
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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 a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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 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) -> 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 a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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 a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity (Tokens Text)
newlines
        ParsecT DockerfileError Text Identity Text
onlySpaces1
    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 :: (?esc :: Char) => Parser FoundWhitespace
foundWhitespace :: (?esc::Char) =>
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 a b.
a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT DockerfileError Text Identity Text
onlySpaces1, ParsecT DockerfileError Text Identity FoundWhitespace
(?esc::Char) =>
ParsecT DockerfileError Text Identity FoundWhitespace
escapedLineBreaks]

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

requiredWhitespace :: (?esc :: Char) => Parser ()
requiredWhitespace :: (?esc::Char) => Parser ()
requiredWhitespace = do
  FoundWhitespace
ws <- ParsecT DockerfileError Text Identity FoundWhitespace
(?esc::Char) =>
ParsecT DockerfileError Text Identity FoundWhitespace
foundWhitespace
  case FoundWhitespace
ws of
    FoundWhitespace
FoundWhitespace -> () -> Parser ()
forall a. a -> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FoundWhitespace
MissingWhitespace -> String -> Parser ()
forall a. String -> ParsecT DockerfileError Text Identity a
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 :: (?esc :: Char) => String -> Parser Text
untilEol :: (?esc::Char) =>
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 a. String -> ParsecT DockerfileError Text Identity a
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 a. a -> ParsecT DockerfileError Text Identity a
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
(?esc::Char) =>
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
/= ?esc::Char
Char
?esc),
            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 -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== ?esc::Token Text
Token Text
?esc) ParsecT DockerfileError Text Identity Text
-> Parser () -> ParsecT DockerfileError Text Identity Text
forall a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT DockerfileError Text Identity Char -> Parser ()
forall a. ParsecT DockerfileError Text Identity a -> 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 :: (?esc :: Char) => Text -> Parser Text
symbol :: (?esc::Char) => 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 ()
(?esc::Char) => Parser ()
whitespace
  Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
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
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'

stringWithEscaped :: (?esc :: Char) => [Char] -> Maybe (Char -> Bool) -> Parser Text
stringWithEscaped :: (?esc::Char) =>
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 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 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 (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== ?esc::Token Text
Token Text
?esc) ParsecT DockerfileError Text Identity Text
-> Parser () -> ParsecT DockerfileError Text Identity Text
forall a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT DockerfileError Text Identity Text -> Parser ()
forall a. ParsecT DockerfileError Text Identity a -> 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 (Char -> Text
T.singleton ?esc::Char
Char
?esc) ParsecT DockerfileError Text Identity (Tokens Text)
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity Text
forall a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity b
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
(?esc::Char) =>
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 -> Token Text
c Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ?esc::Token Text
Token Text
?esc 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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> ParsecT DockerfileError Text Identity Char
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 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 :: (?esc :: Char) => Parser a -> Parser a
lexeme :: forall a. (?esc::Char) => Parser a -> Parser a
lexeme Parser a
p = do
  a
x <- Parser a
p
  Parser ()
(?esc::Char) => Parser ()
requiredWhitespace
  a -> Parser a
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

lexeme' :: Parser a -> Parser a
lexeme' :: forall a.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity a
lexeme' Parser a
p = do
  a
x <- Parser a
p
  ParsecT DockerfileError Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT DockerfileError Text Identity Text
onlySpaces
  a -> Parser a
forall a. a -> ParsecT DockerfileError Text Identity 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 :: (?esc :: Char) => Char -> Bool
isSpaceNl :: (?esc::Char) => 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
== ?esc::Char
Char
?esc

anyUnless :: (?esc :: Char) => (Char -> Bool) -> Parser Text
anyUnless :: (?esc::Char) =>
(Char -> Bool) -> ParsecT DockerfileError Text Identity Text
anyUnless Char -> Bool
predicate = (?esc::Char) =>
String
-> (Char -> Bool) -> ParsecT DockerfileError Text Identity Text
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 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
<|> Text -> ParsecT DockerfileError Text Identity Text
forall a. a -> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

someUnless :: (?esc :: Char) => String -> (Char -> Bool) -> Parser Text
someUnless :: (?esc::Char) =>
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 a. String -> ParsecT DockerfileError Text Identity a
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 a. a -> ParsecT DockerfileError Text Identity a
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
(?esc::Char) =>
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 ((?esc::Char) => Char -> Bool
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 -> Token Text
c Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== ?esc::Token Text
Token Text
?esc 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 a b.
ParsecT DockerfileError Text Identity a
-> ParsecT DockerfileError Text Identity b
-> ParsecT DockerfileError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT DockerfileError Text Identity Char -> Parser ()
forall a. ParsecT DockerfileError Text Identity a -> 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)