<div dir="ltr">I feel a bit silly, but could you explain to me where the overlap is here?<br></div><br><div class="gmail_quote">On Sat Feb 14 2015 at 3:45:30 PM adam vogt <<a href="mailto:vogt.adam@gmail.com">vogt.adam@gmail.com</a>> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi Clinton,<br>
<br>
I think the problem is that the instance:<br>
<br>
> instance (Functor f) => CanMap (f a) b<br>
<br>
is overlapped by instances for containers that take a parameter but<br>
are not instances of Functor. For example:<br>
<br>
> instance (Unbox a, Unbox b) => CanMap (Data.Vector.Unboxed.Vector a) b<br>
<br>
Using {-# LANGUAGE OverlappingInstances #-} is a big deal for some people.<br>
<br>
Regards,<br>
Adam<br>
<br>
On Wed, Feb 11, 2015 at 2:00 PM, Clinton Mead <<a href="mailto:clintonmead@gmail.com" target="_blank">clintonmead@gmail.com</a>> wrote:<br>
> ClassyPrelude has two map functions, namely:<br>
><br>
> 1. "map"<br>
> 2. "omap"<br>
><br>
> "map" works on any Functor. However, things like "Text" are not functors as<br>
> they aren't generic containers. As can be seen in the following code:<br>
><br>
> module Main where<br>
>   import Prelude ()<br>
>   import ClassyPrelude<br>
>   import qualified Data.Text as T<br>
>   import Data.Char as C<br>
><br>
>   main = do<br>
>     let l = [1,2,3] :: [Int]<br>
>     let t = (T.pack "Hello")<br>
>     let m = Just 5<br>
>     print $ map (*2) l<br>
>     print $ map (*2) m<br>
>     print $ omap C.toUpper t<br>
>     return ()<br>
><br>
><br>
> Notice one has to use "omap" to deal with the Text. The thing is, I found it<br>
> trivially easy to get "map" to work for both calls. Here's the code:<br>
><br>
> {-# LANGUAGE MultiParamTypeClasses #-}<br>
> {-# LANGUAGE TypeFamilies #-}<br>
><br>
> module Main where<br>
>   import Prelude hiding (map)<br>
>   import qualified Data.Text as T<br>
>   import Data.Char as C<br>
>   import Control.Monad (Functor)<br>
><br>
>   class CanMap a b where<br>
>     type Element a :: *<br>
>     type Container a b :: *<br>
>     map :: (Element a -> b) -> a -> Container a b<br>
><br>
>   instance (Functor f) => CanMap (f a) b where<br>
>     type Element (f a) = a<br>
>     type Container (f a) b = f b<br>
>     map = fmap<br>
><br>
>   instance CanMap T.Text Char where<br>
>     type Element T.Text = Char<br>
>     type Container T.Text Char = T.Text<br>
>     map = T.map<br>
><br>
>   main = do<br>
>     let l = [1,2,3] :: [Int]<br>
>     let m = Just 5<br>
>     let t = (T.pack "Hello")<br>
>     print $ map (*2) l<br>
>     print $ map (*2) m<br>
>     print $ map C.toUpper t<br>
>     return ()<br>
><br>
><br>
> All that's required is to add instances to CanMap for any monomorphic<br>
> containers. ClassyPrelude already does this anyway with "omap" in the<br>
> Data.MonoTraversable module. I suspect however there's a good reason I'm<br>
> missing about why there should be two separate map functions to deal with<br>
> these alternate situations, but I'm wondering what that is.<br>
><br>
> ______________________________<u></u>_________________<br>
> Haskell-Cafe mailing list<br>
> <a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
> <a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/<u></u>mailman/listinfo/haskell-cafe</a><br>
><br>
______________________________<u></u>_________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/<u></u>mailman/listinfo/haskell-cafe</a><br>
</blockquote></div>