module Buffet.Parse.ParseDish
  ( get
  ) where

import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Parse.ParseGlobalBuildStage as ParseGlobalBuildStage
import qualified Buffet.Parse.ParseHealthCheck as ParseHealthCheck
import qualified Buffet.Parse.ParseMetadata as ParseMetadata
import qualified Buffet.Parse.PartitionByBuildStage as PartitionByBuildStage
import qualified Buffet.Toolbox.ExceptionTools as ExceptionTools
import qualified Control.Exception as Exception
import qualified Language.Docker as Docker
import qualified Language.Docker.Parser as Parser
import Prelude (FilePath, IO, Show, ($), (.), fmap, pure, show)

newtype Exception =
  Exception Parser.Error

instance Show Exception where
  show :: Exception -> String
show (Exception Error
error) = Error -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Docker.errorBundlePretty Error
error

instance Exception.Exception Exception

get :: FilePath -> IO Ir.Dish
get :: String -> IO Dish
get String
dockerfilePath = do
  Dockerfile
dockerfile <- String -> IO Dockerfile
parseDockerfile String
dockerfilePath
  Dish -> IO Dish
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dish -> IO Dish) -> Dish -> IO Dish
forall a b. (a -> b) -> a -> b
$ String -> Dockerfile -> Dish
parseDish String
dockerfilePath Dockerfile
dockerfile

parseDockerfile :: FilePath -> IO Docker.Dockerfile
parseDockerfile :: String -> IO Dockerfile
parseDockerfile = (Error -> Exception)
-> IO (Either Error Dockerfile) -> IO Dockerfile
forall e a b. Exception e => (a -> e) -> IO (Either a b) -> IO b
ExceptionTools.eitherThrow Error -> Exception
Exception (IO (Either Error Dockerfile) -> IO Dockerfile)
-> (String -> IO (Either Error Dockerfile))
-> String
-> IO Dockerfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Either Error Dockerfile)
Docker.parseFile

parseDish :: FilePath -> Docker.Dockerfile -> Ir.Dish
parseDish :: String -> Dockerfile -> Dish
parseDish String
dockerfilePath Dockerfile
dockerfile =
  Dish :: String
-> Metadata
-> DockerfilePart
-> [DockerfilePart]
-> DockerfilePart
-> Maybe Text
-> Dish
Ir.Dish
    { dockerfilePath :: String
Ir.dockerfilePath = String
dockerfilePath
    , metadata :: Metadata
Ir.metadata = Dockerfile -> Metadata
ParseMetadata.get Dockerfile
globalStage
    , beforeFirstBuildStage :: DockerfilePart
Ir.beforeFirstBuildStage = Dockerfile -> DockerfilePart
dropPositions Dockerfile
beforeFirstStage
    , localBuildStages :: [DockerfilePart]
Ir.localBuildStages = (Dockerfile -> DockerfilePart) -> [Dockerfile] -> [DockerfilePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dockerfile -> DockerfilePart
dropPositions [Dockerfile]
localStages
    , globalBuildStage :: DockerfilePart
Ir.globalBuildStage = Dockerfile -> DockerfilePart
ParseGlobalBuildStage.get Dockerfile
globalStage
    , healthCheck :: Maybe Text
Ir.healthCheck = Dockerfile -> Maybe Text
ParseHealthCheck.get Dockerfile
globalStage
    }
  where
    (Dockerfile
beforeFirstStage, [Dockerfile]
localStages, Dockerfile
globalStage) =
      Dockerfile -> (Dockerfile, [Dockerfile], Dockerfile)
PartitionByBuildStage.get Dockerfile
dockerfile

dropPositions :: Docker.Dockerfile -> Ir.DockerfilePart
dropPositions :: Dockerfile -> DockerfilePart
dropPositions = (InstructionPos Text -> Instruction Text)
-> Dockerfile -> DockerfilePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InstructionPos Text -> Instruction Text
forall args. InstructionPos args -> Instruction args
Docker.instruction