module Language.Docker.Parser where
import Control.Monad (void)
import Data.ByteString.Char8 (pack)
import Data.String
import Text.Parsec hiding (label)
import Text.Parsec.String (Parser)
import qualified Text.Parsec.Token as Token
import Language.Docker.Lexer
import Language.Docker.Normalize
import Language.Docker.Syntax
comment :: Parser Instruction
comment = do
void $ char '#'
text <- untilEol
return $ Comment text
taggedImage :: Parser BaseImage
taggedImage = do
name <- untilOccurrence ":\n"
void $ oneOf ":"
tag <- untilEol
return $ TaggedImage name tag
digestedImage :: Parser BaseImage
digestedImage = do
name <- untilOccurrence "@\n"
void $ oneOf "@"
digest <- untilEol
return $ DigestedImage name (pack digest)
untaggedImage :: Parser BaseImage
untaggedImage = do
name <- many (noneOf "\n")
return $ UntaggedImage name
baseImage :: Parser BaseImage
baseImage = try taggedImage <|> try digestedImage <|> try untaggedImage
from :: Parser Instruction
from = do
reserved "FROM"
image <- baseImage
return $ From image
cmd :: Parser Instruction
cmd = do
reserved "CMD"
args <- arguments
return $ Cmd args
copy :: Parser Instruction
copy = do
reserved "COPY"
src <- many (noneOf " ")
Token.whiteSpace lexer
dst <- many (noneOf "\n")
return $ Copy src dst
shell :: Parser Instruction
shell = do
reserved "SHELL"
args <- arguments
return $ Shell args
stopsignal :: Parser Instruction
stopsignal = do
reserved "STOPSIGNAL"
args <- many (noneOf "\n")
return $ Stopsignal args
quotedValue :: Parser String
quotedValue = do
void $ char '"'
literal <- untilOccurrence "\""
void $ char '"'
return literal
rawValue :: Parser String
rawValue = many1 (noneOf [' ', '=', '\n'])
singleValue :: Parser String
singleValue = try quotedValue <|> try rawValue
pair :: Parser (String, String)
pair = do
key <- rawValue
void $ oneOf "= "
spaces
value <- singleValue
return (key, value)
pairs :: Parser Pairs
pairs = do
_ <- many (char ' ')
first <- pair
next <- remainingPairs
return (first : next)
remainingPairs :: Parser Pairs
remainingPairs = try (char ' ' >> pairs) <|> try (return [])
label :: Parser Instruction
label = do
reserved "LABEL"
p <- pairs
return $ Label p
arg :: Parser Instruction
arg = do
reserved "ARG"
p <- untilEol
return $ Arg p
env :: Parser Instruction
env = do
reserved "ENV"
p <- pairs
return $ Env p
user :: Parser Instruction
user = do
reserved "USER"
username <- untilEol
return $ User username
add :: Parser Instruction
add = do
reserved "ADD"
src <- untilOccurrence " "
Token.whiteSpace lexer
dst <- untilOccurrence "\n"
return $ Add src dst
expose :: Parser Instruction
expose = do
reserved "EXPOSE"
sports <- untilEol
let port = fromString sports
return $ Expose port
run :: Parser Instruction
run = do
reserved "RUN"
c <- arguments
return $ Run c
untilEol :: Parser String
untilEol = many (noneOf "\n")
untilOccurrence :: String -> Parser String
untilOccurrence t = many $ noneOf t
workdir :: Parser Instruction
workdir = do
reserved "WORKDIR"
directory <- many (noneOf "\n")
return $ Workdir directory
volume :: Parser Instruction
volume = do
reserved "VOLUME"
directory <- many (noneOf "\n")
return $ Volume directory
maintainer :: Parser Instruction
maintainer = do
reserved "MAINTAINER"
name <- untilEol
return $ Maintainer name
argumentsExec :: Parser Arguments
argumentsExec = brackets $ commaSep stringLiteral
argumentsShell :: Parser Arguments
argumentsShell = do
args <- untilEol
return $ words args
arguments :: Parser Arguments
arguments = try argumentsExec <|> try argumentsShell
entrypoint :: Parser Instruction
entrypoint = do
reserved "ENTRYPOINT"
args <- arguments
return $ Entrypoint args
onbuild :: Parser Instruction
onbuild = do
reserved "ONBUILD"
i <- parseInstruction
return $ OnBuild i
eolInstruction :: Parser Instruction
eolInstruction = do
eol
return EOL
healthcheck :: Parser Instruction
healthcheck = do
reserved "HEALTHCHECK"
args <- untilEol
return $ Healthcheck args
parseInstruction :: Parser Instruction
parseInstruction =
try onbuild <|>
try from <|>
try copy <|>
try run <|>
try workdir <|>
try entrypoint <|>
try volume <|>
try expose <|>
try env <|>
try arg <|>
try user <|>
try label <|>
try stopsignal <|>
try cmd <|>
try shell <|>
try maintainer <|>
try add <|>
try comment <|>
try healthcheck <|>
try eolInstruction
contents :: Parser a -> Parser a
contents p = do
Token.whiteSpace lexer
r <- p
eof
return r
eol :: Parser ()
eol = void $ char '\n' <|> (char '\r' >> option '\n' (char '\n'))
dockerfile :: Parser Dockerfile
dockerfile =
many $
do
pos <- getPosition
i <- parseInstruction
optional eol
return $ InstructionPos i (sourceName pos) (sourceLine pos)
parseString :: String -> Either ParseError Dockerfile
parseString s = parse (contents dockerfile) "<string>" $ normalizeEscapedLines s
parseFile :: String -> IO (Either ParseError Dockerfile)
parseFile file = do
program <- readFile file
return $ parse (contents dockerfile) file $ normalizeEscapedLines program