winery-1.1.2: test/Spec.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-missing-signatures#-}
import Control.Monad
import Data.ByteString (ByteString)
import Data.Int
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.Scientific (Scientific)
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.Text (Text)
import Data.Time (UTCTime, NominalDiffTime)
import Codec.Winery
import Codec.Winery.Internal
import Data.Word
import qualified Data.ByteString.FastBuilder as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
import qualified Data.Vector.Storable as SV
import qualified Data.Vector.Unboxed as UV
import GHC.Generics (Generic)
import Test.QuickCheck
import qualified Test.QuickCheck.Gen as Gen
import Test.QuickCheck.Instances ()
import Control.Applicative ((<|>))

prop_VarInt :: Int -> Property
prop_VarInt i = evalDecoder decodeVarInt
  (B.toStrictByteString $ varInt i) === i

prop_Unit = testSerialise @ ()
prop_Bool = testSerialise @ Bool
prop_Word8 = testSerialise @ Word8
prop_Word16 = testSerialise @ Word16
prop_Word32 = testSerialise @ Word32
prop_Word64 = testSerialise @ Word64
prop_Word = testSerialise @ Word
prop_Int8 = testSerialise @ Int8
prop_Int16 = testSerialise @ Int16
prop_Int32 = testSerialise @ Int32
prop_Int64 = testSerialise @ Int64
prop_Int = testSerialise @ Int
prop_Float = testSerialise @ Float
prop_Double = testSerialise @ Double
prop_Text = testSerialise @ Text
prop_Integer = testSerialise @ Integer
prop_Char = testSerialise @ Char
prop_Maybe_Int = testSerialise @ (Maybe Int)
prop_ByteString = testSerialise @ ByteString
prop_ByteString_Lazy = testSerialise @ BL.ByteString
prop_UTCTime = testSerialise @ UTCTime
prop_NominalDiffTime = testSerialise @ NominalDiffTime
prop_List_Int = testSerialise @ [Int]
prop_Vector_Int = testSerialise @ (V.Vector Int) . V.fromList
prop_Vector_Storable_Int = testSerialise @ (SV.Vector Int) . SV.fromList
prop_Vector_Unboxed_Int = testSerialise @ (UV.Vector Int) . UV.fromList
prop_Map_Int_Int = testSerialise @ (Map Int Int)
prop_HashMap_String_Int = testSerialise @ (HM.HashMap String Int) . HM.fromList
prop_IntMap_Int = testSerialise @ (IntMap Int)
prop_Set_Int = testSerialise @ (Set Int)
prop_IntSet = testSerialise @ IntSet
prop_Seq_Int = testSerialise @ (Seq Int)
prop_Scientific = testSerialise @ Scientific
prop_Tuple2 = testSerialise @ (Bool, Int)
prop_Tuple3 = testSerialise @ (Bool, Int, Text)
prop_Tuple4 = testSerialise @ (Bool, Int, Text, Double)
prop_Either_String_Int = testSerialise @ (Either String Int)
prop_Ordering = testSerialise @ Ordering

data TRec = TRec
  { foo :: !Int
  , bar :: !Text
  } deriving (Show, Eq, Generic)

instance Arbitrary TRec where
  arbitrary = TRec <$> arbitrary <*> arbitrary

instance Serialise TRec where
  bundleSerialise = bundleRecord id

prop_TRec = testSerialise @ TRec

data TList a = TCons a (TList a) | TNil deriving (Show, Eq, Generic)

instance Serialise a => Serialise (TList a) where
  bundleSerialise = bundleVariant id

instance Arbitrary a => Arbitrary (TList a) where
  arbitrary = sized $ \n -> if n <= 0
    then pure TNil
    else TCons <$> arbitrary <*> scale pred arbitrary

prop_TList_Int = testSerialise @ (TList Int)

data Tree
  = Leaf
  | Branch Node
  deriving (Show, Eq, Generic)

data Node = Node { left :: !Tree, value :: !Int, right :: !Tree }
  deriving (Show, Eq, Generic)

instance Arbitrary Tree where
  arbitrary = sized $ \n -> if n <= 0
    then pure Leaf
    else Branch <$> arbitrary

instance Arbitrary Node where
  arbitrary = sized $ \n -> do
    leftSize <- Gen.choose (0, max 0 $ n - 1)
    let rightSize = max 0 $ n - 1 - leftSize
    Node <$> resize leftSize arbitrary <*> arbitrary <*> resize rightSize arbitrary

instance Serialise Tree where
  bundleSerialise = bundleVariant id

instance Serialise Node where
  bundleSerialise = bundleRecord $ const $ buildExtractor $ Node
    <$> (extractField "left" <|> extractField "leftChild")
    <*> extractField "value"
    <*> (extractField "right" <|> extractField "rightChild")

prop_tree = testSerialise @ Tree
prop_node = testSerialise @ Node

data Foo = Foo | Bar | Baz | Qux | FooBar | FooBaz | FooQux deriving (Generic, Eq, Show, Enum)

instance Arbitrary Foo where
  arbitrary = toEnum <$> Gen.choose (0, 6)

instance Serialise Foo where
  bundleSerialise = bundleVariant id

prop_Foo = testSerialise @ Foo

return []
main = void $ $quickCheckAll