module Main where
import Data.Primitive
import qualified Data.Serialize as Serialize
import qualified Data.Vector.Primitive as PrimitiveVector
import qualified Focus
import qualified Main.Gens as Gen
import qualified Main.Transaction as Transaction
import PrimitiveExtras.By6Bits (By6Bits)
import qualified PrimitiveExtras.By6Bits as By6Bits
import qualified PrimitiveExtras.PrimArray as PrimArray
import qualified PrimitiveExtras.SmallArray as SmallArray
import qualified Test.QuickCheck as QuickCheck
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Prelude hiding (choose)
main :: IO ()
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 :: String -> Gen (Transaction.Transaction Int) -> TestTree
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)