From 557a3d4b6e153192d21d9b3ecb8bd5d2b619befc Mon Sep 17 00:00:00 2001
From: Auke Booij <aukebb@hasura.io>
Date: Fri, 18 Feb 2022 15:57:09 +0100
Subject: [PATCH] Derive a few Semigroup+Monoid instances

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3717
GitOrigin-RevId: 9bc7f64754a8461a006d9b633a712124f828166e
---
 .../src-lib/Hasura/Backends/BigQuery/Types.hs  |  8 +-------
 .../Hasura/Backends/MSSQL/Types/Instances.hs   |  6 ++----
 .../Hasura/Backends/MySQL/Types/Instances.hs   | 18 ++++++++----------
 .../src-lib/Hasura/GraphQL/Transport/HTTP.hs   |  9 ++-------
 4 files changed, 13 insertions(+), 28 deletions(-)

diff --git a/server/src-lib/Hasura/Backends/BigQuery/Types.hs b/server/src-lib/Hasura/Backends/BigQuery/Types.hs
index af221aebf10..b08d4f45585 100644
--- a/server/src-lib/Hasura/Backends/BigQuery/Types.hs
+++ b/server/src-lib/Hasura/Backends/BigQuery/Types.hs
@@ -319,13 +319,7 @@ instance NFData JoinSource
 
 newtype Where
   = Where [Expression]
-  deriving (NFData, Eq, Ord, Show, Generic, Data, Lift, FromJSON, Hashable, Cacheable)
-
-instance Monoid Where where
-  mempty = Where mempty
-
-instance Semigroup Where where
-  (Where x) <> (Where y) = Where (x <> y)
+  deriving (NFData, Eq, Ord, Show, Generic, Data, Lift, FromJSON, Hashable, Cacheable, Semigroup, Monoid)
 
 data Cardinality
   = Many
diff --git a/server/src-lib/Hasura/Backends/MSSQL/Types/Instances.hs b/server/src-lib/Hasura/Backends/MSSQL/Types/Instances.hs
index 8f63802bdec..596b1f493ea 100644
--- a/server/src-lib/Hasura/Backends/MSSQL/Types/Instances.hs
+++ b/server/src-lib/Hasura/Backends/MSSQL/Types/Instances.hs
@@ -233,11 +233,9 @@ instance FromJSON n => FromJSON (Countable n)
 
 deriving instance Ord ColumnName
 
-instance Monoid Where where
-  mempty = Where mempty
+deriving instance Monoid Where
 
-instance Semigroup Where where
-  (Where x) <> (Where y) = Where (x <> y)
+deriving instance Semigroup Where
 
 instance Monoid Top where
   mempty = NoTop
diff --git a/server/src-lib/Hasura/Backends/MySQL/Types/Instances.hs b/server/src-lib/Hasura/Backends/MySQL/Types/Instances.hs
index 3b2878a7029..1875d7bfd6e 100644
--- a/server/src-lib/Hasura/Backends/MySQL/Types/Instances.hs
+++ b/server/src-lib/Hasura/Backends/MySQL/Types/Instances.hs
@@ -20,7 +20,7 @@ import Hasura.Prelude
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
 
-$( fmap concat $ for
+$( concat <$> for
      [''Aliased]
      \name ->
        [d|
@@ -42,7 +42,7 @@ $( fmap concat $ for
          |]
  )
 
-$( fmap concat $ for
+$( concat <$> for
      [ ''Where,
        ''Aggregate,
        ''EntityAlias,
@@ -81,7 +81,7 @@ $( fmap concat $ for
          |]
  )
 
-$( fmap concat $ for
+$( concat <$> for
      [ ''ScalarType
      ]
      \name ->
@@ -98,17 +98,17 @@ $( fmap concat $ for
          |]
  )
 
-$( fmap concat $ for
+$( concat <$> for
      [''TableName, ''ScalarType]
      \name -> [d|deriving instance Ord $(conT name)|]
  )
 
-$( fmap concat $ for
+$( concat <$> for
      [''TableName, ''NullsOrder, ''Order]
      \name -> [d|deriving instance Lift $(conT name)|]
  )
 
-$( fmap concat $ for
+$( concat <$> for
      [''Order, ''NullsOrder, ''ScalarType, ''FieldName]
      \name ->
        [d|
@@ -167,11 +167,9 @@ instance ToJSONKey ScalarType
 instance ToTxt ScalarType where
   toTxt = tshow
 
-instance Monoid Where where
-  mempty = Where mempty
+deriving newtype instance Monoid Where
 
-instance Semigroup Where where
-  (Where x) <> (Where y) = Where (x <> y)
+deriving newtype instance Semigroup Where
 
 instance Monoid Top where
   mempty = NoTop
diff --git a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs
index cc7c4f01208..db6a588153c 100644
--- a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs
+++ b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs
@@ -36,6 +36,7 @@ import Data.ByteString.Lazy qualified as LBS
 import Data.Dependent.Map qualified as DM
 import Data.Environment qualified as Env
 import Data.HashMap.Strict.InsOrd qualified as OMap
+import Data.Monoid (Any (..))
 import Data.Text qualified as T
 import Hasura.Backends.Postgres.Instances.Transport (runPGMutationTransaction)
 import Hasura.Base.Error
@@ -226,17 +227,11 @@ buildResponse telemType res f = case res of
 -- | A predicate on session variables. The 'Monoid' instance makes it simple
 -- to combine several predicates disjunctively.
 newtype SessVarPred = SessVarPred {unSessVarPred :: SessionVariable -> SessionVariableValue -> Bool}
+  deriving (Semigroup, Monoid) via (SessionVariable -> SessionVariableValue -> Any)
 
 keepAllSessionVariables :: SessVarPred
 keepAllSessionVariables = SessVarPred $ \_ _ -> True
 
-instance Semigroup SessVarPred where
-  SessVarPred p1 <> SessVarPred p2 = SessVarPred $ \sv svv ->
-    p1 sv svv || p2 sv svv
-
-instance Monoid SessVarPred where
-  mempty = SessVarPred $ \_ _ -> False
-
 runSessVarPred :: SessVarPred -> SessionVariables -> SessionVariables
 runSessVarPred = filterSessionVariables . unSessVarPred