2020-07-24 12:44:34 +03:00
|
|
|
-- |
|
|
|
|
-- Module : Streamly.Test.Common
|
|
|
|
-- Copyright : (c) 2020 Composewell Technologies
|
|
|
|
--
|
|
|
|
-- License : BSD-3-Clause
|
|
|
|
-- Maintainer : streamly@composewell.com
|
|
|
|
-- Stability : experimental
|
|
|
|
-- Portability : GHC
|
|
|
|
|
|
|
|
module Streamly.Test.Common
|
|
|
|
( equals
|
|
|
|
, listEquals
|
2020-12-10 18:19:38 +03:00
|
|
|
, checkListEqual
|
|
|
|
, chooseInt
|
2023-07-25 13:36:47 +03:00
|
|
|
, chooseDouble
|
2020-07-24 12:44:34 +03:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Control.Monad (when)
|
|
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
|
|
import Data.List ((\\))
|
2020-12-10 18:19:38 +03:00
|
|
|
import Test.QuickCheck (Property, Gen, choose, counterexample)
|
|
|
|
import Test.QuickCheck.Monadic (PropertyM, assert, monitor, monadicIO)
|
2020-07-24 12:44:34 +03:00
|
|
|
|
|
|
|
equals
|
|
|
|
:: (Show a, Monad m)
|
|
|
|
=> (a -> a -> Bool) -> a -> a -> PropertyM m ()
|
|
|
|
equals eq stream list = do
|
|
|
|
when (not $ stream `eq` list) $
|
|
|
|
monitor
|
|
|
|
(counterexample $
|
|
|
|
"stream " <> show stream
|
|
|
|
<> "\nlist " <> show list
|
|
|
|
)
|
|
|
|
assert (stream `eq` list)
|
|
|
|
|
|
|
|
listEquals
|
|
|
|
:: (Show a, Eq a, MonadIO m)
|
|
|
|
=> ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
|
|
|
|
listEquals eq stream list = do
|
|
|
|
when (not $ stream `eq` list) $ liftIO $ putStrLn $
|
|
|
|
"stream " <> show stream
|
|
|
|
<> "\nlist " <> show list
|
2021-01-23 23:55:40 +03:00
|
|
|
<> "\nstream length " <> show (length stream)
|
|
|
|
<> "\nlist length " <> show (length list)
|
2020-07-24 12:44:34 +03:00
|
|
|
<> "\nstream \\\\ list " <> show (stream \\ list)
|
|
|
|
<> "\nlist \\\\ stream " <> show (list \\ stream)
|
|
|
|
when (not $ stream `eq` list) $
|
|
|
|
monitor
|
|
|
|
(counterexample $
|
|
|
|
"stream " <> show stream
|
|
|
|
<> "\nlist " <> show list
|
2021-01-23 23:55:40 +03:00
|
|
|
<> "\nstream length " <> show (length stream)
|
|
|
|
<> "\nlist length " <> show (length list)
|
2020-07-24 12:44:34 +03:00
|
|
|
<> "\nstream \\\\ list " <> show (stream \\ list)
|
|
|
|
<> "\nlist \\\\ stream " <> show (list \\ stream)
|
|
|
|
)
|
|
|
|
assert (stream `eq` list)
|
2020-12-10 18:19:38 +03:00
|
|
|
|
|
|
|
checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property
|
|
|
|
checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
|
|
|
|
|
|
|
|
chooseInt :: (Int, Int) -> Gen Int
|
|
|
|
chooseInt = choose
|
2023-07-25 13:36:47 +03:00
|
|
|
|
|
|
|
chooseDouble :: (Double, Double) -> Gen Double
|
|
|
|
chooseDouble = choose
|