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

module Pandora.Paradigm.Primary.Functor.Function where

import Pandora.Pattern.Category ((.), identity)
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate))

infixr 2 !
infixr 9 %
infixl 1 &

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 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 (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
point = (!)

instance Bindable ((->) e) where
	e -> a
f >>= :: (e -> a) -> (a -> e -> b) -> e -> b
>>= a -> e -> b
g = \e
x -> a -> e -> b
g (e -> a
f e
x) 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

{-# INLINE (!) #-}
(!) :: a -> b -> a
a
x ! :: a -> b -> a
! b
_ = 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