{-# LANGUAGE StandaloneDeriving , MultiParamTypeClasses , TypeFamilies , FlexibleInstances , DeriveGeneric , OverloadedStrings #-} module Spec.Types where import qualified Data.Serialize as Cereal import qualified Data.Aeson as Json import qualified Data.ByteString.Lazy as LBS import Test.Serialization.Symbiote (SymbioteOperation (..), Symbiote (..)) import Test.Serialization.Symbiote.Abides import Test.QuickCheck (Arbitrary (..)) import Test.QuickCheck.Gen (oneof, scale, getSize) import GHC.Generics (Generic) instance SymbioteOperation () () where data Operation () = UnitId perform UnitId () = () deriving instance Show (Operation ()) deriving instance Generic (Operation ()) instance Arbitrary (Operation ()) where arbitrary = pure UnitId instance SymbioteOperation Int Bool where data Operation Int = IntCommutativeRing (Operation (AbidesCommutativeRing Int)) perform op x = case op of IntCommutativeRing op' -> perform op' (AbidesCommutativeRing x) deriving instance Show (Operation Int) deriving instance Generic (Operation Int) instance Cereal.Serialize (Operation Int) instance Json.ToJSON (Operation Int) instance Json.FromJSON (Operation Int) instance Arbitrary (Operation Int) where arbitrary = IntCommutativeRing <$> arbitrary instance SymbioteOperation Double Bool where data Operation Double = DoubleField (Operation (AbidesField Double)) perform op x = case op of DoubleField op' -> perform op' (AbidesField x) deriving instance Show (Operation Double) deriving instance Generic (Operation Double) instance Cereal.Serialize (Operation Double) instance Json.ToJSON (Operation Double) instance Json.FromJSON (Operation Double) instance Arbitrary (Operation Double) where arbitrary = DoubleField <$> arbitrary instance Eq a => SymbioteOperation [a] (Either Bool [a]) where data Operation [a] = ListMonoid (Operation (AbidesMonoid [a])) | ReverseList | InitList | TailList perform op x = case op of ListMonoid op' -> Left (perform op' (AbidesMonoid x)) ReverseList -> Right (reverse x) InitList -> Right $ if null x then [] else init x TailList -> Right $ if null x then [] else tail x deriving instance Show a => Show (Operation [a]) deriving instance Generic (Operation [a]) instance Cereal.Serialize a => Cereal.Serialize (Operation [a]) instance Json.ToJSON a => Json.ToJSON (Operation [a]) instance Json.FromJSON a => Json.FromJSON (Operation [a]) instance Arbitrary a => Arbitrary (Operation [a]) where arbitrary = oneof [ pure ReverseList , pure InitList , pure TailList , ListMonoid <$> arbitrary ] instance SymbioteOperation Json.Value Json.Value where data Operation Json.Value = JsonId perform _ x = x deriving instance Show (Operation Json.Value) deriving instance Generic (Operation Json.Value) instance Arbitrary (Operation Json.Value) where arbitrary = pure JsonId instance Symbiote Json.Value Json.Value LBS.ByteString where encode = Json.encode decode = Json.decode encodeOut _ = Json.encode decodeOut _ = Json.decode encodeOp _ = "id" decodeOp x | x == "id" = Just JsonId | otherwise = Nothing instance Arbitrary Json.Value where arbitrary = do s <- getSize if s <= 1 then oneof [ pure Json.Null , Json.Bool <$> arbitrary , Json.Number <$> arbitrary ] else oneof [ Json.String <$> scale (`div` 2) arbitrary , Json.Array <$> scale (`div` 2) arbitrary , Json.Object <$> scale (`div` 2) arbitrary ]