Control.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.IO.Mismi.Control (tests) where

import           Control.Monad.Catch (throwM, catchIOError)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Resource (register)

import           Data.IORef (modifyIORef, newIORef, readIORef)

import           Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import           Mismi.Control (awsBracket)

import           P

import           System.IO.Error (userError)

import           Test.Mismi (testAWS, liftAWS, runAWSDefaultRegion)

prop_bracket :: Property
prop_bracket =
  property $ do
    l <- forAll $ Gen.list (Range.linear 0 100) (Gen.text (Range.linear 0 50) Gen.alphaNum)
    final <- forAll $ Gen.text (Range.linear 1 10) Gen.alphaNum
    action <- forAll $ Gen.text (Range.linear 1 10) Gen.alphaNum

    ref <- liftIO $ newIORef l
    let
      after' = (flip modifyIORef (final :))
      action' = (flip modifyIORef (action :))
    liftIO . runAWSDefaultRegion $ awsBracket (liftIO $ return ref) (liftIO . after') (liftIO . action')
    result <- liftIO $ readIORef ref
    result === final : action : l

prop_bracket_catch :: Property
prop_bracket_catch =
  property $ do
    l <- forAll $ Gen.list (Range.linear 0 100) (Gen.text (Range.linear 0 50) Gen.alphaNum)
    final <- forAll $ Gen.text (Range.linear 1 10) Gen.alphaNum

    ref <- liftIO $ newIORef l
    let
      after' = (flip modifyIORef (final :))
      action' = const $ throwM (userError "")
    liftIO . runAWSDefaultRegion $
      awsBracket (liftIO $ return ref) (liftIO . after') (liftIO . action') `catchIOError` (const $ return ())
    result <- liftIO $ readIORef ref
    result === final : l


prop_testAWS :: Property
prop_testAWS =
  withTests 1 . testAWS $
    pure ()

prop_testAWS_PropertyT :: Property
prop_testAWS_PropertyT =
  withTests 1 . property . liftAWS $ do
    False === False
    True === True


prop_finalizer :: Property
prop_finalizer =
  property $ do
    ref <- liftIO $ newIORef (0 :: Int)
    liftIO . runAWSDefaultRegion $ do
      void $ register (modifyIORef ref (const $ 1))
    result <- liftIO $ readIORef ref
    result === 1

tests :: IO Bool
tests =
  checkSequential $$(discover)