Original Question
I would like to make the following work:
class Functor2 c where
fmap2 :: (a->b) -> c x a -> c x b
instance Functor (c x) => Functor2 c where
fmap2 = fmap
However I get the error:
Could not deduce (Functor (c x1)) arising from a use of `fmap'
from the context (Functor (c x))
How can I do it?
My use case
I want to use the Arrow methods (and sugar, etc) for my Applicative instances. More specifically I want:
newtype Wrap f g a b = W { unwrap :: ( f (g a b) ) }
instance (Category g, "Forall x." Applicative (g x), Applicative f) => Arrow (Wrap f g)
This instance would automatically follow from these (already working) instances:
instance (Category g, Applicative f) => Category (Wrap f g) where
id = W $ pure id
(W x) . (W y) = W $ liftA2 (.) x y
instance (Applicative (g x), Applicative f) => Functor (Wrap f g x) where
fmap f = W . fmap (fmap f) . unwrap
instance (Applicative (g x), Applicative f) => Applicative (Wrap f g x) where
pure = W . pure . pure
(W ab) <*> (W a) = W $ pure (<*>) <*> ab <*> a
if I could get this one to work:
instance (Category c, "Forall x." Applicative (c x)) => Arrow c where
arr f = (pure f) <*> id
first a = pure (,) <*> (arr fst >>> a) <*> (arr snd)
The types of arr and first check out in the compiler. The problem is the required "Forall x.", which I do not know how to state in Haskell.
An easy example for such a g is ->: Category (->) and Applicative ((->) x) for all x.
This does not really achieve your goal, but maybe it could be a step forward.
Your forall x. Functor (c x) is written AllFunctor2 c in this approach.
The main drawback is that you have to provide an instance to every functor you want to put in that class.
{-# LANGUAGE GADTs, ScopedTypeVariables #-}
data Ftor f where
Ftor :: Functor f => Ftor f
class AllFunctor2 c where
allFtor2 :: Ftor (c a)
instance AllFunctor2 (->) where
allFtor2 = Ftor
fmap2 :: AllFunctor2 c => (a->b) -> c x a -> c x b
fmap2 f (x :: c x a) = case allFtor2 :: Ftor (c x) of Ftor -> fmap f x
Probably the above is not so different from providing instances to Functor2 directly:
class Functor2 c where
fmap2 :: (a->b) -> c x a -> c x b
instance Functor2 (->) where
fmap2 = fmap
Related
I'm reading through Chapter 25 (Composing Types) of the haskellbook, and wish to understand applicative composition more completely
The author provides a type to embody type composition:
newtype Compose f g a =
Compose { getCompose :: f (g a) }
deriving (Eq, Show)
and supplies the functor instance for this type:
instance (Functor f, Functor g) =>
Functor (Compose f g) where
fmap f (Compose fga) =
Compose $ (fmap . fmap) f fga
But the Applicative instance is left as an exercise to the reader:
instance (Applicative f, Applicative g) =>
Applicative (Compose f g) where
-- pure :: a -> Compose f g a
pure = Compose . pure . pure
-- (<*>) :: Compose f g (a -> b)
-- -> Compose f g a
-- -> Compose f g b
Compose fgf <*> Compose fgx = undefined
I can cheat and look the answer up online... The source for Data.Functor.Compose provides the applicative instance definition:
Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
but I'm having trouble understanding what's going on here. According to type signatures, both f and x are wrapped up in two layers of applicative structure. The road block I seem to be hitting though is understanding what's going on with this bit: (<*>) <$> f. I will probably have follow up questions, but they probably depend on how that expression is evaluated. Is it saying "fmap <*> over f" or "apply <$> to f"?
Please help to arrive at an intuitive understanding of what's happening here.
Thanks! :)
Consider the expression a <$> b <*> c. It means take the function a, and map it over the functor b, which will yield a new functor, and then map that new functor over the functor c.
First, imagine that a is (\x y -> x + y), b is Just 3, and c is Just 5. a <$> b then evaluates to Just (\y -> 3 + y), and a <$> b <*> c then evaluates to Just 8.
(If what's before here doesn't make sense, then you should try to understand single layers of applicatives further before you try to understand multiple layers of them.)
Similarly, in your case, a is (<*>), b is f, and c is x. If you were to choose suitable values for f and x, you'd see that they can be easily evaluated as well (though be sure to keep your layers distinct; the (<*>) in your case belongs to the inner Applicative, whereas the <$> and <*> belong to the outer one).
Rather than <*>, you can define liftA2.
import Control.Applicative (Applicative (..))
newtype Compose f g a = Compose
{ getCompose :: f (g a) }
deriving Functor
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
pure a = Compose (pure (pure a))
-- liftA2 :: (a -> b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
liftA2 f (Compose fga) (Compose fgb) = Compose _1
We have fga :: f (g a) and fgb :: f (g b) and we need _1 :: f (g c). Since f is applicative, we can combine those two values using liftA2:
liftA2 f (Compose fga) (Compose fgb) = Compose (liftA2 _2 fga fgb)
Now we need
_2 :: g a -> g b -> g c
Since g is also applicative, we can use its liftA2 as well:
liftA2 f (Compose fga) (Compose fgb) = Compose (liftA2 (liftA2 f) fga fgb)
This pattern of lifting liftA2 applications is useful for other things too. Generally speaking,
liftA2 . liftA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c)
liftA2 . liftA2 . liftA2
:: (Applicative f, Applicative g, Applicative h)
=> (a -> b -> c) -> f (g (h a)) -> f (g (h b)) -> f (g (h c))
I was thinking about unzipping operations and realized that one way to express them is by traversing in a Biapplicative functor.
import Data.Biapplicative
class Traversable2 t where
traverse2 :: Biapplicative p
=> (a -> p b c) -> t a -> p (t b) (t c)
-- Note: sequence2 :: [(a,b)] -> ([a], [b])
sequence2 :: (Traversable2 t, Biapplicative p)
=> t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id
instance Traversable2 [] where
traverse2 _ [] = bipure [] []
traverse2 f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs
It smells to me as though every instance of Traversable can be transformed mechanically into an instance of Traversable2. But I haven't yet found a way to actually implement traverse2 using traverse, short of converting to and from lists or perhaps playing extremely dirty tricks with unsafeCoerce. Is there a nice way to do this?
Further evidence that anything Traversable is Traversable2:
class (Functor t, Foldable t) => Traversable2 t where
traverse2 :: Biapplicative p
=> (a -> p b c) -> t a -> p (t b) (t c)
default traverse2 ::
(Biapplicative p, Generic1 t, GTraversable2 (Rep1 t))
=> (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f xs = bimap to1 to1 $ gtraverse2 f (from1 xs)
class GTraversable2 r where
gtraverse2 :: Biapplicative p
=> (a -> p b c) -> r a -> p (r b) (r c)
instance GTraversable2 V1 where
gtraverse2 _ x = bipure (case x of) (case x of)
instance GTraversable2 U1 where
gtraverse2 _ _ = bipure U1 U1
instance GTraversable2 t => GTraversable2 (M1 i c t) where
gtraverse2 f (M1 t) = bimap M1 M1 $ gtraverse2 f t
instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :*: u) where
gtraverse2 f (t :*: u) = bimap (:*:) (:*:) (gtraverse2 f t) <<*>> gtraverse2 f u
instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :+: u) where
gtraverse2 f (L1 t) = bimap L1 L1 (gtraverse2 f t)
gtraverse2 f (R1 t) = bimap R1 R1 (gtraverse2 f t)
instance GTraversable2 (K1 i c) where
gtraverse2 f (K1 x) = bipure (K1 x) (K1 x)
instance (Traversable2 f, GTraversable2 g) => GTraversable2 (f :.: g) where
gtraverse2 f (Comp1 x) = bimap Comp1 Comp1 $ traverse2 (gtraverse2 f) x
instance Traversable2 t => GTraversable2 (Rec1 t) where
gtraverse2 f (Rec1 xs) = bimap Rec1 Rec1 $ traverse2 f xs
instance GTraversable2 Par1 where
gtraverse2 f (Par1 p) = bimap Par1 Par1 (f p)
I think I might have something that fits your bill. (Edit: It doesn't, see comments.) You can define newtypes over p () c and p b () and make them Functor instances.
Implementation
Here's your class again with default definitions. I went the route of implementing sequence2 in terms of sequenceA because it seemed simpler.
class Functor t => Traversable2 t where
{-# MINIMAL traverse2 | sequence2 #-}
traverse2 :: Biapplicative p => (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f = sequence2 . fmap f
sequence2 :: Biapplicative p => t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id
Now, the "right part" of the Biapplicative is
newtype R p c = R { runR :: p () c }
instance Bifunctor p => Functor (R p) where
fmap f (R x) = R $ bimap id f x
instance Biapplicative p => Applicative (R p) where
pure x = R (bipure () x)
R f <*> R x =
let f' = biliftA2 const (flip const) (bipure id ()) f
in R $ f' <<*>> x
mkR :: Biapplicative p => p b c -> R p c
mkR = R . biliftA2 const (flip const) (bipure () ())
sequenceR :: (Traversable t, Biapplicative p) => t (p b c) -> p () (t c)
sequenceR = runR . sequenceA . fmap mkR
with the "left part" much the same. The full code is in this gist.
Now we can make p (t b) () and p () (t c) and reassemble them into p (t b) (t c).
instance (Functor t, Traversable t) => Traversable2 t where
sequence2 x = biliftA2 const (flip const) (sequenceL x) (sequenceR x)
I needed to turn on FlexibleInstances and UndecidableInstances for that instance declaration. Also, somehow ghc wanted a Functor constaint.
Testing
I verified with your instance for [] that it gives the same results:
main :: IO ()
main = do
let xs = [(x, ord x - 97) | x <- ['a'..'g']]
print xs
print (sequence2 xs)
print (sequence2' xs)
traverse2' :: Biapplicative p => (a -> p b c) -> [a] -> p [b] [c]
traverse2' _ [] = bipure [] []
traverse2' f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs
sequence2' :: Biapplicative p => [p b c] -> p [b] [c]
sequence2' = traverse2' id
outputs
[('a',0),('b',1),('c',2),('d',3),('e',4),('f',5),('g',6)]
("abcdefg",[0,1,2,3,4,5,6])
("abcdefg",[0,1,2,3,4,5,6])
This was a fun exercise!
The following seems to do the trick, exploiting “only” undefined. Possibly the traversable laws guarantee that this is ok, but I've not attempted to prove it.
{-# LANGUAGE GADTs, KindSignatures, TupleSections #-}
import Data.Biapplicative
import Data.Traversable
data Bimock :: (* -> * -> *) -> * -> * where
Bimock :: p a b -> Bimock p (a,b)
Bimfmap :: ((a,b) -> c) -> p a b -> Bimock p c
Bimpure :: a -> Bimock p a
Bimapp :: Bimock p ((a,b) -> c) -> p a b -> Bimock p c
instance Functor (Bimock p) where
fmap f (Bimock p) = Bimfmap f p
fmap f (Bimfmap g p) = Bimfmap (f . g) p
fmap f (Bimpure x) = Bimpure (f x)
fmap f (Bimapp gs xs) = Bimapp (fmap (f .) gs) xs
instance Biapplicative p => Applicative (Bimock p) where
pure = Bimpure
Bimpure f<*>xs = fmap f xs
fs<*>Bimpure x = fmap ($x) fs
fs<*>Bimock p = Bimapp fs p
Bimfmap g h<*>Bimfmap i xs = Bimfmap (\(~(a₁,a₂),~(b₁,b₂)) -> g (a₁,b₁) $ i (a₂, b₂))
$ bimap (,) (,) h<<*>>xs
Bimapp g h<*>xs = fmap uncurry g <*> ((,)<$>Bimock h<*>xs)
runBimock :: Biapplicative p => Bimock p (a,b) -> p a b
runBimock (Bimock p) = p
runBimock (Bimfmap f p) = bimap (fst . f . (,undefined)) (snd . f . (undefined,)) p
runBimock (Bimpure (a,b)) = bipure a b
runBimock (Bimapp (Bimpure f) xs) = runBimock . fmap f $ Bimock xs
runBimock (Bimapp (Bimfmap h g) xs)
= runBimock . fmap (\(~(a₂,a₁),~(b₂,b₁)) -> h (a₂,b₂) (a₁,b₁))
. Bimock $ bimap (,) (,) g<<*>>xs
runBimock (Bimapp (Bimapp h g) xs)
= runBimock . (fmap (\θ (~(a₂,a₁),~(b₂,b₁)) -> θ (a₂,b₂) (a₁,b₁)) h<*>)
. Bimock $ bimap (,) (,) g<<*>>xs
traverse2 :: (Biapplicative p, Traversable t) => (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f s = runBimock . fmap (\bcs->(fmap fst bcs, fmap snd bcs)) $ traverse (Bimock . f) s
sequence2 :: (Traversable t, Biapplicative p)
=> t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id
And even if this is safe, I wouldn't be surprised if it gives horrible performance, what with the irrefutable patterns and quadratic (or even exponential?) tuple-tree buildup.
A few observations short of a complete, original answer.
If you have a Biapplicative bifunctor, what you can do with it is apply it to something and separate it into a pair of bifunctors isomorphic to its two components.
data Helper w a b = Helper {
left :: w a (),
right :: w () b
}
runHelper :: forall p a b. Biapplicative p => Helper p a b -> p a b
runHelper x = biliftA2 const (flip const) (left x) (right x)
makeHelper :: (Biapplicative p)
=> p a b -> Helper p a b
makeHelper w = Helper (bimap id (const ()) w)
(bimap (const ()) id w)
type Separated w a b = (w a (), w () b)
It would be possible to combine the approaches of #nnnmmm and #leftroundabout by applying fmap (makeHelper . f) to the structure s, eliminating the need for undefined, but then you would need to make Helper or its replacement an instance of some typeclass with the useful operations that let you solve the problem.
If you have a Traversable structure, what you can do is sequenceA Applicative functors (in which case your solution will look like traverse2 f = fromHelper . sequenceA . fmap (makeHelper . f), where your Applicative instance builds a pair of t structures) or traverse it using a Functor (in which case your solution will look like traverse2 f = fromHelper . traverse (g . makeHelper . f) where ...). Either way, you need to define a Functor instance, since Applicative inherits from Functor. You might try to build your Functor from <<*>> and bipure id id, or bimap, or you might work on both separated variables in the same pass.
Unfortunately, to make the types work for the Functor instance, you have to paramaterize :: p b c to a type we would informally call :: w (b,c) where the one parameter is the Cartesian product of the two parameters of p. Haskell’s type system doesn’t seem to allow this without non-standard extensions, but #leftroundabout pulls this off ably with the Bimock class. using undefined to coerce both separated functors to have the same type.
For performance, what you want to do is make no more than one traversal, which produces an object isomorphic to p (t b) (t c) that you can then convert (similar to the Naturality law). You therefore want to implement traverse2 rather than sequence2 and define sequence2 as traverse2 id, to avoid traversing twice. If you separate variables and produce something isomorphic to (p (t b) (), p () (t c)), you can then recombine them as #mmmnnn does.
In practical use, I suspect you would want to impose some additional structure on the problem. Your question kept the components b and c of the Bifunctor completely free, but in practice they will usually be either covariant or contravariant functors that can be sequenced with biliftA2 or traversed together over a Bitraversable rather than Traversable t, or perhaps even have a Semigroup, Applicative or Monad instance.
A particularly efficient optimization would be if your p is isomorphic to a Monoid whose <> operation produces a data structure isomorphic to your t. (This works for lists and binary trees; Data.ByteString.Builder is an algebraic type that has this property.) In this case, the associativity of the operation lets you transform the structure into either a strict left fold or a lazy right fold.
This was an excellent question, and although I don’t have better code than #leftroundabout for the general case, I learned a lot from working on it.
One only mildly evil way to do this is using something like Magma from lens. This seems considerably simpler than leftaroundabout's solution, although it's not beautiful either.
data Mag a b t where
Pure :: t -> Mag a b t
Map :: (x -> t) -> Mag a b x -> Mag a b t
Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
One :: a -> Mag a b b
instance Functor (Mag a b) where
fmap = Map
instance Applicative (Mag a b) where
pure = Pure
(<*>) = Ap
traverse2 :: forall t a b c f. (Traversable t, Biapplicative f)
=> (a -> f b c) -> t a -> f (t b) (t c)
traverse2 f0 xs0 = go m m
where
m :: Mag a x (t x)
m = traverse One xs0
go :: forall x y. Mag a b x -> Mag a c y -> f x y
go (Pure t) (Pure u) = bipure t u
go (Map f x) (Map g y) = bimap f g (go x y)
go (Ap fs xs) (Ap gs ys) = go fs gs <<*>> go xs ys
go (One x) (One y) = f0 x
go _ _ = error "Impossible"
I'm stuck with Functor instance for composition of other functors in haskell.
data Cmps f g x = Cmps {getCmps :: f (g x)} deriving (Eq,Show)
--
instance (Functor f, Functor g) => Functor (Cmps f g) where
-- fmap :: (a -> b) -> (Cmps f g) a -> (Cmps f g) b
fmap = ?
In GHC.Generics functor just derived with {-# LANGUAGE DeriveFunctor #-}
-- | Composition of functors
infixr 7 :.:
newtype (:.:) f (g :: * -> *) (p :: *) = Comp1 { unComp1 :: f (g p) }
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)`
I can't get some like fmap h (Cmps f g x) = Cmps f g (h x) becouse of error
The constructor ‘Cmps’ should have 1 argument, but has been given 3, and something like fmap h (f (g x)) don't work too. How can I get f, g and x from Cmps type in fmap implementation?
Consolidating the remarks by Li-yao Xia and orlan as an answer.
In your Cmps definition...
data Cmps f g x = Cmps {getCmps :: f (g x)} deriving (Eq,Show)
... f, g and x are type variables; they do not stand for fields. Cmps has a single field, of type f (g x). Accordingly, the fmap implementation for it should be:
instance (Functor f, Functor g) => Functor (Cmps f g) where
-- fmap :: (a -> b) -> (Cmps f g) a -> (Cmps f g) b
fmap h (Cmps x) = Cmps (fmap (fmap h) x)
If you want to compare that with an equivalent instance in the core libraries which is not derived, have a look at Compose from Data.Functor.Compose.
We can define data Free f a = Pure a | Free (f (Free f a)) and so have Functor f => Monad (Free f).
If we define
data T f a b = R a | S b | T (f a (T f a b)) have we some analogous M so Profunctor f => M (T f a), where class Profunctor f where dimap :: (a -> b) -> (c -> d) -> f b c -> f a d?
I've been wondering ever since i noted Data.Comp.Term.Context and Free are isomorphic about a potential analog for Data.Comp.Param.Term.Context.
There's a more appropriate notion of making a free thing from a profunctor. Then we can work by analogy.
A free monoid, Y, generated by a set X is can be thought of as the solution to the equation "Y=1+XY". In Haskell notation that is
data List a = Nil | Cons a (List a)
A free monad, M, generated by the functor F can be thought of as the solution to the equation "M=1+FM" where the product "FM' is the composition of functors. 1 is just the identity functor. In Haskell notation that is
data Free f a = Pure a | Free (f (Free a))
Making something free from a profunctor P should look like a solution, A, to "A=1+PA". The product "PA" is the standard composition of profunctors. The 1 is the "identity" profunctor, (->). So we get
data Free p a b = Pure (a -> b) | forall x.Free (p a x) (Free p x b)
This is also a profunctor:
instance Profunctor b => Profunctor (Free b) where
lmap f (Pure g) = Pure (g . f)
lmap f (Free g h) = Free (lmap f g) h
rmap f (Pure g) = Pure (f . g)
rmap f (Free g h) = Free g (rmap f h)
If the profunctor is strong then so is the free version:
instance Strong p => Strong (Free p) where
first' (Pure f) = Pure (first' f)
first' (Free f g) = Free (first' f) (first' g)
But what actually is Free p? It's actually a thing called a pre-arrow. Restricting, free strong profunctors are arrows:
instance Profunctor p => Category (Free p) where
id = Pure id
Pure f . Pure g = Pure (f . g)
Free g h . Pure f = Free (lmap f g) h
Pure f . Free g h = Free g (Pure f . h)
f . Free g h = Free g (f . h)
instance (Profunctor p, Strong p) => Arrow (Free p) where
arr = Pure
first = first'
Intuitively you can think of an element of a profunctor P a b as taking an a-ish thing to a b-ish thing, the canonical example being given by (->). Free P is an unevaluated chain of these elements with compatible (but unobservable) intermediate types.
So i think i figured it out: M ~ Monad ☺
instance Profunctor f => Functor (T f a) where
fmap f (In m) = In (dimap id (fmap f) m)
fmap f (Hole x) = Hole (f x)
fmap f (Var v) = Var v
instance Profunctor f => Applicative (T f a) where
pure = Hole
(<*>) = ap
instance Profunctor f => Monad (T f a) where
In m >>= f = In ((>>= f) <$> m)
Hole x >>= f = f x
Var v >>= _ = Var v
Seems obvious in hindthought.
This question deals with constructing a proper Monad instance from something that is a monad, but only under certain constraints - for example Set. The trick is to wrap it into ContT, which defers the constraints to wrapping/unwrapping its values.
Now I'd like to do the same with Applicatives. In particular, I have an Applicative instance whose pure has a type-class constraint. Is there a similar trick how to construct a valid Applicative instance?
(Is there "the mother of all applicative functors" just as there is for monads?)
What may be the most consistent way available is starting from Category, where it's quite natural to have a restriction to objects: Object!
class Category k where
type Object k :: * -> Constraint
id :: Object k a => k a a
(.) :: (Object k a, Object k b, Object k c)
=> k b c -> k a b -> k a c
Then we define functors similar to how Edward does it
class (Category r, Category t) => Functor f r t | f r -> t, f t -> r where
fmap :: (Object r a, Object t (f a), Object r b, Object t (f b))
=> r a b -> t (f a) (f b)
All of this works nicely and is implemented in the constrained-categories library, which – shame on me! – still isn't on Hackage.
Applicative is unfortunately a bit less straightforward to do. Mathematically, these are monoidal functors, so we first need monoidal categories. categories has that class, but it doesn't work with the constraint-based version because our objects are always anything of kind * with a constraint. So what I did is make up a Curry class, which kind of approximates this.
Then, we can do Monoidal functors:
class (Functor f r t, Curry r, Curry t) => Monoidal f r t where
pure :: (Object r a, Object t (f a)) => a `t` f a
fzipWith :: (PairObject r a b, Object r c, PairObject t (f a) (f b), Object t (f c))
=> r (a, b) c -> t (f a, f b) (f c)
This is actually equivalent to Applicative when we have proper closed cartesian categories. In the constrained-categories version, the signatures unfortunately look very horrible:
(<*>) :: ( Applicative f r t
, MorphObject r a b, Object r (r a b)
, MorphObject t (f a) (f b), Object t (t (f a) (f b)), Object t (f (r a b))
, PairObject r (r a b) a, PairObject t (f (r a b)) (f a)
, Object r a, Object r b, Object t (f a), Object t (f b))
=> f (r a b) `t` t (f a) (f b)
Still, it actually works – for the unconstrained case, duh! I haven't yet found a convenient way to use it with nontrivial constraints.
But again, Applicative is equivalent to Monoidal, and that can be used as demonstrated in the Set example.
I'm not sure the notion of "restricted applicative" is unique, as different presentations are not isomorphic. That said here is one and something at least somewhat along the lines of Codensity. The idea is to have a "free functor" together with a unit
{-# LANGUAGE TypeFamilies, ConstraintKinds, ExistentialQuantification #-}
import GHC.Prim (Constraint)
import Control.Applicative
class RFunctor f where
type C f :: * -> Constraint
rfmap :: C f b => (a -> b) -> f a -> f b
class RFunctor f => RApplicative f where
rpure :: C f a => a -> f a
rzip :: f a -> f b -> f (a,b)
data UAp f a
= Pure a
| forall b. Embed (f b) (b -> a)
toUAp :: C f a => f a -> UAp f a
toUAp x = Embed x id
fromUAp :: (RApplicative f, C f a) => UAp f a -> f a
fromUAp (Pure x) = rpure x
fromUAp (Embed x f) = rfmap f x
zipUAp :: RApplicative f => UAp f a -> UAp f b -> UAp f (a,b)
zipUAp (Pure a) (Pure b) = Pure (a,b)
zipUAp (Pure a) (Embed b f) = Embed b (\x -> (a,f x))
zipUAp (Embed a f) (Pure b) = Embed a (\x -> (f x,b))
zipUAp (Embed a f) (Embed b g) = Embed (rzip a b) (\(x,y) -> (f x,g y))
instance Functor (UAp f) where
fmap f (Pure a) = Pure (f a)
fmap f (Embed a g) = Embed a (f . g)
instance RApplicative f => Applicative (UAp f) where
pure = Pure
af <*> ax = fmap (\(f,x) -> f x) $ zipUAp af ax
EDIT: Fixed some bugs. That is what happens when you don't compile before posting.
Because every Monad is a Functor, you can use the same ContT trick.
pure becomes return
fmap f x becomes x >>= (return . f)