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)
Related
How Can I instantiate the following data types to be Functor ?
data LiftItOut f a = LiftItOut (f a)
data Parappa f g a = DaWrappa (f a) (g a)
data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
data Notorious g o a t = Notorious (g o) (g a) (g t)
There are not very clear for the declaration themselves, inside the parantheses in the right member, is that function application (I ve never seen that, only basic type constructors)? I am new to haskell and I am just trying to understand the basics.
Ask the compiler to show you how. Use the command line flag -ddump-deriv, enable the DeriveFunctor language extension, and put deriving Functor at the end of each type definition, and then the compiler will print Functor instances for each of them:
==================== Derived instances ====================
Derived class instances:
instance GHC.Base.Functor g =>
GHC.Base.Functor (Main.Notorious g o a) where
GHC.Base.fmap f_aK1 (Main.Notorious a1_aK2 a2_aK3 a3_aK4)
= Main.Notorious a1_aK2 a2_aK3 (GHC.Base.fmap f_aK1 a3_aK4)
(GHC.Base.<$) z_aK5 (Main.Notorious a1_aK6 a2_aK7 a3_aK8)
= Main.Notorious a1_aK6 a2_aK7 ((GHC.Base.<$) z_aK5 a3_aK8)
instance forall k (f :: k -> *) (g :: * -> *) (a :: k).
GHC.Base.Functor g =>
GHC.Base.Functor (Main.IgnoreOne f g a) where
GHC.Base.fmap f_aK9 (Main.IgnoringSomething a1_aKa a2_aKb)
= Main.IgnoringSomething a1_aKa (GHC.Base.fmap f_aK9 a2_aKb)
(GHC.Base.<$) z_aKc (Main.IgnoringSomething a1_aKd a2_aKe)
= Main.IgnoringSomething a1_aKd ((GHC.Base.<$) z_aKc a2_aKe)
instance (GHC.Base.Functor f, GHC.Base.Functor g) =>
GHC.Base.Functor (Main.Parappa f g) where
GHC.Base.fmap f_aKf (Main.DaWrappa a1_aKg a2_aKh)
= Main.DaWrappa
(GHC.Base.fmap f_aKf a1_aKg) (GHC.Base.fmap f_aKf a2_aKh)
(GHC.Base.<$) z_aKi (Main.DaWrappa a1_aKj a2_aKk)
= Main.DaWrappa
((GHC.Base.<$) z_aKi a1_aKj) ((GHC.Base.<$) z_aKi a2_aKk)
instance GHC.Base.Functor f =>
GHC.Base.Functor (Main.LiftItOut f) where
GHC.Base.fmap f_aKl (Main.LiftItOut a1_aKm)
= Main.LiftItOut (GHC.Base.fmap f_aKl a1_aKm)
(GHC.Base.<$) z_aKn (Main.LiftItOut a1_aKo)
= Main.LiftItOut ((GHC.Base.<$) z_aKn a1_aKo)
That's kind of messy-looking, but it's rather straightforward to clean up:
data LiftItOut f a = LiftItOut (f a)
instance Functor f => Functor (LiftItOut f) where
fmap f (LiftItOut a) = LiftItOut (fmap f a)
data Parappa f g a = DaWrappa (f a) (g a)
instance (Functor f, Functor g) => Functor (Parappa f g) where
fmap f (DaWrappa a1 a2) = DaWrappa (fmap f a1) (fmap f a2)
data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
instance Functor g => Functor (IgnoreOne f g a) where
fmap f (IgnoringSomething a1 a2) = IgnoringSomething a1 (fmap f a2)
data Notorious g o a t = Notorious (g o) (g a) (g t)
instance Functor g => Functor (Notorious g o a) where
fmap f (Notorious a1 a2 a3) = Notorious a1 a2 (fmap f a3)
Also worth noting that your LiftItOut is isomorphic to Ap and IdentityT, and your Parappa is isomorphic to Product.
A functor f is a type constructor with an associated function fmap that from a function of type (a -> b) creates a function of type (f a) -> (f b) which applies it "on the inside": (the parentheses are redundant and are used for clarity/emphasis only)
fmap :: (Functor f) => ( a -> b)
-> (f a) -> (f b)
-- i.e. g :: a -> b -- from this
-- --------------------------
-- fmap g :: (f a) -> (f b) -- we get this
(read it "fmap of g from a to b goes from f a to f b").
Put differently, something being a "Functor" means that it can be substituted for f in
fmap id (x :: f a) = x
(fmap g . fmap h) = fmap (g . h)
so that the expressions involved make sense (i.e. are well formed, i.e. have a type), and, importantly, the above equations hold -- they are in fact the two "Functor laws".
You have
data LiftItOut h a = MkLiftItOut (h a) -- "Mk..." for "Make..."
------------- ----------- ------
new type, data type of the data constructor's
defined here constructor one argument (one field)
This means h a is a type of a thing which can serve as an argument to MkLiftItOut. For example, Maybe Int (i.e. h ~ Maybe and a ~ Int), [(Float,String)] (i.e. h ~ [] and a ~ (Float,String)), etc.
h, a are type variables -- meaning, they can be replaced by any specific type so that the whole syntactic expressions make sense.
These syntactic expressions include MkLiftItOut x which is a thing of type LiftItOut h a provided x is a thing of type h a; LiftItOut h a which is a type; h a which is a type of a thing which can appear as an argument to MkLiftItOut. Thus we can have in our programs
v1 = MkLiftItOut ([1,2,3] :: [] Int ) :: LiftItOut [] Int
v2 = MkLiftItOut ((Just "") :: Maybe String) :: LiftItOut Maybe String
v3 = MkLiftItOut (Nothing :: Maybe () ) :: LiftItOut Maybe ()
.....
etc. Then we have
ghci> :i Functor
class Functor (f :: * -> *) where
fmap :: (a -> b) -> f a -> f b
(<$) :: a -> f b -> f a
..........
This means that Functor f => (f a) is a type of a thing which a variable can reference, e.g.
-- f a
v4 = Just 4 :: Maybe Int
v41 = 4 :: Int
v5 = [4.4, 5.5] :: [] Float
v51 = 4.4 :: Float
v52 = 5.5 :: Float
v6 = (1,"a") :: ((,) Int) String -- or simpler, `(Int, String)`
v61 = "a" :: String
v7 = (\x -> 7) :: ((->) Int) Int -- or simpler, `Int -> Int`
Here a is a type of a thing, f a is a type of a thing, f is a type which, when given a type of a thing, becomes a type of a thing; etc. There's no thing which can be referenced by a variable which would have the type f on its own.
All the above fs are instances of the Functor typeclass. This means that somewhere in the libraries there are definitions of
instance Functor Maybe where ....
instance Functor [] where ....
instance Functor ((,) a) where ....
instance Functor ((->) r) where ....
Notice we always have the f, and the a. f in particular can be made of more than one constituents, but a is always some one type.
Thus in this case we must have
instance Functor (LiftItOut h) where ....
(...why? do convince yourself in this; see how all the above statements apply and are correct)
Then the actual definition must be
-- fmap :: (a -> b) -> f a -> f b
-- fmap :: (a -> b) -> LiftItOut h a -> LiftItOut h b
fmap g (MkLiftItOut x ) = (MkLiftItOut y )
where
y = ....
In particular, we'll have
-- g :: a -> b -- x :: (h a) -- y :: (h b)
and we don't even know what the h is.
How can we solve this? How can we construct an h b-type of thing from an h a-type of thing when we don't even know anything about h, a, nor b?
We can't.
But what if we knew that h is also a Functor?
instance (Functor h) => Functor (LiftItOut h) where
-- fmap :: (a -> b) -> (f a) -> (f b)
-- fmap :: (a -> b) -> (LiftItOut h a) -> (LiftItOut h b)
fmap g (MkLiftItOut x ) = (MkLiftItOut y )
where
-- fmap :: (a -> b) -> (h a) -> (h b)
y = ....
Hopefully you can finish this up. And also do the other types in your question as well. If not, post a new question for the one type with which you might have any further problems.
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"
Is there a name for this family of operations?
Functor f => f (a, b) -> (f a, f b)
Functor f => f (a, b, c) -> (f a, f b, f c)
...
Functor f => f (a, b, ..., z) -> (f a, f b, ..., f z)
They're easy to implement, just trying to figure out what to call it.
\fab -> (fst <$> fab, snd <$> fab)
For me, it came up in the context of f ~ (x ->).
In your specific context f ~ (x ->), I think they can be called "power laws".
Indeed, in theory, it is common to write A -> B as the power B^A. The pair type (A,B) is also commonly written as a product (A*B).
Your first law is then written as
(A*B)^C = A^C * B^C
and is a classic type isomorphism. This can be easily generalized to tuples in the obvious way.
In the general case, where f is an arbitrary functor, I can't think of nothing else than "distribution", right now.
There is Data.Distributive which is the dual of Data.Traversable. It provides the distribute function which can be specialized e.g. as f (Stream a) -> Stream (f a) or distribute :: f (Vec n a) -> Vec n (f a). The latter example is a homogeneous variant of your family of functions.
But we can generalize Data.Distributive a bit just like lenses generalize functors. Enter Colens:
type Colens s t a b = forall f. Functor f => (f a -> b) -> f s -> t
Here is the mirror of Control.Lens.Each:
class Coeach s t a b | s -> a, t -> b, s b -> t, t a -> s where
coeach :: Colens s t a b
instance (a~a', b~b') => Coeach (a,a') (b,b') a b where
coeach f p = (f $ fst <$> p, f $ snd <$> p)
instance (a~a2, a~a3, b~b2, b~b3) => Coeach (a,a2,a3) (b,b2,b3) a b where
coeach f p = ...
...
And just like with each we can iterate over tuples
each_id1 :: Applicative f => (f a, f a) -> f (a, a)
each_id1 = each id
each_id2 :: Applicative f => (f a, f a, f a) -> f (a, a, a)
each_id2 = each id
with coeach we can coiterate over tuples:
coeach_id1 :: Functor f => f (a, a) -> (f a, f a)
coeach_id1 = coeach id
coeach_id2 :: Functor f => f (a, a, a) -> (f a, f a, f a)
coeach_id2 = coeach id
This is still homogeneous, though. I don't know lens much, so can't say whether there is a heterogeneous each and the corresponding coeach.
I have a recursive datatype which has a Functor instance:
data Expr1 a
= Val1 a
| Add1 (Expr1 a) (Expr1 a)
deriving (Eq, Show, Functor)
Now, I'm interested in modifying this datatype to support general recursion schemes, as they are described in this tutorial and this Hackage package. I managed to get the catamorphism to work:
newtype Fix f = Fix {unFix :: f (Fix f)}
data ExprF a r
= Val a
| Add r r
deriving (Eq, Show, Functor)
type Expr2 a = Fix (ExprF a)
cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . unFix
eval :: Expr2 Int -> Int
eval = cata $ \case
Val n -> n
Add x y -> x + y
main :: IO ()
main =
print $ eval
(Fix (Add (Fix (Val 1)) (Fix (Val 2))))
But now I can't figure out how to give Expr2 the same functor instance that the original Expr had. It seems there is a kind mismatch when trying to define the functor instance:
instance Functor (Fix (ExprF a)) where
fmap = undefined
Kind mis-match
The first argument of `Functor' should have kind `* -> *',
but `Fix (ExprF a)' has kind `*'
In the instance declaration for `Functor (Fix (ExprF a))'
How do I write a Functor instance for Expr2?
I thought about wrapping Expr2 in a newtype with newtype Expr2 a = Expr2 (Fix (ExprF a)) but then this newtype needs to be unwrapped to be passed to cata, which I don't like very much. I also don't know if it would be possible to automatically derive the Expr2 functor instance like I did with Expr1.
This is an old sore for me. The crucial point is that your ExprF is functorial in both its parameters. So if we had
class Bifunctor b where
bimap :: (x1 -> y1) -> (x2 -> y2) -> b x1 x2 -> b y1 y2
then you could define (or imagine a machine defining for you)
instance Bifunctor ExprF where
bimap k1 k2 (Val a) = Val (k1 a)
bimap k1 k2 (Add x y) = Add (k2 x) (k2 y)
and now you can have
newtype Fix2 b a = MkFix2 (b a (Fix2 b a))
accompanied by
map1cata2 :: Bifunctor b => (a -> a') -> (b a' t -> t) -> Fix2 b a -> t
map1cata2 e f (MkFix2 bar) = f (bimap e (map1cata2 e f) bar)
which in turn gives you that when you take a fixpoint in one of the parameters, what's left is still functorial in the other
instance Bifunctor b => Functor (Fix2 b) where
fmap k = map1cata2 k MkFix2
and you sort of get what you wanted. But your Bifunctor instance isn't going to be built by magic. And it's a bit annoying that you need a different fixpoint operator and a whole new kind of functor. The trouble is that you now have two sorts of substructure: "values" and "subexpressions".
And here's the turn. There is a notion of functor which is closed under fixpoints. Turn on the kitchen sink (especially DataKinds) and
type s :-> t = forall x. s x -> t x
class FunctorIx (f :: (i -> *) -> (o -> *)) where
mapIx :: (s :-> t) -> f s :-> f t
Note that "elements" come in a kind indexed over i and "structures" in a kind indexed over some other o. We take i-preserving functions on elements to o preserving functions on structures. Crucially, i and o can be different.
The magic words are "1, 2, 4, 8, time to exponentiate!". A type of kind * can easily be turned into a trivially indexed GADT of kind () -> *. And two types can be rolled together to make a GADT of kind Either () () -> *. That means we can roll both sorts of substructure together. In general, we have a kind of type level either.
data Case :: (a -> *) -> (b -> *) -> Either a b -> * where
CL :: f a -> Case f g (Left a)
CR :: g b -> Case f g (Right b)
equipped with its notion of "map"
mapCase :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g'
mapCase ff gg (CL fx) = CL (ff fx)
mapCase ff gg (CR gx) = CR (gg gx)
So we can refunctor our bifactors as Either-indexed FunctorIx instances.
And now we can take the fixpoint of any node structure f which has places for either elements p or subnodes. It's just the same deal we had above.
newtype FixIx (f :: (Either i o -> *) -> (o -> *))
(p :: i -> *)
(b :: o)
= MkFixIx (f (Case p (FixIx f p)) b)
mapCata :: forall f p q t. FunctorIx f =>
(p :-> q) -> (f (Case q t) :-> t) -> FixIx f p :-> t
mapCata e f (MkFixIx node) = f (mapIx (mapCase e (mapCata e f)) node)
But now, we get the fact that FunctorIx is closed under FixIx.
instance FunctorIx f => FunctorIx (FixIx f) where
mapIx f = mapCata f MkFixIx
Functors on indexed sets (with the extra freedom to vary the index) can be very precise and very powerful. They enjoy many more convenient closure properties than Functors do. I don't suppose they'll catch on.
I wonder if you might be better off using the Free type:
data Free f a
= Pure a
| Wrap (f (Free f a))
deriving Functor
data ExprF r
= Add r r
deriving Functor
This has the added benefit that there are quite a few libraries that work on free monads already, so maybe they'll save you some work.
Nothing wrong with pigworker's answer, but maybe you can use a simpler one as a stepping-stone:
{-# LANGUAGE DeriveFunctor, ScopedTypeVariables #-}
import Prelude hiding (map)
newtype Fix f = Fix { unFix :: f (Fix f) }
-- This is the catamorphism function you hopefully know and love
-- already. Generalizes 'foldr'.
cata :: Functor f => (f r -> r) -> Fix f -> r
cata phi = phi . fmap (cata phi) . unFix
-- The 'Bifunctor' class. You can find this in Hackage, so if you
-- want to use this just use it from there.
--
-- Minimal definition: either 'bimap' or both 'first' and 'second'.
class Bifunctor f where
bimap :: (a -> c) -> (b -> d) -> f a b -> f c d
bimap f g = first f . second g
first :: (a -> c) -> f a b -> f c b
first f = bimap f id
second :: (b -> d) -> f a b -> f a d
second g = bimap id g
-- The generic map function. I wrote this out with
-- ScopedTypeVariables to make it easier to read...
map :: forall f a b. (Functor (f a), Bifunctor f) =>
(a -> b) -> Fix (f a) -> Fix (f b)
map f = cata phi
where phi :: f a (Fix (f b)) -> Fix (f b)
phi = Fix . first f
Now your expression language works like this:
-- This is the base (bi)functor for your expression type.
data ExprF a r = Val a
| Add r r
deriving (Eq, Show, Functor)
instance Bifunctor ExprF where
bimap f g (Val a) = Val (f a)
bimap f g (Add l r) = Add (g l) (g r)
newtype Expr a = Expr (Fix (ExprF a))
instance Functor Expr where
fmap f (Expr exprF) = Expr (map f exprF)
EDIT: Here's a link to the bifunctors package in Hackage.
The keyword type is used only as a synonymous of an existing type, maybe this is what you are looking for
newtype Expr2 a r = In { out :: (ExprF a r)} deriving Functor
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