{-# 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) )
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
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 ::
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 ::
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
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 ::
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 ::
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
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 ::
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 ::
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
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)
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
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
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
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
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
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 ::
(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' ::
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
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)
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
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))
(.===.) ::
(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