{- HLINT ignore "Avoid restricted extensions" -}
{-# LANGUAGE DeriveGeneric #-}

module Buffet.Parse.Print
  ( get
  ) where

import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Toolbox.DockerTools as DockerTools
import qualified Buffet.Toolbox.TextTools as TextTools
import qualified Data.Aeson as Aeson
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified GHC.Generics as Generics
import qualified Language.Docker as Docker
import Prelude (Eq, FilePath, Maybe, Ord, Show, ($), (.), (<$>), fmap)

data Buffet =
  Buffet
    { Buffet -> Text
copyDummySourcePath :: T.Text
    , Buffet -> Map Option Dish
optionToDish :: Map.Map Ir.Option Dish
    }
  deriving (Buffet -> Buffet -> Bool
(Buffet -> Buffet -> Bool)
-> (Buffet -> Buffet -> Bool) -> Eq Buffet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Buffet -> Buffet -> Bool
$c/= :: Buffet -> Buffet -> Bool
== :: Buffet -> Buffet -> Bool
$c== :: Buffet -> Buffet -> Bool
Eq, (forall x. Buffet -> Rep Buffet x)
-> (forall x. Rep Buffet x -> Buffet) -> Generic Buffet
forall x. Rep Buffet x -> Buffet
forall x. Buffet -> Rep Buffet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Buffet x -> Buffet
$cfrom :: forall x. Buffet -> Rep Buffet x
Generics.Generic, Eq Buffet
Eq Buffet
-> (Buffet -> Buffet -> Ordering)
-> (Buffet -> Buffet -> Bool)
-> (Buffet -> Buffet -> Bool)
-> (Buffet -> Buffet -> Bool)
-> (Buffet -> Buffet -> Bool)
-> (Buffet -> Buffet -> Buffet)
-> (Buffet -> Buffet -> Buffet)
-> Ord Buffet
Buffet -> Buffet -> Bool
Buffet -> Buffet -> Ordering
Buffet -> Buffet -> Buffet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Buffet -> Buffet -> Buffet
$cmin :: Buffet -> Buffet -> Buffet
max :: Buffet -> Buffet -> Buffet
$cmax :: Buffet -> Buffet -> Buffet
>= :: Buffet -> Buffet -> Bool
$c>= :: Buffet -> Buffet -> Bool
> :: Buffet -> Buffet -> Bool
$c> :: Buffet -> Buffet -> Bool
<= :: Buffet -> Buffet -> Bool
$c<= :: Buffet -> Buffet -> Bool
< :: Buffet -> Buffet -> Bool
$c< :: Buffet -> Buffet -> Bool
compare :: Buffet -> Buffet -> Ordering
$ccompare :: Buffet -> Buffet -> Ordering
$cp1Ord :: Eq Buffet
Ord, Int -> Buffet -> ShowS
[Buffet] -> ShowS
Buffet -> String
(Int -> Buffet -> ShowS)
-> (Buffet -> String) -> ([Buffet] -> ShowS) -> Show Buffet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Buffet] -> ShowS
$cshowList :: [Buffet] -> ShowS
show :: Buffet -> String
$cshow :: Buffet -> String
showsPrec :: Int -> Buffet -> ShowS
$cshowsPrec :: Int -> Buffet -> ShowS
Show)

instance Aeson.ToJSON Buffet where
  toJSON :: Buffet -> Value
toJSON = Options -> Buffet -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
TextTools.defaultJsonOptions

data Dish =
  Dish
    { Dish -> String
dockerfilePath :: FilePath
    , Dish -> Metadata
metadata :: Metadata
    , Dish -> DockerfilePart
beforeFirstBuildStage :: DockerfilePart
    , Dish -> [DockerfilePart]
localBuildStages :: [DockerfilePart]
    , Dish -> DockerfilePart
globalBuildStage :: DockerfilePart
    , Dish -> Maybe Text
healthCheck :: Maybe T.Text
    }
  deriving (Dish -> Dish -> Bool
(Dish -> Dish -> Bool) -> (Dish -> Dish -> Bool) -> Eq Dish
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dish -> Dish -> Bool
$c/= :: Dish -> Dish -> Bool
== :: Dish -> Dish -> Bool
$c== :: Dish -> Dish -> Bool
Eq, (forall x. Dish -> Rep Dish x)
-> (forall x. Rep Dish x -> Dish) -> Generic Dish
forall x. Rep Dish x -> Dish
forall x. Dish -> Rep Dish x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dish x -> Dish
$cfrom :: forall x. Dish -> Rep Dish x
Generics.Generic, Eq Dish
Eq Dish
-> (Dish -> Dish -> Ordering)
-> (Dish -> Dish -> Bool)
-> (Dish -> Dish -> Bool)
-> (Dish -> Dish -> Bool)
-> (Dish -> Dish -> Bool)
-> (Dish -> Dish -> Dish)
-> (Dish -> Dish -> Dish)
-> Ord Dish
Dish -> Dish -> Bool
Dish -> Dish -> Ordering
Dish -> Dish -> Dish
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dish -> Dish -> Dish
$cmin :: Dish -> Dish -> Dish
max :: Dish -> Dish -> Dish
$cmax :: Dish -> Dish -> Dish
>= :: Dish -> Dish -> Bool
$c>= :: Dish -> Dish -> Bool
> :: Dish -> Dish -> Bool
$c> :: Dish -> Dish -> Bool
<= :: Dish -> Dish -> Bool
$c<= :: Dish -> Dish -> Bool
< :: Dish -> Dish -> Bool
$c< :: Dish -> Dish -> Bool
compare :: Dish -> Dish -> Ordering
$ccompare :: Dish -> Dish -> Ordering
$cp1Ord :: Eq Dish
Ord, Int -> Dish -> ShowS
[Dish] -> ShowS
Dish -> String
(Int -> Dish -> ShowS)
-> (Dish -> String) -> ([Dish] -> ShowS) -> Show Dish
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dish] -> ShowS
$cshowList :: [Dish] -> ShowS
show :: Dish -> String
$cshow :: Dish -> String
showsPrec :: Int -> Dish -> ShowS
$cshowsPrec :: Int -> Dish -> ShowS
Show)

instance Aeson.ToJSON Dish where
  toJSON :: Dish -> Value
toJSON = Options -> Dish -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
TextTools.defaultJsonOptions

data Metadata =
  Metadata
    { Metadata -> Text
title :: T.Text
    , Metadata -> Text
url :: T.Text
    , Metadata -> Map TagKey [TagValue]
tags :: Map.Map Ir.TagKey [Ir.TagValue]
    }
  deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq, (forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metadata x -> Metadata
$cfrom :: forall x. Metadata -> Rep Metadata x
Generics.Generic, Eq Metadata
Eq Metadata
-> (Metadata -> Metadata -> Ordering)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Metadata)
-> (Metadata -> Metadata -> Metadata)
-> Ord Metadata
Metadata -> Metadata -> Bool
Metadata -> Metadata -> Ordering
Metadata -> Metadata -> Metadata
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Metadata -> Metadata -> Metadata
$cmin :: Metadata -> Metadata -> Metadata
max :: Metadata -> Metadata -> Metadata
$cmax :: Metadata -> Metadata -> Metadata
>= :: Metadata -> Metadata -> Bool
$c>= :: Metadata -> Metadata -> Bool
> :: Metadata -> Metadata -> Bool
$c> :: Metadata -> Metadata -> Bool
<= :: Metadata -> Metadata -> Bool
$c<= :: Metadata -> Metadata -> Bool
< :: Metadata -> Metadata -> Bool
$c< :: Metadata -> Metadata -> Bool
compare :: Metadata -> Metadata -> Ordering
$ccompare :: Metadata -> Metadata -> Ordering
$cp1Ord :: Eq Metadata
Ord, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show)

instance Aeson.ToJSON Metadata where
  toJSON :: Metadata -> Value
toJSON = Options -> Metadata -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
TextTools.defaultJsonOptions

type DockerfilePart = [T.Text]

get :: Ir.Buffet -> T.Text
get :: Buffet -> Text
get = Buffet -> Text
forall a. ToJSON a => a -> Text
TextTools.prettyPrintJson (Buffet -> Text) -> (Buffet -> Buffet) -> Buffet -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffet -> Buffet
transformBuffet

transformBuffet :: Ir.Buffet -> Buffet
transformBuffet :: Buffet -> Buffet
transformBuffet Buffet
buffet =
  Buffet :: Text -> Map Option Dish -> Buffet
Buffet
    { copyDummySourcePath :: Text
copyDummySourcePath = Buffet -> Text
Ir.copyDummySourcePath Buffet
buffet
    , optionToDish :: Map Option Dish
optionToDish = Dish -> Dish
transformDish (Dish -> Dish) -> Map Option Dish -> Map Option Dish
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffet -> Map Option Dish
Ir.optionToDish Buffet
buffet
    }

transformDish :: Ir.Dish -> Dish
transformDish :: Dish -> Dish
transformDish Dish
dish =
  Dish :: String
-> Metadata
-> DockerfilePart
-> [DockerfilePart]
-> DockerfilePart
-> Maybe Text
-> Dish
Dish
    { dockerfilePath :: String
dockerfilePath = Dish -> String
Ir.dockerfilePath Dish
dish
    , metadata :: Metadata
metadata = Metadata -> Metadata
transformMetadata (Metadata -> Metadata) -> Metadata -> Metadata
forall a b. (a -> b) -> a -> b
$ Dish -> Metadata
Ir.metadata Dish
dish
    , beforeFirstBuildStage :: DockerfilePart
beforeFirstBuildStage =
        DockerfilePart -> DockerfilePart
transformDockerfilePart (DockerfilePart -> DockerfilePart)
-> DockerfilePart -> DockerfilePart
forall a b. (a -> b) -> a -> b
$ Dish -> DockerfilePart
Ir.beforeFirstBuildStage Dish
dish
    , localBuildStages :: [DockerfilePart]
localBuildStages = DockerfilePart -> DockerfilePart
transformDockerfilePart (DockerfilePart -> DockerfilePart)
-> [DockerfilePart] -> [DockerfilePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dish -> [DockerfilePart]
Ir.localBuildStages Dish
dish
    , globalBuildStage :: DockerfilePart
globalBuildStage = DockerfilePart -> DockerfilePart
transformDockerfilePart (DockerfilePart -> DockerfilePart)
-> DockerfilePart -> DockerfilePart
forall a b. (a -> b) -> a -> b
$ Dish -> DockerfilePart
Ir.globalBuildStage Dish
dish
    , healthCheck :: Maybe Text
healthCheck = Dish -> Maybe Text
Ir.healthCheck Dish
dish
    }

transformMetadata :: Ir.Metadata -> Metadata
transformMetadata :: Metadata -> Metadata
transformMetadata Metadata
meta =
  Metadata :: Text -> Text -> Map TagKey [TagValue] -> Metadata
Metadata {title :: Text
title = Metadata -> Text
Ir.title Metadata
meta, url :: Text
url = Metadata -> Text
Ir.url Metadata
meta, tags :: Map TagKey [TagValue]
tags = Metadata -> Map TagKey [TagValue]
Ir.tags Metadata
meta}

transformDockerfilePart :: Ir.DockerfilePart -> DockerfilePart
transformDockerfilePart :: DockerfilePart -> DockerfilePart
transformDockerfilePart = (Instruction Text -> Text) -> DockerfilePart -> DockerfilePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Instruction Text -> Text
transformInstruction

transformInstruction :: Docker.Instruction T.Text -> T.Text
transformInstruction :: Instruction Text -> Text
transformInstruction = Text -> Text
T.stripEnd (Text -> Text)
-> (Instruction Text -> Text) -> Instruction Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instruction Text -> Text
DockerTools.printInstruction