<div dir="ltr"><div dir="ltr"><br class="">Thanks Alexander and Tran,<div><br></div><div>So I went through the whole process of defining newtype, but it was quite a long process.  My code below.</div><div><br></div><div>Surely it would make more sense if the HashMap monoid were defined in terms of the monoid of its value type?</div>
<div><br></div><div>In that case you could choose the monoid for the value to take the left value, which would be the equivalent of the current behaviour.</div><div><br></div><div>Cheers,</div><div><br></div><div>-John</div>
<div><br></div><div><div><font face="courier new, monospace">import qualified  Control.Applicative as A</font></div><div><font face="courier new, monospace">import            Data.Hashable</font></div><div><font face="courier new, monospace">import qualified  Data.HashMap.Lazy as M</font></div>
<div><font face="courier new, monospace">import            Data.Monoid</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">newtype HashMap k v = HashMap (M.HashMap k v)</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">instance (Eq k, Hashable k, Monoid v) => Monoid (HashMap k v) where</font></div><div><font face="courier new, monospace">  mempty = empty</font></div>
<div><font face="courier new, monospace">  mappend (HashMap a) (HashMap b) = HashMap (M.unionWith mappend a b)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">empty :: HashMap k v</font></div>
<div><font face="courier new, monospace">empty = HashMap M.empty</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">singleton :: Hashable k => k -> v -> HashMap k v</font></div>
<div><font face="courier new, monospace">singleton k v = HashMap (M.singleton k v)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">null :: HashMap k v -> Bool</font></div>
<div><font face="courier new, monospace">null (HashMap m) = M.null m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">size :: HashMap k v -> Int</font></div>
<div><font face="courier new, monospace">size (HashMap m) = M.size $ m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">member :: (Eq k, Hashable k) => k -> HashMap k a -> Bool</font></div>
<div><font face="courier new, monospace">member k (HashMap m) = M.member k m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v</font></div>
<div><font face="courier new, monospace">lookup k (HashMap m) = M.lookup k m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">lookupDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v</font></div>
<div><font face="courier new, monospace">lookupDefault v k (HashMap m) = M.lookupDefault v k m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">(!) :: (Eq k, Hashable k) => HashMap k v -> k -> v</font></div>
<div><font face="courier new, monospace">(!) (HashMap m) k = (M.!) m k</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">insert k v (HashMap m) = HashMap (M.insert k v m)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">insertWith f k v (HashMap m) = HashMap (M.insertWith f k v m)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">delete k (HashMap m) = HashMap $ M.delete k m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">adjust f k (HashMap m) = HashMap $ M.adjust f k m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">union :: (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">union (HashMap a) (HashMap b) = HashMap (M.union a b)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">unionWith f (HashMap a) (HashMap b) = HashMap (M.unionWith f a b)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v</font></div>
<div><font face="courier new, monospace">unions ms = HashMap (M.unions [un m | m <- ms])</font></div><div><font face="courier new, monospace">  where un (HashMap m) = m</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">map  :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2</font></div><div><font face="courier new, monospace">map f (HashMap m) = HashMap (M.map f m)</font></div><div>
<font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">--mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2</font></div><div><font face="courier new, monospace">--mapWithKey f (HashMap m) = HashMap (M.mapWithKey f m)</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">traverseWithKey :: A.Applicative f => (k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)</font></div><div>
<font face="courier new, monospace">traverseWithKey f (HashMap m) = HashMap `fmap` (M.traverseWithKey f m)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">difference :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v</font></div>
<div><font face="courier new, monospace">difference (HashMap a) (HashMap b) = HashMap (M.difference a b)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">intersection :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v</font></div>
<div><font face="courier new, monospace">intersection (HashMap a) (HashMap b) = HashMap (M.intersection a b)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3</font></div>
<div><font face="courier new, monospace">intersectionWith f (HashMap a) (HashMap b) = HashMap (M.intersectionWith f a b)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">foldl' :: (a -> v -> a) -> a -> HashMap k v -> a</font></div>
<div><font face="courier new, monospace">foldl' f v (HashMap m) = M.foldl' f v m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a</font></div>
<div><font face="courier new, monospace">foldlWithKey' f v (HashMap m) = M.foldlWithKey' f v m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">foldr :: (v -> a -> a) -> a -> HashMap k v -> a</font></div>
<div><font face="courier new, monospace">foldr f v (HashMap m) = M.foldr f v m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a</font></div>
<div><font face="courier new, monospace">foldrWithKey f v (HashMap m) = M.foldrWithKey f v m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">filter :: (v -> Bool) -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">filter f (HashMap m) = HashMap (M.filter f m)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">filterWithKey :: (k -> v -> Bool) -> HashMap k v -> HashMap k v</font></div>
<div><font face="courier new, monospace">filterWithKey f (HashMap m) = HashMap (M.filterWithKey f m)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">keys :: HashMap k v -> [k]</font></div>
<div><font face="courier new, monospace">keys (HashMap m) = M.keys m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">elems :: HashMap k v -> [v]</font></div>
<div><font face="courier new, monospace">elems (HashMap m) = M.elems m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">toList :: HashMap k v -> [(k, v)]</font></div>
<div><font face="courier new, monospace">toList (HashMap m) = M.toList m</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v</font></div>
<div><font face="courier new, monospace">fromList kvs = HashMap (M.fromList kvs)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v</font></div>
<div><font face="courier new, monospace">fromListWith f kvs = HashMap (M.fromListWith f kvs)</font></div><div><br></div></div><div><br></div></div><div class=""><div class="h5"><div class="gmail_extra"><br></div></div></div>
</div><div class="gmail_extra"><br><br><div class="gmail_quote">On 10 May 2014 16:07, Alexander V Vershilov <span dir="ltr"><<a href="mailto:alexander.vershilov@gmail.com" target="_blank">alexander.vershilov@gmail.com</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><p dir="ltr">Hi, John.</p>
<p dir="ltr">You can always use newtype wrapper if you need to overload existing method behavior:</p>
<p dir="ltr">newtype MyHashMap a b = MyHashMap { unMy :: HashMap a b}</p>
<p dir="ltr">instance Monoid (MyHasMap a b) where<br>
  mempty = MyHasMap mempty<br>
  mappend a b = your_overloaded_function</p>
<p dir="ltr">Then just wrap and unwrap your data to do a custom mappend, also you can write a wrapper function, in case if you'll restrict types then it may work only for the types you need:</p>
<p dir="ltr">(<~>) :: HashMap Int (HashMap Int Int) -> HashMap Int (HashMap Int Int) -> HashMap Int (HashMap Int Int)<br>
a <~> b = unMy $ (<>) `on` MyHashMap a b</p>
<p dir="ltr">--<br>
Alexander</p>
</blockquote></div><br></div>

<br>
<div style="color:rgb(34,34,34);font-family:arial,sans-serif;background-color:rgb(255,255,255)"><font color="#999999"><a href="http://www.gocatch.com/" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/goCatchlogo.png"></a><br></font></div><font color="#999999" style="font-family:arial,sans-serif;background-color:rgb(255,255,255)">  Sydney, Australia</font><div style="color:rgb(34,34,34);font-family:arial,sans-serif;background-color:rgb(255,255,255)"><font color="#999999"><br></font><div><font color="#999999"> <a href="https://www.facebook.com/goCatch" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/FBsigicon.png"></a> <a href="https://twitter.com/gocatchapp" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/TWsigicon.png"></a> <a href="http://www.linkedin.com/company/goCatch" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/LIsigicon.png"></a>  <a href="https://itunes.apple.com/au/app/gocatch/id444439909?mt=8" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/ASsigicon.png"></a> <a href="https://play.google.com/store/apps/details?id=com.gocatchapp.goCatch&hl=en" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/AMsigicon.png"></a> <a href="http://www.windowsphone.com/en-au/store/app/gocatch/d76b0eb5-bad6-429f-b99e-0ce85d953f93" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/P7sigicon.png"></a> <a href="http://appworld.blackberry.com/webstore/content/31917887/" style="color:rgb(17,85,204)" target="_blank"><img src="http://www.gocatch.com/assets/bbworld.jpg"></a></font></div></div>