PersistSpec.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.GenValidity.PersistSpec
  ( spec,
  )
where

import Data.GenValidity.Persist
import Data.Validity.Containers
import Database.Persist
import Database.Persist.TH
import GHC.Generics (Generic)
import Test.Hspec
import Test.QuickCheck
import Test.Validity

share
  [mkPersist sqlSettings]
  [persistLowerCase|

Thing
  number Int

  deriving Show
  deriving Eq
  deriving Ord
  deriving Generic

|]

instance Validity Thing

instance GenUnchecked Thing

instance GenValid Thing

spec :: Spec
spec = do
  genValidSpec @ThingId
  shrinkValidSpec @ThingId
  genValidSpec @(Entity Thing)
  shrinkValidSpec @(Entity Thing)
  describe "genSeperateIds"
    $ it "generates values with seperate ids"
    $ forAll genSeperateIds
    $ \is -> distinctOrd (is :: [Key Thing])
  describe "genSeperateIdsFor"
    $ it "generates values with seperate ids"
    $ forAll genValid
    $ \as ->
      forAll (genSeperateIdsFor as) $ \es -> distinctOrd $ map entityKey (es :: [Entity Thing])
  describe "genValidsWithSeperateIds" $ do
    it "generates values with seperate ids"
      $ forAll (genValidsWithSeperateIDs genValid)
      $ \es ->
        distinctOrd $ map entityKey (es :: [Entity Thing])
    it "generates values with seperate ids"
      $ forAll (genValidsWithSeperateIDs genValid)
      $ \es ->
        distinctOrd $ map entityKey (es :: [Entity Thing])
  describe "validsWithSeperateIDs"
    $ it "generates values with seperate ids"
    $ forAll validsWithSeperateIDs
    $ \es -> distinctOrd $ map entityKey (es :: [Entity Thing])