Replace Boilerplate Monoid/Semigroup instances with generics

Cabal/Distribution/PackageDescription.hs

@@ -111,7 +111,7 @@ module Distribution.PackageDescription (
 
 import Distribution.Compat.Binary
 import qualified Distribution.Compat.Semigroup as Semi ((<>))
-import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup)
+import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty, gmappend)
 import qualified Distribution.Compat.ReadP as Parse
 import Distribution.Compat.ReadP   ((<++))
 import Distribution.Package
@@ -314,15 +314,12 @@ data SetupBuildInfo = SetupBuildInfo {
 
 instance Binary SetupBuildInfo
 
-instance Monoid SetupBuildInfo where
-  mempty = SetupBuildInfo {
-    setupDepends = Semi.mempty
-  }
+instance Semi.Monoid SetupBuildInfo where
+  mempty = gmempty
   mappend = (Semi.<>)
 
 instance Semigroup SetupBuildInfo where
-  a <> b = SetupBuildInfo { setupDepends = combine setupDepends }
-    where combine field = field a `mappend` field b
+  (<>) = gmappend
 
 -- ---------------------------------------------------------------------------
 -- Module renaming
@@ -498,11 +495,7 @@ data Executable = Executable {
 instance Binary Executable
 
 instance Monoid Executable where
-  mempty = Executable {
-    exeName    = mempty,
-    modulePath = mempty,
-    buildInfo  = mempty
-  }
+  mempty = gmempty
   mappend = (Semi.<>)
 
 instance Semigroup Executable where

Cabal/Distribution/Simple/Haddock.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveGeneric #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Simple.Haddock
@@ -54,6 +56,7 @@ import Data.Char        ( isSpace )
 import Data.Either      ( rights )
 import Data.Foldable    ( traverse_, foldl' )
 import Data.Maybe       ( fromMaybe, listToMaybe )
+import GHC.Generics     ( Generic )
 
 import System.Directory (doesFileExist)
 import System.FilePath  ( (</>), (<.>)
@@ -97,7 +100,7 @@ data HaddockArgs = HaddockArgs {
  -- ^ To find the correct GHC, required.
  argTargets :: [FilePath]
  -- ^ Modules to process.
-}
+} deriving Generic
 
 -- | The FilePath of a directory, it's a monoid under '(</>)'.
 newtype Directory = Dir { unDir' :: FilePath } deriving (Read,Show,Eq,Ord)
@@ -760,46 +763,11 @@ exeBuildDir lbi exe = buildDir lbi </> exeName exe </> exeName exe ++ "-tmp"
 -- ------------------------------------------------------------------------------
 -- Boilerplate Monoid instance.
 instance Monoid HaddockArgs where
-    mempty = HaddockArgs {
-                argInterfaceFile = mempty,
-                argPackageName = mempty,
-                argHideModules = mempty,
-                argIgnoreExports = mempty,
-                argLinkSource = mempty,
-                argCssFile = mempty,
-                argContents = mempty,
-                argVerbose = mempty,
-                argOutput = mempty,
-                argInterfaces = mempty,
-                argOutputDir = mempty,
-                argTitle = mempty,
-                argPrologue = mempty,
-                argGhcOptions = mempty,
-                argGhcLibDir = mempty,
-                argTargets = mempty
-             }
+    mempty = gmempty
     mappend = (Semi.<>)
 
 instance Semigroup HaddockArgs where
-    a <> b = HaddockArgs {
-                argInterfaceFile = mult argInterfaceFile,
-                argPackageName = mult argPackageName,
-                argHideModules = mult argHideModules,
-                argIgnoreExports = mult argIgnoreExports,
-                argLinkSource = mult argLinkSource,
-                argCssFile = mult argCssFile,
-                argContents = mult argContents,
-                argVerbose = mult argVerbose,
-                argOutput = mult argOutput,
-                argInterfaces = mult argInterfaces,
-                argOutputDir = mult argOutputDir,
-                argTitle = mult argTitle,
-                argPrologue = mult argPrologue,
-                argGhcOptions = mult argGhcOptions,
-                argGhcLibDir = mult argGhcLibDir,
-                argTargets = mult argTargets
-             }
-      where mult f = f a `mappend` f b
+    (<>) = gmappend
 
 instance Monoid Directory where
     mempty = Dir "."

Cabal/Distribution/Simple/InstallDirs.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 
 -----------------------------------------------------------------------------
@@ -90,49 +91,16 @@ data InstallDirs dir = InstallDirs {
         htmldir      :: dir,
         haddockdir   :: dir,
         sysconfdir   :: dir
-    } deriving (Eq, Read, Show, Generic)
+    } deriving (Eq, Read, Show, Functor, Generic)
 
 instance Binary dir => Binary (InstallDirs dir)
 
-instance Functor InstallDirs where
-  fmap f dirs = InstallDirs {
-    prefix       = f (prefix dirs),
-    bindir       = f (bindir dirs),
-    libdir       = f (libdir dirs),
-    libsubdir    = f (libsubdir dirs),
-    dynlibdir    = f (dynlibdir dirs),
-    libexecdir   = f (libexecdir dirs),
-    includedir   = f (includedir dirs),
-    datadir      = f (datadir dirs),
-    datasubdir   = f (datasubdir dirs),
-    docdir       = f (docdir dirs),
-    mandir       = f (mandir dirs),
-    htmldir      = f (htmldir dirs),
-    haddockdir   = f (haddockdir dirs),
-    sysconfdir   = f (sysconfdir dirs)
-  }
-
 instance (Semigroup dir, Monoid dir) => Monoid (InstallDirs dir) where
-  mempty = InstallDirs {
-      prefix       = mempty,
-      bindir       = mempty,
-      libdir       = mempty,
-      libsubdir    = mempty,
-      dynlibdir    = mempty,
-      libexecdir   = mempty,
-      includedir   = mempty,
-      datadir      = mempty,
-      datasubdir   = mempty,
-      docdir       = mempty,
-      mandir       = mempty,
-      htmldir      = mempty,
-      haddockdir   = mempty,
-      sysconfdir   = mempty
-  }
+  mempty = gmempty
   mappend = (Semi.<>)
 
 instance Semigroup dir => Semigroup (InstallDirs dir) where
-  (<>) = combineInstallDirs (<>)
+  (<>) = gmappend
 
 combineInstallDirs :: (a -> b -> c)
                    -> InstallDirs a

Cabal/Distribution/Simple/Program/GHC.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveGeneric #-}
+
 module Distribution.Simple.Program.GHC (
     GhcOptions(..),
     GhcMode(..),
@@ -27,6 +29,7 @@ import Distribution.Verbosity
 import Distribution.Utils.NubList
 import Language.Haskell.Extension
 
+import GHC.Generics (Generic)
 import qualified Data.Map as M
 
 -- | A structured set of GHC options/flags
@@ -211,7 +214,7 @@ data GhcOptions = GhcOptions {
   -- Modifies some of the GHC error messages.
   ghcOptCabal         :: Flag Bool
 
-} deriving Show
+} deriving (Show, Generic)
 
 
 data GhcMode = GhcModeCompile     -- ^ @ghc -c@
@@ -496,116 +499,8 @@ packageDbArgs implInfo
 -- Boilerplate Monoid instance for GhcOptions
 
 instance Monoid GhcOptions where
-  mempty = GhcOptions {
-    ghcOptMode               = mempty,
-    ghcOptExtra              = mempty,
-    ghcOptExtraDefault       = mempty,
-    ghcOptInputFiles         = mempty,
-    ghcOptInputModules       = mempty,
-    ghcOptOutputFile         = mempty,
-    ghcOptOutputDynFile      = mempty,
-    ghcOptSourcePathClear    = mempty,
-    ghcOptSourcePath         = mempty,
-    ghcOptThisUnitId         = mempty,
-    ghcOptPackageDBs         = mempty,
-    ghcOptPackages           = mempty,
-    ghcOptHideAllPackages    = mempty,
-    ghcOptNoAutoLinkPackages = mempty,
-    ghcOptLinkLibs           = mempty,
-    ghcOptLinkLibPath        = mempty,
-    ghcOptLinkOptions        = mempty,
-    ghcOptLinkFrameworks     = mempty,
-    ghcOptLinkFrameworkDirs  = mempty,
-    ghcOptNoLink             = mempty,
-    ghcOptLinkNoHsMain       = mempty,
-    ghcOptCcOptions          = mempty,
-    ghcOptCppOptions         = mempty,
-    ghcOptCppIncludePath     = mempty,
-    ghcOptCppIncludes        = mempty,
-    ghcOptFfiIncludes        = mempty,
-    ghcOptLanguage           = mempty,
-    ghcOptExtensions         = mempty,
-    ghcOptExtensionMap       = mempty,
-    ghcOptOptimisation       = mempty,
-    ghcOptDebugInfo          = mempty,
-    ghcOptProfilingMode      = mempty,
-    ghcOptProfilingAuto      = mempty,
-    ghcOptSplitObjs          = mempty,
-    ghcOptNumJobs            = mempty,
-    ghcOptHPCDir             = mempty,
-    ghcOptGHCiScripts        = mempty,
-    ghcOptHiSuffix           = mempty,
-    ghcOptObjSuffix          = mempty,
-    ghcOptDynHiSuffix        = mempty,
-    ghcOptDynObjSuffix       = mempty,
-    ghcOptHiDir              = mempty,
-    ghcOptObjDir             = mempty,
-    ghcOptOutputDir          = mempty,
-    ghcOptStubDir            = mempty,
-    ghcOptDynLinkMode        = mempty,
-    ghcOptShared             = mempty,
-    ghcOptFPic               = mempty,
-    ghcOptDylibName          = mempty,
-    ghcOptRPaths             = mempty,
-    ghcOptVerbosity          = mempty,
-    ghcOptCabal              = mempty
-  }
+  mempty = gmempty
   mappend = (Semi.<>)
 
 instance Semigroup GhcOptions where
-  a <> b = GhcOptions {
-    ghcOptMode               = combine ghcOptMode,
-    ghcOptExtra              = combine ghcOptExtra,
-    ghcOptExtraDefault       = combine ghcOptExtraDefault,
-    ghcOptInputFiles         = combine ghcOptInputFiles,
-    ghcOptInputModules       = combine ghcOptInputModules,
-    ghcOptOutputFile         = combine ghcOptOutputFile,
-    ghcOptOutputDynFile      = combine ghcOptOutputDynFile,
-    ghcOptSourcePathClear    = combine ghcOptSourcePathClear,
-    ghcOptSourcePath         = combine ghcOptSourcePath,
-    ghcOptThisUnitId         = combine ghcOptThisUnitId,
-    ghcOptPackageDBs         = combine ghcOptPackageDBs,
-    ghcOptPackages           = combine ghcOptPackages,
-    ghcOptHideAllPackages    = combine ghcOptHideAllPackages,
-    ghcOptNoAutoLinkPackages = combine ghcOptNoAutoLinkPackages,
-    ghcOptLinkLibs           = combine ghcOptLinkLibs,
-    ghcOptLinkLibPath        = combine ghcOptLinkLibPath,
-    ghcOptLinkOptions        = combine ghcOptLinkOptions,
-    ghcOptLinkFrameworks     = combine ghcOptLinkFrameworks,
-    ghcOptLinkFrameworkDirs  = combine ghcOptLinkFrameworkDirs,
-    ghcOptNoLink             = combine ghcOptNoLink,
-    ghcOptLinkNoHsMain       = combine ghcOptLinkNoHsMain,
-    ghcOptCcOptions          = combine ghcOptCcOptions,
-    ghcOptCppOptions         = combine ghcOptCppOptions,
-    ghcOptCppIncludePath     = combine ghcOptCppIncludePath,
-    ghcOptCppIncludes        = combine ghcOptCppIncludes,
-    ghcOptFfiIncludes        = combine ghcOptFfiIncludes,
-    ghcOptLanguage           = combine ghcOptLanguage,
-    ghcOptExtensions         = combine ghcOptExtensions,
-    ghcOptExtensionMap       = combine ghcOptExtensionMap,
-    ghcOptOptimisation       = combine ghcOptOptimisation,
-    ghcOptDebugInfo          = combine ghcOptDebugInfo,
-    ghcOptProfilingMode      = combine ghcOptProfilingMode,
-    ghcOptProfilingAuto      = combine ghcOptProfilingAuto,
-    ghcOptSplitObjs          = combine ghcOptSplitObjs,
-    ghcOptNumJobs            = combine ghcOptNumJobs,
-    ghcOptHPCDir             = combine ghcOptHPCDir,
-    ghcOptGHCiScripts        = combine ghcOptGHCiScripts,
-    ghcOptHiSuffix           = combine ghcOptHiSuffix,
-    ghcOptObjSuffix          = combine ghcOptObjSuffix,
-    ghcOptDynHiSuffix        = combine ghcOptDynHiSuffix,
-    ghcOptDynObjSuffix       = combine ghcOptDynObjSuffix,
-    ghcOptHiDir              = combine ghcOptHiDir,
-    ghcOptObjDir             = combine ghcOptObjDir,
-    ghcOptOutputDir          = combine ghcOptOutputDir,
-    ghcOptStubDir            = combine ghcOptStubDir,
-    ghcOptDynLinkMode        = combine ghcOptDynLinkMode,
-    ghcOptShared             = combine ghcOptShared,
-    ghcOptFPic               = combine ghcOptFPic,
-    ghcOptDylibName          = combine ghcOptDylibName,
-    ghcOptRPaths             = combine ghcOptRPaths,
-    ghcOptVerbosity          = combine ghcOptVerbosity,
-    ghcOptCabal              = combine ghcOptCabal
-  }
-    where
-      combine field = field a `mappend` field b
+  (<>) = gmappend