{-# LANGUAGE RankNTypes, ExplicitForAll #-}

-- | Defines useful and alternative applicative functions and constructs.
module Hextra.Applicative where

infixl 5 <:>
(<:>) :: forall f a b. Applicative f => f a -> f b -> f (a, b)
<:> :: f a -> f b -> f (a, b)
(<:>) f a
a f b
b = (,) (a -> b -> (a, b)) -> f a -> f (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (b -> (a, b)) -> f b -> f (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
b
-- ^ Pairs up all elements in two applicative functors.
-- One of the operations/values of the monoidal presentation of functors

infixl 4 <::>
(<::>) :: forall f a b. Applicative f => f a -> f b -> f (a, b)
<::> :: f a -> f b -> f (a, b)
(<::>) = f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f (a, b)
(<:>)
-- ^ Just (\<:\>), but with lower precedence

infixl 6 <<>>
(<<>>) :: forall f a. (Applicative f, Monoid a) => f a -> f a -> f a
f a
a <<>> :: f a -> f a -> f a
<<>> f a
b = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> f a -> f (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (a -> a) -> f a -> f a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
b
-- ^ Adds up values in two applicative functors.

unit :: forall f. Applicative f => f ()
unit :: f ()
unit = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
-- ^ Applicative functor with () in it
-- One of the operations/values of the monoidal presentation of functors

(<.>) :: forall f b c a. Applicative f => f (b -> c) -> f (a -> b) -> f (a -> c)
<.> :: f (b -> c) -> f (a -> b) -> f (a -> c)
(<.>) f (b -> c)
f f (a -> b)
g = (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((b -> c) -> (a -> b) -> a -> c)
-> f (b -> c) -> f ((a -> b) -> a -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
f f ((a -> b) -> a -> c) -> f (a -> b) -> f (a -> c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a -> b)
g
-- ^ Composes two applicative functions.

mkApp :: forall f a b. Functor f => (forall x y. f x -> f y -> f (x, y)) -> f (a -> b) -> f a -> f b
mkApp :: (forall x y. f x -> f y -> f (x, y)) -> f (a -> b) -> f a -> f b
mkApp forall x y. f x -> f y -> f (x, y)
(?) f (a -> b)
f f a
x = ((a -> b, a) -> b) -> f (a -> b, a) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)) (f (a -> b, a) -> f b) -> f (a -> b, a) -> f b
forall a b. (a -> b) -> a -> b
$ f (a -> b)
f f (a -> b) -> f a -> f (a -> b, a)
forall x y. f x -> f y -> f (x, y)
? f a
x
-- ^ Creates a (\<*\>) definition from a definition of (\<:\>).
-- mkApp (\<:\>) = (\<*\>)

mkPure :: forall f a. Functor f => (f ()) -> a -> f a
mkPure :: f () -> a -> f a
mkPure f ()
u a
a = (() -> a) -> f () -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> () -> a
forall a b. a -> b -> a
const a
a) f ()
u
-- ^ Creates a pure definition from a definition of unit.
-- mkPure unit = pure

class Monoidal f where
    nilA :: f ()
    zipA :: f a -> f b -> f (a, b)

mkNilA :: forall f. Functor f => (forall x. x -> f x) -> f ()
mkNilA :: (forall x. x -> f x) -> f ()
mkNilA forall x. x -> f x
p = () -> f ()
forall x. x -> f x
p ()

mkZipA :: forall f a b. Functor f => (forall x y. f (x -> y) -> f x -> f y) -> f a -> f b -> f (a, b)
mkZipA :: (forall x y. f (x -> y) -> f x -> f y) -> f a -> f b -> f (a, b)
mkZipA forall x y. f (x -> y) -> f x -> f y
(?) f a
x f b
y = ((,) (a -> b -> (a, b)) -> f a -> f (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x) f (b -> (a, b)) -> f b -> f (a, b)
forall x y. f (x -> y) -> f x -> f y
? f b
y