{-# LANGUAGE OverloadedStrings #-}

module Language.Docker.Parser
  ( parseText,
    parseFile,
    parseStdin,
    Parser,
    Error,
    DockerfileError (..),
  )
where

import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import Language.Docker.Parser.Instruction (parseInstruction)
import Language.Docker.Parser.Prelude
import Language.Docker.Syntax

contents :: Parser a -> Parser a
contents :: Parser a -> Parser a
contents Parser a
p = do
  ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT DockerfileError Text Identity Text
 -> ParsecT DockerfileError Text Identity ())
-> ParsecT DockerfileError Text Identity Text
-> ParsecT DockerfileError Text Identity ()
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 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
'\r' 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
' ' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
  a
r <- Parser a
p
  ParsecT DockerfileError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

dockerfile :: Parser Dockerfile
dockerfile :: Parser Dockerfile
dockerfile =
  ParsecT DockerfileError Text Identity (InstructionPos Text)
-> Parser Dockerfile
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT DockerfileError Text Identity (InstructionPos Text)
 -> Parser Dockerfile)
-> ParsecT DockerfileError Text Identity (InstructionPos Text)
-> Parser Dockerfile
forall a b. (a -> b) -> a -> b
$ do
    SourcePos
pos <- ParsecT DockerfileError Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
    Instruction Text
i <- Parser (Instruction Text)
parseInstruction
    ParsecT DockerfileError Text Identity ()
eol ParsecT DockerfileError Text Identity ()
-> ParsecT DockerfileError Text Identity ()
-> ParsecT DockerfileError Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT DockerfileError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT DockerfileError Text Identity ()
-> String -> ParsecT DockerfileError Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"a new line followed by the next instruction"
    InstructionPos Text
-> ParsecT DockerfileError Text Identity (InstructionPos Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstructionPos Text
 -> ParsecT DockerfileError Text Identity (InstructionPos Text))
-> InstructionPos Text
-> ParsecT DockerfileError Text Identity (InstructionPos Text)
forall a b. (a -> b) -> a -> b
$ Instruction Text -> Text -> Linenumber -> InstructionPos Text
forall args.
Instruction args -> Text -> Linenumber -> InstructionPos args
InstructionPos Instruction Text
i (String -> Text
T.pack (String -> Text) -> (SourcePos -> String) -> SourcePos -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> String
sourceName (SourcePos -> Text) -> SourcePos -> Text
forall a b. (a -> b) -> a -> b
$ SourcePos
pos) (Pos -> Linenumber
unPos (Pos -> Linenumber)
-> (SourcePos -> Pos) -> SourcePos -> Linenumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceLine (SourcePos -> Linenumber) -> SourcePos -> Linenumber
forall a b. (a -> b) -> a -> b
$ SourcePos
pos)

parseText :: Text -> Either Error Dockerfile
parseText :: Text -> Either Error Dockerfile
parseText = Parser Dockerfile -> String -> Text -> Either Error Dockerfile
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser Dockerfile -> Parser Dockerfile
forall a. Parser a -> Parser a
contents Parser Dockerfile
dockerfile) String
"<string>" (Text -> Either Error Dockerfile)
-> (Text -> Text) -> Text -> Either Error Dockerfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dos2unix

parseFile :: FilePath -> IO (Either Error Dockerfile)
parseFile :: String -> IO (Either Error Dockerfile)
parseFile String
file = ByteString -> Either Error Dockerfile
doParse (ByteString -> Either Error Dockerfile)
-> IO ByteString -> IO (Either Error Dockerfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
file
  where
    doParse :: ByteString -> Either Error Dockerfile
doParse = Parser Dockerfile -> String -> Text -> Either Error Dockerfile
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser Dockerfile -> Parser Dockerfile
forall a. Parser a -> Parser a
contents Parser Dockerfile
dockerfile) String
file (Text -> Either Error Dockerfile)
-> (ByteString -> Text) -> ByteString -> Either Error Dockerfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dos2unix (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
E.decodeUtf8With OnDecodeError
E.lenientDecode

-- | Reads the standard input until the end and parses the contents as a Dockerfile
parseStdin :: IO (Either Error Dockerfile)
parseStdin :: IO (Either Error Dockerfile)
parseStdin = ByteString -> Either Error Dockerfile
doParse (ByteString -> Either Error Dockerfile)
-> IO ByteString -> IO (Either Error Dockerfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
B.getContents
  where
    doParse :: ByteString -> Either Error Dockerfile
doParse = Parser Dockerfile -> String -> Text -> Either Error Dockerfile
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser Dockerfile -> Parser Dockerfile
forall a. Parser a -> Parser a
contents Parser Dockerfile
dockerfile) String
"/dev/stdin" (Text -> Either Error Dockerfile)
-> (ByteString -> Text) -> ByteString -> Either Error Dockerfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dos2unix (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
E.decodeUtf8With OnDecodeError
E.lenientDecode

-- | Changes crlf line endings to simple line endings
dos2unix :: T.Text -> T.Text
dos2unix :: Text -> Text
dos2unix = Text -> Text -> Text -> Text
T.replace Text
"\r\n" Text
"\n"