groan-0.1.0.0: tests/spec.hs

import Control.Exception (SomeException, try)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Primitive (RealWorld)
import Data.Foldable (forM_)
import Data.Functor ((<&>))
import Data.Int
import Data.Primitive.Contiguous qualified as C
import Data.Vector.Groan (pushFoldableBack)
import Data.Vector.Groan qualified as B
import Data.Vector.Groan.List qualified as List
import Data.Vector.Groan.Unboxed qualified as U
import Data.Vector.Unboxed qualified as UV
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Test.Hspec
import Test.Hspec.Hedgehog
import Prelude

type Element = Int32

genElement :: Gen Element
genElement = Gen.int32 (Range.linear minBound maxBound)

genElements :: Gen [Element]
genElements = Gen.list (Range.exponential 0 100) genElement

genManyElements :: Gen [Element]
genManyElements = Gen.list (Range.exponential 100 5000) genElement

testOp
  :: (a ~ Element, Show r, Eq r)
  => ([a] -> IO (buffer a))
  -> (buffer a -> IO (C.Array a))
  -> (buffer a -> IO r)
  -> (List.Buffer a -> IO r)
  -> PropertyT IO ()
testOp bufferNew bufferFreeze bufferOp listOp = do
  elements <- forAll genElements
  buf <- liftIO (bufferNew elements)
  listBuf <- liftIO (List.thaw (C.fromList elements))
  referenceOpResult <- liftIO (try @SomeException (listOp listBuf) <&> either (const Nothing) Just)
  actualOpResult <- liftIO (try @SomeException (bufferOp buf) <&> either (const Nothing) Just)
  reference <- liftIO (List.freeze listBuf)
  actual <- liftIO (bufferFreeze buf)
  referenceOpResult === actualOpResult
  reference === actual

main :: IO ()
main = hspec do
  describe "Data.Vector.Groan" do
    let
      testBOp
        :: (Eq r, Show r)
        => (B.Buffer RealWorld Element -> IO r)
        -> (List.Buffer Element -> IO r)
        -> PropertyT IO ()
      testBOp = testOp (B.thaw . C.fromList) B.freeze
    it "pushBack[1]" do
      elt <- forAll genElement
      testBOp
        (`B.pushBack` elt)
        (`List.pushBack` elt)
    it "pushBack[n]" do
      elts <- forAll genManyElements
      testBOp
        (\buf -> mapM_ (B.pushBack buf) elts)
        (\list -> mapM_ (List.pushBack list) elts)
    it "pushFoldableBack" do
      elts <- forAll genElements
      testBOp
        (`B.pushFoldableBack` elts)
        (`List.pushFoldableBack` elts)
    it "pushAllBack" do
      elts <- forAll genElements
      testBOp
        (`B.pushAllBack` C.toSlice (C.fromList @C.Array elts))
        (`List.pushFoldableBack` elts)
    it "popBack" do
      testBOp B.popBack List.popBack
    it "read" do
      i <- forAll (Gen.int (Range.linear 0 100))
      testBOp (`B.read` i) (`List.read` i)

  describe "Data.Vector.Groan.Unboxed" do
    let
      testUOp
        :: (Eq r, Show r)
        => (U.Buffer RealWorld Element -> IO r)
        -> (List.Buffer Element -> IO r)
        -> PropertyT IO ()
      testUOp = testOp (U.thaw . UV.fromList) (fmap (C.fromList . UV.toList) . U.freeze)
    it "pushBack[1]" do
      elt <- forAll genElement
      testUOp
        (`U.pushBack` elt)
        (`List.pushBack` elt)
    it "pushBack[n]" do
      elts <- forAll genManyElements
      testUOp
        (\buf -> mapM_ (U.pushBack buf) elts)
        (\list -> mapM_ (List.pushBack list) elts)
    it "popBack" do
      testUOp U.popBack List.popBack
    it "read" do
      i <- forAll (Gen.int (Range.linear 0 100))
      testUOp (`U.read` i) (`List.read` i)