From 3408e1e630f593ca93b5e79e7e7121a1fa813307 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sun, 4 Feb 2018 19:49:16 -0500 Subject: [PATCH 1/4] Adapt to Semigroup changes in base-4.11 --- yesod-core/ChangeLog.md | 6 ++++ yesod-core/Yesod/Core/Internal/LiteApp.hs | 10 +++++- yesod-core/Yesod/Core/Types.hs | 44 +++++++++++++---------- yesod-core/yesod-core.cabal | 2 +- yesod-form/ChangeLog.md | 4 +++ yesod-form/Yesod/Form/Types.hs | 9 +++-- yesod-form/yesod-form.cabal | 2 +- yesod-test/ChangeLog.md | 4 +++ yesod-test/Yesod/Test.hs | 4 +-- yesod-test/yesod-test.cabal | 3 +- 10 files changed, 59 insertions(+), 29 deletions(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index b66fa67e..8234e978 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,3 +1,9 @@ +## 1.6.1 + +* Add a `Semigroup LiteApp` instance, and explicitly define `(<>)` in the + already existing `Semigroup` instances for `WidgetFor`, `Head`, `Body`, + `GWData`, and `UniqueList`. + ## 1.6.0 * Upgrade to conduit 1.3.0 diff --git a/yesod-core/Yesod/Core/Internal/LiteApp.hs b/yesod-core/Yesod/Core/Internal/LiteApp.hs index c9a6f51d..cc1a16d5 100644 --- a/yesod-core/Yesod/Core/Internal/LiteApp.hs +++ b/yesod-core/Yesod/Core/Internal/LiteApp.hs @@ -4,6 +4,9 @@ module Yesod.Core.Internal.LiteApp where #if __GLASGOW_HASKELL__ < 710 import Data.Monoid #endif +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup (Semigroup(..)) +#endif import Yesod.Routes.Class import Yesod.Core.Class.Yesod import Yesod.Core.Class.Dispatch @@ -42,9 +45,14 @@ instance RenderRoute LiteApp where instance ParseRoute LiteApp where parseRoute (x, _) = Just $ LiteAppRoute x +instance Semigroup LiteApp where + LiteApp x <> LiteApp y = LiteApp $ \m ps -> x m ps <|> y m ps + instance Monoid LiteApp where mempty = LiteApp $ \_ _ -> Nothing - mappend (LiteApp x) (LiteApp y) = LiteApp $ \m ps -> x m ps <|> y m ps +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif type LiteHandler = HandlerFor LiteApp type LiteWidget = WidgetFor LiteApp diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index 2bdf4072..e55bc6ad 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -31,6 +31,7 @@ import Data.IORef (IORef, modifyIORef') import Data.Map (Map, unionWith) import qualified Data.Map as Map import Data.Monoid (Endo (..), Last (..)) +import Data.Semigroup (Semigroup(..)) import Data.Serialize (Serialize (..), putByteString) import Data.String (IsString (fromString)) @@ -55,12 +56,10 @@ import Web.Cookie (SetCookie) import Yesod.Core.Internal.Util (getTime, putTime) import Yesod.Routes.Class (RenderRoute (..), ParseRoute (..)) import Control.Monad.Reader (MonadReader (..)) -import Data.Monoid ((<>)) import Control.DeepSeq (NFData (rnf)) import Control.DeepSeq.Generics (genericRnf) import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap) import Control.Monad.Logger (MonadLoggerIO (..)) -import Data.Semigroup (Semigroup) import UnliftIO (MonadUnliftIO (..), UnliftIO (..)) -- Sessions @@ -255,8 +254,11 @@ data WidgetData site = WidgetData instance a ~ () => Monoid (WidgetFor site a) where mempty = return () - mappend x y = x >> y -instance a ~ () => Semigroup (WidgetFor site a) +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif +instance a ~ () => Semigroup (WidgetFor site a) where + x <> y = x >> y -- | A 'String' can be trivially promoted to a widget. -- @@ -356,11 +358,9 @@ data Stylesheet url = Stylesheet { styleLocation :: !(Location url), styleAttrib newtype Title = Title { unTitle :: Html } newtype Head url = Head (HtmlUrl url) - deriving Monoid -instance Semigroup (Head a) + deriving (Semigroup, Monoid) newtype Body url = Body (HtmlUrl url) - deriving Monoid -instance Semigroup (Body a) + deriving (Semigroup, Monoid) type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder @@ -375,16 +375,19 @@ data GWData a = GWData } instance Monoid (GWData a) where mempty = GWData mempty mempty mempty mempty mempty mempty mempty - mappend (GWData a1 a2 a3 a4 a5 a6 a7) - (GWData b1 b2 b3 b4 b5 b6 b7) = GWData - (a1 `mappend` b1) - (a2 `mappend` b2) - (a3 `mappend` b3) - (a4 `mappend` b4) +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif +instance Semigroup (GWData a) where + GWData a1 a2 a3 a4 a5 a6 a7 <> + GWData b1 b2 b3 b4 b5 b6 b7 = GWData + (a1 <> b1) + (a2 <> b2) + (a3 <> b3) + (a4 <> b4) (unionWith mappend a5 b5) - (a6 `mappend` b6) - (a7 `mappend` b7) -instance Semigroup (GWData a) + (a6 <> b6) + (a7 <> b7) data HandlerContents = HCContent !H.Status !TypedContent @@ -473,8 +476,11 @@ instance MonadLoggerIO (HandlerFor site) where instance Monoid (UniqueList x) where mempty = UniqueList id - UniqueList x `mappend` UniqueList y = UniqueList $ x . y -instance Semigroup (UniqueList x) +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif +instance Semigroup (UniqueList x) where + UniqueList x <> UniqueList y = UniqueList $ x . y instance IsString Content where fromString = flip ContentBuilder Nothing . BB.stringUtf8 diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index abefefcf..38e27c93 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.0 +version: 1.6.1 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md index 9af79a52..79a704be 100644 --- a/yesod-form/ChangeLog.md +++ b/yesod-form/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.6.1 + +* Explicitly define `(<>)` in the `Semigroup` instance for `Enctype` + ## 1.6.0 * Upgrade to yesod-core 1.6.0 diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs index bd4e91df..898e319b 100644 --- a/yesod-form/Yesod/Form/Types.hs +++ b/yesod-form/Yesod/Form/Types.hs @@ -104,9 +104,12 @@ instance ToValue Enctype where toValue Multipart = "multipart/form-data" instance Monoid Enctype where mempty = UrlEncoded - mappend UrlEncoded UrlEncoded = UrlEncoded - mappend _ _ = Multipart -instance Semigroup Enctype +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif +instance Semigroup Enctype where + UrlEncoded <> UrlEncoded = UrlEncoded + _ <> _ = Multipart data Ints = IntCons Int Ints | IntSingle Int instance Show Ints where diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index aa54488a..adfcd2a9 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.6.0 +version: 1.6.1 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index 07c308ef..55daaf22 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.6.1 + +* Fix the build with `base-4.11` (GHC 8.4). + ## 1.6.0 * Upgrade to yesod-core 1.6.0 diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 977e838a..b3d49320 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -158,6 +158,7 @@ import Data.Time.Clock (getCurrentTime) import Control.Applicative ((<$>)) import Text.Show.Pretty (ppShow) import Data.Monoid (mempty) +import Data.Semigroup (Semigroup(..)) #if MIN_VERSION_base(4,9,0) import GHC.Stack (HasCallStack) #elif MIN_VERSION_base(4,8,1) @@ -570,9 +571,6 @@ genericNameFromLabel match label = do name:_ -> return name _ -> failure $ "More than one label contained " <> label -(<>) :: T.Text -> T.Text -> T.Text -(<>) = T.append - byLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains) -> T.Text -- ^ The text contained in the @\