module Buffet.Test.TestInternal
  ( get
  ) where

import qualified Buffet.Assemble.AssembleInternal as AssembleInternal
import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Test.Configuration as Configuration
import qualified Buffet.Test.ParseArguments as ParseArguments
import qualified Buffet.Test.TestDish as TestDish
import qualified Buffet.Test.TestResult as TestResult
import qualified Buffet.Test.TestSetup as TestSetup
import qualified Buffet.Test.UsingDockerImage as UsingDockerImage
import qualified Buffet.Toolbox.TextTools as TextTools
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import Prelude (Bool(True), IO, ($), (.), (<$>), and, fmap, sequenceA)
import qualified System.IO as IO

type TestResults = Map.Map Ir.Option TestResult.TestResult

get :: Configuration.Configuration -> Ir.Buffet -> IO (Bool, T.Text)
get :: Configuration -> Buffet -> IO (Bool, Text)
get Configuration
configuration Buffet
buffet = do
  Map Option Text
arguments <- Configuration -> IO (Map Option Text)
ParseArguments.get Configuration
configuration
  let use :: Text -> IO (Bool, Text)
use Text
image = TestResults -> (Bool, Text)
evaluateTestResults (TestResults -> (Bool, Text)) -> IO TestResults -> IO (Bool, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Option (IO TestResult) -> IO TestResults
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA Map Option (IO TestResult)
tests
        where
          tests :: Map Option (IO TestResult)
tests = (Option -> Dish -> Maybe (IO TestResult))
-> Map Option Dish -> Map Option (IO TestResult)
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey Option -> Dish -> Maybe (IO TestResult)
test (Map Option Dish -> Map Option (IO TestResult))
-> Map Option Dish -> Map Option (IO TestResult)
forall a b. (a -> b) -> a -> b
$ Buffet -> Map Option Dish
Ir.optionToDish Buffet
buffet
          test :: Option -> Dish -> Maybe (IO TestResult)
test Option
option Dish
dish = Text -> IO TestResult
testSetup (Text -> IO TestResult) -> Maybe Text -> Maybe (IO TestResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option -> Map Option Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Option
option Map Option Text
arguments
            where
              testSetup :: Text -> IO TestResult
testSetup Text
optionValue =
                TestSetup -> IO TestResult
TestDish.get
                  TestSetup :: Handle -> Text -> Option -> Text -> Dish -> TestSetup
TestSetup.TestSetup
                    { log :: Handle
TestSetup.log = Handle
log
                    , image :: Text
TestSetup.image = Text
image
                    , option :: Option
TestSetup.option = Option
option
                    , optionValue :: Text
TestSetup.optionValue = Text
optionValue
                    , dish :: Dish
TestSetup.dish = Dish
dish
                    }
      imageConfiguration :: Configuration
imageConfiguration =
        Configuration :: Handle -> DockerBuild -> Configuration
UsingDockerImage.Configuration
          { log :: Handle
UsingDockerImage.log = Handle
log
          , dockerBuild :: DockerBuild
UsingDockerImage.dockerBuild =
              DockerBuild :: Text -> Map Option Text -> DockerBuild
UsingDockerImage.DockerBuild
                { dockerfile :: Text
UsingDockerImage.dockerfile = Buffet -> Text
AssembleInternal.get Buffet
buffet
                , arguments :: Map Option Text
UsingDockerImage.arguments = Map Option Text
arguments
                }
          }
  (Text -> IO (Bool, Text)) -> Configuration -> IO (Bool, Text)
forall a. (Text -> IO a) -> Configuration -> IO a
UsingDockerImage.get Text -> IO (Bool, Text)
use Configuration
imageConfiguration
  where
    log :: Handle
log = Handle
IO.stderr

evaluateTestResults :: TestResults -> (Bool, T.Text)
evaluateTestResults :: TestResults -> (Bool, Text)
evaluateTestResults TestResults
testResults =
  (Map Option Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Map Option Bool -> Bool) -> Map Option Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (TestResult -> Bool) -> TestResults -> Map Option Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestResult -> Bool
isSuccess TestResults
testResults, TestResults -> Text
forall a. ToJSON a => a -> Text
TextTools.prettyPrintJson TestResults
testResults)

isSuccess :: TestResult.TestResult -> Bool
isSuccess :: TestResult -> Bool
isSuccess = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
Maybe.fromMaybe Bool
True (Maybe Bool -> Bool)
-> (TestResult -> Maybe Bool) -> TestResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestResult -> Maybe Bool
TestResult.healthCheckPassed