{-# LANGUAGE CPP #-}
module Utils.Containers.Internal.EqOrdUtil
  ( EqM(..)
  , OrdM(..)
  ) where

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Utils.Containers.Internal.StrictPair

newtype EqM a = EqM { forall a. EqM a -> a -> StrictPair Bool a
runEqM :: a -> StrictPair Bool a }

-- | Composes left-to-right, short-circuits on False
instance Semigroup (EqM a) where
  EqM a
f <> :: EqM a -> EqM a -> EqM a
<> EqM a
g = (a -> StrictPair Bool a) -> EqM a
forall a. (a -> StrictPair Bool a) -> EqM a
EqM ((a -> StrictPair Bool a) -> EqM a)
-> (a -> StrictPair Bool a) -> EqM a
forall a b. (a -> b) -> a -> b
$ \a
x -> case EqM a -> a -> StrictPair Bool a
forall a. EqM a -> a -> StrictPair Bool a
runEqM EqM a
f a
x of
    r :: StrictPair Bool a
r@(Bool
e :*: a
x') -> if Bool
e then EqM a -> a -> StrictPair Bool a
forall a. EqM a -> a -> StrictPair Bool a
runEqM EqM a
g a
x' else StrictPair Bool a
r

instance Monoid (EqM a) where
  mempty :: EqM a
mempty = (a -> StrictPair Bool a) -> EqM a
forall a. (a -> StrictPair Bool a) -> EqM a
EqM (Bool
True Bool -> a -> StrictPair Bool a
forall a b. a -> b -> StrictPair a b
:*:)
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

newtype OrdM a = OrdM { forall a. OrdM a -> a -> StrictPair Ordering a
runOrdM :: a -> StrictPair Ordering a }

-- | Composes left-to-right, short-circuits on non-EQ
instance Semigroup (OrdM a) where
  OrdM a
f <> :: OrdM a -> OrdM a -> OrdM a
<> OrdM a
g = (a -> StrictPair Ordering a) -> OrdM a
forall a. (a -> StrictPair Ordering a) -> OrdM a
OrdM ((a -> StrictPair Ordering a) -> OrdM a)
-> (a -> StrictPair Ordering a) -> OrdM a
forall a b. (a -> b) -> a -> b
$ \a
x -> case OrdM a -> a -> StrictPair Ordering a
forall a. OrdM a -> a -> StrictPair Ordering a
runOrdM OrdM a
f a
x of
    r :: StrictPair Ordering a
r@(Ordering
o :*: a
x') -> case Ordering
o of
      Ordering
EQ -> OrdM a -> a -> StrictPair Ordering a
forall a. OrdM a -> a -> StrictPair Ordering a
runOrdM OrdM a
g a
x'
      Ordering
_ -> StrictPair Ordering a
r

instance Monoid (OrdM a) where
  mempty :: OrdM a
mempty = (a -> StrictPair Ordering a) -> OrdM a
forall a. (a -> StrictPair Ordering a) -> OrdM a
OrdM (Ordering
EQ Ordering -> a -> StrictPair Ordering a
forall a b. a -> b -> StrictPair a b
:*:)
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif