From 9228bda32f0a3f6d52e7cc5eb444376e7b024d8c Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 23 Apr 2018 13:20:13 -0400
Subject: semigroup monoid change fallout; drop ghc 7 support

Fix build with ghc 8.4, which broke due to the Semigroup Monoid change.
See https://prime.haskell.org/wiki/Libraries/Proposals/SemigroupMonoid

Dropped support for building propellor with ghc 7 (as in debian
oldstable), to avoid needing to depend on the semigroups transitional
package, but also because it's just too old to be worth supporting.

If we indeed drop ghc 7 support entirely, some code to support "jessie"
can be removed; concurrent-output can be de-embedded, and the Singletons
code can be simplified.

This commit was sponsored by Jack Hill on Patreon.
---
 src/Propellor/DotDir.hs                      |  2 +-
 src/Propellor/PrivData.hs                    |  3 ++-
 src/Propellor/Property/Ccache.hs             |  6 +++++-
 src/Propellor/Property/Conductor.hs          |  7 ++++---
 src/Propellor/Property/Debootstrap.hs        |  8 ++++++--
 src/Propellor/Property/DiskImage/PartSpec.hs |  8 ++++++--
 src/Propellor/Property/Firewall.hs           |  6 +++++-
 src/Propellor/Property/FreeBSD/Pkg.hs        |  6 ++++--
 src/Propellor/Property/FreeBSD/Poudriere.hs  |  7 ++++---
 src/Propellor/Property/Installer/Target.hs   |  6 +++++-
 src/Propellor/Property/Mount.hs              |  3 ++-
 src/Propellor/Property/Parted.hs             | 20 +++++++++++++-------
 src/Propellor/Property/Parted/Types.hs       | 23 ++++++++++++++++-------
 src/Propellor/Property/Ssh.hs                | 17 ++++++++++++-----
 src/Propellor/Types/Chroot.hs                | 21 ++++++++++++++-------
 src/Propellor/Types/Core.hs                  | 10 +++++++---
 src/Propellor/Types/Dns.hs                   | 16 ++++++++++------
 src/Propellor/Types/Docker.hs                | 10 +++++++---
 src/Propellor/Types/Info.hs                  | 10 +++++++---
 src/Propellor/Types/Result.hs                | 15 +++++++++------
 20 files changed, 139 insertions(+), 65 deletions(-)

(limited to 'src')

diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 125cec3f..dc881eeb 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -271,7 +271,7 @@ minimalConfig = do
 		, "  Main-Is: config.hs"
 		, "  GHC-Options: -threaded -Wall -fno-warn-tabs -O0"
 		, "  Extensions: TypeOperators"
-		, "  Build-Depends: propellor >= 3.0, base >= 3"
+		, "  Build-Depends: propellor >= 3.0, base >= 4.9"
 		]
 	configcontent =
 		[ "-- This is the main configuration file for Propellor, and is used to build"
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 516eda03..9b62720f 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -37,6 +37,7 @@ import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
 import Control.Applicative
 import Data.Monoid
+import Data.Semigroup as Sem
 import Prelude
 
 import Propellor.Types
@@ -279,7 +280,7 @@ makePrivDataDir = createDirectoryIfMissing False privDataDir
 
 newtype PrivInfo = PrivInfo
 	{ fromPrivInfo :: S.Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext) }
-	deriving (Eq, Ord, Show, Typeable, Monoid)
+	deriving (Eq, Ord, Show, Typeable, Sem.Semigroup, Monoid)
 
 -- PrivInfo always propagates out of containers, so that propellor
 -- can see which hosts need it.
diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs
index a2bef117..ebc21b88 100644
--- a/src/Propellor/Property/Ccache.hs
+++ b/src/Propellor/Property/Ccache.hs
@@ -14,6 +14,7 @@ import qualified Propellor.Property.Apt as Apt
 import Utility.FileMode
 import Utility.DataUnits
 import System.Posix.Files
+import qualified Data.Semigroup as Sem
 
 -- | Limits on the size of a ccache
 data Limit
@@ -25,9 +26,12 @@ data Limit
 	| NoLimit
 	| Limit :+ Limit
 
+instance Sem.Semigroup Limit where
+	(<>) = (:+)
+
 instance Monoid Limit where
 	mempty  = NoLimit
-	mappend = (:+)
+	mappend = (<>)
 
 -- | A string that will be parsed to get a data size.
 --
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index cfeb5aa7..1a67402a 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -81,6 +81,7 @@ import Propellor.Types.Info
 import qualified Propellor.Property.Ssh as Ssh
 
 import qualified Data.Set as S
+import qualified Data.Semigroup as Sem
 
 -- | Class of things that can be conducted.
 --
@@ -313,9 +314,9 @@ cdesc n = "conducting " ++ n
 -- A Host's Info indicates when it's a conductor for hosts, and when it's
 -- stopped being a conductor.
 newtype ConductorFor = ConductorFor [Host]
-	deriving (Typeable, Monoid)
+	deriving (Typeable, Sem.Semigroup, Monoid)
 newtype NotConductorFor = NotConductorFor [Host]
-	deriving (Typeable, Monoid)
+	deriving (Typeable, Sem.Semigroup, Monoid)
 
 instance Show ConductorFor where
 	show (ConductorFor l) = "ConductorFor " ++ show (map hostName l)
@@ -329,7 +330,7 @@ instance IsInfo NotConductorFor where
 
 -- Added to Info when a host has been orchestrated.
 newtype Orchestrated = Orchestrated Any
-	deriving (Typeable, Monoid, Show)
+	deriving (Typeable, Sem.Semigroup, Monoid, Show)
 instance IsInfo Orchestrated where
 	propagateInfo _ = PropagateInfo False
 
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 7c8e9618..c6e5c373 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -19,12 +19,13 @@ import Utility.FileMode
 
 import Data.List
 import Data.Char
+import qualified Data.Semigroup as Sem
 import System.Posix.Directory
 import System.Posix.Files
 
 type Url = String
 
--- | A monoid for debootstrap configuration.
+-- | A data type for debootstrap configuration.
 -- mempty is a default debootstrapped system.
 data DebootstrapConfig
 	= DefaultConfig
@@ -35,9 +36,12 @@ data DebootstrapConfig
 	| DebootstrapConfig :+ DebootstrapConfig
 	deriving (Show)
 
+instance Sem.Semigroup DebootstrapConfig where
+	(<>) = (:+)
+
 instance Monoid DebootstrapConfig where
 	mempty  = DefaultConfig
-	mappend = (:+)
+	mappend = (<>)
 
 toParams :: DebootstrapConfig -> [CommandParam]
 toParams DefaultConfig = []
diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs
index b78e4280..0698d806 100644
--- a/src/Propellor/Property/DiskImage/PartSpec.hs
+++ b/src/Propellor/Property/DiskImage/PartSpec.hs
@@ -43,6 +43,7 @@ import Propellor.Property.Mount
 
 import Data.List (sortBy)
 import Data.Ord
+import qualified Data.Semigroup as Sem
 
 -- | Specifies a partition with a given filesystem.
 --
@@ -110,7 +111,7 @@ data PartInfoVal
 	| AdjustPartSpecInfo MountPoint (PartSpec PartLocation -> PartSpec PartLocation)
 
 newtype PartInfo = PartInfo [PartInfoVal]
-	deriving (Monoid, Typeable)
+	deriving (Monoid, Sem.Semigroup, Typeable)
 
 instance IsInfo PartInfo where
 	propagateInfo _ = PropagateInfo False
@@ -183,9 +184,12 @@ adjustPartition mp f = pureInfoProperty
 data PartLocation = Beginning | Middle | End
 	deriving (Eq, Ord)
 
+instance Sem.Semigroup PartLocation where
+	_ <> b = b
+
 instance Monoid PartLocation where
 	mempty = Middle
-	mappend _ b = b
+	mappend = (<>)
 
 partLocation :: PartSpec PartLocation -> PartLocation -> PartSpec PartLocation
 partLocation (mp, o, p, _) l = (mp, o, p, l)
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index bbc14473..ff7ffebf 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -18,6 +18,7 @@ module Propellor.Property.Firewall (
 ) where
 
 import Data.Monoid
+import qualified Data.Semigroup as Sem
 import Data.Char
 import Data.List
 
@@ -199,6 +200,9 @@ data Rules
 
 infixl 0 :-
 
+instance Sem.Semigroup Rules where
+	(<>) = (:-)
+
 instance Monoid Rules where
 	mempty  = Everything
-	mappend = (:-)
+	mappend = (<>)
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 77bf5768..56ac55fb 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -9,6 +9,8 @@ module Propellor.Property.FreeBSD.Pkg where
 import Propellor.Base
 import Propellor.Types.Info
 
+import qualified Data.Semigroup as Sem
+
 noninteractiveEnv :: [([Char], [Char])]
 noninteractiveEnv = [("ASSUME_ALWAYS_YES", "yes")]
 
@@ -37,7 +39,7 @@ pkgCmd cmd args =
 		lines <$> readProcessEnv p a (Just noninteractiveEnv)
 
 newtype PkgUpdate = PkgUpdate String
-	deriving (Typeable, Monoid, Show)
+	deriving (Typeable, Sem.Semigroup, Monoid, Show)
 instance IsInfo PkgUpdate where
 	propagateInfo _ = PropagateInfo False
 
@@ -54,7 +56,7 @@ update =
 			`setInfoProperty` (toInfo (PkgUpdate ""))
 
 newtype PkgUpgrade = PkgUpgrade String
-	deriving (Typeable, Monoid, Show)
+	deriving (Typeable, Sem.Semigroup, Monoid, Show)
 
 instance IsInfo PkgUpgrade where
 	propagateInfo _ = PropagateInfo False
diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index 378c5530..cde2a6d3 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -8,17 +8,18 @@ module Propellor.Property.FreeBSD.Poudriere where
 
 import Propellor.Base
 import Propellor.Types.Info
-import Data.List
-
 import qualified Propellor.Property.FreeBSD.Pkg as Pkg
 import qualified Propellor.Property.ZFS as ZFS
 import qualified Propellor.Property.File as File
 
+import Data.List
+import qualified Data.Semigroup as Sem
+
 poudriereConfigPath :: FilePath
 poudriereConfigPath = "/usr/local/etc/poudriere.conf"
 
 newtype PoudriereConfigured = PoudriereConfigured String
-	deriving (Typeable, Monoid, Show)
+	deriving (Typeable, Sem.Semigroup, Monoid, Show)
 
 instance IsInfo PoudriereConfigured where
 	propagateInfo _ = PropagateInfo False
diff --git a/src/Propellor/Property/Installer/Target.hs b/src/Propellor/Property/Installer/Target.hs
index 80e660ad..54e9075e 100644
--- a/src/Propellor/Property/Installer/Target.hs
+++ b/src/Propellor/Property/Installer/Target.hs
@@ -112,6 +112,7 @@ import Data.List
 import Data.Char
 import Data.Ord
 import Data.Ratio
+import qualified Data.Semigroup as Sem
 import System.Process (readProcess)
 
 -- | Partition table for the target disk.
@@ -438,9 +439,12 @@ getMountsSizes = mapMaybe (parse . words) . lines <$> readProcess "findmnt" ps "
 data TargetFilled = TargetFilled (Ratio Integer)
 	deriving (Show, Eq)
 
+instance Sem.Semigroup TargetFilled where
+	TargetFilled n <> TargetFilled m = TargetFilled (n+m) 
+
 instance Monoid TargetFilled where
 	mempty = TargetFilled (0 % 1)
-	mappend (TargetFilled n) (TargetFilled m) = TargetFilled (n+m)
+	mappend = (<>)
 
 newtype TargetFilledHandle = TargetFilledHandle Integer
 
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 71f1733e..53129f50 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -10,6 +10,7 @@ import Propellor.Base
 import Utility.Path
 
 import Data.List
+import qualified Data.Semigroup as Sem
 
 -- | type of filesystem to mount ("auto" to autodetect)
 type FsType = String
@@ -24,7 +25,7 @@ type MountPoint = FilePath
 --
 -- For default mount options, use `mempty`.
 newtype MountOpts = MountOpts [String]
-	deriving Monoid
+	deriving (Sem.Semigroup, Monoid)
 
 class ToMountOpts a where
 	toMountOpts :: a -> MountOpts
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index 81b84972..39ee1723 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -42,6 +42,7 @@ import Propellor.Types.PartSpec (PartSpec)
 import Utility.DataUnits
 
 import System.Posix.Files
+import qualified Data.Semigroup as Sem
 import Data.List (genericLength)
 
 data Eep = YesReallyDeleteDiskContents
@@ -178,16 +179,21 @@ data DiskPart = FixedDiskPart | DynamicDiskPart DiskSpaceUse
 
 data DiskSpaceUse = Percent Int | RemainingSpace
 
+instance Sem.Semigroup DiskPart where
+	FixedDiskPart <> FixedDiskPart = FixedDiskPart
+	DynamicDiskPart (Percent a) <> DynamicDiskPart (Percent b) =
+		DynamicDiskPart (Percent (a + b))
+	DynamicDiskPart RemainingSpace <> DynamicDiskPart RemainingSpace = 
+		DynamicDiskPart RemainingSpace
+	DynamicDiskPart (Percent a) <> _ = DynamicDiskPart (Percent a)
+	_ <> DynamicDiskPart (Percent b) = DynamicDiskPart (Percent b)
+	DynamicDiskPart RemainingSpace <> _ = DynamicDiskPart RemainingSpace
+	_ <> DynamicDiskPart RemainingSpace = DynamicDiskPart RemainingSpace
+
 instance Monoid DiskPart
   where
 	mempty = FixedDiskPart
-	mappend FixedDiskPart FixedDiskPart = FixedDiskPart
-	mappend (DynamicDiskPart (Percent a)) (DynamicDiskPart (Percent b)) = DynamicDiskPart (Percent (a + b))
-	mappend (DynamicDiskPart RemainingSpace) (DynamicDiskPart RemainingSpace) = DynamicDiskPart RemainingSpace
-	mappend (DynamicDiskPart (Percent a)) _ = DynamicDiskPart (Percent a)
-	mappend _ (DynamicDiskPart (Percent b)) = DynamicDiskPart (Percent b)
-	mappend (DynamicDiskPart RemainingSpace) _ = DynamicDiskPart RemainingSpace
-	mappend _ (DynamicDiskPart RemainingSpace) = DynamicDiskPart RemainingSpace
+	mappend = (<>)
 
 -- | Make a partition use some percentage of the size of the disk
 -- (less all fixed size partitions), or the remaining space in the disk.
diff --git a/src/Propellor/Property/Parted/Types.hs b/src/Propellor/Property/Parted/Types.hs
index cfd8760d..5891cc16 100644
--- a/src/Propellor/Property/Parted/Types.hs
+++ b/src/Propellor/Property/Parted/Types.hs
@@ -4,6 +4,9 @@ import qualified Propellor.Property.Partition as Partition
 import Utility.DataUnits
 
 import Data.Char
+import qualified Data.Semigroup as Sem
+import Data.Monoid
+import Prelude
 
 class PartedVal a where
 	pval :: a -> String
@@ -19,14 +22,17 @@ instance PartedVal TableType where
 data PartTable = PartTable TableType Alignment [Partition]
 	deriving (Show)
 
-instance Monoid PartTable where
-	-- | default TableType is MSDOS, with a `safeAlignment`.
-	mempty = PartTable MSDOS safeAlignment []
+instance Sem.Semigroup PartTable where
 	-- | uses the TableType of the second parameter
 	-- and the larger alignment,
-	mappend (PartTable _l1 a1 ps1) (PartTable l2 a2 ps2) =
+	PartTable _l1 a1 ps1 <> PartTable l2 a2 ps2 =
 		PartTable l2 (max a1 a2) (ps1 ++ ps2)
 
+instance Monoid PartTable where
+	-- | default TableType is MSDOS, with a `safeAlignment`.
+	mempty = PartTable MSDOS safeAlignment []
+	mappend = (<>)
+
 -- | A partition on the disk.
 data Partition = Partition
 	{ partType :: PartType
@@ -80,11 +86,14 @@ fromPartSize :: PartSize -> ByteSize
 fromPartSize (MegaBytes b) = b * 1000000
 fromPartSize (Bytes n) = n
 
+instance Sem.Semigroup PartSize where
+	MegaBytes a <> MegaBytes b = MegaBytes (a + b)
+	Bytes a <> b = Bytes (a + fromPartSize b)
+	a <> Bytes b = Bytes (b + fromPartSize a)
+
 instance Monoid PartSize where
 	mempty = MegaBytes 0
-	mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)
-	mappend (Bytes a) b = Bytes (a + fromPartSize b)
-	mappend a (Bytes b) = Bytes (b + fromPartSize a)
+	mappend = (<>)
 
 reducePartSize :: PartSize -> PartSize -> PartSize
 reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index fd89f97a..05098983 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -45,6 +45,7 @@ import Utility.FileMode
 import System.PosixCompat
 import qualified Data.Map as M
 import qualified Data.Set as S
+import qualified Data.Semigroup as Sem
 import Data.List
 
 installed :: Property UnixLike
@@ -229,13 +230,16 @@ newtype HostKeyInfo = HostKeyInfo
 instance IsInfo HostKeyInfo where
 	propagateInfo _ = PropagateInfo False
 
-instance Monoid HostKeyInfo where
-	mempty = HostKeyInfo M.empty
-	mappend (HostKeyInfo old) (HostKeyInfo new) =
+instance Sem.Semigroup HostKeyInfo where
+	HostKeyInfo old <> HostKeyInfo new =
 		-- new first because union prefers values from the first
 		-- parameter when there is a duplicate key
 		HostKeyInfo (new `M.union` old)
 
+instance Monoid HostKeyInfo where
+	mempty = HostKeyInfo M.empty
+	mappend = (<>)
+
 userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property (HasInfo + UnixLike)
 userPubKeys u@(User n) l = pureInfoProperty ("ssh pubkey for " ++ n) $
 	UserKeyInfo (M.singleton u (S.fromList l))
@@ -250,10 +254,13 @@ newtype UserKeyInfo = UserKeyInfo
 instance IsInfo UserKeyInfo where
 	propagateInfo _ = PropagateInfo False
 
+instance Sem.Semigroup UserKeyInfo where
+	UserKeyInfo old <> UserKeyInfo new =
+		UserKeyInfo (M.unionWith S.union old new)
+
 instance Monoid UserKeyInfo where
 	mempty = UserKeyInfo M.empty
-	mappend (UserKeyInfo old) (UserKeyInfo new) =
-		UserKeyInfo (M.unionWith S.union old new)
+	mappend = (<>)
 
 -- | Sets up a user with the specified public keys, and the corresponding
 -- private keys from the privdata.
diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs
index da912120..b27203e5 100644
--- a/src/Propellor/Types/Chroot.hs
+++ b/src/Propellor/Types/Chroot.hs
@@ -7,6 +7,7 @@ import Propellor.Types.Empty
 import Propellor.Types.Info
 
 import Data.Monoid
+import qualified Data.Semigroup as Sem
 import qualified Data.Map as M
 
 data ChrootInfo = ChrootInfo
@@ -18,13 +19,16 @@ data ChrootInfo = ChrootInfo
 instance IsInfo ChrootInfo where
 	propagateInfo _ = PropagateInfo False
 
-instance Monoid ChrootInfo where
-	mempty = ChrootInfo mempty mempty
-	mappend old new = ChrootInfo
+instance Sem.Semigroup ChrootInfo where
+	old <> new = ChrootInfo
 		{ _chroots = M.union (_chroots old) (_chroots new)
 		, _chrootCfg = _chrootCfg old <> _chrootCfg new
 		}
 
+instance Monoid ChrootInfo where
+	mempty = ChrootInfo mempty mempty
+	mappend = (<>)
+
 instance Empty ChrootInfo where
 	isEmpty i = and
 		[ isEmpty (_chroots i)
@@ -36,12 +40,15 @@ data ChrootCfg
 	| SystemdNspawnCfg [(String, Bool)]
 	deriving (Show, Eq)
 
+instance Sem.Semigroup ChrootCfg where
+	v <> NoChrootCfg = v
+	NoChrootCfg <> v = v
+	SystemdNspawnCfg l1 <> SystemdNspawnCfg l2 =
+		SystemdNspawnCfg (l1 <> l2)
+
 instance Monoid ChrootCfg where
 	mempty = NoChrootCfg
-	mappend v NoChrootCfg = v
-	mappend NoChrootCfg v = v
-	mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) =
-		SystemdNspawnCfg (l1 <> l2)
+	mappend = (<>)
 
 instance Empty ChrootCfg where
 	isEmpty c= c == NoChrootCfg
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
index a805f561..cd3e09c5 100644
--- a/src/Propellor/Types/Core.hs
+++ b/src/Propellor/Types/Core.hs
@@ -10,6 +10,7 @@ import Propellor.Types.OS
 import Propellor.Types.Result
 
 import Data.Monoid
+import qualified Data.Semigroup as Sem
 import "mtl" Control.Monad.RWS.Strict
 import Control.Monad.Catch
 import Control.Applicative
@@ -50,15 +51,18 @@ instance LiftPropellor IO where
 
 -- | When two actions are appended together, the second action
 -- is only run if the first action does not fail.
-instance Monoid (Propellor Result) where
-	mempty = return NoChange
-	mappend x y = do
+instance Sem.Semigroup (Propellor Result) where
+	x <> y = do
 		rx <- x
 		case rx of
 			FailedChange -> return FailedChange
 			_ -> do
 				ry <- y
 				return (rx <> ry)
+	
+instance Monoid (Propellor Result) where
+	mempty = return NoChange
+	mappend = (<>)
 
 -- | An action that Propellor runs at the end, after trying to satisfy all
 -- properties. It's passed the combined Result of the entire Propellor run.
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index 513f162a..21a4860c 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -12,6 +12,7 @@ import Utility.Split
 import Data.Word
 import qualified Data.Map as M
 import qualified Data.Set as S
+import qualified Data.Semigroup as Sem
 import Data.List
 import Data.Monoid
 import Prelude
@@ -26,7 +27,7 @@ instance ConfigurableValue IPAddr where
 	val (IPv6 addr) = addr
 
 newtype AliasesInfo = AliasesInfo (S.Set HostName)
-	deriving (Show, Eq, Ord, Monoid, Typeable)
+	deriving (Show, Eq, Ord, Sem.Semigroup, Monoid, Typeable)
 
 instance IsInfo AliasesInfo where
 	propagateInfo _ = PropagateInfo False
@@ -42,7 +43,7 @@ fromAliasesInfo (AliasesInfo s) = S.toList s
 -- of the containers in the host be reflected in the DNS.
 newtype DnsInfoPropagated = DnsInfoPropagated
 	{ fromDnsInfoPropagated :: S.Set Record }
-	deriving (Show, Eq, Ord, Monoid, Typeable)
+	deriving (Show, Eq, Ord, Sem.Semigroup, Monoid, Typeable)
 
 toDnsInfoPropagated :: S.Set Record -> DnsInfoPropagated
 toDnsInfoPropagated = DnsInfoPropagated
@@ -55,7 +56,7 @@ instance IsInfo DnsInfoPropagated where
 -- the host.
 newtype DnsInfoUnpropagated = DnsInfoUnpropagated
 	{ fromDnsInfoUnpropagated :: S.Set Record }
-	deriving (Show, Eq, Ord, Monoid, Typeable)
+	deriving (Show, Eq, Ord, Sem.Semigroup, Monoid, Typeable)
 
 toDnsInfoUnpropagated :: S.Set Record -> DnsInfoUnpropagated
 toDnsInfoUnpropagated = DnsInfoUnpropagated
@@ -183,15 +184,18 @@ instance IsInfo NamedConfMap where
 -- | Adding a Master NamedConf stanza for a particulr domain always
 -- overrides an existing Secondary stanza for that domain, while a
 -- Secondary stanza is only added when there is no existing Master stanza.
-instance Monoid NamedConfMap where
-	mempty = NamedConfMap M.empty
-	mappend (NamedConfMap old) (NamedConfMap new) = NamedConfMap $
+instance Sem.Semigroup NamedConfMap where
+	NamedConfMap old <> NamedConfMap new = NamedConfMap $
 		M.unionWith combiner new old
 	  where
 		combiner n o = case (confDnsServerType n, confDnsServerType o) of
 			(Secondary, Master) -> o
 			_  -> n
 
+instance Monoid NamedConfMap where
+	mempty = NamedConfMap M.empty
+	mappend = (<>)
+
 instance Empty NamedConfMap where
 	isEmpty (NamedConfMap m) = isEmpty m
 
diff --git a/src/Propellor/Types/Docker.hs b/src/Propellor/Types/Docker.hs
index 6ff340e5..79577591 100644
--- a/src/Propellor/Types/Docker.hs
+++ b/src/Propellor/Types/Docker.hs
@@ -7,6 +7,7 @@ import Propellor.Types.Empty
 import Propellor.Types.Info
 
 import Data.Monoid
+import qualified Data.Semigroup as Sem
 import qualified Data.Map as M
 
 data DockerInfo = DockerInfo
@@ -18,13 +19,16 @@ data DockerInfo = DockerInfo
 instance IsInfo DockerInfo where
 	propagateInfo _ = PropagateInfo False
 
-instance Monoid DockerInfo where
-	mempty = DockerInfo mempty mempty
-	mappend old new = DockerInfo
+instance Sem.Semigroup DockerInfo where
+	old <> new = DockerInfo
 		{ _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
 		, _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new)
 		}
 
+instance Monoid DockerInfo where
+	mempty = DockerInfo mempty mempty
+	mappend = (<>)
+
 instance Empty DockerInfo where
 	isEmpty i = and
 		[ isEmpty (_dockerRunParams i)
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index 06c45ed2..2ab6da7b 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -17,6 +17,7 @@ module Propellor.Types.Info (
 import Data.Dynamic
 import Data.Maybe
 import Data.Monoid
+import qualified Data.Semigroup as Sem
 import qualified Data.Typeable as T
 import Prelude
 
@@ -25,7 +26,7 @@ import Prelude
 -- Many different types of data can be contained in the same Info value
 -- at the same time. See `toInfo` and `fromInfo`.
 newtype Info = Info [InfoEntry]
-	deriving (Monoid, Show)
+	deriving (Sem.Semigroup, Monoid, Show)
 
 data InfoEntry where
 	InfoEntry :: (IsInfo v, Typeable v) => v -> InfoEntry
@@ -80,10 +81,13 @@ mapInfo f (Info l) = Info (map go l)
 data InfoVal v = NoInfoVal | InfoVal v
 	deriving (Typeable, Show)
 
+instance Sem.Semigroup (InfoVal v) where
+	_ <> v@(InfoVal _) = v
+	v <> NoInfoVal = v
+
 instance Monoid (InfoVal v) where
 	mempty = NoInfoVal
-	mappend _ v@(InfoVal _) = v
-	mappend v NoInfoVal = v
+	mappend = (<>)
 
 instance (Typeable v, Show v) => IsInfo (InfoVal v) where
 	propagateInfo _ = PropagateInfo False
diff --git a/src/Propellor/Types/Result.hs b/src/Propellor/Types/Result.hs
index 5209094b..f552b29b 100644
--- a/src/Propellor/Types/Result.hs
+++ b/src/Propellor/Types/Result.hs
@@ -1,6 +1,7 @@
 module Propellor.Types.Result where
 
 import System.Console.ANSI
+import qualified Data.Semigroup as Sem
 import Data.Monoid
 import Prelude
 
@@ -8,14 +9,16 @@ import Prelude
 data Result = NoChange | MadeChange | FailedChange
 	deriving (Read, Show, Eq)
 
+instance Sem.Semigroup Result where
+	FailedChange <> _ = FailedChange
+	_ <> FailedChange = FailedChange
+	MadeChange <> _ = MadeChange
+	_ <> MadeChange = MadeChange
+	NoChange <> NoChange = NoChange
+
 instance Monoid Result where
 	mempty = NoChange
-
-	mappend FailedChange _ = FailedChange
-	mappend _ FailedChange = FailedChange
-	mappend MadeChange _ = MadeChange
-	mappend _ MadeChange = MadeChange
-	mappend NoChange NoChange = NoChange
+	mappend = (<>)
 
 class ToResult t where
 	toResult :: t -> Result
-- 
cgit v1.3-2-g0d8e