{-# 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