{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Ord.OneLiner (
GOrd(..)
, gEquals
, gNotEquals
, gCompare
, gLTE
, gLT
, gGTE
, gGT
, gMax
, gMin
) where
import Data.Coerce
import Data.Data
import Data.Monoid
import GHC.Generics
import Generics.OneLiner
newtype GOrd a = GOrd { getGOrd :: a }
deriving (Show, Read, Data, Generic, Functor, Foldable, Traversable)
instance ( ADT a
, Constraints a Eq
)
=> Eq (GOrd a) where
(==) = coerce (gEquals @a)
{-# INLINE (==) #-}
(/=) = coerce (gNotEquals @a)
{-# INLINE (/=) #-}
instance ( ADT a
, Constraints a Eq
, Constraints a Ord
)
=> Ord (GOrd a) where
compare = coerce (gCompare @a)
{-# INLINE compare #-}
(<=) = coerce (gLTE @a)
{-# INLINE (<=) #-}
(<) = coerce (gLT @a)
{-# INLINE (<) #-}
(>=) = coerce (gGTE @a)
{-# INLINE (>=) #-}
(>) = coerce (gGT @a)
{-# INLINE (>) #-}
max = coerce (gMax @a)
{-# INLINE max #-}
min = coerce (gMin @a)
{-# INLINE min #-}
gEquals
:: forall a. (ADT a, Constraints a Eq)
=> a -> a -> Bool
gEquals x y = ctorIndex x == ctorIndex y
&& getAll (mzipWith @Eq (\x' -> All . (== x')) x y)
{-# INLINE gEquals #-}
gNotEquals
:: forall a. (ADT a, Constraints a Eq)
=> a -> a -> Bool
gNotEquals x y = ctorIndex x /= ctorIndex y
|| getAny (mzipWith @Eq (\x' -> Any . (/= x')) x y)
{-# INLINE gNotEquals #-}
gCompare
:: forall a. (ADT a, Constraints a Ord)
=> a -> a -> Ordering
gCompare x y = compare (ctorIndex x) (ctorIndex y)
<> mzipWith @Ord compare x y
{-# INLINE gCompare #-}
gLTE
:: forall a. (ADT a, Constraints a Ord)
=> a -> a -> Bool
gLTE x y = not $ gGT x y
{-# INLINE gLTE #-}
gLT :: forall a. (ADT a, Constraints a Ord)
=> a -> a -> Bool
gLT x y = ctorIndex x < ctorIndex y
|| getAny (mzipWith @Ord (\x' -> Any . (x' <)) x y)
{-# INLINE gLT #-}
gGTE
:: forall a. (ADT a, Constraints a Ord)
=> a -> a -> Bool
gGTE x y = not $ gLT x y
{-# INLINE gGTE #-}
gGT :: forall a. (ADT a, Constraints a Ord)
=> a -> a -> Bool
gGT x y = ctorIndex x > ctorIndex y
|| getAny (mzipWith @Ord (\x' -> Any . (x' >)) x y)
{-# INLINE gGT #-}
gMax
:: forall a. (ADT a, Constraints a Ord)
=> a -> a -> a
gMax x y | gLTE x y = y
| otherwise = x
{-# INLINE gMax #-}
gMin
:: forall a. (ADT a, Constraints a Ord)
=> a -> a -> a
gMin x y | gLTE x y = x
| otherwise = y
{-# INLINE gMin #-}