From e57b62235ff20ec9fe08e184d3455068dbffe528 Mon Sep 17 00:00:00 2001
From: Maximilian Tagher <feedback.tagher@gmail.com>
Date: Sun, 8 Feb 2015 16:55:06 -0800
Subject: [PATCH] Add more semigroups instances

---
 yesod-core/Yesod/Core/Types.hs | 4 ++++
 yesod-form/Yesod/Form/Types.hs | 6 ++++++
 yesod-form/yesod-form.cabal    | 1 +
 3 files changed, 11 insertions(+)

diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 4ee00694..5fa5c3d3 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -334,8 +334,10 @@ newtype Title = Title { unTitle :: Html }
 
 newtype Head url = Head (HtmlUrl url)
     deriving Monoid
+instance Semigroup (Head a)
 newtype Body url = Body (HtmlUrl url)
     deriving Monoid
+instance Semigroup (Body a)
 
 type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder
 
@@ -359,6 +361,7 @@ instance Monoid (GWData a) where
         (unionWith mappend a5 b5)
         (a6 `mappend` b6)
         (a7 `mappend` b7)
+instance Semigroup (GWData a)
 
 data HandlerContents =
       HCContent H.Status !TypedContent
@@ -523,6 +526,7 @@ instance MonadIO m => MonadLoggerIO (HandlerT site m) where
 instance Monoid (UniqueList x) where
     mempty = UniqueList id
     UniqueList x `mappend` UniqueList y = UniqueList $ x . y
+instance Semigroup (UniqueList x)
 
 instance IsString Content where
     fromString = flip ContentBuilder Nothing . Blaze.ByteString.Builder.Char.Utf8.fromString
diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs
index a5800efb..74875134 100644
--- a/yesod-form/Yesod/Form/Types.hs
+++ b/yesod-form/Yesod/Form/Types.hs
@@ -34,6 +34,7 @@ import Control.Monad.Trans.Class
 import Data.String (IsString (..))
 import Yesod.Core
 import qualified Data.Map as Map
+import Data.Semigroup (Semigroup, (<>))
 
 -- | A form can produce three different results: there was no data available,
 -- the data was invalid, or there was a successful parse.
@@ -58,6 +59,8 @@ instance Applicative FormResult where
 instance Monoid m => Monoid (FormResult m) where
     mempty = pure mempty
     mappend x y = mappend <$> x <*> y
+instance Semigroup m => Semigroup (FormResult m) where
+    x <> y = (<>) <$> x <*> y
 
 -- | The encoding type required by a form. The 'ToHtml' instance produces values
 -- that can be inserted directly into HTML.
@@ -70,6 +73,7 @@ instance Monoid Enctype where
     mempty = UrlEncoded
     mappend UrlEncoded UrlEncoded = UrlEncoded
     mappend _ _ = Multipart
+instance Semigroup Enctype
 
 data Ints = IntCons Int Ints | IntSingle Int
 instance Show Ints where
@@ -106,6 +110,8 @@ instance Monad m => Applicative (AForm m) where
 instance (Monad m, Monoid a) => Monoid (AForm m a) where
     mempty = pure mempty
     mappend a b = mappend <$> a <*> b
+instance (Monad m, Semigroup a) => Semigroup (AForm m a) where
+    a <> b = (<>) <$> a <*> b
 
 instance MonadTrans AForm where
     lift f = AForm $ \_ _ ints -> do
diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal
index 9d979f63..4f96f7f2 100644
--- a/yesod-form/yesod-form.cabal
+++ b/yesod-form/yesod-form.cabal
@@ -41,6 +41,7 @@ library
                    , byteable
                    , aeson
                    , resourcet
+                   , semigroups
 
     if flag(network-uri)
       build-depends: network-uri >= 2.6