DVec.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Spec.DVec (tests) where

import Hedgehog
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testPropertyNamed)

import Foreign (allocaBytes, peekByteOff, pokeByteOff)
import Graphics.Gl.Block qualified as Block

import Geomancy.DMat4 qualified
import Geomancy.DVec2 qualified
import Geomancy.DVec3 qualified
import Geomancy.DVec4 qualified
import Geomancy.Mat4 qualified

import Support.Gen
  ( forAllDTransform
  , forAllTransform
  , genDQuaternion
  , genDVec2
  , genDVec3
  , genDVec4
  , genVec2
  , genVec3
  , genVec4
  )
import Support.Property (pattern PROP_TESTS, storableRoundtrip)

tests :: TestTree
tests = testGroup "DVec"
  [ testPropertyNamed "convert_roundtrip" "prop_dvec_convert_roundtrip" prop_dvec_convert_roundtrip
  , testPropertyNamed "storable_roundtrip" "prop_dvec_storable_roundtrip" prop_dvec_storable_roundtrip
  , testPropertyNamed "dvec3_packed_write_bounds" "prop_dvec3_packed_write_bounds" prop_dvec3_packed_write_bounds
  ]

prop_dvec_convert_roundtrip :: Property
prop_dvec_convert_roundtrip = withDiscards 1000 . withTests PROP_TESTS $ property do
  v2 <- forAll genVec2
  v2 === Geomancy.DVec2.toVec2 (Geomancy.DVec2.fromVec2 v2)

  v3 <- forAll genVec3
  v3 === Geomancy.DVec3.toVec3 (Geomancy.DVec3.fromVec3 v3)

  v4 <- forAll genVec4
  v4 === Geomancy.DVec4.toVec4 (Geomancy.DVec4.fromVec4 v4)

  (m, _m) <- forAllTransform
  Geomancy.Mat4.toListRowMajor m ===
    Geomancy.Mat4.toListRowMajor (Geomancy.DMat4.toMat4 $ Geomancy.DMat4.fromMat4 m)

prop_dvec_storable_roundtrip :: Property
prop_dvec_storable_roundtrip = withDiscards 1000 . withTests PROP_TESTS $ property do
  d2 <- forAll genDVec2
  storableRoundtrip d2 >>= (d2 ===)

  d3 <- forAll genDVec3
  storableRoundtrip d3 >>= (d3 ===)

  let d3p = Geomancy.DVec3.Packed d3
  storableRoundtrip d3p >>= (d3p ===)

  d4 <- forAll genDVec4
  storableRoundtrip d4 >>= (d4 ===)

  (m, _m) <- forAllDTransform
  m' <- storableRoundtrip m
  Geomancy.DMat4.toListRowMajor m === Geomancy.DMat4.toListRowMajor m'

  dq <- forAll genDQuaternion
  storableRoundtrip dq >>= (dq ===)

prop_dvec3_packed_write_bounds :: Property
prop_dvec3_packed_write_bounds = withTests PROP_TESTS $ property do
  d3 <- forAll genDVec3
  let sentinel = 42 :: Double
  (d3', afterSlot) <- evalIO $ allocaBytes 32 \ptr -> do
    pokeByteOff ptr 24 sentinel
    pokeByteOff ptr 0 (Block.Packed d3)
    (,) <$> fmap Block.getPacked (peekByteOff ptr 0) <*> peekByteOff ptr 24
  d3 === d3'
  sentinel === afterSlot