{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Fresnel.Functor.Ap1
( Ap1(..)
) where

import Data.Functor.Apply

newtype Ap1 f a = Ap1 { forall (f :: * -> *) a. Ap1 f a -> f a
getAp1 :: f a }
  deriving (Functor (Ap1 f)
Functor (Ap1 f) =>
(forall a. a -> Ap1 f a)
-> (forall a b. Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b)
-> (forall a b c. (a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c)
-> (forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b)
-> (forall a b. Ap1 f a -> Ap1 f b -> Ap1 f a)
-> Applicative (Ap1 f)
forall a. a -> Ap1 f a
forall a b. Ap1 f a -> Ap1 f b -> Ap1 f a
forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b
forall a b. Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
forall a b c. (a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (Ap1 f)
forall (f :: * -> *) a. Applicative f => a -> Ap1 f a
forall (f :: * -> *) a b.
Applicative f =>
Ap1 f a -> Ap1 f b -> Ap1 f a
forall (f :: * -> *) a b.
Applicative f =>
Ap1 f a -> Ap1 f b -> Ap1 f b
forall (f :: * -> *) a b.
Applicative f =>
Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
$cpure :: forall (f :: * -> *) a. Applicative f => a -> Ap1 f a
pure :: forall a. a -> Ap1 f a
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
<*> :: forall a b. Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
liftA2 :: forall a b c. (a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
Ap1 f a -> Ap1 f b -> Ap1 f b
*> :: forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
Ap1 f a -> Ap1 f b -> Ap1 f a
<* :: forall a b. Ap1 f a -> Ap1 f b -> Ap1 f a
Applicative, Functor (Ap1 f)
Functor (Ap1 f) =>
(forall a b. Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b)
-> (forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b)
-> (forall a b. Ap1 f a -> Ap1 f b -> Ap1 f a)
-> (forall a b c. (a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c)
-> Apply (Ap1 f)
forall a b. Ap1 f a -> Ap1 f b -> Ap1 f a
forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b
forall a b. Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
forall a b c. (a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
forall (f :: * -> *).
Functor f =>
(forall a b. f (a -> b) -> f a -> f b)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Apply f
forall (f :: * -> *). Apply f => Functor (Ap1 f)
forall (f :: * -> *) a b. Apply f => Ap1 f a -> Ap1 f b -> Ap1 f a
forall (f :: * -> *) a b. Apply f => Ap1 f a -> Ap1 f b -> Ap1 f b
forall (f :: * -> *) a b.
Apply f =>
Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
$c<.> :: forall (f :: * -> *) a b.
Apply f =>
Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
<.> :: forall a b. Ap1 f (a -> b) -> Ap1 f a -> Ap1 f b
$c.> :: forall (f :: * -> *) a b. Apply f => Ap1 f a -> Ap1 f b -> Ap1 f b
.> :: forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b
$c<. :: forall (f :: * -> *) a b. Apply f => Ap1 f a -> Ap1 f b -> Ap1 f a
<. :: forall a b. Ap1 f a -> Ap1 f b -> Ap1 f a
$cliftF2 :: forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
liftF2 :: forall a b c. (a -> b -> c) -> Ap1 f a -> Ap1 f b -> Ap1 f c
Apply, (forall a b. (a -> b) -> Ap1 f a -> Ap1 f b)
-> (forall a b. a -> Ap1 f b -> Ap1 f a) -> Functor (Ap1 f)
forall a b. a -> Ap1 f b -> Ap1 f a
forall a b. (a -> b) -> Ap1 f a -> Ap1 f b
forall (f :: * -> *) a b. Functor f => a -> Ap1 f b -> Ap1 f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Ap1 f a -> Ap1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Ap1 f a -> Ap1 f b
fmap :: forall a b. (a -> b) -> Ap1 f a -> Ap1 f b
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> Ap1 f b -> Ap1 f a
<$ :: forall a b. a -> Ap1 f b -> Ap1 f a
Functor, Applicative (Ap1 f)
Applicative (Ap1 f) =>
(forall a b. Ap1 f a -> (a -> Ap1 f b) -> Ap1 f b)
-> (forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b)
-> (forall a. a -> Ap1 f a)
-> Monad (Ap1 f)
forall a. a -> Ap1 f a
forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b
forall a b. Ap1 f a -> (a -> Ap1 f b) -> Ap1 f b
forall (f :: * -> *). Monad f => Applicative (Ap1 f)
forall (f :: * -> *) a. Monad f => a -> Ap1 f a
forall (f :: * -> *) a b. Monad f => Ap1 f a -> Ap1 f b -> Ap1 f b
forall (f :: * -> *) a b.
Monad f =>
Ap1 f a -> (a -> Ap1 f b) -> Ap1 f b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (f :: * -> *) a b.
Monad f =>
Ap1 f a -> (a -> Ap1 f b) -> Ap1 f b
>>= :: forall a b. Ap1 f a -> (a -> Ap1 f b) -> Ap1 f b
$c>> :: forall (f :: * -> *) a b. Monad f => Ap1 f a -> Ap1 f b -> Ap1 f b
>> :: forall a b. Ap1 f a -> Ap1 f b -> Ap1 f b
$creturn :: forall (f :: * -> *) a. Monad f => a -> Ap1 f a
return :: forall a. a -> Ap1 f a
Monad)

instance (Apply f, Semigroup a) => Semigroup (Ap1 f a) where
  Ap1 f a
a <> :: Ap1 f a -> Ap1 f a -> Ap1 f a
<> Ap1 f a
b = f a -> Ap1 f a
forall (f :: * -> *) a. f a -> Ap1 f a
Ap1 ((a -> a -> a) -> f a -> f a -> f a
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) f a
a f a
b)