Lenses.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.Pointless.Lenses
-- Copyright   :  (c) 2009 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Pointless Lenses:
-- bidirectional lenses with point-free programming
-- 
-- This module defines the structure of lenses and provides Quickcheck procedures to test lens well-behavedness.
--
-----------------------------------------------------------------------------

module Generics.Pointless.Lenses where
    
import Generics.Pointless.Functors

-- | The data type of lenses
data Lens c a = Lens { get :: c  -> a
                     , put :: (a,c) -> c
                     , create :: a -> c
                     }

-- | The type of natural lenses.
-- Lenses that encode bidirectional natural transformations.
type NatLens f g = forall x. x -> Lens (Rep f x) (Rep g x)

-- | Increment a number.
inc_lns :: Enum a => Lens a a
inc_lns = Lens succ (pred . fst) pred

-- | Decrement a number.
dec_lns :: Enum a => Lens a a
dec_lns = Lens pred (succ . fst) succ

-- | QuickCheck procedure to test if a lens is well-behaved.
wb :: (Eq a,Eq c) => Lens c a -> a -> c -> Bool
wb l a c = putget l a c && getput l c && createget l a

-- | QuickCheck procedure to test if a lens satisfies the PutGet law.
putget :: (Eq a,Eq c) => Lens c a -> a -> c -> Bool
putget l a c = get l (put l (a,c)) == a

-- | QuickCheck procedure to test if a lens satisfies the GetPut law.
getput :: Eq c => Lens c a -> c -> Bool
getput l c = put l (get l c,c) == c

-- | QuickCheck procedure to test if a lens satisfies the CreateGet law.
createget :: Eq a => Lens c a -> a -> Bool
createget l a = get l (create l a) == a