Add Semigroup instances for existing Monoids

Ensures forwards compatibility with future Haskell/GHC releases
as the Semigroup/Monoid Proposal is gradually implemented.

Closes #525 and #536.

6 files changed, 83 insertions, 0 deletions

diff --git a/lib/Hakyll/Check.hs b/lib/Hakyll/Check.hs
index f001cbe..05ad1fd 100644
--- a/lib/Hakyll/Check.hs
+++ b/lib/Hakyll/Check.hs
@@ -19,6 +19,9 @@ import           Control.Monad.Trans          (liftIO)
 import           Control.Monad.Trans.Resource (runResourceT)
 import           Data.List                    (isPrefixOf)
 import qualified Data.Map.Lazy                as Map
+#if MIN_VERSION_base(4,9,0)
+import           Data.Semigroup               (Semigroup (..))
+#endif
 import           Network.URI                  (unEscapeString)
 import           System.Directory             (doesDirectoryExist,
                                                doesFileExist)
@@ -85,10 +88,20 @@ data CheckerWrite = CheckerWrite
 
 
 --------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup CheckerWrite where
+    (<>) (CheckerWrite f1 o1) (CheckerWrite f2 o2) =
+        CheckerWrite (f1 + f2) (o1 + o2)
+
+instance Monoid CheckerWrite where
+    mempty  = CheckerWrite 0 0
+    mappend = (<>)
+#else
 instance Monoid CheckerWrite where
     mempty                                            = CheckerWrite 0 0
     mappend (CheckerWrite f1 o1) (CheckerWrite f2 o2) =
         CheckerWrite (f1 + f2) (o1 + o2)
+#endif
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Compiler/Internal.hs b/lib/Hakyll/Core/Compiler/Internal.hs
index 7b1df83..5b6d1aa 100644
--- a/lib/Hakyll/Core/Compiler/Internal.hs
+++ b/lib/Hakyll/Core/Compiler/Internal.hs
@@ -1,5 +1,6 @@
 --------------------------------------------------------------------------------
 -- | Internally used compiler module
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -32,6 +33,9 @@ import           Control.Applicative            (Alternative (..))
 import           Control.Exception              (SomeException, handle)
 import           Control.Monad                  (forM_)
 import           Control.Monad.Except            (MonadError (..))
+#if MIN_VERSION_base(4,9,0)
+import           Data.Semigroup                 (Semigroup (..))
+#endif
 import           Data.Set                       (Set)
 import qualified Data.Set                       as S
 
@@ -83,10 +87,20 @@ data CompilerWrite = CompilerWrite
 
 
 --------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup CompilerWrite where
+    (<>) (CompilerWrite d1 h1) (CompilerWrite d2 h2) =
+        CompilerWrite (d1 ++ d2) (h1 + h2)
+
+instance Monoid CompilerWrite where
+    mempty  = CompilerWrite [] 0
+    mappend = (<>)
+#else
 instance Monoid CompilerWrite where
     mempty = CompilerWrite [] 0
     mappend (CompilerWrite d1 h1) (CompilerWrite d2 h2) =
         CompilerWrite (d1 ++ d2) (h1 + h2)
+#endif
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Identifier/Pattern.hs b/lib/Hakyll/Core/Identifier/Pattern.hs
index 83d5adc..a36e464 100644
--- a/lib/Hakyll/Core/Identifier/Pattern.hs
+++ b/lib/Hakyll/Core/Identifier/Pattern.hs
@@ -28,6 +28,7 @@
 --
 -- The 'capture' function allows the user to get access to the elements captured
 -- by the capture elements in a glob or regex pattern.
+{-# LANGUAGE CPP #-}
 module Hakyll.Core.Identifier.Pattern
     ( -- * The pattern type
       Pattern
@@ -62,6 +63,9 @@ import           Control.Monad          (msum)
 import           Data.Binary            (Binary (..), getWord8, putWord8)
 import           Data.List              (inits, isPrefixOf, tails)
 import           Data.Maybe             (isJust)
+#if MIN_VERSION_base(4,9,0)
+import           Data.Semigroup         (Semigroup (..))
+#endif
 import           Data.Set               (Set)
 import qualified Data.Set               as S
 
@@ -136,9 +140,18 @@ instance IsString Pattern where
 
 
 --------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup Pattern where
+    (<>) = (.&&.)
+
+instance Monoid Pattern where
+    mempty  = Everything
+    mappend = (<>)
+#else
 instance Monoid Pattern where
     mempty  = Everything
     mappend = (.&&.)
+#endif
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Routes.hs b/lib/Hakyll/Core/Routes.hs
index 513725f..06bf633 100644
--- a/lib/Hakyll/Core/Routes.hs
+++ b/lib/Hakyll/Core/Routes.hs
@@ -25,6 +25,7 @@
 --   not appear in your site directory.
 --
 -- * If an item matches multiple routes, the first rule will be chosen.
+{-# LANGUAGE CPP        #-}
 {-# LANGUAGE Rank2Types #-}
 module Hakyll.Core.Routes
     ( UsedMetadata
@@ -42,6 +43,9 @@ module Hakyll.Core.Routes
 
 
 --------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+import           Data.Semigroup                 (Semigroup (..))
+#endif
 import           System.FilePath                (replaceExtension)
 
 
@@ -74,6 +78,18 @@ newtype Routes = Routes
 
 
 --------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup Routes where
+    (<>) (Routes f) (Routes g) = Routes $ \p id' -> do
+        (mfp, um) <- f p id'
+        case mfp of
+            Nothing -> g p id'
+            Just _  -> return (mfp, um)
+
+instance Monoid Routes where
+    mempty  = Routes $ \_ _ -> return (Nothing, False)
+    mappend = (<>)
+#else
 instance Monoid Routes where
     mempty = Routes $ \_ _ -> return (Nothing, False)
     mappend (Routes f) (Routes g) = Routes $ \p id' -> do
@@ -81,6 +97,7 @@ instance Monoid Routes where
         case mfp of
             Nothing -> g p id'
             Just _  -> return (mfp, um)
+#endif
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Rules/Internal.hs b/lib/Hakyll/Core/Rules/Internal.hs
index 0641dcf..647af74 100644
--- a/lib/Hakyll/Core/Rules/Internal.hs
+++ b/lib/Hakyll/Core/Rules/Internal.hs
@@ -1,4 +1,5 @@
 --------------------------------------------------------------------------------
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE Rank2Types                 #-}
 module Hakyll.Core.Rules.Internal
@@ -16,6 +17,9 @@ import           Control.Monad.Reader           (ask)
 import           Control.Monad.RWS              (RWST, runRWST)
 import           Control.Monad.Trans            (liftIO)
 import qualified Data.Map                       as M
+#if MIN_VERSION_base(4,9,0)
+import           Data.Semigroup                 (Semigroup (..))
+#endif
 import           Data.Set                       (Set)
 
 
@@ -52,10 +56,20 @@ data RuleSet = RuleSet
 
 
 --------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup RuleSet where
+    (<>) (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
+        RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
+
+instance Monoid RuleSet where
+    mempty  = RuleSet mempty mempty mempty mempty
+    mappend = (<>)
+#else
 instance Monoid RuleSet where
     mempty = RuleSet mempty mempty mempty mempty
     mappend (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
         RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
+#endif
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index b6c7994..d570506 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -35,6 +35,9 @@ module Hakyll.Web.Template.Context
 import           Control.Applicative           (Alternative (..))
 import           Control.Monad                 (msum)
 import           Data.List                     (intercalate)
+#if MIN_VERSION_base(4,9,0)
+import           Data.Semigroup                (Semigroup (..))
+#endif
 import           Data.Time.Clock               (UTCTime (..))
 import           Data.Time.Format              (formatTime)
 import qualified Data.Time.Format              as TF
@@ -78,9 +81,18 @@ newtype Context a = Context
 
 
 --------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup (Context a) where
+    (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
+
+instance Monoid (Context a) where
+    mempty  = missingField
+    mappend = (<>)
+#else
 instance Monoid (Context a) where
     mempty                          = missingField
     mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
+#endif
 
 
 --------------------------------------------------------------------------------