1{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-} 2{-# OPTIONS_GHC -fno-warn-orphans #-} -- OK because a test module 3 4module TestUtil 5 (runTests 6 ,testGen, testRaw 7 ,erroneous, erroneousIO 8 ,(====), (==>) 9 ,ASCIIString(..) 10 ,module X 11 ) where 12 13import Test.QuickCheck 14import System.IO.Unsafe 15import Text.Show.Functions() 16 17import Control.Concurrent.Extra as X 18import Control.Exception.Extra as X 19import Control.Monad.Extra as X 20import Data.Char as X 21import Data.Either.Extra as X 22import Data.Function as X 23import Data.IORef.Extra as X 24import Data.List.Extra as X hiding (union, unionBy) 25import Data.List.NonEmpty.Extra as X (NonEmpty(..), (|>), (|:), appendl, appendr, union, unionBy) 26import Data.Maybe as X 27import Data.Monoid as X 28import Data.Tuple.Extra as X 29import Data.Version.Extra as X 30import Numeric.Extra as X 31import System.Directory.Extra as X 32import System.FilePath as X 33import System.Info.Extra as X 34import System.IO.Extra as X 35import System.Process.Extra as X 36import System.Time.Extra as X 37 38 39{-# NOINLINE testCount #-} 40testCount :: IORef Int 41testCount = unsafePerformIO $ newIORef 0 42 43testGen :: Testable prop => String -> prop -> IO () 44testGen msg prop = testRaw msg $ do 45 r <- quickCheckResult prop 46 case r of 47 Success{} -> pure () 48 _ -> errorIO "Test failed" 49 50testRaw :: String -> IO () -> IO () 51testRaw msg test = do 52 putStrLn msg 53 test 54 modifyIORef testCount (+1) 55 56 57erroneous :: Show a => a -> Bool 58erroneous x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate $ length $ show x 59 60erroneousIO :: Show a => IO a -> Bool 61erroneousIO x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate . length . show =<< x 62 63(====) :: (Show a, Eq a) => a -> a -> Bool 64a ==== b 65 | a == b = True 66 | otherwise = error $ "Not equal!\n" ++ show a ++ "\n" ++ show b 67 68runTests :: IO () -> IO () 69runTests t = do 70 -- ensure that capturing output is robust 71 hSetBuffering stdout NoBuffering 72 hSetBuffering stderr NoBuffering 73 writeIORef testCount 0 74 t 75 n <- readIORef testCount 76 putStrLn $ "Success (" ++ show n ++ " tests)" 77 78instance Testable a => Testable (IO a) where 79 property = property . unsafePerformIO 80 81-- We only use this property to assert equality as a property 82-- And the Show instance is useless (since it may be non-deterministic) 83-- So we print out full information on failure 84instance (Show a, Eq a) => Eq (IO a) where 85 a == b = unsafePerformIO $ do 86 a <- try_ $ captureOutput a 87 b <- try_ $ captureOutput b 88 if a == b then pure True else 89 error $ show ("IO values not equal", a, b) 90 91instance Show (IO a) where 92 show _ = "<<IO>>" 93 94instance Arbitrary a => Arbitrary (IO a) where 95 arbitrary = do 96 (prnt :: Maybe Int, thrw :: Maybe Int, res) <- arbitrary 97 pure $ do 98 whenJust prnt print 99 whenJust thrw (fail . show) 100 pure res 101 102instance Eq SomeException where 103 a == b = show a == show b 104