phatsort-0.5.0.1: test/TestLib.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module TestLib where

-- https://hackage.haskell.org/package/base
import Control.Monad.IO.Class (MonadIO(liftIO))
import GHC.Stack (HasCallStack)

-- https://hackage.haskell.org/package/HMock
import Test.HMock (MockT, makeMockable)

-- https://hackage.haskell.org/package/MonadRandom
import qualified Control.Monad.Random.Lazy as Rand
import Control.Monad.Random.Lazy (MonadRandom)

-- https://hackage.haskell.org/package/tasty-hunit
import qualified Test.Tasty.HUnit as HUnit

-- https://hackage.haskell.org/package/transformers
import Control.Monad.Trans.Class (lift)

-- (phatsort)
import PhatSort.Monad.FileSystem (MonadFileSystem)
import PhatSort.Monad.Stdio (MonadStdio)
import PhatSort.Monad.Sync (MonadSync)

------------------------------------------------------------------------------

makeMockable [t|MonadFileSystem|]

makeMockable [t|MonadStdio|]

makeMockable [t|MonadSync|]

------------------------------------------------------------------------------

instance MonadRandom m => MonadRandom (MockT m) where
  getRandomR  = lift . Rand.getRandomR
  getRandom   = lift   Rand.getRandom
  getRandomRs = lift . Rand.getRandomRs
  getRandoms  = lift   Rand.getRandoms

------------------------------------------------------------------------------

assertSuccess
  :: (HasCallStack, MonadIO m)
  => Either String ()
  -> m ()
assertSuccess = \case
    Right () -> pure ()
    Left err -> liftIO . HUnit.assertFailure $ "unexpected error: " ++ err

------------------------------------------------------------------------------

assertError
  :: (HasCallStack, MonadIO m)
  => String  -- ^ expected error message
  -> Either String ()
  -> m ()
assertError expected = \case
    Left err
      | err == expected -> pure ()
      | otherwise -> liftIO . HUnit.assertFailure $ unlines
          [ "unexpected error message"
          , "  expected: " ++ expected
          , "  but got:  " ++ err
          ]
    Right () -> liftIO . HUnit.assertFailure $ unlines
      [ "unexpected success"
      , "  expected error message: " ++ expected
      ]