From 000627c94a4d4aedb0a4216e781f6af65936ef9c Mon Sep 17 00:00:00 2001 From: Christian Barcenas Date: Sun, 11 Feb 2018 03:22:28 -0800 Subject: 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. --- lib/Hakyll/Check.hs | 13 +++++++++++++ lib/Hakyll/Core/Compiler/Internal.hs | 14 ++++++++++++++ lib/Hakyll/Core/Identifier/Pattern.hs | 13 +++++++++++++ lib/Hakyll/Core/Routes.hs | 17 +++++++++++++++++ lib/Hakyll/Core/Rules/Internal.hs | 14 ++++++++++++++ lib/Hakyll/Web/Template/Context.hs | 12 ++++++++++++ 6 files changed, 83 insertions(+) (limited to 'lib/Hakyll') 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 -------------------------------------------------------------------------------- -- cgit v1.2.3