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, parseComment)
import Language.Docker.Parser.Prelude
import Language.Docker.Syntax

contents :: Parser a -> Parser a
contents :: forall a. 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
onlyWhitespaces
  a
r <- Parser a
p
  ParsecT DockerfileError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  a -> Parser a
forall a. a -> ParsecT DockerfileError Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

dockerfile :: (?esc :: Char) => Parser Dockerfile
dockerfile :: (?esc::Char) => 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)
(?esc::Char) => Parser (Instruction Text)
parseInstruction
    ParsecT DockerfileError Text Identity ()
(?esc::Char) => ParsecT DockerfileError Text Identity ()
eol ParsecT DockerfileError Text Identity ()
-> ParsecT DockerfileError Text Identity ()
-> ParsecT DockerfileError Text Identity ()
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 ()
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 a. a -> ParsecT DockerfileError Text Identity a
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 Text
txt = do
  let ?esc = [Text] -> Char
findEscapePragma (Text -> [Text]
T.lines (Text -> Text
dos2unix Text
txt))
   in 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
(?esc::Char) => Parser Dockerfile
dockerfile) String
"<string>" (Text -> Text
dos2unix Text
txt)

parseFile :: FilePath -> IO (Either Error Dockerfile)
parseFile :: String -> IO (Either Error Dockerfile)
parseFile String
file = String -> ByteString -> Either Error Dockerfile
doParse String
file (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

-- | 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 = String -> ByteString -> Either Error Dockerfile
doParse String
"/dev/stdin" (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

-- | Parses a list of lines from a dockerfile one by one until either the escape
-- | pragma has been found, or pragmas are no longer expected.
-- | Pragmas can occur only until a comment, an empty line or another
-- | instruction occurs (i.e. they have to be the first lines of a Dockerfile).
findEscapePragma :: [Text] -> Char
findEscapePragma :: [Text] -> Char
findEscapePragma [] = Char
defaultEsc
findEscapePragma (Text
l:[Text]
ls) =
  case Parser (Instruction Text)
-> String -> Text -> Either Error (Instruction Text)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser (Instruction Text) -> Parser (Instruction Text)
forall a. Parser a -> Parser a
contents Parser (Instruction Text)
(?esc::Char) => Parser (Instruction Text)
parseComment) String
"<line>" Text
l of
    Left Error
_ -> Char
defaultEsc
    Right (Pragma (Escape (EscapeChar Char
c))) -> Char
c
    Right (Pragma PragmaDirective
_) -> [Text] -> Char
findEscapePragma [Text]
ls
    Right Instruction Text
_ -> Char
defaultEsc
  where
    ?esc = ?esc::Char
Char
defaultEsc

doParse :: FilePath -> B.ByteString -> Either Error Dockerfile
doParse :: String -> ByteString -> Either Error Dockerfile
doParse String
path ByteString
txt = do
  let ?esc = [Text] -> Char
findEscapePragma (Text -> [Text]
T.lines Text
src)
   in 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
(?esc::Char) => Parser Dockerfile
dockerfile) String
path Text
src
  where
    src :: Text
src =
      case Linenumber -> ByteString -> ByteString
B.take Linenumber
4 ByteString
txt of
        ByteString
"\255\254\NUL\NUL" ->
          Text -> Text
dos2unix (OnDecodeError -> ByteString -> Text
E.decodeUtf32LEWith OnDecodeError
E.lenientDecode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> ByteString -> ByteString
B.drop Linenumber
4 ByteString
txt)
        ByteString
"\NUL\NUL\254\255" ->
          Text -> Text
dos2unix (OnDecodeError -> ByteString -> Text
E.decodeUtf32BEWith OnDecodeError
E.lenientDecode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> ByteString -> ByteString
B.drop Linenumber
4 ByteString
txt)
        ByteString
_ ->
          case Linenumber -> ByteString -> ByteString
B.take Linenumber
2 ByteString
txt of
            ByteString
"\255\254" ->
              Text -> Text
dos2unix (OnDecodeError -> ByteString -> Text
E.decodeUtf16LEWith OnDecodeError
E.lenientDecode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> ByteString -> ByteString
B.drop Linenumber
2 ByteString
txt)
            ByteString
"\254\255" ->
              Text -> Text
dos2unix (OnDecodeError -> ByteString -> Text
E.decodeUtf16BEWith OnDecodeError
E.lenientDecode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> ByteString -> ByteString
B.drop Linenumber
2 ByteString
txt)
            ByteString
_ ->
              case Linenumber -> ByteString -> ByteString
B.take Linenumber
3 ByteString
txt of
                ByteString
"\239\187\191" ->
                  Text -> Text
dos2unix (OnDecodeError -> ByteString -> Text
E.decodeUtf8With OnDecodeError
E.lenientDecode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> ByteString -> ByteString
B.drop Linenumber
3 ByteString
txt)
                ByteString
_ -> Text -> Text
dos2unix (OnDecodeError -> ByteString -> Text
E.decodeUtf8With OnDecodeError
E.lenientDecode ByteString
txt)

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