Commit 916a502a authored by Duncan Coutts's avatar Duncan Coutts Committed by Edward Z. Yang
Browse files

Introduce (but not yet use) monoids MapLast and MapMappend

These are newtype wrappers with different Monoid instances. This is for
following our more recent approach to the Monoid instances of our config
types where rather than having custom mappen methods, we derive generic
Monoid/Semigroup instances and rely on using special types like NubList
for individual fields that need different mappend behaviour.

The Map type has mappend behaviour that is not usually what we want for
our configuration types. The normal Map mappend prefers the first
argument over the second when keys overlap between the two maps. We
normally want later things to either override or to extend, like our
normal Flag (like Last) monoid or list monoid. So MapLast is a Map with
Flag/Last-like behaviour, ie flip Map.union, while MapMappend is a Map
that merges values when keys overlap, ie Map.unionWith (<>). The latter
helps when the Map values are lists or further records.
parent e8e29025
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-- | Handling project configuration, types.
--
......@@ -14,6 +14,9 @@ module Distribution.Client.ProjectConfig.Types (
SolverSettings(..),
BuildTimeSettings(..),
-- * Extra useful Monoids
MapLast(..),
MapMappend(..),
) where
import Distribution.Client.Types
......@@ -46,6 +49,7 @@ import Distribution.Verbosity
( Verbosity )
import Data.Map (Map)
import qualified Data.Map as Map
import Distribution.Compat.Binary (Binary)
import Distribution.Compat.Semigroup
import GHC.Generics (Generic)
......@@ -228,6 +232,34 @@ instance Binary ProjectConfigShared
instance Binary PackageConfig
-- | Newtype wrapper for 'Map' that provides a 'Monoid' instance that takes
-- the last value rather than the first value for overlapping keys.
newtype MapLast k v = MapLast { getMapLast :: Map k v }
deriving (Eq, Show, Functor, Generic, Binary)
instance Ord k => Monoid (MapLast k v) where
mempty = MapLast Map.empty
mappend = (<>)
instance Ord k => Semigroup (MapLast k v) where
MapLast a <> MapLast b = MapLast (flip Map.union a b)
-- rather than Map.union which is the normal Map monoid instance
-- | Newtype wrapper for 'Map' that provides a 'Monoid' instance that
-- 'mappend's values of overlapping keys rather than taking the first.
newtype MapMappend k v = MapMappend { getMapMappend :: Map k v }
deriving (Eq, Show, Functor, Generic, Binary)
instance (Semigroup v, Ord k) => Monoid (MapMappend k v) where
mempty = MapMappend Map.empty
mappend = (<>)
instance (Semigroup v, Ord k) => Semigroup (MapMappend k v) where
MapMappend a <> MapMappend b = MapMappend (Map.unionWith (<>) a b)
-- rather than Map.union which is the normal Map monoid instance
instance Monoid ProjectConfig where
mempty = gmempty
mappend = (<>)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment