-- | Module with reusable properties that can be tested for common type classes
module Test.Cardano.Base.Properties (
  expectStorable,
) where

import Control.Monad (when)
import Data.Bits
import Foreign.Marshal.Alloc (allocaBytes, allocaBytesAligned)
import Foreign.Storable
import Test.Hspec
import Test.QuickCheck

expectStorable ::
  (Storable a, Show a, Eq a) =>
  -- | Storable element to test.
  a ->
  -- | Offset to prefix the allocated buffer
  NonNegative Int ->
  -- | Slack to be padded after the element
  NonNegative Int ->
  Expectation
expectStorable :: forall a.
(Storable a, Show a, Eq a) =>
a -> NonNegative Int -> NonNegative Int -> Expectation
expectStorable a
x (NonNegative Int
offset) (NonNegative Int
slack) = do
  let size :: Int
size = a -> Int
forall a. Storable a => a -> Int
sizeOf a
x
  a -> Int
forall a. Storable a => a -> Int
alignment a
x Int -> (Int -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
  -- Alignment of more that 64bytes makes no sense on modern CPUs
  a -> Int
forall a. Storable a => a -> Int
alignment a
x Int -> (Int -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64)
  -- Twice the size is too big
  a -> Int
forall a. Storable a => a -> Int
alignment a
x Int -> (Int -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (\Int
a -> (Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size)
  -- Is power of two or zero:
  a -> Int
forall a. Storable a => a -> Int
alignment a
x Int -> (Int -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` \Int
a -> Int -> Int
forall a. Bits a => a -> Int
popCount Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
  let roundtrip :: Ptr a -> Expectation
roundtrip Ptr a
ptr = do
        Ptr a -> a -> Expectation
forall a. Storable a => Ptr a -> a -> Expectation
poke Ptr a
ptr a
x
        a
x0 <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
        a
x0 a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
x
        Ptr a -> Int -> a -> Expectation
forall b. Ptr b -> Int -> a -> Expectation
forall a b. Storable a => Ptr b -> Int -> a -> Expectation
pokeByteOff Ptr a
ptr Int
offset a
x
        a
xByteOff <- Ptr a -> Int -> IO a
forall b. Ptr b -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
ptr Int
offset
        a
xByteOff a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
x
        Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slack) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size) (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$ do
          Ptr a -> Int -> a -> Expectation
forall a. Storable a => Ptr a -> Int -> a -> Expectation
pokeElemOff Ptr a
ptr Int
1 a
x
          a
xElemOff <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
1
          a
xElemOff a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
x
  Int -> (Ptr a -> Expectation) -> Expectation
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slack) Ptr a -> Expectation
roundtrip
  Int -> Int -> (Ptr a -> Expectation) -> Expectation
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slack) (a -> Int
forall a. Storable a => a -> Int
alignment a
x) Ptr a -> Expectation
roundtrip