[Haskell-cafe] Rationale for two separate map functions in ClassyPrelude
Amos Robinson
amos.robinson at gmail.com
Sat Feb 14 04:52:14 UTC 2015
I feel a bit silly, but could you explain to me where the overlap is here?
On Sat Feb 14 2015 at 3:45:30 PM adam vogt <vogt.adam at gmail.com> wrote:
> Hi Clinton,
>
> I think the problem is that the instance:
>
> > instance (Functor f) => CanMap (f a) b
>
> is overlapped by instances for containers that take a parameter but
> are not instances of Functor. For example:
>
> > instance (Unbox a, Unbox b) => CanMap (Data.Vector.Unboxed.Vector a) b
>
> Using {-# LANGUAGE OverlappingInstances #-} is a big deal for some people.
>
> Regards,
> Adam
>
> On Wed, Feb 11, 2015 at 2:00 PM, Clinton Mead <clintonmead at gmail.com>
> wrote:
> > ClassyPrelude has two map functions, namely:
> >
> > 1. "map"
> > 2. "omap"
> >
> > "map" works on any Functor. However, things like "Text" are not functors
> as
> > they aren't generic containers. As can be seen in the following code:
> >
> > module Main where
> > import Prelude ()
> > import ClassyPrelude
> > import qualified Data.Text as T
> > import Data.Char as C
> >
> > main = do
> > let l = [1,2,3] :: [Int]
> > let t = (T.pack "Hello")
> > let m = Just 5
> > print $ map (*2) l
> > print $ map (*2) m
> > print $ omap C.toUpper t
> > return ()
> >
> >
> > Notice one has to use "omap" to deal with the Text. The thing is, I
> found it
> > trivially easy to get "map" to work for both calls. Here's the code:
> >
> > {-# LANGUAGE MultiParamTypeClasses #-}
> > {-# LANGUAGE TypeFamilies #-}
> >
> > module Main where
> > import Prelude hiding (map)
> > import qualified Data.Text as T
> > import Data.Char as C
> > import Control.Monad (Functor)
> >
> > class CanMap a b where
> > type Element a :: *
> > type Container a b :: *
> > map :: (Element a -> b) -> a -> Container a b
> >
> > instance (Functor f) => CanMap (f a) b where
> > type Element (f a) = a
> > type Container (f a) b = f b
> > map = fmap
> >
> > instance CanMap T.Text Char where
> > type Element T.Text = Char
> > type Container T.Text Char = T.Text
> > map = T.map
> >
> > main = do
> > let l = [1,2,3] :: [Int]
> > let m = Just 5
> > let t = (T.pack "Hello")
> > print $ map (*2) l
> > print $ map (*2) m
> > print $ map C.toUpper t
> > return ()
> >
> >
> > All that's required is to add instances to CanMap for any monomorphic
> > containers. ClassyPrelude already does this anyway with "omap" in the
> > Data.MonoTraversable module. I suspect however there's a good reason I'm
> > missing about why there should be two separate map functions to deal with
> > these alternate situations, but I'm wondering what that is.
> >
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20150214/1069efc0/attachment.html>
More information about the Haskell-Cafe
mailing list