{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
#include "free-common.h"
module Control.Applicative.Free.Final
(
Ap(..)
, runAp
, runAp_
, liftAp
, hoistAp
, retractAp
) where
import Control.Applicative
import Data.Functor.Apply
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid
#endif
newtype Ap f a = Ap { Ap f a
-> forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
_runAp :: forall g. Applicative g => (forall x. f x -> g x) -> g a }
runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a
runAp :: (forall x. f x -> g x) -> Ap f a -> g a
runAp forall x. f x -> g x
phi Ap f a
m = Ap f a -> (forall x. f x -> g x) -> g a
forall (f :: * -> *) a.
Ap f a
-> forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
_runAp Ap f a
m forall x. f x -> g x
phi
runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m
runAp_ :: (forall a. f a -> m) -> Ap f b -> m
runAp_ forall a. f a -> m
f = Const m b -> m
forall a k (b :: k). Const a b -> a
getConst (Const m b -> m) -> (Ap f b -> Const m b) -> Ap f b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. f x -> Const m x) -> Ap f b -> Const m b
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (m -> Const m x
forall k a (b :: k). a -> Const a b
Const (m -> Const m x) -> (f x -> m) -> f x -> Const m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> m
forall a. f a -> m
f)
instance Functor (Ap f) where
fmap :: (a -> b) -> Ap f a -> Ap f b
fmap a -> b
f (Ap forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
g) = (forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g b)
-> Ap f b
forall (f :: * -> *) a.
(forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
Ap (\forall x. f x -> g x
k -> (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ((forall x. f x -> g x) -> g a
forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
g forall x. f x -> g x
k))
instance Apply (Ap f) where
Ap forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g (a -> b)
f <.> :: Ap f (a -> b) -> Ap f a -> Ap f b
<.> Ap forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
x = (forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g b)
-> Ap f b
forall (f :: * -> *) a.
(forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
Ap (\forall x. f x -> g x
k -> (forall x. f x -> g x) -> g (a -> b)
forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g (a -> b)
f forall x. f x -> g x
k g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall x. f x -> g x) -> g a
forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
x forall x. f x -> g x
k)
instance Applicative (Ap f) where
pure :: a -> Ap f a
pure a
x = (forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
forall (f :: * -> *) a.
(forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
Ap (\forall x. f x -> g x
_ -> a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
Ap forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g (a -> b)
f <*> :: Ap f (a -> b) -> Ap f a -> Ap f b
<*> Ap forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
x = (forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g b)
-> Ap f b
forall (f :: * -> *) a.
(forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
Ap (\forall x. f x -> g x
k -> (forall x. f x -> g x) -> g (a -> b)
forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g (a -> b)
f forall x. f x -> g x
k g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall x. f x -> g x) -> g a
forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
x forall x. f x -> g x
k)
liftAp :: f a -> Ap f a
liftAp :: f a -> Ap f a
liftAp f a
x = (forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
forall (f :: * -> *) a.
(forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
Ap (\forall x. f x -> g x
k -> f a -> g a
forall x. f x -> g x
k f a
x)
hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp forall a. f a -> g a
f (Ap forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g b
g) = (forall (g :: * -> *).
Applicative g =>
(forall x. g x -> g x) -> g b)
-> Ap g b
forall (f :: * -> *) a.
(forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a)
-> Ap f a
Ap (\forall x. g x -> g x
k -> (forall x. f x -> g x) -> g b
forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g b
g (g x -> g x
forall x. g x -> g x
k (g x -> g x) -> (f x -> g x) -> f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> g x
forall a. f a -> g a
f))
retractAp :: Applicative f => Ap f a -> f a
retractAp :: Ap f a -> f a
retractAp (Ap forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
g) = (forall x. f x -> f x) -> f a
forall (g :: * -> *).
Applicative g =>
(forall x. f x -> g x) -> g a
g forall a. a -> a
forall x. f x -> f x
id