[Git][ghc/ghc][master] Add Semigroup/Monoid for Q (#18123)

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
5f621a78 by Vladislav Zavialov at 2020-05-28T16:23:58-04:00
Add Semigroup/Monoid for Q (#18123)

- - - - -


4 changed files:

- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- + testsuite/tests/th/T18123.hs
- testsuite/tests/th/all.T


Changes:

=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -33,6 +33,7 @@ import Data.IORef
 import System.IO.Unsafe ( unsafePerformIO )
 import Control.Monad (liftM)
 import Control.Monad.IO.Class (MonadIO (..))
+import Control.Applicative (liftA2)
 import System.IO        ( hPutStrLn, stderr )
 import Data.Char        ( isAlpha, isAlphaNum, isUpper, ord )
 import Data.Int
@@ -206,6 +207,14 @@ instance Applicative Q where
   Q f <*> Q x = Q (f <*> x)
   Q m *> Q n = Q (m *> n)
 
+-- | @since 2.17.0.0
+instance Semigroup a => Semigroup (Q a) where
+  (<>) = liftA2 (<>)
+
+-- | @since 2.17.0.0
+instance Monoid a => Monoid (Q a) where
+  mempty = pure mempty
+
 -----------------------------------------------------
 --
 --              The Quote class


=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -22,6 +22,8 @@
   * Fix Show instance for `Bytes`: we were showing the pointer value while we
     want to show the contents (#16457).
 
+  * Add `Semigroup` and `Monoid` instances for `Q` (#18123).
+
 ## 2.16.0.0 *TBA*
 
   * Add support for tuple sections. (#15843) The type signatures of `TupE` and


=====================================
testsuite/tests/th/T18123.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell, StandaloneDeriving #-}
+module T18123 where
+
+import Language.Haskell.TH
+
+data Point = MkPoint { _x, _y :: Double }
+data Rect = MkRect { _p1, _p2 :: Point }
+
+let
+    deriveEq :: Name -> DecsQ
+    deriveEq name = [d| deriving instance Eq $(conT name) |]
+ in
+    foldMap deriveEq [ ''Point, ''Rect ]


=====================================
testsuite/tests/th/all.T
=====================================
@@ -507,3 +507,4 @@ test('TH_PprStar', normal, compile, ['-v0 -dsuppress-uniques'])
 test('TH_StringLift', normal, compile, [''])
 test('TH_BytesShowEqOrd', normal, compile_and_run, [''])
 test('T18121', normal, compile, [''])
+test('T18123', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f621a78217237a4bdfb299b68827da6cc8f357e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f621a78217237a4bdfb299b68827da6cc8f357e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200528/55fb5a4c/attachment-0001.html>