{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.GenValidity.Persist where import Data.GenValidity import Data.GenValidity.Containers import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Validity.Containers import Data.Validity.Persist () import Database.Persist import Database.Persist.Sql import Test.QuickCheck instance ToBackendKey SqlBackend record => GenUnchecked (Key record) where genUnchecked :: Gen (Key record) genUnchecked = Int64 -> Key record forall record. ToBackendKey SqlBackend record => Int64 -> Key record toSqlKey (Int64 -> Key record) -> Gen Int64 -> Gen (Key record) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen Int64 forall a. GenUnchecked a => Gen a genUnchecked shrinkUnchecked :: Key record -> [Key record] shrinkUnchecked = (Int64 -> Key record) -> [Int64] -> [Key record] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Int64 -> Key record forall record. ToBackendKey SqlBackend record => Int64 -> Key record toSqlKey ([Int64] -> [Key record]) -> (Key record -> [Int64]) -> Key record -> [Key record] forall b c a. (b -> c) -> (a -> b) -> a -> c . Int64 -> [Int64] forall a. GenValid a => a -> [a] shrinkValid (Int64 -> [Int64]) -> (Key record -> Int64) -> Key record -> [Int64] forall b c a. (b -> c) -> (a -> b) -> a -> c . Key record -> Int64 forall record. ToBackendKey SqlBackend record => Key record -> Int64 fromSqlKey instance ToBackendKey SqlBackend record => GenValid (Key record) where genValid :: Gen (Key record) genValid = Int64 -> Key record forall record. ToBackendKey SqlBackend record => Int64 -> Key record toSqlKey (Int64 -> Key record) -> Gen Int64 -> Gen (Key record) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen Int64 forall a. GenValid a => Gen a genValid shrinkValid :: Key record -> [Key record] shrinkValid = Key record -> [Key record] forall a. GenUnchecked a => a -> [a] shrinkUnchecked instance (GenUnchecked a, ToBackendKey SqlBackend a) => GenUnchecked (Entity a) where genUnchecked :: Gen (Entity a) genUnchecked = Key a -> a -> Entity a forall record. Key record -> record -> Entity record Entity (Key a -> a -> Entity a) -> Gen (Key a) -> Gen (a -> Entity a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen (Key a) forall a. GenUnchecked a => Gen a genUnchecked Gen (a -> Entity a) -> Gen a -> Gen (Entity a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Gen a forall a. GenUnchecked a => Gen a genUnchecked shrinkUnchecked :: Entity a -> [Entity a] shrinkUnchecked (Entity Key a k a v) = [Key a -> a -> Entity a forall record. Key record -> record -> Entity record Entity Key a k' a v' | (Key a k', a v') <- (Key a, a) -> [(Key a, a)] forall a. GenUnchecked a => a -> [a] shrinkUnchecked (Key a k, a v)] instance (GenValid a, ToBackendKey SqlBackend a) => GenValid (Entity a) where genValid :: Gen (Entity a) genValid = Key a -> a -> Entity a forall record. Key record -> record -> Entity record Entity (Key a -> a -> Entity a) -> Gen (Key a) -> Gen (a -> Entity a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen (Key a) forall a. GenValid a => Gen a genValid Gen (a -> Entity a) -> Gen a -> Gen (Entity a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Gen a forall a. GenValid a => Gen a genValid shrinkValid :: Entity a -> [Entity a] shrinkValid (Entity Key a k a v) = [Key a -> a -> Entity a forall record. Key record -> record -> Entity record Entity Key a k' a v' | (Key a k', a v') <- (Key a, a) -> [(Key a, a)] forall a. GenValid a => a -> [a] shrinkValid (Key a k, a v)] validsWithSeperateIDs :: forall a. (ToBackendKey SqlBackend a, GenValid a) => Gen [Entity a] validsWithSeperateIDs :: Gen [Entity a] validsWithSeperateIDs = Gen a -> Gen [Entity a] forall a. (PersistEntity a, ToBackendKey SqlBackend a) => Gen a -> Gen [Entity a] genValidsWithSeperateIDs Gen a forall a. GenValid a => Gen a genValid genValidsWithSeperateIDs :: forall a. (PersistEntity a, ToBackendKey SqlBackend a) => Gen a -> Gen [Entity a] genValidsWithSeperateIDs :: Gen a -> Gen [Entity a] genValidsWithSeperateIDs Gen a gen = (Int -> Gen [Entity a]) -> Gen [Entity a] forall a. (Int -> Gen a) -> Gen a sized ((Int -> Gen [Entity a]) -> Gen [Entity a]) -> (Int -> Gen [Entity a]) -> Gen [Entity a] forall a b. (a -> b) -> a -> b $ \Int n -> do [Int] list <- Int -> Gen [Int] arbPartition Int n [Int] -> Gen [Entity a] go [Int] list where go :: [Int] -> Gen [Entity a] go :: [Int] -> Gen [Entity a] go [] = [Entity a] -> Gen [Entity a] forall (f :: * -> *) a. Applicative f => a -> f a pure [] go (Int s : [Int] ss) = do [Entity a] es <- [Int] -> Gen [Entity a] go [Int] ss Int -> Gen [Entity a] -> Gen [Entity a] forall a. Int -> Gen a -> Gen a resize Int s (Gen [Entity a] -> Gen [Entity a]) -> Gen [Entity a] -> Gen [Entity a] forall a b. (a -> b) -> a -> b $ do Key a ei <- Gen (Key a) forall a. GenValid a => Gen a genValid Gen (Key a) -> (Key a -> Bool) -> Gen (Key a) forall a. Gen a -> (a -> Bool) -> Gen a `suchThat` (Key a -> [Key a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `notElem` (Entity a -> Key a) -> [Entity a] -> [Key a] forall a b. (a -> b) -> [a] -> [b] map Entity a -> Key a forall record. Entity record -> Key record entityKey [Entity a] es) a e <- Gen a gen [Entity a] -> Gen [Entity a] forall (f :: * -> *) a. Applicative f => a -> f a pure ([Entity a] -> Gen [Entity a]) -> [Entity a] -> Gen [Entity a] forall a b. (a -> b) -> a -> b $ Key a -> a -> Entity a forall record. Key record -> record -> Entity record Entity Key a ei a e Entity a -> [Entity a] -> [Entity a] forall a. a -> [a] -> [a] : [Entity a] es genSeperateIdsForNE :: forall a. (PersistEntity a, ToBackendKey SqlBackend a, GenValid a) => NonEmpty a -> Gen (NonEmpty (Entity a)) genSeperateIdsForNE :: NonEmpty a -> Gen (NonEmpty (Entity a)) genSeperateIdsForNE (a a :| [a] as) = do [Entity a] es <- [a] -> Gen [Entity a] forall a. (ToBackendKey SqlBackend a, GenValid a) => [a] -> Gen [Entity a] genSeperateIdsFor [a] as Key a i <- Gen (Key a) forall a. GenValid a => Gen a genValid Gen (Key a) -> (Key a -> Bool) -> Gen (Key a) forall a. Gen a -> (a -> Bool) -> Gen a `suchThat` (Key a -> [Key a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `notElem` (Entity a -> Key a) -> [Entity a] -> [Key a] forall a b. (a -> b) -> [a] -> [b] map Entity a -> Key a forall record. Entity record -> Key record entityKey [Entity a] es) NonEmpty (Entity a) -> Gen (NonEmpty (Entity a)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Key a -> a -> Entity a forall record. Key record -> record -> Entity record Entity Key a i a a Entity a -> [Entity a] -> NonEmpty (Entity a) forall a. a -> [a] -> NonEmpty a :| [Entity a] es) genSeperateIds :: forall a. (PersistEntity a, ToBackendKey SqlBackend a) => Gen [Key a] genSeperateIds :: Gen [Key a] genSeperateIds = Gen (Key a) -> Gen [Key a] forall a. Ord a => Gen a -> Gen [a] genSeperate Gen (Key a) forall a. GenValid a => Gen a genValid genSeperateIdsFor :: forall a. (ToBackendKey SqlBackend a, GenValid a) => [a] -> Gen [Entity a] genSeperateIdsFor :: [a] -> Gen [Entity a] genSeperateIdsFor [] = [Entity a] -> Gen [Entity a] forall (f :: * -> *) a. Applicative f => a -> f a pure [] genSeperateIdsFor (a a : [a] as) = NonEmpty (Entity a) -> [Entity a] forall a. NonEmpty a -> [a] NE.toList (NonEmpty (Entity a) -> [Entity a]) -> Gen (NonEmpty (Entity a)) -> Gen [Entity a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> NonEmpty a -> Gen (NonEmpty (Entity a)) forall a. (PersistEntity a, ToBackendKey SqlBackend a, GenValid a) => NonEmpty a -> Gen (NonEmpty (Entity a)) genSeperateIdsForNE (a a a -> [a] -> NonEmpty a forall a. a -> [a] -> NonEmpty a :| [a] as) #if MIN_VERSION_containers(0,6,0) shrinkValidWithSeperateIds :: (PersistEntity a, ToBackendKey SqlBackend a, GenValid a) => [Entity a] -> [[Entity a]] shrinkValidWithSeperateIds :: [Entity a] -> [[Entity a]] shrinkValidWithSeperateIds = ([Entity a] -> Bool) -> [[Entity a]] -> [[Entity a]] forall a. (a -> Bool) -> [a] -> [a] filter ([Key a] -> Bool forall a. Ord a => [a] -> Bool distinctOrd ([Key a] -> Bool) -> ([Entity a] -> [Key a]) -> [Entity a] -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (Entity a -> Key a) -> [Entity a] -> [Key a] forall a b. (a -> b) -> [a] -> [b] map Entity a -> Key a forall record. Entity record -> Key record entityKey) ([[Entity a]] -> [[Entity a]]) -> ([Entity a] -> [[Entity a]]) -> [Entity a] -> [[Entity a]] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Entity a] -> [[Entity a]] forall a. GenValid a => a -> [a] shrinkValid #endif