primitive-extras-0.9: test/Main.hs

module Main where

import Prelude hiding (choose)
import Data.Primitive
import Test.QuickCheck.Instances
import Test.Tasty
import Test.Tasty.Runners
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import PrimitiveExtras.By6Bits (By6Bits)
import qualified Focus
import qualified Test.QuickCheck as QuickCheck
import qualified Test.QuickCheck.Property as QuickCheck
import qualified Main.Transaction as Transaction
import qualified Main.Gens as Gen
import qualified PrimitiveExtras.By6Bits as By6Bits
import qualified PrimitiveExtras.SmallArray as SmallArray
import qualified PrimitiveExtras.PrimArray as PrimArray
import qualified Data.Serialize as Serialize
import qualified Data.Vector.Primitive as PrimitiveVector


main =
  defaultMain $
  testGroup "All" $
  [
    testGroup "SmallArray" $
    [
      testCase "set" $ let
        array = SmallArray.list [1, 2, 3]
        in assertEqual ""
          [1, 4, 3]
          (SmallArray.toList (SmallArray.set 1 4 array))
      ,
      testCase "insert" $ let
        array = SmallArray.list [1, 2, 3]
        in assertEqual ""
          [1, 4, 2, 3]
          (SmallArray.toList (SmallArray.insert 1 4 array))
      ,
      testCase "unset" $ let
        array = SmallArray.list [1, 2, 3]
        in assertEqual ""
          [1, 3]
          (SmallArray.toList (SmallArray.unset 1 array))
      ,
      testCase "focus insert, when exists" $ let
        array = SmallArray.list [1, 2, 3]
        in assertEqual ""
          [1, 4, 3]
          (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement (Focus.insert 4) (== 2) (const False) array))))
      ,
      testCase "focus insert, when doesn't exist" $ let
        array = SmallArray.list [1, 2, 3]
        in assertEqual ""
          [4, 1, 2, 3]
          (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement (Focus.insert 4) (== 4) (const False) array))))
      ,
      testCase "focus delete" $ let
        array = SmallArray.list [1, 2, 3]
        in assertEqual ""
          [1, 3]
          (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement Focus.delete (== 2) (const False) array))))
    ]
    ,
    testGroup "By6Bits" $
    [
      testCase "empty" $ do
        assertEqual ""
          (replicate (finiteBitSize (undefined :: Int)) Nothing)
          (By6Bits.toMaybeList (By6Bits.empty :: By6Bits Int32))
      ,
      testProperty "toMaybeList, maybeList" $ forAll Gen.maybeList $ \ maybeList ->
      maybeList === By6Bits.toMaybeList (By6Bits.maybeList maybeList)
      ,
      testCase "unset" $ assertEqual ""
        ([Just 1, Nothing, Nothing, Just 3] <> replicate (finiteBitSize (undefined :: Int) - 4) Nothing)
        (By6Bits.toMaybeList (By6Bits.unset 1 (By6Bits.maybeList [Just 1, Just 2, Nothing, Just 3])))
      ,
      testTransactionProperty "set" Gen.setTransaction
      ,
      testTransactionProperty "unset" Gen.unsetTransaction
      ,
      testTransactionProperty "focusInsert" Gen.focusInsertTransaction
      ,
      testTransactionProperty "focusDelete" Gen.focusDeleteTransaction
      ,
      testTransactionProperty "unfoldl" Gen.unfoldlTransaction
      ,
      testTransactionProperty "lookup" Gen.lookupTransaction
      ,
      testTransactionProperty "composite" Gen.transaction
    ]
    ,
    testGroup "PrimArray" $
    [
      testProperty "Construction from primitive vector" $ let
        gen = do
          offset <- choose (0, 2)
          length <- choose (0, 100)
          listSize <- let
            minSize = offset + length
            in choose (minSize, minSize + 100)
          list :: [Int32] <- replicateM listSize arbitrary
          return (list, offset, length)
        in forAll gen $ \ (inputList, offset, length) -> let
          !inputVec = PrimitiveVector.fromList inputList
          !sliceVec = PrimitiveVector.slice offset length inputVec
          !sliceList = PrimitiveVector.toList sliceVec
          in sliceList === primArrayToList (PrimArray.primitiveVector sliceVec)
      ,
      testProperty "Serializes well with as in memory" $ forAll (Gen.primArray Gen.element) $ \ primArray ->
      Right primArray ===
      Serialize.runGet (PrimArray.cerealGetAsInMemory Serialize.get)
          (Serialize.runPut ((PrimArray.cerealPutAsInMemory Serialize.put) primArray))
    ]
  ]

testTransactionProperty name transactionGen =
  testProperty (showString "Transaction: " name) $
  forAll ((,) <$> Gen.maybeList <*> transactionGen) $ \ (maybeList, transaction) ->
  case transaction of
    Transaction.Transaction name applyToMaybeList applyToBy6Bits -> let
      ssa = By6Bits.maybeList maybeList
      (result1, newMaybeList) = runState applyToMaybeList maybeList
      (result2, newSsa) = runState applyToBy6Bits ssa
      newSsaMaybeList = By6Bits.toMaybeList newSsa
      in
        QuickCheck.counterexample
          ("transaction: " <> show name <> "\nnewMaybeList1: " <> show newMaybeList <> "\nnewMaybeList2: " <> show newSsaMaybeList <> "\nresult1: " <> show result1 <> "\nresult2: " <> show result2)
          (newMaybeList == By6Bits.toMaybeList newSsa && result1 == result2)