{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE InstanceSigs #-}

module Data.Ord.Ordering where

import Control.Applicative
    ( Applicative(liftA2, pure, (<*>)),
      (<$>),
      Alternative(empty, (<|>)) )
import Control.Lens
    ( view,
      iso,
      isn't,
      prism',
      (#),
      over,
      _Wrapped,
      Getting,
      Iso,
      Lens',
      Prism',
      Rewrapped,
      Wrapped(..) )
import Control.Monad.IO.Class ( MonadIO(..) )
import Control.Monad.Reader
import Control.Monad.State
    ( State, evalState )
import Control.Monad.Trans ( MonadTrans(..) )
import Data.Bool(bool)
import Data.Functor.Identity ( Identity(..) )
import Data.Functor.Contravariant ( Contravariant(contramap) )
import Data.Functor.Contravariant.Divisible
    ( Divisible(..) )
import Data.Functor ( Functor(fmap) )
import Data.Functor.Apply ( Apply((<.>)) )
import Data.Functor.Alt ( Alt((<!>)) )
import Data.Functor.Bind ( Bind((>>-)) )
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Profunctor ( Choice(..), Profunctor(dimap) )

-- $setup
-- >>> import Control.Lens
-- >>> import Control.Monad.State
-- >>> import Data.Eq
-- >>> import Data.Functor.Contravariant
newtype OrderT b f a =
  OrderT (a -> a -> f b)

instance OrderT b' f' a' ~ t =>
  Rewrapped (OrderT b f a) t

instance Wrapped (OrderT b f a) where
  type Unwrapped (OrderT b f a) = a -> a -> f b
  _Wrapped' :: Iso' (OrderT b f a) (Unwrapped (OrderT b f a))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(OrderT a -> a -> f b
x) -> a -> a -> f b
x) forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT

type Order b a =
  OrderT b Identity a

order ::
  Iso
    (Order b a)
    (Order b a)
    (a -> a -> b)
    (a -> a -> b)
order :: forall b a. Iso (Order b a) (Order b a) (a -> a -> b) (a -> a -> b)
order =
  forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\OrderT b Identity a
o a
a1 a
a2 -> forall a. Identity a -> a
runIdentity (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped OrderT b Identity a
o a
a1 a
a2))
    (\a -> a -> b
f -> forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall a. a -> Identity a
Identity (a -> a -> b
f a
a1 a
a2)))

class AsOrdering a where
  _Ordering ::
    Prism' a Ordering
  _LT ::
    Prism' a ()
  _LT =
    forall a. AsOrdering a => Prism' a Ordering
_Ordering forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> Ordering
LT)
      (\case  Ordering
LT ->
                forall a. a -> Maybe a
Just ()
              Ordering
_ ->
                forall a. Maybe a
Nothing
      )
  _EQ ::
    Prism' a ()
  _EQ =
    forall a. AsOrdering a => Prism' a Ordering
_Ordering forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> Ordering
EQ)
      (\case  Ordering
EQ ->
                forall a. a -> Maybe a
Just ()
              Ordering
_ ->
                forall a. Maybe a
Nothing
      )
  _GT ::
    Prism' a ()
  _GT =
    forall a. AsOrdering a => Prism' a Ordering
_Ordering forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\() -> Ordering
GT)
      (\case  Ordering
GT ->
                forall a. a -> Maybe a
Just ()
              Ordering
_ ->
                forall a. Maybe a
Nothing
      )

instance AsOrdering Ordering where
  _Ordering :: Prism' Ordering Ordering
_Ordering =
    forall a. a -> a
id

class HasOrdering a where
  ordering ::
    Lens' a Ordering

instance HasOrdering Ordering where
  ordering :: Lens' Ordering Ordering
ordering =
    forall a. a -> a
id

instance (Applicative f, Semigroup b) => Semigroup (OrderT b f a) where
  OrderT a -> a -> f b
f <> :: OrderT b f a -> OrderT b f a -> OrderT b f a
<> OrderT a -> a -> f b
g =
    forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> f b
f a
a1 a
a2) (a -> a -> f b
g a
a1 a
a2))

instance (Applicative f, Monoid b) => Monoid (OrderT b f a) where
  mempty :: OrderT b f a
mempty =
    forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)

instance Contravariant (OrderT b f) where
  contramap :: forall a' a. (a' -> a) -> OrderT b f a -> OrderT b f a'
contramap a' -> a
f (OrderT a -> a -> f b
g) =
    forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a'
a1 a'
a2 -> a -> a -> f b
g (a' -> a
f a'
a1) (a' -> a
f a'
a2))

instance (Applicative f, Monoid b) => Divisible (OrderT b f) where
  divide :: forall a b c.
(a -> (b, c)) -> OrderT b f b -> OrderT b f c -> OrderT b f a
divide a -> (b, c)
f (OrderT b -> b -> f b
g) (OrderT c -> c -> f b
h) =
    forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> let (b
b1, c
c1) = a -> (b, c)
f a
a1
                          (b
b2, c
c2) = a -> (b, c)
f a
a2
                      in  forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (b -> b -> f b
g b
b1 b
b2) (c -> c -> f b
h c
c1 c
c2))
  conquer :: forall a. OrderT b f a
conquer =
    forall a. Monoid a => a
mempty

-- |
-- >>> view order lt 1 1 :: Ordering
-- LT
--
-- >>> view order lt 1 2 :: Ordering
-- LT
--
-- >>> view order lt 2 1 :: Ordering
-- LT
--
-- prop> \x y -> (view order lt x y :: Ordering) == LT
-- +++ OK, passed 100 tests.
lt ::
  (Applicative f, AsOrdering b) =>
  OrderT b f a
lt :: forall (f :: * -> *) b a.
(Applicative f, AsOrdering b) =>
OrderT b f a
lt =
  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AsOrdering a => Prism' a ()
_LT forall t b. AReview t b -> b -> t
# ()))

-- |
--
-- >>> isLT LT
-- True
--
-- >>> isLT GT
-- False
--
-- >>> isLT EQ
-- False
isLT ::
  AsOrdering a =>
  a
  -> Bool
isLT :: forall a. AsOrdering a => a -> Bool
isLT =
  Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. APrism s t a b -> s -> Bool
isn't forall a. AsOrdering a => Prism' a ()
_LT

-- |
--
-- >>> ifLT 1 2 LT
-- 2
-- >>> ifLT 1 2 GT
-- 1
-- >>> ifLT 1 2 EQ
-- 1
ifLT ::
  AsOrdering x =>
  a
  -> a
  -> x
  -> a
ifLT :: forall x a. AsOrdering x => a -> a -> x -> a
ifLT a
a1 a
a2 =
  forall a. a -> a -> Bool -> a
bool a
a1 a
a2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsOrdering a => a -> Bool
isLT

-- |
-- >>> view order eq 1 1 :: Ordering
-- EQ
--
-- >>> view order eq 1 2 :: Ordering
-- EQ
--
-- >>> view order eq 2 1 :: Ordering
-- EQ
--
-- prop> \x y -> (view order eq x y :: Ordering) == EQ
-- +++ OK, passed 100 tests.
eq ::
  (Applicative f, AsOrdering b) =>
  OrderT b f a
eq :: forall (f :: * -> *) b a.
(Applicative f, AsOrdering b) =>
OrderT b f a
eq =
  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AsOrdering a => Prism' a ()
_EQ forall t b. AReview t b -> b -> t
# ()))

-- |
--
-- >>> isEQ LT
-- False
--
-- >>> isEQ GT
-- False
--
-- >>> isEQ EQ
-- True
isEQ ::
  AsOrdering a =>
  a
  -> Bool
isEQ :: forall a. AsOrdering a => a -> Bool
isEQ =
  Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. APrism s t a b -> s -> Bool
isn't forall a. AsOrdering a => Prism' a ()
_EQ

-- |
--
-- >>> ifEQ 1 2 LT
-- 1
-- >>> ifEQ 1 2 GT
-- 1
-- >>> ifEQ 1 2 EQ
-- 2
ifEQ ::
  AsOrdering x =>
  a
  -> a
  -> x
  -> a
ifEQ :: forall x a. AsOrdering x => a -> a -> x -> a
ifEQ a
a1 a
a2 =
  forall a. a -> a -> Bool -> a
bool a
a1 a
a2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsOrdering a => a -> Bool
isEQ

-- |
-- >>> view order gt 1 1 :: Ordering
-- GT
--
-- >>> view order gt 1 2 :: Ordering
-- GT
--
-- >>> view order gt 2 1 :: Ordering
-- GT
--
-- prop> \x y -> (view order gt x y :: Ordering) == GT
-- +++ OK, passed 100 tests.
gt ::
  (Applicative f, AsOrdering b) =>
  OrderT b f a
gt :: forall (f :: * -> *) b a.
(Applicative f, AsOrdering b) =>
OrderT b f a
gt =
  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AsOrdering a => Prism' a ()
_GT forall t b. AReview t b -> b -> t
# ()))

-- |
--
-- >>> isGT LT
-- False
--
-- >>> isGT GT
-- True
--
-- >>> isGT EQ
-- False
isGT ::
  AsOrdering a =>
  a
  -> Bool
isGT :: forall a. AsOrdering a => a -> Bool
isGT =
  Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. APrism s t a b -> s -> Bool
isn't forall a. AsOrdering a => Prism' a ()
_GT

-- |
--
-- >>> ifGT 1 2 LT
-- 1
-- >>> ifGT 1 2 GT
-- 2
-- >>> ifGT 1 2 EQ
-- 1
ifGT ::
  AsOrdering x =>
  a
  -> a
  -> x
  -> a
ifGT :: forall x a. AsOrdering x => a -> a -> x -> a
ifGT a
a1 a
a2 =
  forall a. a -> a -> Bool -> a
bool a
a1 a
a2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsOrdering a => a -> Bool
isGT

-- |
--
-- prop> \x y -> view order ordOrder x y == x `compare` y
-- +++ OK, passed 100 tests.
ordOrder ::
  (Ord a, AsOrdering b, Applicative f) =>
  OrderT b f a
ordOrder :: forall a b (f :: * -> *).
(Ord a, AsOrdering b, Applicative f) =>
OrderT b f a
ordOrder =
  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    case forall a. Ord a => a -> a -> Ordering
compare a
a1 a
a2 of
      Ordering
LT ->
        forall a. AsOrdering a => Prism' a ()
_LT forall t b. AReview t b -> b -> t
# ()
      Ordering
GT ->
        forall a. AsOrdering a => Prism' a ()
_GT forall t b. AReview t b -> b -> t
# ()
      Ordering
EQ ->
        forall a. AsOrdering a => Prism' a ()
_EQ forall t b. AReview t b -> b -> t
# ())

newtype MonadOrderT a f b =
  MonadOrderT (OrderT b f a)

monadOrder ::
  Iso
    (OrderT b f a)
    (OrderT b' f' a')
    (MonadOrderT a f b)
    (MonadOrderT a' f' b')
monadOrder :: forall b (f :: * -> *) a b' (f' :: * -> *) a'.
Iso
  (OrderT b f a)
  (OrderT b' f' a')
  (MonadOrderT a f b)
  (MonadOrderT a' f' b')
monadOrder =
  forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT
    (\(MonadOrderT OrderT b' f' a'
x) -> OrderT b' f' a'
x)

argument1 ::
  Applicative f =>
  MonadOrderT a f a
argument1 :: forall (f :: * -> *) a. Applicative f => MonadOrderT a f a
argument1 =
  forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a1))

argument2 ::
  Applicative f =>
  MonadOrderT a f a
argument2 :: forall (f :: * -> *) a. Applicative f => MonadOrderT a f a
argument2 =
  forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
a2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a2))

instance Functor f => Functor (MonadOrderT a f) where
  fmap :: Functor f => (a1 -> b) -> MonadOrderT a f a1 -> MonadOrderT a f b
  fmap :: forall a1 b.
Functor f =>
(a1 -> b) -> MonadOrderT a f a1 -> MonadOrderT a f b
fmap a1 -> b
f (MonadOrderT (OrderT a -> a -> f a1
g)) =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a1 -> b
f (a -> a -> f a1
g a
a1 a
a2)))

instance Apply f => Apply (MonadOrderT a f) where
  MonadOrderT (OrderT a -> a -> f (a -> b)
f) <.> :: forall a b.
MonadOrderT a f (a -> b) -> MonadOrderT a f a -> MonadOrderT a f b
<.> MonadOrderT (OrderT a -> a -> f a
g) =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f (a -> b)
f a
a1 a
a2 forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> a -> f a
g a
a1 a
a2))

instance Applicative f => Applicative (MonadOrderT a f) where
  pure :: forall a. a -> MonadOrderT a f a
pure a
a =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a))
  MonadOrderT (OrderT a -> a -> f (a -> b)
f) <*> :: forall a b.
MonadOrderT a f (a -> b) -> MonadOrderT a f a -> MonadOrderT a f b
<*> MonadOrderT (OrderT a -> a -> f a
g) =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f (a -> b)
f a
a1 a
a2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> a -> f a
g a
a1 a
a2))

instance Bind f => Bind (MonadOrderT a f) where
  MonadOrderT (OrderT a -> a -> f a
f) >>- :: forall a b.
MonadOrderT a f a -> (a -> MonadOrderT a f b) -> MonadOrderT a f b
>>- a -> MonadOrderT a f b
g =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a
a -> let MonadOrderT (OrderT a -> a -> f b
k) = a -> MonadOrderT a f b
g a
a in a -> a -> f b
k a
a1 a
a2))

instance Monad f => Monad (MonadOrderT a f) where
  return :: forall a. a -> MonadOrderT a f a
return a
a =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a))
  MonadOrderT (OrderT a -> a -> f a
f) >>= :: forall a b.
MonadOrderT a f a -> (a -> MonadOrderT a f b) -> MonadOrderT a f b
>>= a -> MonadOrderT a f b
g =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> let MonadOrderT (OrderT a -> a -> f b
k) = a -> MonadOrderT a f b
g a
a in a -> a -> f b
k a
a1 a
a2))

instance Alt f => Alt (MonadOrderT a f) where
  MonadOrderT (OrderT a -> a -> f a
f) <!> :: forall a.
MonadOrderT a f a -> MonadOrderT a f a -> MonadOrderT a f a
<!> MonadOrderT (OrderT a -> a -> f a
g) =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> a -> a -> f a
g a
a1 a
a2))

instance Alternative f => Alternative (MonadOrderT a f) where
  empty :: forall a. MonadOrderT a f a
empty =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Alternative f => f a
empty))
  MonadOrderT (OrderT a -> a -> f a
f) <|> :: forall a.
MonadOrderT a f a -> MonadOrderT a f a -> MonadOrderT a f a
<|> MonadOrderT (OrderT a -> a -> f a
g) =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> a -> f a
g a
a1 a
a2))

instance MonadIO f => MonadIO (MonadOrderT a f) where
  liftIO :: forall a. IO a -> MonadOrderT a f a
liftIO IO a
a =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\ a
_ a
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
a))

instance MonadTrans (MonadOrderT a) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> MonadOrderT a m a
lift m a
a =
    forall a (f :: * -> *) b. OrderT b f a -> MonadOrderT a f b
MonadOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> m a
a))

newtype ProfunctorOrderT f a b =
  ProfunctorOrderT (OrderT b f a)

profunctorOrder ::
  Iso
    (OrderT b f a)
    (OrderT b' f' a')
    (ProfunctorOrderT f a b)
    (ProfunctorOrderT f' a' b')
profunctorOrder :: forall b (f :: * -> *) a b' (f' :: * -> *) a'.
Iso
  (OrderT b f a)
  (OrderT b' f' a')
  (ProfunctorOrderT f a b)
  (ProfunctorOrderT f' a' b')
profunctorOrder =
  forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT
    (\(ProfunctorOrderT OrderT b' f' a'
x) -> OrderT b' f' a'
x)

instance Functor f => Profunctor (ProfunctorOrderT f) where
  dimap :: forall a b c d.
(a -> b)
-> (c -> d) -> ProfunctorOrderT f b c -> ProfunctorOrderT f a d
dimap a -> b
f c -> d
g (ProfunctorOrderT (OrderT b -> b -> f c
x)) =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (b -> b -> f c
x (a -> b
f a
a1) (a -> b
f a
a2))))

instance Applicative f => Choice (ProfunctorOrderT f) where
  left' :: forall a b c.
ProfunctorOrderT f a b
-> ProfunctorOrderT f (Either a c) (Either b c)
left' (ProfunctorOrderT (OrderT a -> a -> f b
x))  =
    let lft :: (a -> f (Either a b)) -> Either a b -> f (Either a b)
lft a -> f (Either a b)
l = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> f (Either a b)
l (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
    in  forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\Either a c
a1 Either a c
a2 -> forall {f :: * -> *} {a} {a} {b}.
Applicative f =>
(a -> f (Either a b)) -> Either a b -> f (Either a b)
lft (\a
a1' -> forall {f :: * -> *} {a} {a} {b}.
Applicative f =>
(a -> f (Either a b)) -> Either a b -> f (Either a b)
lft (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> f b
x a
a1') Either a c
a2) Either a c
a1))
  right' :: forall a b c.
ProfunctorOrderT f a b
-> ProfunctorOrderT f (Either c a) (Either c b)
right' (ProfunctorOrderT (OrderT a -> a -> f b
x))  =
    let rgt :: (b -> f (Either a b)) -> Either a b -> f (Either a b)
rgt b -> f (Either a b)
r = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) b -> f (Either a b)
r
    in  forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\Either c a
a1 Either c a
a2 -> forall {f :: * -> *} {b} {a} {b}.
Applicative f =>
(b -> f (Either a b)) -> Either a b -> f (Either a b)
rgt (\a
a1' -> forall {f :: * -> *} {b} {a} {b}.
Applicative f =>
(b -> f (Either a b)) -> Either a b -> f (Either a b)
rgt (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> f b
x a
a1') Either c a
a2) Either c a
a1))

instance Functor f => Functor (ProfunctorOrderT f a) where
  fmap :: forall a b.
(a -> b) -> ProfunctorOrderT f a a -> ProfunctorOrderT f a b
fmap a -> b
f (ProfunctorOrderT (OrderT a -> a -> f a
g)) =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (a -> a -> f a
g a
a1 a
a2)))

instance Apply f => Apply (ProfunctorOrderT f a) where
  ProfunctorOrderT (OrderT a -> a -> f (a -> b)
f) <.> :: forall a b.
ProfunctorOrderT f a (a -> b)
-> ProfunctorOrderT f a a -> ProfunctorOrderT f a b
<.> ProfunctorOrderT (OrderT a -> a -> f a
g) =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f (a -> b)
f a
a1 a
a2 forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> a -> f a
g a
a1 a
a2))

instance Applicative f => Applicative (ProfunctorOrderT f a) where
  pure :: forall a. a -> ProfunctorOrderT f a a
pure a
a =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a))
  ProfunctorOrderT (OrderT a -> a -> f (a -> b)
f) <*> :: forall a b.
ProfunctorOrderT f a (a -> b)
-> ProfunctorOrderT f a a -> ProfunctorOrderT f a b
<*> ProfunctorOrderT (OrderT a -> a -> f a
g) =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f (a -> b)
f a
a1 a
a2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> a -> f a
g a
a1 a
a2))

instance Bind f => Bind (ProfunctorOrderT f a) where
  ProfunctorOrderT (OrderT a -> a -> f a
f) >>- :: forall a b.
ProfunctorOrderT f a a
-> (a -> ProfunctorOrderT f a b) -> ProfunctorOrderT f a b
>>- a -> ProfunctorOrderT f a b
g =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a
a -> let ProfunctorOrderT (OrderT a -> a -> f b
k) = a -> ProfunctorOrderT f a b
g a
a in a -> a -> f b
k a
a1 a
a2))

instance Monad f => Monad (ProfunctorOrderT f a) where
  return :: forall a. a -> ProfunctorOrderT f a a
return a
a =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a))
  ProfunctorOrderT (OrderT a -> a -> f a
f) >>= :: forall a b.
ProfunctorOrderT f a a
-> (a -> ProfunctorOrderT f a b) -> ProfunctorOrderT f a b
>>= a -> ProfunctorOrderT f a b
g =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> let ProfunctorOrderT (OrderT a -> a -> f b
k) = a -> ProfunctorOrderT f a b
g a
a in a -> a -> f b
k a
a1 a
a2))

instance Alt f => Alt (ProfunctorOrderT f a) where
  ProfunctorOrderT (OrderT a -> a -> f a
f) <!> :: forall a.
ProfunctorOrderT f a a
-> ProfunctorOrderT f a a -> ProfunctorOrderT f a a
<!> ProfunctorOrderT (OrderT a -> a -> f a
g) =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> a -> a -> f a
g a
a1 a
a2))

instance Alternative f => Alternative (ProfunctorOrderT f a) where
  empty :: forall a. ProfunctorOrderT f a a
empty =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
_ a
_ -> forall (f :: * -> *) a. Alternative f => f a
empty))
  ProfunctorOrderT (OrderT a -> a -> f a
f) <|> :: forall a.
ProfunctorOrderT f a a
-> ProfunctorOrderT f a a -> ProfunctorOrderT f a a
<|> ProfunctorOrderT (OrderT a -> a -> f a
g) =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> a -> a -> f a
f a
a1 a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> a -> f a
g a
a1 a
a2))

instance MonadIO f => MonadIO (ProfunctorOrderT f a) where
  liftIO :: forall a. IO a -> ProfunctorOrderT f a a
liftIO IO a
a =
    forall (f :: * -> *) a b. OrderT b f a -> ProfunctorOrderT f a b
ProfunctorOrderT (forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\ a
_ a
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
a))

appendOrder ::
  (Applicative f, Semigroup x) =>
  OrderT x f x
appendOrder :: forall (f :: * -> *) x.
(Applicative f, Semigroup x) =>
OrderT x f x
appendOrder =
  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\x
a1 x
a2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (x
a1 forall a. Semigroup a => a -> a -> a
<> x
a2))

listOrder ::
  (Applicative f, AsOrdering b, Semigroup b) =>
  OrderT b f a
  -> OrderT b f [a]
listOrder :: forall (f :: * -> *) b a.
(Applicative f, AsOrdering b, Semigroup b) =>
OrderT b f a -> OrderT b f [a]
listOrder (OrderT a -> a -> f b
f) =
  let lists :: [a] -> [a] -> f b
lists [] [] =
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AsOrdering a => Prism' a ()
_EQ forall t b. AReview t b -> b -> t
# ())
      lists [] (a
_:[a]
_) =
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AsOrdering a => Prism' a ()
_LT forall t b. AReview t b -> b -> t
# ())
      lists (a
_:[a]
_) [] =
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AsOrdering a => Prism' a ()
_GT forall t b. AReview t b -> b -> t
# ())
      lists (a
h1:[a]
t1) (a
h2:[a]
t2) =
        forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> f b
f a
h1 a
h2) ([a] -> [a] -> f b
lists [a]
t1 [a]
t2)
  in  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT [a] -> [a] -> f b
lists

bothOrder ::
  (Applicative f, Semigroup b) =>
  (a -> f b)
  -> OrderT b f a
bothOrder :: forall (f :: * -> *) b a.
(Applicative f, Semigroup b) =>
(a -> f b) -> OrderT b f a
bothOrder a -> f b
f =
  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
a2)

bothOrder' ::
  Semigroup b =>
  (a -> b)
  -> Order b a
bothOrder' :: forall b a. Semigroup b => (a -> b) -> Order b a
bothOrder' a -> b
f =
  forall (f :: * -> *) b a.
(Applicative f, Semigroup b) =>
(a -> f b) -> OrderT b f a
bothOrder (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- |
--
-- >>> getPredicate (orderL _1 (Predicate even)) (1, "a")
-- False
--
-- >>> getPredicate (orderL _1 (Predicate even)) (2, "a")
-- True
--
-- >>> view order (orderL _1 ordOrder) (1, "a") (2, "b") :: Ordering
-- LT
--
-- >>> view order (orderL _1 ordOrder) (2, "a") (1, "b") :: Ordering
-- GT
--
-- >>> view order (orderL _1 ordOrder) (1, "a") (1, "b") :: Ordering
-- EQ
orderL ::
  Contravariant f =>
  Getting a s a
  -> f a
  -> f s
orderL :: forall (f :: * -> *) a s.
Contravariant f =>
Getting a s a -> f a -> f s
orderL =
  forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view

-- |
--
-- >>> view order (ordOrderL _1) (1, "a") (2, "b") :: Ordering
-- LT
--
-- >>> view order (ordOrderL _1) (2, "a") (1, "b") :: Ordering
-- GT
--
-- >>> view order (ordOrderL _1) (1, "a") (1, "b") :: Ordering
-- EQ
ordOrderL ::
  (Ord a, AsOrdering b) =>
  Getting a s a
  -> Order b s
ordOrderL :: forall a b s. (Ord a, AsOrdering b) => Getting a s a -> Order b s
ordOrderL Getting a s a
x =
  forall (f :: * -> *) a s.
Contravariant f =>
Getting a s a -> f a -> f s
orderL Getting a s a
x forall a b (f :: * -> *).
(Ord a, AsOrdering b, Applicative f) =>
OrderT b f a
ordOrder

-- |
--
-- >>> getPredicate (orderS (state (\s -> (1, reverse s))) (Predicate even)) "abc"
-- False
--
-- >>> getPredicate (orderS (state (\s -> (2, reverse s))) (Predicate even)) "abc"
-- True
--
-- >>> view order (orderS (state (\s -> (s + 1, s * 2))) ordOrder) 5 6 :: Ordering
-- LT
--
-- >>> view order (orderS (state (\s -> (s + 1, s * 2))) ordOrder) 5 4 :: Ordering
-- GT
--
-- >>> view order (orderS (state (\s -> (s + 1, s * 2))) ordOrder) 5 5 :: Ordering
-- EQ
orderS ::
  Contravariant f =>
  State a b
  -> f b
  -> f a
orderS :: forall (f :: * -> *) a b.
Contravariant f =>
State a b -> f b -> f a
orderS =
  forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. State s a -> s -> a
evalState

-- |
--
-- >>> view order (ordOrderS (state (\s -> (s + 1, s * 2)))) 5 6 :: Ordering
-- LT
--
-- >>> view order (ordOrderS (state (\s -> (s + 1, s * 2)))) 5 4 :: Ordering
-- GT
--
-- >>> view order (ordOrderS (state (\s -> (s + 1, s * 2)))) 5 5 :: Ordering
-- EQ
ordOrderS ::
  (Ord x, AsOrdering b) =>
  State a x
  -> Order b a
ordOrderS :: forall x b a. (Ord x, AsOrdering b) => State a x -> Order b a
ordOrderS State a x
x =
  forall (f :: * -> *) a b.
Contravariant f =>
State a b -> f b -> f a
orderS State a x
x forall a b (f :: * -> *).
(Ord a, AsOrdering b, Applicative f) =>
OrderT b f a
ordOrder

-- |
--
-- >>> getPredicate (orderR (reader (\r -> r + 1)) (Predicate even)) 1
-- True
--
-- >>> getPredicate (orderR (reader (\r -> r + 1)) (Predicate even)) 2
-- False
--
-- >>> view order (orderR (reader (\r -> r + 1)) ordOrder) 1 0 :: Ordering
-- GT
--
-- >>> view order (orderR (reader (\r -> r + 1)) ordOrder) 1 2 :: Ordering
-- LT
--
-- >>> view order (orderR (reader (\r -> r + 1)) ordOrder) 2 1 :: Ordering
-- GT
orderR ::
  Contravariant f =>
  Reader a b
  -> f b
  -> f a
orderR :: forall (f :: * -> *) a b.
Contravariant f =>
Reader a b -> f b -> f a
orderR =
  forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a. Reader r a -> r -> a
runReader

-- |
--
-- >>> view order (ordOrderR (reader (\r -> r + 1))) 1 0 :: Ordering
-- GT
--
-- >>> view order (ordOrderR (reader (\r -> r + 1))) 1 2 :: Ordering
-- LT
--
-- >>> view order (ordOrderR (reader (\r -> r + 1))) 2 1 :: Ordering
-- GT
ordOrderR ::
  (Ord x, AsOrdering b, Applicative f) =>
  Reader a x
  -> OrderT b f a
ordOrderR :: forall x b (f :: * -> *) a.
(Ord x, AsOrdering b, Applicative f) =>
Reader a x -> OrderT b f a
ordOrderR Reader a x
x =
  forall (f :: * -> *) a b.
Contravariant f =>
Reader a b -> f b -> f a
orderR Reader a x
x forall a b (f :: * -> *).
(Ord a, AsOrdering b, Applicative f) =>
OrderT b f a
ordOrder

-- |
--
-- >>> perRest (OrderT (\a1 a2 -> if a1 == 5 then Nothing else Just (a1 `compare` a2))) [5,1,2,3,5,6]
-- Nothing
--
-- >>> perRest (OrderT (\a1 a2 -> if a1 == 5 then Nothing else Just (a1 `compare` a2))) [5,1,2,3,6]
-- Just [(5,LT),(1,GT),(2,GT),(3,GT),(6,EQ)]
--
-- >>> perRest (OrderT (\a1 a2 -> if a1 == 0 then Nothing else Just (a1 `compare` a2))) [5,1,2,3,6]
-- Just [(5,LT),(1,GT),(2,GT),(3,GT),(6,EQ)]
--
-- >>> perRest (OrderT (\a1 a2 -> if a1 == 0 then Nothing else Just (a1 `compare` a2))) [4,5,1,2,3,6]
-- Just [(4,GT),(5,LT),(1,GT),(2,GT),(3,GT),(6,EQ)]
perRest ::
  (Applicative f, Monoid x) =>
  OrderT x f a
  -> [a]
  -> f [(a, x)]
perRest :: forall (f :: * -> *) x a.
(Applicative f, Monoid x) =>
OrderT x f a -> [a] -> f [(a, x)]
perRest OrderT x f a
_ [] =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure []
perRest OrderT x f a
ord (a
h:[a]
r) =
  (\x
x [(a, x)]
y -> (a
h, x
x) forall a. a -> [a] -> [a]
: [(a, x)]
y) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a f x
b -> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped OrderT x f a
ord a
a a
h forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f x
b) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) [a]
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) x a.
(Applicative f, Monoid x) =>
OrderT x f a -> [a] -> f [(a, x)]
perRest OrderT x f a
ord [a]
r

-- |
--
-- >>> perRest' ordOrder [1,2,3,1,3,2,4] :: [(Int, Ordering)]
-- [(1,GT),(2,GT),(3,LT),(1,GT),(3,LT),(2,GT),(4,EQ)]
perRest' ::
  Monoid x =>
  Order x a
  -> [a]
  -> [(a, x)]
perRest' :: forall x a. Monoid x => Order x a -> [a] -> [(a, x)]
perRest' Order x a
ord =
  forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) x a.
(Applicative f, Monoid x) =>
OrderT x f a -> [a] -> f [(a, x)]
perRest Order x a
ord

-- | Returns a list of all elements in a list with at least one duplicate (equal according
-- to `Order`) in the remainder of the list.
--
-- >>> runIdentity (duplicates (ordOrder :: Order Ordering Int) [])
-- []
--
-- >>> runIdentity (duplicates (ordOrder :: Order Ordering Int) [1..10])
-- []
--
-- >>> runIdentity (duplicates (ordOrder :: Order Ordering Int) [1,2,3,1])
-- [(1,1 :| [])]
--
-- >>> runIdentity (duplicates (ordOrder :: Order Ordering Int) [1,2,3,1,4,5,1])
-- [(1,1 :| [1]),(1,1 :| [])]
--
-- >>> runIdentity (duplicates (ordOrder :: Order Ordering Int) [1,2,3,1,4,5,1,2,6,7,2,1])
-- [(1,1 :| [1,1]),(2,2 :| [2]),(1,1 :| [1]),(1,1 :| []),(2,2 :| [])]
duplicates ::
  (Monad f, AsOrdering b) =>
  OrderT b f a
  -> [a]
  -> f [(a, NonEmpty a)]
duplicates :: forall (f :: * -> *) b a.
(Monad f, AsOrdering b) =>
OrderT b f a -> [a] -> f [(a, NonEmpty a)]
duplicates OrderT b f a
ord [a]
ts =
  let dups :: (a, [a]) -> [(a, NonEmpty a)]
dups (a
_, []) = []
      dups (a
t, a
z:[a]
zs) = [(a
t, a
zforall a. a -> [a] -> NonEmpty a
:|[a]
zs)]
  in  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {a}. (a, [a]) -> [(a, NonEmpty a)]
dups) (forall (f :: * -> *) x a.
(Applicative f, Monoid x) =>
OrderT x f a -> [a] -> f [(a, x)]
perRest (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall b (f :: * -> *) a b' (f' :: * -> *) a'.
Iso
  (OrderT b f a)
  (OrderT b' f' a')
  (MonadOrderT a f b)
  (MonadOrderT a' f' b')
monadOrder (\MonadOrderT a f b
m -> (\a
a1 -> forall x a. AsOrdering x => a -> a -> x -> a
ifEQ [] [a
a1]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => MonadOrderT a f a
argument1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MonadOrderT a f b
m) OrderT b f a
ord) [a]
ts)

-- | Returns a list of all elements in a list with at least one duplicate (equal according
-- to `Order`) in the remainder of the list.
--
-- >>> duplicates' (ordOrder :: Order Ordering Int) []
-- []
--
-- >>> duplicates' (ordOrder :: Order Ordering Int) [1..10]
-- []
--
-- >>> duplicates' (ordOrder :: Order Ordering Int) [1,2,3,1]
-- [(1,1 :| [])]
--
-- >>> duplicates' (ordOrder :: Order Ordering Int) [1,2,3,1,4,5,1]
-- [(1,1 :| [1]),(1,1 :| [])]
--
-- >>> duplicates' (ordOrder :: Order Ordering Int) [1,2,3,1,4,5,1,2,6,7,2,1]
-- [(1,1 :| [1,1]),(2,2 :| [2]),(1,1 :| [1]),(1,1 :| []),(2,2 :| [])]
duplicates' ::
  AsOrdering b =>
  Order b a
  -> [a]
  -> [(a, NonEmpty a)]
duplicates' :: forall b a. AsOrdering b => Order b a -> [a] -> [(a, NonEmpty a)]
duplicates' Order b a
ord =
  forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a.
(Monad f, AsOrdering b) =>
OrderT b f a -> [a] -> f [(a, NonEmpty a)]
duplicates Order b a
ord

-- | Asserts that the two given values (by the Eq instance) are equal in the `Order`
-- regardless of the function of the `Order`
--
-- >>> view order (areEqual 1 2 ordOrder) 3 4 :: Ordering
-- LT
--
-- >>> view order (areEqual 1 2 ordOrder) 4 3 :: Ordering
-- GT
--
-- >>> view order (areEqual 1 2 ordOrder) 3 3 :: Ordering
-- EQ
--
-- >>> view order (areEqual 1 2 ordOrder) 1 3 :: Ordering
-- LT
--
-- >>> view order (areEqual 1 2 ordOrder) 2 3 :: Ordering
-- LT
--
-- >>> view order (areEqual 1 2 ordOrder) 1 2 :: Ordering
-- EQ
--
-- >>> view order (areEqual 1 2 ordOrder) 2 1 :: Ordering
-- EQ
areEqual ::
  (Functor f, Eq a, AsOrdering b) =>
  a
  -> a
  -> OrderT b f a
  -> OrderT b f a
areEqual :: forall (f :: * -> *) a b.
(Functor f, Eq a, AsOrdering b) =>
a -> a -> OrderT b f a -> OrderT b f a
areEqual a
a1' a
a2' (OrderT a -> a -> f b
f) =
  forall b (f :: * -> *) a. (a -> a -> f b) -> OrderT b f a
OrderT (\a
a1 a
a2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
e -> forall a. a -> a -> Bool -> a
bool b
e (forall a. AsOrdering a => Prism' a ()
_EQ forall t b. AReview t b -> b -> t
# ()) ((a
a1 forall a. Eq a => a -> a -> Bool
== a
a1' Bool -> Bool -> Bool
&& a
a2 forall a. Eq a => a -> a -> Bool
== a
a2') Bool -> Bool -> Bool
|| (a
a1 forall a. Eq a => a -> a -> Bool
== a
a2' Bool -> Bool -> Bool
&& a
a2 forall a. Eq a => a -> a -> Bool
== a
a1'))) (a -> a -> f b
f a
a1 a
a2))

-- | An alias for `areEqual`.
(.===.) ::
  (Applicative f, Ord a, AsOrdering b) =>
  a
  -> a
  -> OrderT b f a
a
a1 .===. :: forall (f :: * -> *) a b.
(Applicative f, Ord a, AsOrdering b) =>
a -> a -> OrderT b f a
.===. a
a2 =
  forall (f :: * -> *) a b.
(Functor f, Eq a, AsOrdering b) =>
a -> a -> OrderT b f a -> OrderT b f a
areEqual a
a1 a
a2 forall a b (f :: * -> *).
(Ord a, AsOrdering b, Applicative f) =>
OrderT b f a
ordOrder