From 453e3bb0b10ba346d6332fe91f58e1f54137a69a Mon Sep 17 00:00:00 2001
From: Hitesh Sharma <hitesh.sharma@juspay.in>
Date: Wed, 21 Jun 2023 14:24:21 +0530
Subject: [PATCH 1/2] Supports ghc version 928 - WIP

---
 beam-core/Database/Beam/Backend/SQL/Row.hs         | 11 +++++++++--
 beam-core/Database/Beam/Query/Combinators.hs       |  2 +-
 beam-migrate/Database/Beam/Haskell/Syntax.hs       |  2 ++
 beam-migrate/Database/Beam/Migrate/Actions.hs      | 14 +++-----------
 .../Database/Beam/Migrate/Serialization.hs         | 10 +++++++++-
 beam-postgres/Database/Beam/Postgres/PgSpecific.hs |  6 +++---
 beam-sqlite/Database/Beam/Sqlite/Syntax.hs         |  2 ++
 7 files changed, 29 insertions(+), 18 deletions(-)

diff --git a/beam-core/Database/Beam/Backend/SQL/Row.hs b/beam-core/Database/Beam/Backend/SQL/Row.hs
index e9138f33c..715c29e36 100644
--- a/beam-core/Database/Beam/Backend/SQL/Row.hs
+++ b/beam-core/Database/Beam/Backend/SQL/Row.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE LambdaCase #-} -- for LambdaCase
 
 module Database.Beam.Backend.SQL.Row
   ( FromBackendRowF(..), FromBackendRowM(..)
@@ -63,7 +64,11 @@ data FromBackendRowF be f where
   ParseOneField :: (BackendFromField be a, Typeable a) => (a -> f) -> FromBackendRowF be f
   Alt :: FromBackendRowM be a -> FromBackendRowM be a -> (a -> f) -> FromBackendRowF be f
   FailParseWith :: BeamRowReadError -> FromBackendRowF be f
-deriving instance Functor (FromBackendRowF be)
+instance Functor (FromBackendRowF be) where
+  fmap f = \case
+    ParseOneField p -> ParseOneField $ f . p
+    Alt a b p -> Alt a b $ f . p
+    FailParseWith e -> FailParseWith e
 newtype FromBackendRowM be a = FromBackendRowM (F (FromBackendRowF be) a)
   deriving (Functor, Applicative)
 
@@ -202,7 +207,9 @@ instance (FromBackendRow be x, FromBackendRow be SqlNull) => FromBackendRow be (
                       pure ()))
   valuesNeeded be _ = valuesNeeded be (Proxy @x)
 
-deriving instance Generic (a, b, c, d, e, f, g, h)
+#if !MIN_VERSION_base(4,16,0)
+  deriving instance Generic (a, b, c, d, e, f, g, h)
+#endif
 
 instance (BeamBackend be, FromBackendRow be t) => FromBackendRow be (Tagged tag t) where
   fromBackendRow = Tagged <$> fromBackendRow
diff --git a/beam-core/Database/Beam/Query/Combinators.hs b/beam-core/Database/Beam/Query/Combinators.hs
index 60f33912a..c5a8e590a 100644
--- a/beam-core/Database/Beam/Query/Combinators.hs
+++ b/beam-core/Database/Beam/Query/Combinators.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
 
 module Database.Beam.Query.Combinators
     ( -- * Various SQL functions and constructs
diff --git a/beam-migrate/Database/Beam/Haskell/Syntax.hs b/beam-migrate/Database/Beam/Haskell/Syntax.hs
index 332b705ab..7a0f3dc14 100644
--- a/beam-migrate/Database/Beam/Haskell/Syntax.hs
+++ b/beam-migrate/Database/Beam/Haskell/Syntax.hs
@@ -1033,5 +1033,7 @@ instance Hashable (Hs.CName ())
 instance Hashable (Hs.DerivStrategy ())
 instance Hashable (Hs.MaybePromotedName ())
 #endif
+#if !MIN_VERSION_hashable(1, 3, 4)
 instance Hashable a => Hashable (S.Set a) where
   hashWithSalt s a = hashWithSalt s (S.toList a)
+#endif
diff --git a/beam-migrate/Database/Beam/Migrate/Actions.hs b/beam-migrate/Database/Beam/Migrate/Actions.hs
index 1ad023950..04bd28824 100644
--- a/beam-migrate/Database/Beam/Migrate/Actions.hs
+++ b/beam-migrate/Database/Beam/Migrate/Actions.hs
@@ -301,17 +301,12 @@ createTableActionProvider =
               guard (preTblNm == postTblNm)
 
          (columnsP, columns) <- pure . unzip $
-           do columnP@
-                (TableHasColumn tblNm colNm schema :: TableHasColumn be) <-
-                findPostConditions
+           do columnP@(TableHasColumn tblNm colNm schema :: TableHasColumn be) <- findPostConditions
               guard (tblNm == postTblNm && dataTypeHasBeenCreated schema findPreConditions)
 
               (constraintsP, constraints) <-
                 pure . unzip $ do
-                constraintP@
-                  (TableColumnHasConstraint tblNm' colNm' c
-                   :: TableColumnHasConstraint be) <-
-                  findPostConditions
+                constraintP@(TableColumnHasConstraint tblNm' colNm' c :: TableColumnHasConstraint be) <- findPostConditions
                 guard (postTblNm == tblNm')
                 guard (colNm == colNm')
 
@@ -379,10 +374,7 @@ addColumnProvider =
 
          (constraintsP, constraints) <-
            pure . unzip $ do
-           constraintP@
-             (TableColumnHasConstraint tblNm'' colNm' c
-              :: TableColumnHasConstraint be) <-
-             findPostConditions
+           constraintP@(TableColumnHasConstraint tblNm'' colNm' c :: TableColumnHasConstraint be) <- findPostConditions
            guard (tblNm == tblNm'')
            guard (colNm == colNm')
 
diff --git a/beam-migrate/Database/Beam/Migrate/Serialization.hs b/beam-migrate/Database/Beam/Migrate/Serialization.hs
index b8c87a21b..3dc831359 100644
--- a/beam-migrate/Database/Beam/Migrate/Serialization.hs
+++ b/beam-migrate/Database/Beam/Migrate/Serialization.hs
@@ -39,6 +39,9 @@ import           Control.Applicative
 import           Control.Monad
 
 import           Data.Aeson
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.Key as DAK
+#endif
 import           Data.Aeson.Types (Parser)
 import qualified Data.Dependent.Map as D
 import qualified Data.GADT.Compare as D
@@ -321,8 +324,13 @@ sql92Deserializers = mconcat
                    , beamDeserializer deserializeSql92ReferentialAction
                    , beamDeserializer deserializeSql92Attributes ]
   where
+  #if MIN_VERSION_aeson(2,0,0)
+    makeKey = DAK.fromText
+  #else
+    makeKey = id
+  #endif
     parseSub nm o key parse =
-      withObject (unpack (nm <> "." <> key)) parse =<< o .: key
+      withObject (unpack (nm <> "." <> key)) parse =<< o .: makeKey key
 
     deserializeSql92DataType :: BeamDeserializers be' -> Value
                              -> Parser (BeamSqlBackendDataTypeSyntax be)
diff --git a/beam-postgres/Database/Beam/Postgres/PgSpecific.hs b/beam-postgres/Database/Beam/Postgres/PgSpecific.hs
index a17e4f2a9..4f8bf0f15 100644
--- a/beam-postgres/Database/Beam/Postgres/PgSpecific.hs
+++ b/beam-postgres/Database/Beam/Postgres/PgSpecific.hs
@@ -439,7 +439,7 @@ arrayOf_ q =
 data PgBoundType
   = Inclusive
   | Exclusive
-  deriving (Show, Generic)
+  deriving (Eq, Show, Generic)
 instance Hashable PgBoundType
 
 lBound :: PgBoundType -> ByteString
@@ -452,7 +452,7 @@ uBound Exclusive = ")"
 
 -- | Represents a single bound on a Range. A bound always has a type, but may not have a value
 -- (the absense of a value represents unbounded).
-data PgRangeBound a = PgRangeBound PgBoundType (Maybe a) deriving (Show, Generic)
+data PgRangeBound a = PgRangeBound PgBoundType (Maybe a) deriving (Eq, Show, Generic)
 
 inclusive :: a -> PgRangeBound a
 inclusive = PgRangeBound Inclusive . Just
@@ -471,7 +471,7 @@ unbounded = PgRangeBound Exclusive Nothing
 data PgRange (n :: *) a
   = PgEmptyRange
   | PgRange (PgRangeBound a) (PgRangeBound a)
-  deriving (Show, Generic)
+  deriving (Eq, Show, Generic)
 
 instance Hashable a => Hashable (PgRangeBound a)
 
diff --git a/beam-sqlite/Database/Beam/Sqlite/Syntax.hs b/beam-sqlite/Database/Beam/Sqlite/Syntax.hs
index 673c9290d..82033f0a9 100644
--- a/beam-sqlite/Database/Beam/Sqlite/Syntax.hs
+++ b/beam-sqlite/Database/Beam/Sqlite/Syntax.hs
@@ -92,6 +92,7 @@ import           GHC.Generics
 -- value list is ignored.
 data SqliteSyntax = SqliteSyntax ((SQLData -> Builder) -> Builder) (DL.DList SQLData)
 newtype SqliteData = SqliteData SQLData -- newtype for Hashable
+  deriving (Eq)
 
 instance Show SqliteSyntax where
   show (SqliteSyntax s d) =
@@ -118,6 +119,7 @@ instance Hashable SqliteSyntax where
   hashWithSalt salt (SqliteSyntax s d) =
       hashWithSalt salt ( toLazyByteString (withPlaceholders s)
                         , map SqliteData (DL.toList d) )
+
 instance Hashable SqliteData where
   hashWithSalt salt (SqliteData (SQLInteger i)) = hashWithSalt salt (0 :: Int, i)
   hashWithSalt salt (SqliteData (SQLFloat d))   = hashWithSalt salt (1 :: Int, d)

From 44a60788bbaff2a61b3043ab507f139f713d8b00 Mon Sep 17 00:00:00 2001
From: Hitesh Sharma <hitesh.sharma@juspay.in>
Date: Mon, 26 Jun 2023 20:01:06 +0530
Subject: [PATCH 2/2] UPI-1540 Fixes instance for PgF

---
 beam-postgres/Database/Beam/Postgres/Connection.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/beam-postgres/Database/Beam/Postgres/Connection.hs b/beam-postgres/Database/Beam/Postgres/Connection.hs
index 0fd135261..4b0fe6bab 100644
--- a/beam-postgres/Database/Beam/Postgres/Connection.hs
+++ b/beam-postgres/Database/Beam/Postgres/Connection.hs
@@ -293,7 +293,12 @@ data PgF next where
         FromBackendRow Postgres x =>
         (Maybe x -> next) -> PgF next
     PgLiftWithHandle :: (Pg.Connection -> IO a) -> (a -> next) -> PgF next
-deriving instance Functor PgF
+instance Functor PgF where
+  fmap f = \case
+    PgLiftIO io n -> PgLiftIO io $ f . n
+    PgRunReturning cmd consume n -> PgRunReturning cmd consume $ f . n
+    PgFetchNext n -> PgFetchNext $ f . n
+    PgLiftWithHandle withConn n -> PgLiftWithHandle withConn $ f . n
 
 -- | 'MonadBeam' in which we can run Postgres commands. See the documentation
 -- for 'MonadBeam' on examples of how to use.