{-# LANGUAGE OverloadedStrings #-}
module Language.Docker.Parser.Pairs
( parseEnv,
parseLabel,
)
where
import qualified Data.Text as T
import Language.Docker.Parser.Prelude
import Language.Docker.Syntax
doubleQuotedValue :: Parser Text
doubleQuotedValue = between (string "\"") (string "\"") (stringWithEscaped ['"'] Nothing)
singleQuotedValue :: Parser Text
singleQuotedValue = between (string "'") (string "'") (stringWithEscaped ['\''] Nothing)
unquotedString :: (Char -> Bool) -> Parser Text
unquotedString acceptCondition = do
str <- stringWithEscaped [' ', '\t'] (Just (\c -> acceptCondition c && c /= '"' && c /= '\''))
checkFaults str
where
checkFaults str
| T.null str = fail "a non empty string"
| T.head str == '\'' = customError $ QuoteError "single" (T.unpack str)
| T.head str == '\"' = customError $ QuoteError "double" (T.unpack str)
| otherwise = return str
singleValue :: (Char -> Bool) -> Parser Text
singleValue acceptCondition = mconcat <$> variants
where
variants =
many $
choice
[ doubleQuotedValue <?> "a string inside double quotes",
singleQuotedValue <?> "a string inside single quotes",
unquotedString acceptCondition <?> "a string with no quotes"
]
pair :: Parser (Text, Text)
pair = do
key <- singleValue (/= '=')
value <- withEqualSign <|> withoutEqualSign
return (key, value)
where
withEqualSign = do
void $ char '='
singleValue (\c -> c /= ' ' && c /= '\t')
withoutEqualSign = do
requiredWhitespace
untilEol "value"
pairs :: Parser Pairs
pairs = (pair <?> "a key value pair (key=value)") `sepEndBy1` requiredWhitespace
parseLabel :: Parser (Instruction Text)
parseLabel = do
reserved "LABEL"
Label <$> pairs
parseEnv :: Parser (Instruction Text)
parseEnv = do
reserved "ENV"
Env <$> pairs