ComponentTest.hs

{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ComponentTest where

import Protolude

import Test.Tasty       (TestTree, testGroup)
import Test.Tasty.HUnit

import Control.Monad.Component
import Data.IORef              (modifyIORef, newIORef, readIORef)


tests :: TestTree
tests =
  testGroup "component monad"
  [
    testCase "execute aggregation of components' teardown action works" $ do
      callCountRef <- newIORef (0 :: Int)

      let
        componentOne =
          buildComponentWithCleanup $ do
            return ((), ("one", modifyIORef callCountRef succ))

        componentTwo =
          buildComponentWithTeardown $ do
            t <- newTeardown "two" (modifyIORef callCountRef succ)
            return ((), t)

        componentThree =
          buildComponent $ return ()

        componentAction = do
          componentOne
          componentTwo
          componentThree

      result <- runComponentM "test application" componentAction
      void $ teardown result
      callCount <- readIORef callCountRef
      assertEqual "teardown action got called more than once"
                  2 callCount

  , testCase "component construction failure tears down previous components" $ do
      callCountRef <- newIORef (0 :: Int)

      let
        componentOne =
          buildComponentWithCleanup $ do
            return ((), ("one", modifyIORef callCountRef succ))

        componentTwo =
          buildComponent $ throwIO (ErrorCall "failing hard")

        componentThree =
          buildComponentWithTeardown $ do
            t <- newTeardown "three" (modifyIORef callCountRef succ)
            return ((), t)

        componentAction = do
          componentOne
          void componentTwo
          componentThree

      result <- try $ runComponentM "test application" componentAction
      case result of
        Left (ComponentStartupFailure [err]) -> do
          callCount <- readIORef callCountRef
          assertEqual "expected introduced error, got different one"
                      (Just $ ErrorCall "failing hard")
                      (fromException err)
          assertEqual "teardown action got called more than once" 1 callCount

        Left (err :: ComponentError) -> do
          assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err

        Right _ ->
          assertFailure "expected error, but did not happen"

  , testCase "component construction multiple failure reported when using Applicative" $ do
      callCountRef <- newIORef (0 :: Int)

      let
        componentOne =
          buildComponentWithCleanup $ do
            return ((), ("one", modifyIORef callCountRef succ))

        componentTwo =
          buildComponent $ throwIO (ErrorCall "failing two")

        componentThree =
          buildComponent $ throwIO (ErrorCall "failing three")

        componentAction =
          componentOne
          *> componentTwo
          *> componentThree

      result <- try $ runComponentM "test application" componentAction
      case result of
        Left (ComponentStartupFailure [errTwo, errThree]) -> do
          callCount <- readIORef callCountRef
          assertEqual "expected introduced error, got different one"
                      (Just $ ErrorCall "failing two")
                      (fromException errTwo)
          assertEqual "expected introduced error, got different one"
                      (Just $ ErrorCall "failing three")
                      (fromException errThree)
          assertEqual "teardown action got called more than once" 1 callCount

        Left (err :: ComponentError) -> do
          assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err

        Right _ ->
          assertFailure "expected error, but did not happen"

  , testCase "component construction allows MonadThrow calls" $ do
      callCountRef <- newIORef (0 :: Int)

      let
        componentOne =
          buildComponentWithCleanup $ do
            return ((), ("one", modifyIORef callCountRef succ))

        componentTwo =
          buildComponentWithCleanup $ do
            return ((), ("two", modifyIORef callCountRef succ))

        componentAction = do
          componentOne
          void $ throwM (ErrorCall "failing via MonadThrow")
          componentTwo

      result <- try $ runComponentM "test application" componentAction
      case result of
        Left (ComponentStartupFailure [err]) -> do
          callCount <- readIORef callCountRef
          assertEqual "expected introduced error, got different one"
                      (Just $ ErrorCall "failing via MonadThrow")
                      (fromException err)
          assertEqual "teardown action got called more than once" 1 callCount

        Left (err :: ComponentError) -> do
          assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err

        Right _ ->
          assertFailure "expected error, but did not happen"

  , testCase "component construction allows fail calls" $ do
      callCountRef <- newIORef (0 :: Int)

      let
        componentOne =
          buildComponentWithCleanup $ do
            return ((), ("one", modifyIORef callCountRef succ))

        componentTwo =
          buildComponentWithCleanup $ do
            return ((), ("two", modifyIORef callCountRef succ))

        componentAction = do
          componentOne
          void $ fail "failing via fail"
          componentTwo

      result <- try $ runComponentM "test application" componentAction
      case result of
        Left (ComponentStartupFailure [err]) -> do
          callCount <- readIORef callCountRef
          assertEqual ("expected introduced error, got different one: " <> show err)
                      "failing via fail"
                      (maybe "" (\res ->
                                   case res of
                                     ComponentFailure errMsg ->
                                       errMsg
                                     _ ->
                                       "FAIL - Invalid ComponentException received")
                                (fromException err))
          assertEqual "teardown action got called more than once" 1 callCount

        Left (err :: ComponentError) -> do
          assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err

        Right _ ->
          assertFailure "expected error, but did not happen"
  ]