{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
module Control.Lens.Equality
(
Equality, Equality'
, AnEquality, AnEquality'
, runEq
, substEq
, mapEq
, fromEq
, simply
, simple
, Identical(..)
) where
import Control.Lens.Type
import Data.Functor.Identity
#ifdef HLINT
{-# ANN module "HLint: ignore Use id" #-}
{-# ANN module "HLint: ignore Eta reduce" #-}
#endif
data Identical a b s t where
Identical :: Identical a b a b
type AnEquality s t a b = Identical a (Identity b) a (Identity b) -> Identical a (Identity b) s (Identity t)
type AnEquality' s a = AnEquality s s a a
runEq :: AnEquality s t a b -> Identical s t a b
runEq l = case l Identical of Identical -> Identical
{-# INLINE runEq #-}
substEq :: AnEquality s t a b -> ((s ~ a, t ~ b) => r) -> r
substEq l = case runEq l of
Identical -> \r -> r
{-# INLINE substEq #-}
mapEq :: AnEquality s t a b -> f s -> f a
mapEq l r = substEq l r
{-# INLINE mapEq #-}
fromEq :: AnEquality s t a b -> Equality b a t s
fromEq l = substEq l id
{-# INLINE fromEq #-}
simply :: (Optic' p f s a -> r) -> Optic' p f s a -> r
simply = id
{-# INLINE simply #-}
simple :: Equality' a a
simple = id
{-# INLINE simple #-}