-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.Putlenses.QuickCheck
-- Copyright   :  (C) 2013 Hugo Pacheco
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Hugo Pacheco <hpacheco@nii.ac.jp>
-- Stability   :  provisional
--
-- Quickcheck procedures to test the well-behavedness of partial lenses (and therefore putlenses)
-- 
--
--
----------------------------------------------------------------------------
module Generics.Putlenses.QuickCheck where

import Test.QuickCheck
import Generics.Putlenses.Putlens
	
-- | QuickCheck procedure to test if a lens is well-behaved.
wb :: (Eq s,Eq v) => Lens s v -> s -> v -> Property
wb l s v = putgetPartial (\s v -> True) l s v .&&. getputPartial (\s -> True) l s

-- | QuickCheck procedure to test if a lens is well-behaved, taking as arguments particular domains for get and for put
wbPartial :: (Eq s,Eq v) => (s -> Bool) -> (s -> v -> Bool) -> Lens s v -> s -> v -> Property
wbPartial getDom putDom l s v = putgetPartial putDom l s v .&&. getputPartial getDom l s

putgetPartial :: Eq v => (s -> v -> Bool) -> Lens s v -> s -> v -> Property
putgetPartial putDom l s v = putDom s v ==> get l (put l s v) == v

getputPartial :: Eq s => (s -> Bool) -> Lens s v -> s -> Property
getputPartial getDom l s = getDom s ==> put l s (get l s) == s