Jp 3724 syncbeam

beam-core/Database/Beam/Backend/SQL.hs

@@ -82,7 +82,6 @@ import qualified Control.Monad.Writer.Strict as Strict
 
 import Data.Tagged (Tagged)
 import Data.Text (Text)
-import GHC.Types (Type)
 
 -- * MonadBeam class
 
@@ -227,7 +226,7 @@ class ( -- Every SQL backend must be a beam backend
       , Eq (BeamSqlBackendExpressionSyntax be)
       ) => BeamSqlBackend be
 
-type family BeamSqlBackendSyntax be :: Type
+type family BeamSqlBackendSyntax be :: *
 
 -- | Fake backend that cannot deserialize anything, but is useful for testing
 data MockSqlBackend syntax

beam-core/Database/Beam/Backend/SQL/AST.hs

@@ -122,7 +122,8 @@ data Delete
   = Delete
   { deleteTable :: TableName
   , deleteAlias :: Maybe Text
-  , deleteWhere :: Maybe Expression }
+  , deleteWhere :: Maybe Expression
+  , deleteLimit :: Maybe Int }
   deriving (Show, Eq)
 
 instance IsSql92DeleteSyntax Delete where

beam-core/Database/Beam/Backend/SQL/BeamExtensions.hs

@@ -39,7 +39,6 @@ import qualified Control.Monad.State.Strict as Strict
 import qualified Control.Monad.Writer.Strict as Strict
 
 --import GHC.Generics
-import GHC.Types (Type)
 
 -- | 'MonadBeam's that support returning the newly created rows of an @INSERT@ statement.
 --   Useful for discovering the real value of a defaulted value.
@@ -146,10 +145,10 @@ instance (MonadBeamDeleteReturning be m, Monoid w)
 
 class BeamSqlBackend be => BeamHasInsertOnConflict be where
   -- | Specifies the kind of constraint that must be violated for the action to occur
-  data SqlConflictTarget be (table :: (Type -> Type) -> Type) :: Type
+  data SqlConflictTarget be (table :: (* -> *) -> *) :: *
   -- | What to do when an @INSERT@ statement inserts a row into the table @tbl@
   -- that violates a constraint.
-  data SqlConflictAction be (table :: (Type -> Type) -> Type) :: Type
+  data SqlConflictAction be (table :: (* -> *) -> *) :: *
 
   insertOnConflict
     :: Beamable table

beam-core/Database/Beam/Backend/SQL/Builder.hs

@@ -169,11 +169,12 @@ instance IsSql92DeleteSyntax SqlSyntaxBuilder where
   type Sql92DeleteExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
   type Sql92DeleteTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
 
-  deleteStmt tblNm alias where_ =
+  deleteStmt tblNm alias where_ limit =
     SqlSyntaxBuilder $
     byteString "DELETE FROM " <> buildSql tblNm <>
     maybe mempty (\alias_ -> byteString " AS " <> quoteSql alias_) alias <>
-    maybe mempty (\where_ -> byteString " WHERE " <> buildSql where_) where_
+    maybe mempty (\where_ -> byteString " WHERE " <> buildSql where_) where_ <>
+    maybe mempty (fromString . (" LIMIT " <>) . show) limit
 
   deleteSupportsAlias _ = True
 

beam-core/Database/Beam/Backend/SQL/Row.hs

@@ -1,7 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE PolyKinds #-}
@@ -37,7 +36,6 @@ import           Data.Proxy
 #endif
 
 import           GHC.Generics
-import           GHC.Types (Type)
 import           GHC.TypeLits
 
 -- | The exact error encountered
@@ -65,13 +63,7 @@ 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
-
-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
-
+deriving instance Functor (FromBackendRowF be)
 newtype FromBackendRowM be a = FromBackendRowM (F (FromBackendRowF be) a)
   deriving (Functor, Applicative)
 
@@ -114,7 +106,7 @@ class BeamBackend be => FromBackendRow be a where
   valuesNeeded :: Proxy be -> Proxy a -> Int
   valuesNeeded _ _ = 1
 
-class GFromBackendRow be (exposed :: Type -> Type) rep where
+class GFromBackendRow be (exposed :: * -> *) rep where
   gFromBackendRow :: Proxy exposed -> FromBackendRowM be (rep ())
   gValuesNeeded :: Proxy be -> Proxy exposed -> Proxy rep -> Int
 instance GFromBackendRow be e p => GFromBackendRow be (M1 t f e) (M1 t f p) where
@@ -210,6 +202,8 @@ 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)
+
 instance (BeamBackend be, FromBackendRow be t) => FromBackendRow be (Tagged tag t) where
   fromBackendRow = Tagged <$> fromBackendRow
 

beam-core/Database/Beam/Backend/SQL/SQL2003.hs

@@ -26,7 +26,6 @@ module Database.Beam.Backend.SQL.SQL2003
 import Database.Beam.Backend.SQL.SQL99
 
 import Data.Text (Text)
-import GHC.Types (Type)
 
 type Sql2003SanityCheck syntax =
     ( Sql92ExpressionSyntax syntax ~ Sql2003WindowFrameExpressionSyntax (Sql2003ExpressionWindowFrameSyntax (Sql92ExpressionSyntax syntax))
@@ -37,7 +36,7 @@ type Sql2003SanityCheck syntax =
 class IsSql92FromSyntax from =>
     IsSql2003FromSyntax from where
 
-    type Sql2003FromSampleMethodSyntax from :: Type
+    type Sql2003FromSampleMethodSyntax from :: *
 
     fromTableSample :: Sql92FromTableSourceSyntax from
                     -> Sql2003FromSampleMethodSyntax from
@@ -55,7 +54,7 @@ class ( IsSql99ExpressionSyntax expr
       , IsSql2003WindowFrameSyntax (Sql2003ExpressionWindowFrameSyntax expr) ) =>
     IsSql2003ExpressionSyntax expr where
 
-    type Sql2003ExpressionWindowFrameSyntax expr :: Type
+    type Sql2003ExpressionWindowFrameSyntax expr :: *
 
     overE :: expr
           -> Sql2003ExpressionWindowFrameSyntax expr
@@ -84,9 +83,9 @@ class IsSql99DataTypeSyntax dataType =>
 
 class IsSql2003WindowFrameBoundsSyntax (Sql2003WindowFrameBoundsSyntax frame) =>
     IsSql2003WindowFrameSyntax frame where
-    type Sql2003WindowFrameExpressionSyntax frame :: Type
-    type Sql2003WindowFrameOrderingSyntax frame :: Type
-    type Sql2003WindowFrameBoundsSyntax frame :: Type
+    type Sql2003WindowFrameExpressionSyntax frame :: *
+    type Sql2003WindowFrameOrderingSyntax frame :: *
+    type Sql2003WindowFrameBoundsSyntax frame :: *
 
     frameSyntax :: Maybe [Sql2003WindowFrameExpressionSyntax frame]
                 -> Maybe [Sql2003WindowFrameOrderingSyntax frame]
@@ -95,7 +94,7 @@ class IsSql2003WindowFrameBoundsSyntax (Sql2003WindowFrameBoundsSyntax frame) =>
 
 class IsSql2003WindowFrameBoundSyntax (Sql2003WindowFrameBoundsBoundSyntax bounds) =>
     IsSql2003WindowFrameBoundsSyntax bounds where
-    type Sql2003WindowFrameBoundsBoundSyntax bounds :: Type
+    type Sql2003WindowFrameBoundsBoundSyntax bounds :: *
     fromToBoundSyntax :: Sql2003WindowFrameBoundsBoundSyntax bounds
                       -> Maybe (Sql2003WindowFrameBoundsBoundSyntax bounds)
                       -> bounds

beam-core/Database/Beam/Backend/SQL/SQL92.hs

@@ -11,7 +11,6 @@ import Data.Tagged
 import Data.Text (Text)
 import Data.Time (LocalTime)
 import Data.Typeable
-import GHC.Types (Type)
 
 -- * Finally tagless style
 
@@ -90,10 +89,10 @@ class ( IsSql92SelectSyntax (Sql92SelectSyntax cmd)
       , IsSql92UpdateSyntax (Sql92UpdateSyntax cmd)
       , IsSql92DeleteSyntax (Sql92DeleteSyntax cmd) ) =>
   IsSql92Syntax cmd where
-  type Sql92SelectSyntax cmd :: Type
-  type Sql92InsertSyntax cmd :: Type
-  type Sql92UpdateSyntax cmd :: Type
-  type Sql92DeleteSyntax cmd :: Type
+  type Sql92SelectSyntax cmd :: *
+  type Sql92InsertSyntax cmd :: *
+  type Sql92UpdateSyntax cmd :: *
+  type Sql92DeleteSyntax cmd :: *
 
   selectCmd :: Sql92SelectSyntax cmd -> cmd
   insertCmd :: Sql92InsertSyntax cmd -> cmd
@@ -103,8 +102,8 @@ class ( IsSql92SelectSyntax (Sql92SelectSyntax cmd)
 class ( IsSql92SelectTableSyntax (Sql92SelectSelectTableSyntax select)
       , IsSql92OrderingSyntax (Sql92SelectOrderingSyntax select) ) =>
     IsSql92SelectSyntax select where
-    type Sql92SelectSelectTableSyntax select :: Type
-    type Sql92SelectOrderingSyntax select :: Type
+    type Sql92SelectSelectTableSyntax select :: *
+    type Sql92SelectOrderingSyntax select :: *
 
     selectStmt :: Sql92SelectSelectTableSyntax select
                -> [Sql92SelectOrderingSyntax select]
@@ -126,13 +125,13 @@ class ( IsSql92ExpressionSyntax (Sql92SelectTableExpressionSyntax select)
 
       , Eq (Sql92SelectTableExpressionSyntax select) ) =>
     IsSql92SelectTableSyntax select where
-  type Sql92SelectTableSelectSyntax select :: Type
-  type Sql92SelectTableExpressionSyntax select :: Type
-  type Sql92SelectTableProjectionSyntax select :: Type
-  type Sql92SelectTableFromSyntax select :: Type
-  type Sql92SelectTableGroupingSyntax select :: Type
-  type Sql92SelectTableSetQuantifierSyntax select :: Type
-  type Sql92SelectTableSetIndexHintsSyntax select :: Type
+  type Sql92SelectTableSelectSyntax select :: *
+  type Sql92SelectTableExpressionSyntax select :: *
+  type Sql92SelectTableProjectionSyntax select :: *
+  type Sql92SelectTableFromSyntax select :: *
+  type Sql92SelectTableGroupingSyntax select :: *
+  type Sql92SelectTableSetQuantifierSyntax select :: *
+  type Sql92SelectTableSetIndexHintsSyntax select :: *
 
   selectTableStmt :: Maybe (Sql92SelectTableSetQuantifierSyntax select)
                   -> Maybe (Text)
@@ -150,8 +149,8 @@ class ( IsSql92InsertValuesSyntax (Sql92InsertValuesSyntax insert)
       , IsSql92TableNameSyntax (Sql92InsertTableNameSyntax insert) ) =>
   IsSql92InsertSyntax insert where
 
-  type Sql92InsertValuesSyntax insert :: Type
-  type Sql92InsertTableNameSyntax insert :: Type
+  type Sql92InsertValuesSyntax insert :: *
+  type Sql92InsertTableNameSyntax insert :: *
 
   insertStmt :: Sql92InsertTableNameSyntax insert
              -> [ Text ]
@@ -161,8 +160,8 @@ class ( IsSql92InsertValuesSyntax (Sql92InsertValuesSyntax insert)
 
 class IsSql92ExpressionSyntax (Sql92InsertValuesExpressionSyntax insertValues) =>
   IsSql92InsertValuesSyntax insertValues where
-  type Sql92InsertValuesExpressionSyntax insertValues :: Type
-  type Sql92InsertValuesSelectSyntax insertValues :: Type
+  type Sql92InsertValuesExpressionSyntax insertValues :: *
+  type Sql92InsertValuesSelectSyntax insertValues :: *
 
   insertSqlExpressions :: [ [ Sql92InsertValuesExpressionSyntax insertValues ] ]
                        -> insertValues
@@ -174,9 +173,9 @@ class ( IsSql92ExpressionSyntax (Sql92UpdateExpressionSyntax update)
       , IsSql92TableNameSyntax (Sql92UpdateTableNameSyntax update) ) =>
       IsSql92UpdateSyntax update where
 
-  type Sql92UpdateTableNameSyntax update :: Type
-  type Sql92UpdateFieldNameSyntax update :: Type
-  type Sql92UpdateExpressionSyntax update :: Type
+  type Sql92UpdateTableNameSyntax update :: *
+  type Sql92UpdateFieldNameSyntax update :: *
+  type Sql92UpdateExpressionSyntax update :: *
 
   updateStmt :: Sql92UpdateTableNameSyntax update
              -> [(Sql92UpdateFieldNameSyntax update, Sql92UpdateExpressionSyntax update)]
@@ -186,11 +185,12 @@ class ( IsSql92ExpressionSyntax (Sql92UpdateExpressionSyntax update)
 class ( IsSql92TableNameSyntax (Sql92DeleteTableNameSyntax delete)
       , IsSql92ExpressionSyntax (Sql92DeleteExpressionSyntax delete) ) =>
   IsSql92DeleteSyntax delete where
-  type Sql92DeleteTableNameSyntax delete :: Type
-  type Sql92DeleteExpressionSyntax delete :: Type
+  type Sql92DeleteTableNameSyntax delete :: *
+  type Sql92DeleteExpressionSyntax delete :: *
 
   deleteStmt :: Sql92DeleteTableNameSyntax delete -> Maybe Text
              -> Maybe (Sql92DeleteExpressionSyntax delete)
+             -> Maybe Int {-^ LIMIT -}
              -> delete
 
   -- | Whether or not the @DELETE@ command supports aliases
@@ -241,12 +241,12 @@ class ( HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Int
       , IsSql92ExtractFieldSyntax (Sql92ExpressionExtractFieldSyntax expr)
       , Typeable expr ) =>
     IsSql92ExpressionSyntax expr where
-  type Sql92ExpressionQuantifierSyntax expr :: Type
-  type Sql92ExpressionValueSyntax expr :: Type
-  type Sql92ExpressionSelectSyntax expr :: Type
-  type Sql92ExpressionFieldNameSyntax expr :: Type
-  type Sql92ExpressionCastTargetSyntax expr :: Type
-  type Sql92ExpressionExtractFieldSyntax expr :: Type
+  type Sql92ExpressionQuantifierSyntax expr :: *
+  type Sql92ExpressionValueSyntax expr :: *
+  type Sql92ExpressionSelectSyntax expr :: *
+  type Sql92ExpressionFieldNameSyntax expr :: *
+  type Sql92ExpressionCastTargetSyntax expr :: *
+  type Sql92ExpressionExtractFieldSyntax expr :: *
 
   valueE :: Sql92ExpressionValueSyntax expr -> expr
 
@@ -325,7 +325,7 @@ instance HasSqlValueSyntax syntax x => HasSqlValueSyntax syntax (SqlSerial x) wh
 class IsSql92AggregationSetQuantifierSyntax (Sql92AggregationSetQuantifierSyntax expr) =>
   IsSql92AggregationExpressionSyntax expr where
 
-  type Sql92AggregationSetQuantifierSyntax expr :: Type
+  type Sql92AggregationSetQuantifierSyntax expr :: *
 
   countAllE :: expr
   countE, avgE, maxE, minE, sumE
@@ -335,18 +335,18 @@ class IsSql92AggregationSetQuantifierSyntax q where
   setQuantifierDistinct, setQuantifierAll :: q
 
 class IsSql92AggregationIndexHintsSyntax ind where
-  type Sql92AggregationIndexHintsSyntax ind :: Type
+  type Sql92AggregationIndexHintsSyntax ind :: *
   setIndexForce, setIndexUse
     :: Sql92AggregationIndexHintsSyntax ind -> ind
 
 class IsSql92ExpressionSyntax (Sql92ProjectionExpressionSyntax proj) => IsSql92ProjectionSyntax proj where
-  type Sql92ProjectionExpressionSyntax proj :: Type
+  type Sql92ProjectionExpressionSyntax proj :: *
 
   projExprs :: [ (Sql92ProjectionExpressionSyntax proj, Maybe Text) ]
             -> proj
 
 class IsSql92OrderingSyntax ord where
-  type Sql92OrderingExpressionSyntax ord :: Type
+  type Sql92OrderingExpressionSyntax ord :: *
   ascOrdering, descOrdering
     :: Sql92OrderingExpressionSyntax ord -> ord
 
@@ -358,25 +358,25 @@ class IsSql92TableNameSyntax tblName where
 class IsSql92TableNameSyntax (Sql92TableSourceTableNameSyntax tblSource) =>
   IsSql92TableSourceSyntax tblSource where
 
-  type Sql92TableSourceSelectSyntax tblSource :: Type
-  type Sql92TableSourceExpressionSyntax tblSource :: Type
-  type Sql92TableSourceTableNameSyntax tblSource :: Type
+  type Sql92TableSourceSelectSyntax tblSource :: *
+  type Sql92TableSourceExpressionSyntax tblSource :: *
+  type Sql92TableSourceTableNameSyntax tblSource :: *
 
   tableNamed :: Sql92TableSourceTableNameSyntax tblSource
              -> tblSource
   tableFromSubSelect :: Sql92TableSourceSelectSyntax tblSource -> tblSource
   tableFromValues :: [ [ Sql92TableSourceExpressionSyntax tblSource ] ] -> tblSource
 
 class IsSql92GroupingSyntax grouping where
-  type Sql92GroupingExpressionSyntax grouping :: Type
+  type Sql92GroupingExpressionSyntax grouping :: *
 
   groupByExpressions :: [ Sql92GroupingExpressionSyntax grouping ] -> grouping
 
 class ( IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax from)
       , IsSql92ExpressionSyntax (Sql92FromExpressionSyntax from) ) =>
     IsSql92FromSyntax from where
-  type Sql92FromTableSourceSyntax from :: Type
-  type Sql92FromExpressionSyntax from :: Type
+  type Sql92FromTableSourceSyntax from :: *
+  type Sql92FromExpressionSyntax from :: *
 
   fromTable :: Sql92FromTableSourceSyntax from
             -> Maybe (Text, Maybe [Text])

beam-core/Database/Beam/Backend/SQL/SQL99.hs

@@ -16,7 +16,6 @@ module Database.Beam.Backend.SQL.SQL99
 import Database.Beam.Backend.SQL.SQL92
 
 import Data.Text ( Text )
-import GHC.Types (Type)
 
 class IsSql92SelectSyntax select =>
   IsSql99SelectSyntax select
@@ -54,7 +53,7 @@ class IsSql92DataTypeSyntax dataType =>
 
 class IsSql92SelectSyntax syntax =>
   IsSql99CommonTableExpressionSelectSyntax syntax where
-  type Sql99SelectCTESyntax syntax :: Type
+  type Sql99SelectCTESyntax syntax :: *
 
   withSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax
 
@@ -64,6 +63,6 @@ class IsSql99CommonTableExpressionSelectSyntax syntax
   withRecursiveSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax
 
 class IsSql99CommonTableExpressionSyntax syntax where
-  type Sql99CTESelectSyntax syntax :: Type
+  type Sql99CTESelectSyntax syntax :: *
 
   cteSubquerySyntax :: Text -> [Text] -> Sql99CTESelectSyntax syntax -> syntax

beam-core/Database/Beam/Backend/Types.hs

@@ -12,7 +12,7 @@ import           GHC.Types
 -- | Class for all Beam backends
 class BeamBackend be where
   -- | Requirements to marshal a certain type from a database of a particular backend
-  type BackendFromField be :: Type -> Constraint
+  type BackendFromField be :: * -> Constraint
 
 -- | newtype mainly used to inspect the tag structure of a particular
 --   'Beamable'. Prevents overlapping instances in some case. Usually not used
@@ -27,4 +27,4 @@ data Exposed x
 -- >                 deriving (Generic, Typeable)
 --
 -- See 'Columnar' for more information.
-data Nullable (c :: Type -> Type) x
+data Nullable (c :: * -> *) x