-- |
-- Module:      Hedgehog.Classes.MVector
-- Copyright:   (c) 2019-2020 Andrew Lelechenko
-- Licence:     BSD3
--

{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if !HAVE_VECTOR

module Hedgehog.Classes.MVector () where

#else

module Hedgehog.Classes.MVector
  ( muvectorLaws
  ) where

import Control.Monad (when)
import Control.Monad.ST
import qualified Data.Vector.Generic.Mutable as MU (basicInitialize)
import qualified Data.Vector.Unboxed.Mutable as MU

import Hedgehog
import Hedgehog.Classes.Common
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

-- | Test that a 'Vector.Unboxed.MVector' instance obey several laws.
muvectorLaws :: (Eq a, MU.Unbox a, Show a) => Gen a -> Laws
muvectorLaws :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Laws
muvectorLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Vector.Unboxed.MVector"
  [ (String
"New-Length", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
newLength Gen a
gen)
  , (String
"Replicate-Length", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
replicateLength Gen a
gen)
  , (String
"Slice-Length", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceLength Gen a
gen)
  , (String
"Grow-Length", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
growLength Gen a
gen)

  , (String
"Write-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeRead Gen a
gen)
  , (String
"Set-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
setRead Gen a
gen)
  , (String
"Sliced-Set-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedSetRead Gen a
gen)
  , (String
"Replicate-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
replicateRead Gen a
gen)

  , (String
"Slice-Overlaps", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceOverlaps Gen a
gen)
  , (String
"Slice-Copy", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceCopy Gen a
gen)
  , (String
"Slice-Move", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceMove Gen a
gen)

  , (String
"Write-Copy-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeCopyRead Gen a
gen)
  , (String
"Write-Move-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeMoveRead Gen a
gen)
  , (String
"Write-Grow-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeGrowRead Gen a
gen)
  , (String
"Sliced-Write-Copy-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedWriteCopyRead Gen a
gen)
  , (String
"Sliced-Write-Move-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedWriteMoveRead Gen a
gen)
  , (String
"Sliced-Write-Grow-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedWriteGrowRead Gen a
gen)

  , (String
"Write-InitializeAround-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeInitializeAroundRead Gen a
gen)
  , (String
"Write-ClearAround-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeClearAroundRead Gen a
gen)
  , (String
"Write-SetAround-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeSetAroundRead Gen a
gen)
  , (String
"Write-WriteAround-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeWriteAroundRead Gen a
gen)
  , (String
"Write-CopyAround-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeCopyAroundRead Gen a
gen)
  , (String
"Write-MoveAround-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeMoveAroundRead Gen a
gen)

  , (String
"Write-InitializeBetween-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeInitializeBetweenRead Gen a
gen)
  , (String
"Write-ClearBetween-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeClearBetweenRead Gen a
gen)
  , (String
"Write-SetBetween-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeSetBetweenRead Gen a
gen)
  , (String
"Write-CopyBetween-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeCopyBetweenRead Gen a
gen)
  , (String
"Write-MoveBetween-Read", Gen a -> Property
forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeMoveBetweenRead Gen a
gen)
  ]

genNonNegative :: Gen Int
genNonNegative :: Gen Int
genNonNegative = Range Int -> Gen Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
1000)

genPositive :: Gen Int
genPositive :: Gen Int
genPositive = Range Int -> Gen Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
1000)

-------------------------------------------------------------------------------
-- Length

newLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
newLength :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
newLength Gen a
_ = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genNonNegative
  (=== len) (runST $ MU.length <$> (MU.new len :: ST s (MU.MVector s a)))

replicateLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
replicateLength :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
replicateLength Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a   <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  len <- forAll genNonNegative
  (=== len) (runST $ MU.length <$> MU.replicate len a)

sliceLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
sliceLength :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceLength Gen a
_ = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  ix     <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genNonNegative
  subLen <- forAll genNonNegative
  excess <- forAll genPositive
  (=== subLen) (runST $ MU.length . MU.slice ix subLen <$> (MU.new (ix + subLen + excess) :: ST s (MU.MVector s a)))

growLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
growLength :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
growLength Gen a
_ = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genPositive
  by  <- forAll genPositive
  (=== len + by) $ runST $ do
    arr <- MU.new len :: ST s (MU.MVector s a)
    MU.length <$> MU.grow arr by

-------------------------------------------------------------------------------
-- Read

writeRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    arr <- MU.new (ix + excess)
    MU.write arr ix a
    MU.read arr ix

setRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
setRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
setRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    arr <- MU.new (ix + excess)
    MU.set arr a
    MU.read arr ix

slicedSetRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
slicedSetRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedSetRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  before <- forAll genNonNegative
  after  <- forAll genNonNegative
  (=== a) $ runST $ do
    arr <- newSlice before after (ix + excess)
    MU.set arr a
    MU.read arr ix

replicateRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
replicateRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
replicateRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    arr <- MU.replicate (ix + excess) a
    MU.read arr ix

-------------------------------------------------------------------------------
-- Overlaps

sliceOverlaps :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
sliceOverlaps :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceOverlaps Gen a
_ = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  i  <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genNonNegative
  ij <- forAll genNonNegative
  jk <- forAll genNonNegative
  kl <- forAll genNonNegative
  lm <- forAll genNonNegative
  let j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ij
      k = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jk
      l = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
kl
      m = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lm
  runST $ do
    arr <- MU.new (m + 1) :: ST s (MU.MVector s a)
    let slice1 = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
i (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MVector s a
arr
        slice2 = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
j (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MVector s a
arr
    pure $ assert $ MU.overlaps slice1 slice2

sliceCopy :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
sliceCopy :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceCopy Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  i      <- forAll genNonNegative
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  ij     <- forAll genNonNegative
  jk     <- forAll genNonNegative
  let j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ij
      k = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jk
  runST $ do
    arr <- MU.new k :: ST s (MU.MVector s a)
    let src = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
i (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
        dst = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
j (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
    if MU.overlaps src dst then pure success else do
      MU.write src ix a
      MU.copy dst src
      valSrc <- MU.read src ix
      valDst <- MU.read dst ix
      pure $ (valSrc, valDst) === (a, a)

sliceMove :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
sliceMove :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
sliceMove Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  i      <- forAll genNonNegative
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  ij     <- forAll genNonNegative
  jk     <- forAll genNonNegative
  let j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ij
      k = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jk
  (=== a) $ runST $ do
    arr <- MU.new k :: ST s (MU.MVector s a)
    let src = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
i (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
        dst = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
j (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
    MU.write src ix a
    MU.move dst src
    MU.read dst ix

-------------------------------------------------------------------------------
-- Write + copy/move/grow

writeCopyRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeCopyRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeCopyRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    src <- MU.new (ix + excess)
    MU.write src ix a
    dst <- MU.new (ix + excess)
    MU.copy dst src
    MU.clear src
    MU.read dst ix

writeMoveRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeMoveRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeMoveRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    src <- MU.new (ix + excess)
    MU.write src ix a
    dst <- MU.new (ix + excess)
    MU.move dst src
    MU.clear src
    MU.read dst ix

writeGrowRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeGrowRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeGrowRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  by     <- forAll genPositive
  (=== a) $ runST $ do
    src <- MU.new (ix + excess)
    MU.write src ix a
    dst <- MU.grow src by
    MU.clear src
    MU.read dst ix

slicedWriteCopyRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
slicedWriteCopyRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedWriteCopyRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a         <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix        <- forAll genNonNegative
  excess    <- forAll genPositive
  beforeSrc <- forAll genNonNegative
  afterSrc  <- forAll genNonNegative
  beforeDst <- forAll genNonNegative
  afterDst  <- forAll genNonNegative
  (=== a) $ runST $ do
    src <- newSlice beforeSrc afterSrc (ix + excess)
    MU.write src ix a
    dst <- newSlice beforeDst afterDst (ix + excess)
    MU.copy dst src
    MU.clear src
    MU.read dst ix

slicedWriteMoveRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
slicedWriteMoveRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedWriteMoveRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a         <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix        <- forAll genNonNegative
  excess    <- forAll genPositive
  beforeSrc <- forAll genNonNegative
  afterSrc  <- forAll genNonNegative
  beforeDst <- forAll genNonNegative
  afterDst  <- forAll genNonNegative
  (=== a) $ runST $ do
    src <- newSlice beforeSrc afterSrc (ix + excess)
    MU.write src ix a
    dst <- newSlice beforeDst afterDst (ix + excess)
    MU.move dst src
    MU.clear src
    MU.read dst ix

slicedWriteGrowRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
slicedWriteGrowRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
slicedWriteGrowRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a         <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix        <- forAll genNonNegative
  excess    <- forAll genPositive
  by        <- forAll genPositive
  beforeSrc <- forAll genNonNegative
  afterSrc  <- forAll genNonNegative
  (=== a) $ runST $ do
    src <- newSlice beforeSrc afterSrc (ix + excess)
    MU.write src ix a
    dst <- MU.grow src by
    MU.clear src
    MU.read dst ix

-------------------------------------------------------------------------------
-- Write + overwrite around

writeInitializeAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeInitializeAroundRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeInitializeAroundRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    arr <- MU.new (ix + excess)
    MU.write arr ix a
    when (ix > 0) $
      MU.basicInitialize (MU.slice 0 ix arr)
    when (excess > 1) $
      MU.basicInitialize (MU.slice (ix + 1) (excess - 1) arr)
    MU.read arr ix

writeClearAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeClearAroundRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeClearAroundRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    arr <- MU.new (ix + excess)
    MU.write arr ix a
    when (ix > 0) $
      MU.clear (MU.slice 0 ix arr)
    when (excess > 1) $
      MU.clear (MU.slice (ix + 1) (excess - 1) arr)
    MU.read arr ix

writeSetAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeSetAroundRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeSetAroundRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  b      <- forAll gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    arr <- MU.new (ix + excess)
    MU.write arr ix a
    when (ix > 0) $
      MU.set (MU.slice 0 ix arr) b
    when (excess > 1) $
      MU.set (MU.slice (ix + 1) (excess - 1) arr) b
    MU.read arr ix

writeWriteAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeWriteAroundRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeWriteAroundRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  b      <- forAll gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    arr <- MU.new (ix + excess)
    MU.write arr ix a
    when (ix > 0) $
      MU.write arr (ix - 1) b
    when (excess > 1) $
      MU.write arr (ix + 1) b
    MU.read arr ix

writeCopyAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeCopyAroundRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeCopyAroundRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    src <- MU.new (ix + excess)
    dst <- MU.new (ix + excess)
    MU.write dst ix a
    when (ix > 0) $
      MU.copy (MU.slice 0 ix dst) (MU.slice 0 ix src)
    when (excess > 1) $
      MU.copy (MU.slice (ix + 1) (excess - 1) dst) (MU.slice (ix + 1) (excess - 1) src)
    MU.read dst ix

writeMoveAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeMoveAroundRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeMoveAroundRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  ix     <- forAll genNonNegative
  excess <- forAll genPositive
  (=== a) $ runST $ do
    src <- MU.new (ix + excess)
    dst <- MU.new (ix + excess)
    MU.write dst ix a
    when (ix > 0) $
      MU.move (MU.slice 0 ix dst) (MU.slice 0 ix src)
    when (excess > 1) $
      MU.move (MU.slice (ix + 1) (excess - 1) dst) (MU.slice (ix + 1) (excess - 1) src)
    MU.read dst ix

-------------------------------------------------------------------------------
-- Two writes + overwrite in between

writeInitializeBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeInitializeBetweenRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeInitializeBetweenRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  b      <- forAll gen
  ix     <- forAll genNonNegative
  dix    <- forAll genPositive
  excess <- forAll genPositive
  (=== (a, b)) $ runST $ do
    arr <- MU.new (ix + dix + excess)
    MU.write arr ix a
    MU.write arr (ix + dix) b
    MU.basicInitialize (MU.slice (ix + 1) (dix - 1) arr)
    (,) <$> MU.read arr ix <*> MU.read arr (ix + dix)

writeClearBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeClearBetweenRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeClearBetweenRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  b      <- forAll gen
  ix     <- forAll genNonNegative
  dix    <- forAll genPositive
  excess <- forAll genPositive
  (=== (a, b)) $ runST $ do
    arr <- MU.new (ix + dix + excess)
    MU.write arr ix a
    MU.write arr (ix + dix) b
    MU.clear (MU.slice (ix + 1) (dix - 1) arr)
    (,) <$> MU.read arr ix <*> MU.read arr (ix + dix)

writeSetBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeSetBetweenRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeSetBetweenRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  b      <- forAll gen
  c      <- forAll gen
  ix     <- forAll genNonNegative
  dix    <- forAll genPositive
  excess <- forAll genPositive
  (=== (a, b)) $ runST $ do
    arr <- MU.new (ix + dix + excess)
    MU.write arr ix a
    MU.write arr (ix + dix) b
    MU.set (MU.slice (ix + 1) (dix - 1) arr) c
    (,) <$> MU.read arr ix <*> MU.read arr (ix + dix)

writeCopyBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeCopyBetweenRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeCopyBetweenRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  b      <- forAll gen
  ix     <- forAll genNonNegative
  dix    <- forAll genPositive
  excess <- forAll genPositive
  (=== (a, b)) $ runST $ do
    src <- MU.new (ix + dix + excess)
    dst <- MU.new (ix + dix + excess)
    MU.write dst ix a
    MU.write dst (ix + dix) b
    MU.copy (MU.slice (ix + 1) (dix - 1) dst) (MU.slice (ix + 1) (dix - 1) src)
    (,) <$> MU.read dst ix <*> MU.read dst (ix + dix)

writeMoveBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property
writeMoveBetweenRead :: forall a. (Eq a, Unbox a, Show a) => Gen a -> Property
writeMoveBetweenRead Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a      <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  b      <- forAll gen
  ix     <- forAll genNonNegative
  dix    <- forAll genPositive
  excess <- forAll genPositive
  (=== (a, b)) $ runST $ do
    src <- MU.new (ix + dix + excess)
    dst <- MU.new (ix + dix + excess)
    MU.write dst ix a
    MU.write dst (ix + dix) b
    MU.move (MU.slice (ix + 1) (dix - 1) dst) (MU.slice (ix + 1) (dix - 1) src)
    (,) <$> MU.read dst ix <*> MU.read dst (ix + dix)

-------------------------------------------------------------------------------
-- Utils

newSlice :: MU.Unbox a => Int -> Int -> Int -> ST s (MU.MVector s a)
newSlice :: forall a s. Unbox a => Int -> Int -> Int -> ST s (MVector s a)
newSlice Int
before Int
after Int
len = do
  arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
after)
  pure $ MU.slice before len arr

#endif