<div dir="ltr">ClassyPrelude has two map functions, namely:<div><br></div><div>1. "map"</div><div>2. "omap"</div><div><br></div><div>"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:</div><div><br></div><blockquote style="margin:0px 0px 0px 40px;border:none;padding:0px"><div><div>module Main where</div></div><div><div>  import Prelude ()</div></div><div><div>  import ClassyPrelude</div></div><div><div>  import qualified Data.Text as T</div></div><div><div>  import Data.Char as C</div></div><div><div><br></div></div><div><div>  main = do</div></div><div><div>    let l = [1,2,3] :: [Int]</div></div><div><div>    let t = (T.pack "Hello")</div></div><div><div>    let m = Just 5</div></div><div><div>    print $ map (*2) l</div></div><div><div>    print $ map (*2) m</div></div><div><div>    print $ omap C.toUpper t</div></div><div><div>    return ()</div></div></blockquote><blockquote style="margin:0px 0px 0px 40px;border:none;padding:0px"><div><br></div></blockquote><div>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:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div>{-# LANGUAGE MultiParamTypeClasses #-}</div></div><div><div>{-# LANGUAGE TypeFamilies #-}</div></div><div><br></div></blockquote><blockquote style="margin:0px 0px 0px 40px;border:none;padding:0px"><div><div>module Main where</div></div><div><div>  import Prelude hiding (map)</div></div><div><div>  import qualified Data.Text as T</div></div><div><div>  import Data.Char as C</div></div><div><div>  import Control.Monad (Functor)</div></div><div><div><br></div></div><div><div>  class CanMap a b where</div></div><div><div>    type Element a :: *</div></div><div><div>    type Container a b :: *</div></div><div><div>    map :: (Element a -> b) -> a -> Container a b</div></div><div><div><br></div></div><div><div>  instance (Functor f) => CanMap (f a) b where</div></div><div><div>    type Element (f a) = a</div></div><div><div>    type Container (f a) b = f b</div></div><div><div>    map = fmap    </div></div><div><div>      </div></div><div><div>  instance CanMap T.Text Char where</div></div><div><div>    type Element T.Text = Char</div></div><div><div>    type Container T.Text Char = T.Text</div></div><div><div>    map = T.map</div></div><div><div>    </div></div><div><div>  main = do</div></div><div><div>    let l = [1,2,3] :: [Int]</div></div><div><div>    let m = Just 5</div></div><div><div>    let t = (T.pack "Hello")</div></div><div><div>    print $ map (*2) l</div></div><div><div>    print $ map (*2) m</div></div><div><div>    print $ map C.toUpper t</div></div><div><div>    return ()</div></div></blockquote><div><br></div><div>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.</div></div>