simplistic-generics-0.1.0.0: src/Generics/Simplistic/Derive/Eq.hs

{-# language GADTs,
             TypeFamilies,
             ConstraintKinds,
             TypeOperators,
             FlexibleContexts #-}
module Generics.Simplistic.Derive.Eq where

import Data.Functor.Identity
import Generics.Simplistic

geq :: (Applicative w, OnLeaves Eq f)
    => SRep w f -> SRep w f -> w Bool
geq S_U1       S_U1       = pure True
geq (S_L1 x)   (S_L1 y)   = geq x y
geq (S_R1 x)   (S_R1 y)   = geq x y
geq (x :**: y) (u :**: v) = (&&) <$> geq x u <*> geq y v
geq (S_K1 x)   (S_K1 y)   = (==) <$> x <*> y
geq (S_M1 _ x) (S_M1 _ y) = geq x y
geq (S_ST x)   (S_ST y)   = geq x y
geq _          _          = pure False

geq' :: (GenericSy a, OnLeaves Eq (Rep a)) => a -> a -> Bool
geq' x y = runIdentity $ geq (fromS x) (fromS y)