{-# OPTIONS_GHC -fno-warn-orphans #-}

module Pandora.Paradigm.Primary.Functor.Function where

import Pandora.Pattern.Category (Category ((.), ($), (#), identity))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), Covariant_ ((-<$>-)))
import Pandora.Pattern.Functor.Contravariant (Contravariant_ ((->$<-)))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-)))
import Pandora.Pattern.Functor.Pointable (Pointable (point), Pointable_ (point_))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)), Bindable_ (join_))
import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate))
import Pandora.Pattern.Functor.Divariant (Divariant ((>->)), Divariant_ ((->->-)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Ringoid (Ringoid ((*)))
import Pandora.Paradigm.Primary.Transformer.Flip (Flip (Flip))

infixr 2 !.
infixr 9 %
infixl 1 &

instance Category (->) where
	identity :: a -> a
identity a
x = a
x
	b -> c
f . :: (b -> c) -> (a -> b) -> a -> c
. a -> b
g = \a
x -> b -> c
f (a -> b
g a
x)

instance Covariant ((->) a) where
	<$> :: (a -> b) -> (a -> a) -> a -> b
(<$>) = (a -> b) -> (a -> a) -> a -> b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
(.)

instance Covariant_ ((->) a) (->) (->) where
	-<$>- :: (a -> b) -> (a -> a) -> a -> b
(-<$>-) = (a -> b) -> (a -> a) -> a -> b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
(.)

instance Contravariant_ (Flip (->) a) (->) (->) where
	a -> b
f ->$<- :: (a -> b) -> Flip (->) a b -> Flip (->) a a
->$<- Flip b -> a
g = (a -> a) -> Flip (->) a a
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip ((a -> a) -> Flip (->) a a) -> (a -> a) -> Flip (->) a a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ b -> a
g (b -> a) -> (a -> b) -> a -> a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> b
f

instance Applicative ((->) e) where
	<*> :: (e -> a -> b) -> (e -> a) -> e -> b
(<*>) e -> a -> b
f e -> a
g e
x = e -> a -> b
f e
x (a -> b) -> a -> b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ e -> a
g e
x

instance Distributive ((->) e) where
	u a
g >>- :: u a -> (a -> e -> b) -> ((->) e :. u) := b
>>- a -> e -> b
f = \e
e -> (a -> e -> b
f (a -> e -> b) -> e -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
% e
e) (a -> b) -> u a -> u b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> u a
g

instance Pointable ((->) e) (->) where
	point :: a -> e -> a
point = a -> e -> a
forall a b. a -> b -> a
(!.)

instance Pointable_ ((->) e) (->) where
	point_ :: a -> e -> a
point_ = a -> e -> a
forall a b. a -> b -> a
(!.)

instance Bindable ((->) e) where
	e -> a
f >>= :: (e -> a) -> (a -> e -> b) -> e -> b
>>= a -> e -> b
g = \e
x -> a -> e -> b
g (a -> e -> b) -> a -> e -> b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# e -> a
f e
x (e -> b) -> e -> b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# e
x

instance Bindable_ ((->) e) (->) where
	join_ :: (e -> e -> a) -> e -> a
join_ e -> e -> a
f = \e
x -> e -> e -> a
f e
x (e -> a) -> e -> a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# e
x

instance Representable ((->) e) where
	type Representation ((->) e) = e
	<#> :: Representation ((->) e) -> a <:= (->) e
(<#>) = ((e -> a) -> e -> a
forall (m :: * -> * -> *) a. Category m => m a a
identity ((e -> a) -> e -> a) -> e -> a <:= (->) e
forall a b c. (a -> b -> c) -> b -> a -> c
%)
	tabulate :: (Representation ((->) e) -> a) -> e -> a
tabulate = (Representation ((->) e) -> a) -> e -> a
forall (m :: * -> * -> *) a. Category m => m a a
identity

instance Divariant ((->)) where
	>-> :: (a -> b) -> (c -> d) -> (b -> c) -> a -> d
(>->) a -> b
ab c -> d
cd b -> c
bc = c -> d
cd (c -> d) -> (a -> c) -> a -> d
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. b -> c
bc (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> b
ab

instance Divariant_ ((->)) (->) (->) (->) where
	->->- :: (a -> b) -> (c -> d) -> (b -> c) -> a -> d
(->->-) a -> b
ab c -> d
cd b -> c
bc = c -> d
cd (c -> d) -> (a -> c) -> a -> d
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. b -> c
bc (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> b
ab

instance Semigroup r => Semigroup (e -> r) where
	e -> r
f + :: (e -> r) -> (e -> r) -> e -> r
+ e -> r
g = \e
e -> e -> r
f e
e r -> r -> r
forall a. Semigroup a => a -> a -> a
+ e -> r
g e
e

instance Ringoid r => Ringoid (e -> r) where
	e -> r
f * :: (e -> r) -> (e -> r) -> e -> r
* e -> r
g = \e
e -> e -> r
f e
e r -> r -> r
forall a. Ringoid a => a -> a -> a
* e -> r
g e
e

(-.#..-) :: (Covariant_ (v a) (->) target, Category v) => v c d -> target (v a (v b c)) (v a (v b d))
-.#..- :: v c d -> target (v a (v b c)) (v a (v b d))
(-.#..-) v c d
f = (v b c -> v b d) -> target (v a (v b c)) (v a (v b d))
forall (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) a b.
Covariant_ t source target =>
source a b -> target (t a) (t b)
(-<$>-) (v c d
f v c d -> v b c -> v b d
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
.)

{-# INLINE (!.) #-}
(!.) :: a -> b -> a
a
x !. :: a -> b -> a
!. b
_ = a
x

{-# INLINE (!..) #-}
(!..) :: a -> b -> c -> a
!.. :: a -> b -> c -> a
(!..) a
x b
_ c
_ = a
x

{-# INLINE (!...) #-}
(!...) :: a -> b -> c -> d -> a
!... :: a -> b -> c -> d -> a
(!...) a
x b
_ c
_ d
_ = a
x

{-# INLINE (%) #-}
(%) :: (a -> b -> c) -> b -> a -> c
% :: (a -> b -> c) -> b -> a -> c
(%) a -> b -> c
f b
x a
y = a -> b -> c
f a
y b
x

{-# INLINE (&) #-}
(&) :: a -> (a -> b) -> b
a
x & :: a -> (a -> b) -> b
& a -> b
f = a -> b
f a
x

fix :: (a -> a) -> a
fix :: (a -> a) -> a
fix a -> a
f = let x :: a
x = a -> a
f a
x in a
x