import Data.BinaryList (BinList,Exponent)
import qualified Data.BinaryList as BL
import Data.BinaryList.Serialize (Direction (..), fromDecoded)
import Format.BinaryStore
import Test.Tasty
import qualified Test.Tasty.QuickCheck as QC
import Test.QuickCheck
import Control.Applicative (pure,empty,(<$>))
import qualified Data.Foldable as F
instance Arbitrary a => Arbitrary (BinList a) where
arbitrary = do
l <- choose (0,12 :: Exponent)
BL.replicateA l arbitrary
instance Arbitrary Direction where
arbitrary = elements [FromLeft,FromRight]
instance Arbitrary a => Arbitrary (TValue a) where
arbitrary = oneof [pure empty, pure <$> arbitrary]
-- Approximately equal class
class Approx a where
(~=) :: a -> a -> Bool
instance Approx Double where
x ~= y = abs (x - y) <= 0.00001
instance Approx a => Approx (BinList a) where
xs ~= ys = F.and $ BL.zipWith (~=) xs ys
instance Approx a => Approx (Either e a) where
Right x ~= Right y = x ~= y
Left _ ~= Left _ = True
_ ~= _ = False
instance Approx a => Approx (Maybe a) where
Just x ~= Just y = x ~= y
Nothing ~= Nothing = True
_ ~= _ = False
instance Approx a => Approx (TValue a) where
tv ~= tv' = fromTValue tv ~= fromTValue tv'
--
main :: IO ()
main = defaultMain $ testGroup "binary-store"
[ testGroup "Double"
[ QC.testProperty "read/create"
$ \xs dr c bz -> forAll (choose (1,255))
$ \d -> forAll (choose (0,d))
$ \n -> ( createBinaryStore dr n d c bz xs >>= fromDecoded . readBinaryStore )
~= Right (xs :: BinList Double)
, QC.testProperty "read/decode/encode/create"
$ \xs dr c bz -> forAll (choose (1,255))
$ \d -> forAll (choose (0,d))
$ \n -> ( createBinaryStore dr n d c bz xs >>= decode . encode >>= fromDecoded . readBinaryStore )
~= Right (xs :: BinList Double)
]
, testGroup "Maybe Double"
[ QC.testProperty "read/create"
$ \xs dr c bz -> forAll (choose (1,255))
$ \d -> forAll (choose (0,d))
$ \n -> ( createBinaryStore dr n d c bz xs >>= fromDecoded . readBinaryStore )
~= Right (xs :: BinList (Maybe Double))
, QC.testProperty "read/decode/encode/create"
$ \xs dr c bz -> forAll (choose (1,255))
$ \d -> forAll (choose (0,d))
$ \n -> ( createBinaryStore dr n d c bz xs >>= decode . encode >>= fromDecoded . readBinaryStore )
~= Right (xs :: BinList (Maybe Double))
]
, testGroup "TValue Double"
[ QC.testProperty "read/create"
$ \xs dr c bz -> forAll (choose (1,255))
$ \d -> forAll (choose (0,d))
$ \n -> ( createBinaryStore dr n d c bz xs >>= fromDecoded . readBinaryStore )
~= Right (xs :: BinList (TValue Double))
, QC.testProperty "read/decode/encode/create"
$ \xs dr c bz -> forAll (choose (1,255))
$ \d -> forAll (choose (0,d))
$ \n -> ( createBinaryStore dr n d c bz xs >>= decode . encode >>= fromDecoded . readBinaryStore )
~= Right (xs :: BinList (TValue Double))
]
]