summaryrefslogtreecommitdiff
path: root/libraries/base/Data
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/base/Data')
-rw-r--r--libraries/base/Data/Either.hs5
-rw-r--r--libraries/base/Data/Maybe.hs16
-rw-r--r--libraries/base/Data/Monoid.hs99
-rw-r--r--libraries/base/Data/Proxy.hs11
4 files changed, 33 insertions, 98 deletions
diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs
index cf45e79456..5b3b5e2e70 100644
--- a/libraries/base/Data/Either.hs
+++ b/libraries/base/Data/Either.hs
@@ -56,6 +56,11 @@ instance Functor (Either a) where
fmap _ (Left x) = Left x
fmap f (Right y) = Right (f y)
+instance Applicative (Either e) where
+ pure = Right
+ Left e <*> _ = Left e
+ Right f <*> r = fmap f r
+
instance Monad (Either e) where
return = Right
Left l >>= _ = Left l
diff --git a/libraries/base/Data/Maybe.hs b/libraries/base/Data/Maybe.hs
index fe2a0abc1e..991a25cb12 100644
--- a/libraries/base/Data/Maybe.hs
+++ b/libraries/base/Data/Maybe.hs
@@ -49,10 +49,26 @@ import GHC.Base
data Maybe a = Nothing | Just a
deriving (Eq, Ord)
+-- | 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
+ mempty = Nothing
+ Nothing `mappend` m = m
+ m `mappend` Nothing = m
+ Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
+
instance Functor Maybe where
fmap _ Nothing = Nothing
fmap f (Just a) = Just (f a)
+instance Applicative Maybe where
+ pure = return
+ (<*>) = liftA2 id
+
instance Monad Maybe where
(Just x) >>= k = k x
Nothing >>= _ = Nothing
diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs
index b71176b19c..4bd1839559 100644
--- a/libraries/base/Data/Monoid.hs
+++ b/libraries/base/Data/Monoid.hs
@@ -46,7 +46,6 @@ import GHC.Read
import GHC.Show
import GHC.Generics
import Data.Maybe
-import Data.Proxy
{-
-- just for testing
@@ -54,42 +53,6 @@ import Data.Maybe
import Test.QuickCheck
-- -}
--- ---------------------------------------------------------------------------
--- | The class of monoids (types with an associative binary operation that
--- has an identity). Instances should satisfy the following laws:
---
--- * @mappend mempty x = x@
---
--- * @mappend x mempty = x@
---
--- * @mappend x (mappend y z) = mappend (mappend x y) z@
---
--- * @mconcat = 'foldr' mappend mempty@
---
--- The method names refer to the monoid of lists under concatenation,
--- but there are many other instances.
---
--- Minimal complete definition: 'mempty' and 'mappend'.
---
--- Some types can be viewed as a monoid in more than one way,
--- e.g. both addition and multiplication on numbers.
--- In such cases we often define @newtype@s and make those instances
--- of 'Monoid', e.g. 'Sum' and 'Product'.
-
-class Monoid a where
- mempty :: a
- -- ^ Identity of 'mappend'
- mappend :: a -> a -> a
- -- ^ An associative operation
- mconcat :: [a] -> a
-
- -- ^ Fold a list using the monoid.
- -- For most types, the default definition for 'mconcat' will be
- -- used, but the function is included in the class definition so
- -- that an optimized version can be provided for specific types.
-
- mconcat = foldr mappend mempty
-
infixr 6 <>
-- | An infix synonym for 'mappend'.
@@ -101,55 +64,6 @@ infixr 6 <>
-- Monoid instances.
-instance Monoid [a] where
- mempty = []
- mappend = (++)
-
-instance Monoid b => Monoid (a -> b) where
- mempty _ = mempty
- mappend f g x = f x `mappend` g x
-
-instance Monoid () where
- -- Should it be strict?
- mempty = ()
- _ `mappend` _ = ()
- mconcat _ = ()
-
-instance (Monoid a, Monoid b) => Monoid (a,b) where
- mempty = (mempty, mempty)
- (a1,b1) `mappend` (a2,b2) =
- (a1 `mappend` a2, b1 `mappend` b2)
-
-instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
- mempty = (mempty, mempty, mempty)
- (a1,b1,c1) `mappend` (a2,b2,c2) =
- (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
-
-instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
- mempty = (mempty, mempty, mempty, mempty)
- (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
- (a1 `mappend` a2, b1 `mappend` b2,
- c1 `mappend` c2, d1 `mappend` d2)
-
-instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
- Monoid (a,b,c,d,e) where
- mempty = (mempty, mempty, mempty, mempty, mempty)
- (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
- (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
- d1 `mappend` d2, e1 `mappend` e2)
-
--- lexicographical ordering
-instance Monoid Ordering where
- mempty = EQ
- LT `mappend` _ = LT
- EQ `mappend` y = y
- GT `mappend` _ = GT
-
-instance Monoid (Proxy s) where
- mempty = Proxy
- mappend _ _ = Proxy
- mconcat _ = Proxy
-
-- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
newtype Dual a = Dual { getDual :: a }
deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
@@ -229,18 +143,6 @@ instance Num a => Monoid (Product a) where
-- 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
- mempty = Nothing
- Nothing `mappend` m = m
- m `mappend` Nothing = m
- Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
-
-- | Maybe monoid returning the leftmost non-Nothing value.
newtype First a = First { getFirst :: Maybe a }
@@ -251,6 +153,7 @@ instance Monoid (First a) where
r@(First (Just _)) `mappend` _ = r
First Nothing `mappend` r = r
+
-- | Maybe monoid returning the rightmost non-Nothing value.
newtype Last a = Last { getLast :: Maybe a }
deriving (Eq, Ord, Read, Show, Generic, Generic1)
diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs
index ab89066cfa..38a43b0b0f 100644
--- a/libraries/base/Data/Proxy.hs
+++ b/libraries/base/Data/Proxy.hs
@@ -69,10 +69,21 @@ instance Bounded (Proxy s) where
minBound = Proxy
maxBound = Proxy
+instance Monoid (Proxy s) where
+ mempty = Proxy
+ mappend _ _ = Proxy
+ mconcat _ = Proxy
+
instance Functor Proxy where
fmap _ _ = Proxy
{-# INLINE fmap #-}
+instance Applicative Proxy where
+ pure _ = Proxy
+ {-# INLINE pure #-}
+ _ <*> _ = Proxy
+ {-# INLINE (<*>) #-}
+
instance Monad Proxy where
return _ = Proxy
{-# INLINE return #-}
View Lorry Controller Status