Attached is a git patch for base which makes the proposed changes.
From 824bdca994b3fcceff21fcb68e1b18f1d4f03bd5 Mon Sep 17 00:00:00 2001
From: Bas van Dijk <v.dijk....@gmail.com>
Date: Fri, 16 Dec 2011 15:16:14 +0100
Subject: [PATCH] Give the Maybe Monoid the expected
 failure-and-prioritized-choice semantics instead of the
 lift-a-semigroup-to-a-monoid semantics. The old semantics
 didn't even achieve the latter since it required a Monoid
 instance on a, rather than a semigroup Also DEPRECATE First
 in favor of Maybe and Last in favor of Dual.

---
 Data/Monoid.hs |   46 ++++++++++++++++++++--------------------------
 1 files changed, 20 insertions(+), 26 deletions(-)

diff --git a/Data/Monoid.hs b/Data/Monoid.hs
index 228e254..d1d9564 100644
--- a/Data/Monoid.hs
+++ b/Data/Monoid.hs
@@ -186,14 +186,14 @@ instance Num a => Monoid (Product a) where
 --
 -- @
 -- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
--- findLast pred = getLast . foldMap (\x -> if pred x
---                                            then Last (Just x)
---                                            else Last Nothing)
+-- findLast pred = getDual . foldMap (\x -> if pred x
+--                                            then Dual (Just x)
+--                                            else Dual Nothing)
 -- @
 --
 -- Much of Data.Map's interface can be implemented with
 -- Data.Map.alter. Some of the rest can be implemented with a new
--- @alterA@ function and either 'First' or 'Last':
+-- @alterA@ function and either 'Maybe' or 'Dual Maybe':
 --
 -- > alterA :: (Applicative f, Ord k) =>
 -- >           (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
@@ -204,28 +204,21 @@ instance Num a => Monoid (Product a) where
 -- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
 --                     -> Map k v -> (Maybe v, Map k v)
 -- insertLookupWithKey combine key value =
---   Arrow.first getFirst . alterA doChange key
+--   alterA doChange key
 --   where
---   doChange Nothing = (First Nothing, Just value)
---   doChange (Just oldValue) =
---     (First (Just oldValue),
---      Just (combine key value oldValue))
+--   doChange m@Nothing         = (m, Just value)
+--   doChange m@(Just oldValue) = (m, Just (combine key value oldValue))
 -- @
 
--- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
--- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be
--- turned into a monoid simply by adjoining an element @e@ not in @S@
--- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since
--- there is no \"Semigroup\" typeclass providing just 'mappend', we
--- use 'Monoid' instead.
-instance Monoid a => Monoid (Maybe a) where
+instance Monoid (Maybe a) where
   mempty = Nothing
-  Nothing `mappend` m = m
-  m `mappend` Nothing = m
-  Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
-
+  Nothing `mappend` r = r
+  l       `mappend` _ = l
 
 -- | Maybe monoid returning the leftmost non-Nothing value.
+--
+-- /DEPRECATED in favor of 'Maybe'!/
+{-# DEPRECATED First "Use Maybe instead" #-}
 newtype First a = First { getFirst :: Maybe a }
 #ifndef __HADDOCK__
         deriving (Eq, Ord, Read, Show)
@@ -237,11 +230,13 @@ instance Show a => Show (First a)
 #endif
 
 instance Monoid (First a) where
-        mempty = First Nothing
-        r@(First (Just _)) `mappend` _ = r
-        First Nothing `mappend` r = r
+        mempty = First mempty
+        First l `mappend` First r = First (l `mappend` r)
 
 -- | Maybe monoid returning the rightmost non-Nothing value.
+--
+-- /DEPRECATED in favor of 'Dual'!/
+{-# DEPRECATED Last "Use Dual instead" #-}
 newtype Last a = Last { getLast :: Maybe a }
 #ifndef __HADDOCK__
         deriving (Eq, Ord, Read, Show)
@@ -253,9 +248,8 @@ instance Show a => Show (Last a)
 #endif
 
 instance Monoid (Last a) where
-        mempty = Last Nothing
-        _ `mappend` r@(Last (Just _)) = r
-        r `mappend` Last Nothing = r
+        mempty = Last mempty
+        Last x `mappend` Last y = Last (y `mappend` x)
 
 {-
 {--------------------------------------------------------------------
-- 
1.7.5.4

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to