<div dir="ltr"><div>I've been thinking about generalising Functor, as I had something which was "Functor like" but didn't seem to fit into the existing definition. The example I'll present isn't the problem I was trying to solve, but it probably illustrates the solution better. The questions I have is:<br></div><div>1. Is this useful?</div><div>2. Has this been done?</div><div><br></div><div>If the answers are Yes and No, I'll continue on into making this into a package.</div><div><br></div><div>Anyway, here's what I've done:<br><div><br></div><div>As we know, the type signature of fmap is the following:<br></div><div><br></div><div>fmap :: Functor f => (a -> b) -> (f a -> f b)</div><div><br></div><div>I've put brackets around the last two arguments to show that fmap can be also seen as a function which takes a function and returns a new function, in a different "space", for want of a better word.</div><div><br></div><div>fmap should also follow this rule:</div><div><br></div><div>fmap (f . g) == (fmap f . fmap g)</div><div><br></div><div>So we can map an ordinary function into the "Maybe" space, but in a way that composing functions in the putting them in the space is the same as putting them in the space then composing them.</div><div><br></div><div>I thought it would be nice if we could fmap to Kleisli Arrows, like so:</div><div><br></div><div>fmap :: Monad m => (a -> b) -> Kleisli m a b</div><div><br></div><div>Of course this is just "arr". But "arr" follows fmap's rules, so I thought it would be nice to make it a functor.</div><div><br></div><div>So I was looking for more generalised versions of "Functor", and I found the 'categories' package, which had the following definition:</div></div><div><br></div><div><br></div><div><span class="" style="margin:0px;padding:0px;color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px">class</span><span style="color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px;background-color:rgb(240,240,240)"> (</span><a href="https://hackage.haskell.org/package/base-4.7.0.1/docs/Control-Category.html#t:Category" style="margin:0px;padding:0px;text-decoration:none;color:rgb(171,105,84);font-family:monospace;font-size:13px;line-height:16.1200008392334px">Category</a><span style="color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px;background-color:rgb(240,240,240)"> r, </span><a href="https://hackage.haskell.org/package/base-4.7.0.1/docs/Control-Category.html#t:Category" style="margin:0px;padding:0px;text-decoration:none;color:rgb(171,105,84);font-family:monospace;font-size:13px;line-height:16.1200008392334px">Category</a><span style="color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px;background-color:rgb(240,240,240)"> t) => </span><a name="t:Functor" class="" style="margin:0px;padding:0px;font-weight:bold;color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px">Functor</a><span style="color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px;background-color:rgb(240,240,240)"> f r t | f r -> t, f t -> r </span><span class="" style="margin:0px;padding:0px;color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px">where<br></span><a name="v:fmap" class="" style="margin:0px;padding:0px;font-weight:bold;color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px">  fmap</a><span style="color:rgb(0,0,0);font-family:monospace;font-size:13px;line-height:16.1200008392334px;background-color:rgb(240,240,240)"> :: r a b -> t (f a) (f b)</span><br></div><div><br></div><div>This solves half my problem, as now I can set r = (->) and t = Kleisli m and I've got the categories right. But it forces the "output" category to have a data constructor.</div><div><br></div><div>So:<br><br>fmap :: Monad m => (a -> b) -> Kleisli m a b<br><br>Just won't fit. I'd need to make it:<br><br>fmap :: Monad m => (a -> b) -> Kleisli m (Id a) (Id b)<br></div><div><br>and then unwrap the results. I found this ugly though.</div><div><br></div><div>So I've gone with another approached. I've linked the code here: <a href="http://ideone.com/TEg4MN">http://ideone.com/TEg4MN</a> and also included it inline at the bottom of this mail. <br><br>Defining functors now becomes a bit wordy, but basically what I've defined is two functor instances. The first is just a copy of the existing functor instances to maintain the status quo behaviour. But secondly I've defined the Kleisli instance as discussed above.<br><br>The "main" line, does two calls to fmap. The outermost (on the left) is just an ordinary fmap call on lists. The innermost, fmaps the function "triple" into a Kleisli Arrow, allowing it to be composed with the the Kleisli arrow already defined, 'evenOrNothing'. Type inference works this all out magically without signatures being required. <br><br>Like I said, is approach new and useful? Improvements would be appreciated also, I'm only over the last few months really started focusing on learning Haskell properly (after leaving my previous job of 8 years), so I'm sure I'm still doing plenty of things not quite right.<br><br>Thanks,</div><div><br></div><div>Clinton</div><div><br></div><div>---</div><div><br></div><div><div><br></div><div>{-# LANGUAGE TypeFamilies #-}</div><div>{-# LANGUAGE FlexibleContexts #-}</div><div><br></div><div>module Main (</div><div>    main</div><div>) where</div><div><br></div><div>import qualified Control.Arrow</div><div>import Prelude hiding (Functor, fmap, (.))</div><div>import Control.Category (Category, (.))</div><div>import qualified Data.Functor</div><div>import qualified Control.Arrow</div><div>import Control.Arrow (Kleisli(Kleisli), runKleisli)</div><div><br></div><div>type family F (r :: (* -> * -> *)) (t :: (* -> * -> *)) x</div><div>type family InputParam f x</div><div>type family ResultParam f x</div><div>type family InputCategory f :: (* -> * -> *)</div><div>type family ResultCategory f :: (* -> * -> *)</div><div><br></div><div>class Functor f where</div><div>  fmap ::</div><div>    (</div><div>      Category r, Category t,</div><div>      f ~ F r t c, f ~ F r t d,</div><div>      r ~ InputCategory f, t ~ ResultCategory f,</div><div>      a ~ InputParam f c, b ~ InputParam f d,</div><div>      c ~ ResultParam f a, d ~ ResultParam f b</div><div>    ) =></div><div>      r a b -> t c d</div><div><br></div><div><br></div><div>data OrdinaryFunctor :: (* -> *) -> *</div><div>type instance F (->) (->) (f a) = OrdinaryFunctor f</div><div>type instance InputParam (OrdinaryFunctor f) (f a) = a</div><div>type instance ResultParam (OrdinaryFunctor f) a = f a</div><div>type instance InputCategory (OrdinaryFunctor f) = (->)</div><div>type instance ResultCategory (OrdinaryFunctor f) = (->)</div><div><br></div><div>instance (Data.Functor.Functor f) => Functor (OrdinaryFunctor f) where</div><div>  fmap = Data.Functor.fmap</div><div><br></div><div>data KleisliFunctor :: (* -> *) -> *</div><div>type instance F (->) (Kleisli m) a = KleisliFunctor m</div><div>type instance InputParam (KleisliFunctor f) a = a</div><div>type instance ResultParam (KleisliFunctor m) a = a</div><div>type instance InputCategory (KleisliFunctor m) = (->)</div><div>type instance ResultCategory (KleisliFunctor m) = Kleisli m</div><div><br></div><div>instance (Monad m) => Functor (KleisliFunctor m) where</div><div>  fmap = Control.Arrow.arr</div><div><br></div><div>triple = (*3)</div><div>evenOrNothing = Kleisli (\x -> if (even x) then Just x else Nothing)</div><div><br></div><div>main = print $ fmap (runKleisli (evenOrNothing . fmap triple)) [3..6]</div></div><div><br></div></div>