diff --git a/.envrc b/.envrc deleted file mode 100644 index 3550a30f2..000000000 --- a/.envrc +++ /dev/null @@ -1 +0,0 @@ -use flake diff --git a/beam-core/Database/Beam/Backend/SQL.hs b/beam-core/Database/Beam/Backend/SQL.hs index 1991e434d..02e903910 100644 --- a/beam-core/Database/Beam/Backend/SQL.hs +++ b/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 diff --git a/beam-core/Database/Beam/Backend/SQL/AST.hs b/beam-core/Database/Beam/Backend/SQL/AST.hs index fa27dcfa6..3d730c1c8 100644 --- a/beam-core/Database/Beam/Backend/SQL/AST.hs +++ b/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 diff --git a/beam-core/Database/Beam/Backend/SQL/BeamExtensions.hs b/beam-core/Database/Beam/Backend/SQL/BeamExtensions.hs index 36b4029b3..5f76e2e9b 100644 --- a/beam-core/Database/Beam/Backend/SQL/BeamExtensions.hs +++ b/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 diff --git a/beam-core/Database/Beam/Backend/SQL/Builder.hs b/beam-core/Database/Beam/Backend/SQL/Builder.hs index c66774018..0b1e9cb3f 100644 --- a/beam-core/Database/Beam/Backend/SQL/Builder.hs +++ b/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 diff --git a/beam-core/Database/Beam/Backend/SQL/Row.hs b/beam-core/Database/Beam/Backend/SQL/Row.hs index a15474b10..e9138f33c 100644 --- a/beam-core/Database/Beam/Backend/SQL/Row.hs +++ b/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 diff --git a/beam-core/Database/Beam/Backend/SQL/SQL2003.hs b/beam-core/Database/Beam/Backend/SQL/SQL2003.hs index c11221c2c..2b60d5ec4 100644 --- a/beam-core/Database/Beam/Backend/SQL/SQL2003.hs +++ b/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 diff --git a/beam-core/Database/Beam/Backend/SQL/SQL92.hs b/beam-core/Database/Beam/Backend/SQL/SQL92.hs index f372a420e..ef7dd7cfd 100644 --- a/beam-core/Database/Beam/Backend/SQL/SQL92.hs +++ b/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,9 +358,9 @@ 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 @@ -368,15 +368,15 @@ class IsSql92TableNameSyntax (Sql92TableSourceTableNameSyntax 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]) diff --git a/beam-core/Database/Beam/Backend/SQL/SQL99.hs b/beam-core/Database/Beam/Backend/SQL/SQL99.hs index b626a01fc..68810d79a 100644 --- a/beam-core/Database/Beam/Backend/SQL/SQL99.hs +++ b/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 diff --git a/beam-core/Database/Beam/Backend/Types.hs b/beam-core/Database/Beam/Backend/Types.hs index f48545a3a..fa072fabe 100644 --- a/beam-core/Database/Beam/Backend/Types.hs +++ b/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 diff --git a/beam-core/Database/Beam/Query.hs b/beam-core/Database/Beam/Query.hs index f8c876b20..475198832 100644 --- a/beam-core/Database/Beam/Query.hs +++ b/beam-core/Database/Beam/Query.hs @@ -90,7 +90,7 @@ module Database.Beam.Query -- ** @DELETE@ , SqlDelete(..) - , delete, delete' + , delete, delete', deleteWLimit , runDelete ) where import Prelude hiding (lookup) @@ -122,8 +122,6 @@ import Data.Functor.Const (Const(..)) import Data.Text (Text) import Data.Proxy -import GHC.Types (Type) - import Lens.Micro ((^.)) -- * Query @@ -206,7 +204,7 @@ dumpSqlSelect q = -- * INSERT -- | Represents a SQL @INSERT@ command that has not yet been run -data SqlInsert be (table :: (Type -> Type) -> Type) +data SqlInsert be (table :: (* -> *) -> *) = SqlInsert !(TableSettings table) !(BeamSqlBackendInsertSyntax be) | SqlInsertNoRows @@ -245,7 +243,7 @@ runInsert (SqlInsert _ i) = runNoReturn (insertCmd i) -- | Represents a source of values that can be inserted into a table shaped like -- 'tbl'. -data SqlInsertValues be proj --(tbl :: (Type -> Type) -> Type) +data SqlInsertValues be proj --(tbl :: (* -> *) -> *) = SqlInsertValues (BeamSqlBackendInsertValuesSyntax be) | SqlInsertValuesEmpty @@ -291,7 +289,7 @@ insertFrom s = SqlInsertValues (insertFromSql (buildSqlQuery "t" s)) -- * UPDATE -- | Represents a SQL @UPDATE@ statement for the given @table@. -data SqlUpdate be (table :: (Type -> Type) -> Type) +data SqlUpdate be (table :: (* -> *) -> *) = SqlUpdate !(TableSettings table) !(BeamSqlBackendUpdateSyntax be) | SqlIdentityUpdate -- An update with no assignments @@ -594,20 +592,21 @@ runUpdate SqlIdentityUpdate = pure () -- * DELETE -- | Represents a SQL @DELETE@ statement for the given @table@ -data SqlDelete be (table :: (Type -> Type) -> Type) +data SqlDelete be (table :: (* -> *) -> *) = SqlDelete !(TableSettings table) !(BeamSqlBackendDeleteSyntax be) -- | Build a 'SqlDelete' from a table and a way to build a @WHERE@ clause deleteImplementation :: forall bool be db table . BeamSqlBackend be - => DatabaseEntity be db (TableEntity table) + => Maybe Int + -> DatabaseEntity be db (TableEntity table) -- ^ Table to delete from -> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s bool) -- ^ Build a @WHERE@ clause given a table containing expressions -> SqlDelete be table -deleteImplementation (DatabaseEntity dt@(DatabaseTable {})) mkWhere = +deleteImplementation limit (DatabaseEntity dt@(DatabaseTable {})) mkWhere = SqlDelete (dbTableSettings dt) - (deleteStmt (tableNameFromEntity dt) alias (Just (where_ "t"))) + (deleteStmt (tableNameFromEntity dt) alias (Just (where_ "t")) limit) where supportsAlias = deleteSupportsAlias (Proxy @(BeamSqlBackendDeleteSyntax be)) @@ -625,7 +624,17 @@ delete :: forall be db table -> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool) -- ^ Build a @WHERE@ clause given a table containing expressions -> SqlDelete be table -delete = deleteImplementation @Bool +delete = (deleteImplementation @Bool) Nothing + +deleteWLimit :: forall be db table + . BeamSqlBackend be + => Maybe Int + -> DatabaseEntity be db (TableEntity table) + -- ^ Table to delete from + -> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s SqlBool) + -- ^ Build a @WHERE@ clause given a table containing expressions + -> SqlDelete be table +deleteWLimit = deleteImplementation @SqlBool delete' :: forall be db table . BeamSqlBackend be @@ -634,7 +643,7 @@ delete' :: forall be db table -> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s SqlBool) -- ^ Build a @WHERE@ clause given a table containing expressions -> SqlDelete be table -delete' = deleteImplementation @SqlBool +delete' = (deleteImplementation @SqlBool) Nothing -- | Run a 'SqlDelete' in a 'MonadBeam' runDelete :: (BeamSqlBackend be, MonadBeam be m) diff --git a/beam-core/Database/Beam/Query/Adhoc.hs b/beam-core/Database/Beam/Query/Adhoc.hs index 4f01f63ae..602e8e05f 100644 --- a/beam-core/Database/Beam/Query/Adhoc.hs +++ b/beam-core/Database/Beam/Query/Adhoc.hs @@ -15,10 +15,8 @@ import Control.Monad.Free.Church import qualified Data.Text as T -import GHC.Types (Type) - class Adhoc structure where - type AdhocTable structure (f :: Type -> Type) :: Type + type AdhocTable structure (f :: * -> *) :: * mkAdhocField :: (forall a. T.Text -> f a) -> structure -> AdhocTable structure f diff --git a/beam-core/Database/Beam/Query/CTE.hs b/beam-core/Database/Beam/Query/CTE.hs index 767bc104a..eb119a75b 100644 --- a/beam-core/Database/Beam/Query/CTE.hs +++ b/beam-core/Database/Beam/Query/CTE.hs @@ -19,8 +19,6 @@ import Data.Proxy (Proxy(Proxy)) import Data.Semigroup #endif -import GHC.Types (Type) - data Recursiveness be where Nonrecursive :: Recursiveness be Recursive :: IsSql99RecursiveCommonTableExpressionSelectSyntax (BeamSqlBackendSelectSyntax be) @@ -48,7 +46,7 @@ instance Semigroup (Recursiveness be) where -- 'reuse') even /before/ they're introduced. -- -- See further documentation . -newtype With be (db :: (Type -> Type) -> Type) a +newtype With be (db :: (* -> *) -> *) a = With { runWith :: WriterT (Recursiveness be, [ BeamSql99BackendCTESyntax be ]) (State Int) a } deriving (Monad, Applicative, Functor) diff --git a/beam-core/Database/Beam/Query/Combinators.hs b/beam-core/Database/Beam/Query/Combinators.hs index 7798a6524..f0c69f786 100644 --- a/beam-core/Database/Beam/Query/Combinators.hs +++ b/beam-core/Database/Beam/Query/Combinators.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE CPP #-} module Database.Beam.Query.Combinators diff --git a/beam-core/Database/Beam/Query/CustomSQL.hs b/beam-core/Database/Beam/Query/CustomSQL.hs index 4f1d3851f..0ebc81a0b 100644 --- a/beam-core/Database/Beam/Query/CustomSQL.hs +++ b/beam-core/Database/Beam/Query/CustomSQL.hs @@ -58,12 +58,10 @@ import Data.Semigroup import Data.String import qualified Data.Text as T -import GHC.Types (Type) - -- | A type-class for expression syntaxes that can embed custom expressions. class (Monoid (CustomSqlSyntax syntax), Semigroup (CustomSqlSyntax syntax), IsString (CustomSqlSyntax syntax)) => IsCustomSqlSyntax syntax where - data CustomSqlSyntax syntax :: Type + data CustomSqlSyntax syntax :: * -- | Given an arbitrary string-like expression, produce a 'syntax' that represents the -- 'ByteString' as a SQL expression. diff --git a/beam-core/Database/Beam/Query/Internal.hs b/beam-core/Database/Beam/Query/Internal.hs index 3da0cbccf..1cfe0ee9c 100644 --- a/beam-core/Database/Beam/Query/Internal.hs +++ b/beam-core/Database/Beam/Query/Internal.hs @@ -34,7 +34,7 @@ type ProjectibleInBackend be a = type TablePrefix = T.Text -data QF be (db :: (Type -> Type) -> Type) s next where +data QF be (db :: (* -> *) -> *) s next where QDistinct :: Projectible be r => (r -> WithExprContext (BeamSqlBackendSetQuantifierSyntax be)) -> QM be db s r -> (r -> next) -> QF be db s next @@ -113,7 +113,7 @@ type QM be db s = F (QF be db s) -- | The type of queries over the database `db` returning results of type `a`. -- The `s` argument is a threading argument meant to restrict cross-usage of -- `QExpr`s. 'syntax' represents the SQL syntax that this query is building. -newtype Q be (db :: (Type -> Type) -> Type) s a +newtype Q be (db :: (* -> *) -> *) s a = Q { runQ :: QM be db s a } deriving (Monad, Applicative, Functor) @@ -272,8 +272,8 @@ type family ValueContextSuggestion a :: ErrorMessage where type Projectible be = ProjectibleWithPredicate AnyType be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) type ProjectibleValue be = ProjectibleWithPredicate ValueContext be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) -class ThreadRewritable (s :: Type) (a :: Type) | a -> s where - type WithRewrittenThread s (s' :: Type) a :: Type +class ThreadRewritable (s :: *) (a :: *) | a -> s where + type WithRewrittenThread s (s' :: *) a :: * rewriteThread :: Proxy s' -> a -> WithRewrittenThread s s' a instance Beamable tbl => ThreadRewritable s (tbl (QGenExpr ctxt syntax s)) where @@ -344,7 +344,7 @@ instance ( ThreadRewritable s a, ThreadRewritable s b, ThreadRewritable s c, Thr , rewriteThread s' e, rewriteThread s' f, rewriteThread s' g, rewriteThread s' h ) class ContextRewritable a where - type WithRewrittenContext a ctxt :: Type + type WithRewrittenContext a ctxt :: * rewriteContext :: Proxy ctxt -> a -> WithRewrittenContext a ctxt instance Beamable tbl => ContextRewritable (tbl (QGenExpr old syntax s)) where @@ -428,7 +428,7 @@ newtype BeamSqlBackendWindowFrameSyntax' be { fromBeamSqlBackendWindowFrameSyntax :: BeamSqlBackendWindowFrameSyntax be } -class ProjectibleWithPredicate (contextPredicate :: Type -> Constraint) be res a | a -> be where +class ProjectibleWithPredicate (contextPredicate :: * -> Constraint) be res a | a -> be where project' :: Monad m => Proxy contextPredicate -> Proxy (be, res) -> (forall context. contextPredicate context => Proxy context -> Proxy be -> res -> m res) diff --git a/beam-core/Database/Beam/Query/SQL92.hs b/beam-core/Database/Beam/Query/SQL92.hs index e31359a14..6c0fd81c5 100644 --- a/beam-core/Database/Beam/Query/SQL92.hs +++ b/beam-core/Database/Beam/Query/SQL92.hs @@ -23,8 +23,6 @@ import Data.Proxy (Proxy(Proxy)) import Data.String import qualified Data.Text as T -import GHC.Types (Type) - -- * Beam queries andE' :: IsSql92ExpressionSyntax expr => @@ -56,7 +54,7 @@ data QueryBuilder be , qbFrom :: Maybe (BeamSqlBackendFromSyntax be) , qbWhere :: Maybe (BeamSqlBackendExpressionSyntax be) } -data SelectBuilder be (db :: (Type -> Type) -> Type) a where +data SelectBuilder be (db :: (* -> *) -> *) a where SelectBuilderQ :: ( BeamSqlBackend be , Projectible be a ) => a -> QueryBuilder be -> SelectBuilder be db a diff --git a/beam-core/Database/Beam/Schema/Lenses.hs b/beam-core/Database/Beam/Schema/Lenses.hs index 162b40f6b..0f704f57d 100644 --- a/beam-core/Database/Beam/Schema/Lenses.hs +++ b/beam-core/Database/Beam/Schema/Lenses.hs @@ -18,11 +18,10 @@ import Control.Monad.Identity import Data.Proxy import GHC.Generics -import GHC.Types (Type) import Lens.Micro hiding (to) -class GTableLenses t (m :: Type -> Type) a (lensType :: Type -> Type) where +class GTableLenses t (m :: * -> *) a (lensType :: * -> *) where gTableLenses :: Proxy a -> Lens' (t m) (a p) -> lensType () instance GTableLenses t m a al => GTableLenses t m (M1 s d a) (M1 s d al) where gTableLenses (Proxy :: Proxy (M1 s d a)) lensToHere = M1 $ gTableLenses (Proxy :: Proxy a) (\f -> lensToHere (\(M1 x) -> M1 <$> f x)) diff --git a/beam-core/Database/Beam/Schema/Tables.hs b/beam-core/Database/Beam/Schema/Tables.hs index 57378859a..2f022a39f 100644 --- a/beam-core/Database/Beam/Schema/Tables.hs +++ b/beam-core/Database/Beam/Schema/Tables.hs @@ -103,7 +103,7 @@ import qualified Lens.Micro as Lens -- | Allows introspection into database types. -- --- All database types must be of kind '(Type -> Type) -> Type'. If the type parameter +-- All database types must be of kind '(* -> *) -> *'. If the type parameter -- is named 'f', each field must be of the type of 'f' applied to some type -- for which an 'IsDatabaseEntity' instance exists. -- @@ -288,10 +288,10 @@ instance IsString (FieldModification (TableField tbl) a) where -- | An entity tag for tables. See the documentation for 'Table' or consult the -- [manual](https://haskell-beam.github.io/beam/user-guide/models) for more. -data TableEntity (tbl :: (Type -> Type) -> Type) -data ViewEntity (view :: (Type -> Type) -> Type) ---data UniqueConstraint (tbl :: (Type -> Type) -> Type) (c :: (Type -> Type) -> Type) -data DomainTypeEntity (ty :: Type) +data TableEntity (tbl :: (* -> *) -> *) +data ViewEntity (view :: (* -> *) -> *) +--data UniqueConstraint (tbl :: (* -> *) -> *) (c :: (* -> *) -> *) +data DomainTypeEntity (ty :: *) --data CharacterSetEntity --data CollationEntity --data TranslationEntity @@ -299,7 +299,7 @@ data DomainTypeEntity (ty :: Type) class RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be entityType)) => IsDatabaseEntity be entityType where - data DatabaseEntityDescriptor be entityType :: Type + data DatabaseEntityDescriptor be entityType :: * type DatabaseEntityDefaultRequirements be entityType :: Constraint type DatabaseEntityRegularRequirements be entityType :: Constraint @@ -386,7 +386,7 @@ instance IsDatabaseEntity be (DomainTypeEntity ty) where -- | Represents a meta-description of a particular entityType. Mostly, a wrapper -- around 'DatabaseEntityDescriptor be entityType', but carries around the -- 'IsDatabaseEntity' dictionary. -data DatabaseEntity be (db :: (Type -> Type) -> Type) entityType where +data DatabaseEntity be (db :: (* -> *) -> *) entityType where DatabaseEntity :: IsDatabaseEntity be entityType => DatabaseEntityDescriptor be entityType -> DatabaseEntity be db entityType @@ -433,7 +433,7 @@ instance (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) => gZipDatabase _ combine ~(K1 x) ~(K1 y) = K1 <$> combine x y -data Lenses (t :: (Type -> Type) -> Type) (f :: Type -> Type) x +data Lenses (t :: (* -> *) -> *) (f :: * -> *) x data LensFor t x where LensFor :: Generic t => Lens' t x -> LensFor t x @@ -475,7 +475,7 @@ data LensFor t x where -- turned into query expressions. -- -- The other rules are used within Beam to provide lenses and to expose the inner structure of the data type. -type family Columnar (f :: Type -> Type) x where +type family Columnar (f :: * -> *) x where Columnar Exposed x = Exposed x Columnar Identity x = x @@ -513,7 +513,7 @@ newtype ComposeColumnar f g a = ComposeColumnar (f (Columnar g a)) -- naming convention for you, and then modify it with 'withDbModification' if -- necessary. Under this scheme, the field n be renamed using the 'IsString' -- instance for 'TableField', or the 'fieldNamed' function. -data TableField (table :: (Type -> Type) -> Type) ty +data TableField (table :: (* -> *) -> *) ty = TableField { _fieldPath :: NE.NonEmpty T.Text -- ^ The path that led to this field. Each element is the haskell @@ -560,7 +560,7 @@ type HasBeamFields table f g h = ( GZipTables f g h (Rep (table Exposed)) -- | The big Kahuna! All beam tables implement this class. -- --- The kind of all table types is '(Type -> Type) -> Type'. This is because all table types are actually /table type constructors/. +-- The kind of all table types is '(* -> *) -> *'. This is because all table types are actually /table type constructors/. -- Every table type takes in another type constructor, called the /column tag/, and uses that constructor to instantiate the column types. -- See the documentation for 'Columnar'. -- @@ -590,11 +590,11 @@ type HasBeamFields table f g h = ( GZipTables f g h (Rep (table Exposed)) -- `_blogPostTagline` is declared 'Maybe' so 'Nothing' will be stored as NULL in the database. `_blogPostImageGallery` will be allowed to be empty because it uses the 'Nullable' tag modifier. -- * `blogPostAuthor` references the `AuthorT` table (not given here) and is required. -- * `blogPostImageGallery` references the `ImageGalleryT` table (not given here), but this relation is not required (i.e., it may be 'Nothing'. See 'Nullable'). -class (Typeable table, Beamable table, Beamable (PrimaryKey table)) => Table (table :: (Type -> Type) -> Type) where +class (Typeable table, Beamable table, Beamable (PrimaryKey table)) => Table (table :: (* -> *) -> *) where -- | A data type representing the types of primary keys for this table. -- In order to play nicely with the default deriving mechanism, this type must be an instance of 'Generic'. - data PrimaryKey table (column :: Type -> Type) :: Type + data PrimaryKey table (column :: * -> *) :: * -- | Given a table, this should return the PrimaryKey from the table. By keeping this polymorphic over column, -- we ensure that the primary key values come directly from the table (i.e., they can't be arbitrary constants) @@ -650,12 +650,12 @@ alongsideTable a b = zipBeamFieldsM (\x y -> pure (Columnar' (x :*: y))) a b class Retaggable f x | x -> f where - type Retag (tag :: (Type -> Type) -> Type -> Type) x :: Type + type Retag (tag :: (* -> *) -> * -> *) x :: * retag :: (forall a. Columnar' f a -> Columnar' (tag f) a) -> x -> Retag tag x -instance Beamable tbl => Retaggable f (tbl (f :: Type -> Type)) where +instance Beamable tbl => Retaggable f (tbl (f :: * -> *)) where type Retag tag (tbl f) = tbl (tag f) retag = changeBeamRep @@ -723,14 +723,14 @@ instance ( Retaggable f' a, Retaggable f' b, Retaggable f' c, Retaggable f' d , retag transform e, retag transform f, retag transform g, retag transform h ) -- | Carry a constraint instance and the value it applies to. -data WithConstraint (c :: Type -> Constraint) x where +data WithConstraint (c :: * -> Constraint) x where WithConstraint :: c x => x -> WithConstraint c x -- | Carry a constraint instance. -data HasConstraint (c :: Type -> Constraint) x where +data HasConstraint (c :: * -> Constraint) x where HasConstraint :: c x => HasConstraint c x -class GFieldsFulfillConstraint (c :: Type -> Constraint) (exposed :: Type -> Type) withconstraint where +class GFieldsFulfillConstraint (c :: * -> Constraint) (exposed :: * -> *) withconstraint where gWithConstrainedFields :: Proxy c -> Proxy exposed -> withconstraint () instance GFieldsFulfillConstraint c exposed withconstraint => GFieldsFulfillConstraint c (M1 s m exposed) (M1 s m withconstraint) where @@ -767,11 +767,11 @@ withNullableConstrainedFields = runIdentity . zipBeamFieldsM f (withNullableCons withNullableConstraints :: forall c tbl. (Beamable tbl, FieldsFulfillConstraintNullable c tbl) => tbl (Nullable (HasConstraint c)) withNullableConstraints = to $ gWithConstrainedFields (Proxy @c) (Proxy @(Rep (tbl (Nullable Exposed)))) -type FieldsFulfillConstraint (c :: Type -> Constraint) t = +type FieldsFulfillConstraint (c :: * -> Constraint) t = ( Generic (t (HasConstraint c)), Generic (t Identity), Generic (t Exposed) , GFieldsFulfillConstraint c (Rep (t Exposed)) (Rep (t (HasConstraint c)))) -type FieldsFulfillConstraintNullable (c :: Type -> Constraint) t = +type FieldsFulfillConstraintNullable (c :: * -> Constraint) t = ( Generic (t (Nullable (HasConstraint c))), Generic (t (Nullable Identity)), Generic (t (Nullable Exposed)) , GFieldsFulfillConstraint c (Rep (t (Nullable Exposed))) (Rep (t (Nullable (HasConstraint c))))) @@ -790,7 +790,7 @@ defTblFieldSettings = withProxy $ \proxy -> to' (gDefTblFieldSettings proxy) where withProxy :: (Proxy (Rep (TableSettings table) ()) -> TableSettings table) -> TableSettings table withProxy f = f Proxy -class GZipTables f g h (exposedRep :: Type -> Type) fRep gRep hRep where +class GZipTables f g h (exposedRep :: * -> *) fRep gRep hRep where gZipTables :: Applicative m => Proxy exposedRep -> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a)) -> fRep () @@ -875,20 +875,20 @@ data SubTableStrategy | BeamableStrategy | RecursiveKeyStrategy -type family ChooseSubTableStrategy (tbl :: (Type -> Type) -> Type) (sub :: (Type -> Type) -> Type) :: SubTableStrategy where +type family ChooseSubTableStrategy (tbl :: (* -> *) -> *) (sub :: (* -> *) -> *) :: SubTableStrategy where ChooseSubTableStrategy tbl (PrimaryKey tbl) = 'RecursiveKeyStrategy ChooseSubTableStrategy tbl (PrimaryKey rel) = 'PrimaryKeyStrategy ChooseSubTableStrategy tbl sub = 'BeamableStrategy -- TODO is this necessary -type family CheckNullable (f :: Type -> Type) :: Constraint where +type family CheckNullable (f :: * -> *) :: Constraint where CheckNullable (Nullable f) = () CheckNullable f = TypeError ('Text "Recursive reference without Nullable constraint forms an infinite loop." ':$$: 'Text "Hint: Only embed nullable 'PrimaryKey tbl' within the definition of 'tbl'." ':$$: 'Text " For example, replace 'PrimaryKey tbl f' with 'PrimaryKey tbl (Nullable f)'") -class SubTableStrategyImpl (strategy :: SubTableStrategy) (f :: Type -> Type) sub where +class SubTableStrategyImpl (strategy :: SubTableStrategy) (f :: * -> *) sub where namedSubTable :: Proxy strategy -> sub f -- The defaulting with @TableField rel@ is necessary to avoid infinite loops diff --git a/beam-core/beam-core.cabal b/beam-core/beam-core.cabal index 0e19a1c42..71d8d59b3 100644 --- a/beam-core/beam-core.cabal +++ b/beam-core/beam-core.cabal @@ -56,23 +56,23 @@ library Database.Beam.Query.Relationships Database.Beam.Schema.Lenses - build-depends: base , - aeson , - text , - bytestring , - mtl , - microlens , - ghc-prim , - free , - dlist , - time , - hashable , - network-uri , - containers , - scientific , - vector , - vector-sized , - tagged + build-depends: base >=4.9 && <5.0, + aeson >=0.11 && <1.6, + text >=1.2.2.0 && <1.3, + bytestring >=0.10 && <0.11, + mtl >=2.2.1 && <2.3, + microlens >=0.4 && <0.5, + ghc-prim >=0.5 && <0.6, + free >=4.12 && <5.2, + dlist >=0.7.1.2 && <0.9, + time >=1.6 && <1.10, + hashable >=1.2.4.0 && <1.5, + network-uri >=2.6 && <2.7, + containers >=0.5 && <0.7, + scientific >=0.3 && <0.4, + vector >=0.11 && <0.13, + vector-sized >=0.5 && <1.5, + tagged >=0.8 && <0.9 Default-language: Haskell2010 default-extensions: ScopedTypeVariables, OverloadedStrings, GADTs, RecursiveDo, FlexibleInstances, FlexibleContexts, TypeFamilies, diff --git a/beam-migrate-cli/Database/Beam/Migrate/Tool/Registry.hs b/beam-migrate-cli/Database/Beam/Migrate/Tool/Registry.hs index f56b6d25a..5619ced0b 100644 --- a/beam-migrate-cli/Database/Beam/Migrate/Tool/Registry.hs +++ b/beam-migrate-cli/Database/Beam/Migrate/Tool/Registry.hs @@ -32,7 +32,7 @@ import Data.UUID (UUID) import qualified Data.UUID.V4 as UUID (nextRandom) import qualified Data.Yaml as Yaml -import Network.HostName (getHostName) +import Network.BSD import Numeric (showHex, readHex) diff --git a/beam-migrate-cli/beam-migrate-cli.cabal b/beam-migrate-cli/beam-migrate-cli.cabal index 004c08f0a..995dbdbb2 100644 --- a/beam-migrate-cli/beam-migrate-cli.cabal +++ b/beam-migrate-cli/beam-migrate-cli.cabal @@ -27,36 +27,35 @@ executable beam-migrate Database.Beam.Migrate.Tool.Diff Database.Beam.Migrate.Tool.Log Database.Beam.Migrate.Tool.Migrate - build-depends: base , - beam-core , - beam-migrate , - text , - bytestring , - time , - optparse-applicative , - directory , - filepath , - largeword , - mtl , - fgl , - containers , - unordered-containers , - hashable , - aeson , - unix , - network , - hostname , - yaml , - uuid , - hint , - random , - ansi-terminal , - haskell-src-exts , - cryptonite , - monad-loops , - exceptions , - editor-open , - split + build-depends: base >=4.9 && <5.0, + beam-core >=0.9 && <0.10, + beam-migrate >=0.4 && <0.6, + text >=1.2 && <1.3, + bytestring >=0.10 && <0.11, + time >=1.6 && <1.10, + optparse-applicative >=0.13 && <0.16, + directory >=1.2 && <1.4, + filepath >=1.4 && <1.5, + largeword >=1.2 && <1.3, + mtl >=2.2 && <2.3, + fgl >=5.5 && <5.8, + containers >=0.5 && <0.7, + unordered-containers >=0.2 && <0.3, + hashable >=1.2 && <1.5, + aeson >=0.11 && <1.6, + unix >=2.7 && <2.8, + network >=2.6 && <2.9, + yaml >=0.8 && <0.12, + uuid >=1.3 && <1.4, + hint >=0.6 && <0.10, + random >=1.1 && <1.2, + ansi-terminal >=0.6 && <0.10, + haskell-src-exts >=1.18 && <1.24, + cryptonite >=0.23 && <0.26, + monad-loops >=0.4 && <0.5, + exceptions >=0.8 && <0.11, + editor-open >=0.6 && <0.7, + split >=0.2 && <0.3 default-language: Haskell2010 default-extensions: KindSignatures, OverloadedStrings, TypeFamilies, FlexibleContexts, StandaloneDeriving, GADTs, DeriveFunctor, RankNTypes, ScopedTypeVariables, diff --git a/beam-migrate/Database/Beam/Migrate/Actions.hs b/beam-migrate/Database/Beam/Migrate/Actions.hs index 2c3276968..1ad023950 100644 --- a/beam-migrate/Database/Beam/Migrate/Actions.hs +++ b/beam-migrate/Database/Beam/Migrate/Actions.hs @@ -301,13 +301,15 @@ createTableActionProvider = guard (preTblNm == postTblNm) (columnsP, columns) <- pure . unzip $ - do columnP@(TableHasColumn tblNm colNm schema :: TableHasColumn be) <- + 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 + constraintP@ + (TableColumnHasConstraint tblNm' colNm' c :: TableColumnHasConstraint be) <- findPostConditions guard (postTblNm == tblNm') @@ -377,7 +379,8 @@ addColumnProvider = (constraintsP, constraints) <- pure . unzip $ do - constraintP@(TableColumnHasConstraint tblNm'' colNm' c + constraintP@ + (TableColumnHasConstraint tblNm'' colNm' c :: TableColumnHasConstraint be) <- findPostConditions guard (tblNm == tblNm'') diff --git a/beam-migrate/Database/Beam/Migrate/Generics/Tables.hs b/beam-migrate/Database/Beam/Migrate/Generics/Tables.hs index d15bf20a1..fc0d91b42 100644 --- a/beam-migrate/Database/Beam/Migrate/Generics/Tables.hs +++ b/beam-migrate/Database/Beam/Migrate/Generics/Tables.hs @@ -34,9 +34,8 @@ import Data.Int import Data.Word import GHC.Generics -import GHC.Types (Type) -class BeamMigrateSqlBackend be => GMigratableTableSettings be (i :: Type -> Type) fieldCheck where +class BeamMigrateSqlBackend be => GMigratableTableSettings be (i :: * -> *) fieldCheck where gDefaultTblSettingsChecks :: Proxy be -> Proxy i -> Bool -> fieldCheck () instance (BeamMigrateSqlBackend be, GMigratableTableSettings be xId fieldCheckId) => @@ -83,7 +82,7 @@ instance ( Generic (embeddedTbl (Nullable (Const [FieldCheck]))) -- * Nullability check -type family NullableStatus (x :: Type) :: Bool where +type family NullableStatus (x :: *) :: Bool where NullableStatus (Maybe x) = 'True NullableStatus x = 'False diff --git a/beam-migrate/Database/Beam/Migrate/SQL/SQL92.hs b/beam-migrate/Database/Beam/Migrate/SQL/SQL92.hs index 10a92552c..0d57f0305 100644 --- a/beam-migrate/Database/Beam/Migrate/SQL/SQL92.hs +++ b/beam-migrate/Database/Beam/Migrate/SQL/SQL92.hs @@ -18,8 +18,6 @@ import Data.Typeable import Data.Semigroup #endif -import GHC.Types (Type) - -- * Convenience type synonyms -- | Syntax equalities that any reasonable DDL syntax would follow, @@ -65,9 +63,9 @@ class ( IsSql92CreateTableSyntax (Sql92DdlCommandCreateTableSyntax syntax) , IsSql92DropTableSyntax (Sql92DdlCommandDropTableSyntax syntax) , IsSql92AlterTableSyntax (Sql92DdlCommandAlterTableSyntax syntax)) => IsSql92DdlCommandSyntax syntax where - type Sql92DdlCommandCreateTableSyntax syntax :: Type - type Sql92DdlCommandAlterTableSyntax syntax :: Type - type Sql92DdlCommandDropTableSyntax syntax :: Type + type Sql92DdlCommandCreateTableSyntax syntax :: * + type Sql92DdlCommandAlterTableSyntax syntax :: * + type Sql92DdlCommandDropTableSyntax syntax :: * createTableCmd :: Sql92DdlCommandCreateTableSyntax syntax -> syntax dropTableCmd :: Sql92DdlCommandDropTableSyntax syntax -> syntax @@ -78,10 +76,10 @@ class ( IsSql92TableConstraintSyntax (Sql92CreateTableTableConstraintSyntax synt , IsSql92TableNameSyntax (Sql92CreateTableTableNameSyntax syntax) ) => IsSql92CreateTableSyntax syntax where - type Sql92CreateTableTableNameSyntax syntax :: Type - type Sql92CreateTableColumnSchemaSyntax syntax :: Type - type Sql92CreateTableTableConstraintSyntax syntax :: Type - type Sql92CreateTableOptionsSyntax syntax :: Type + type Sql92CreateTableTableNameSyntax syntax :: * + type Sql92CreateTableColumnSchemaSyntax syntax :: * + type Sql92CreateTableTableConstraintSyntax syntax :: * + type Sql92CreateTableOptionsSyntax syntax :: * createTableSyntax :: Maybe (Sql92CreateTableOptionsSyntax syntax) -> Sql92CreateTableTableNameSyntax syntax @@ -92,15 +90,15 @@ class ( IsSql92TableConstraintSyntax (Sql92CreateTableTableConstraintSyntax synt class IsSql92TableNameSyntax (Sql92DropTableTableNameSyntax syntax) => IsSql92DropTableSyntax syntax where - type Sql92DropTableTableNameSyntax syntax :: Type + type Sql92DropTableTableNameSyntax syntax :: * dropTableSyntax :: Sql92DropTableTableNameSyntax syntax -> syntax class ( IsSql92TableNameSyntax (Sql92AlterTableTableNameSyntax syntax), IsSql92AlterTableActionSyntax (Sql92AlterTableAlterTableActionSyntax syntax) ) => IsSql92AlterTableSyntax syntax where - type Sql92AlterTableTableNameSyntax syntax :: Type - type Sql92AlterTableAlterTableActionSyntax syntax :: Type + type Sql92AlterTableTableNameSyntax syntax :: * + type Sql92AlterTableAlterTableActionSyntax syntax :: * alterTableSyntax :: Sql92AlterTableTableNameSyntax syntax -> Sql92AlterTableAlterTableActionSyntax syntax -> syntax @@ -108,8 +106,8 @@ class ( IsSql92TableNameSyntax (Sql92AlterTableTableNameSyntax syntax), class ( IsSql92ColumnSchemaSyntax (Sql92AlterTableColumnSchemaSyntax syntax) , IsSql92AlterColumnActionSyntax (Sql92AlterTableAlterColumnActionSyntax syntax) ) => IsSql92AlterTableActionSyntax syntax where - type Sql92AlterTableAlterColumnActionSyntax syntax :: Type - type Sql92AlterTableColumnSchemaSyntax syntax :: Type + type Sql92AlterTableAlterColumnActionSyntax syntax :: * + type Sql92AlterTableColumnSchemaSyntax syntax :: * alterColumnSyntax :: Text -> Sql92AlterTableAlterColumnActionSyntax syntax -> syntax addColumnSyntax :: Text -> Sql92AlterTableColumnSchemaSyntax syntax -> syntax @@ -132,9 +130,9 @@ class ( IsSql92ColumnConstraintDefinitionSyntax (Sql92ColumnSchemaColumnConstrai , IsSql92ExpressionSyntax (Sql92ColumnSchemaExpressionSyntax columnSchema) , Typeable columnSchema, Sql92DisplaySyntax columnSchema, Eq columnSchema, Hashable columnSchema ) => IsSql92ColumnSchemaSyntax columnSchema where - type Sql92ColumnSchemaColumnTypeSyntax columnSchema :: Type - type Sql92ColumnSchemaExpressionSyntax columnSchema :: Type - type Sql92ColumnSchemaColumnConstraintDefinitionSyntax columnSchema :: Type + type Sql92ColumnSchemaColumnTypeSyntax columnSchema :: * + type Sql92ColumnSchemaExpressionSyntax columnSchema :: * + type Sql92ColumnSchemaColumnConstraintDefinitionSyntax columnSchema :: * columnSchemaSyntax :: Sql92ColumnSchemaColumnTypeSyntax columnSchema {-^ Column type -} -> Maybe (Sql92ColumnSchemaExpressionSyntax columnSchema) {-^ Default value -} @@ -159,8 +157,8 @@ class ( IsSql92ColumnConstraintSyntax (Sql92ColumnConstraintDefinitionConstraint , IsSql92ConstraintAttributesSyntax (Sql92ColumnConstraintDefinitionAttributesSyntax constraint) , Typeable constraint ) => IsSql92ColumnConstraintDefinitionSyntax constraint where - type Sql92ColumnConstraintDefinitionConstraintSyntax constraint :: Type - type Sql92ColumnConstraintDefinitionAttributesSyntax constraint :: Type + type Sql92ColumnConstraintDefinitionConstraintSyntax constraint :: * + type Sql92ColumnConstraintDefinitionAttributesSyntax constraint :: * constraintDefinitionSyntax :: Maybe Text -> Sql92ColumnConstraintDefinitionConstraintSyntax constraint -> Maybe (Sql92ColumnConstraintDefinitionAttributesSyntax constraint) @@ -177,9 +175,9 @@ class ( IsSql92MatchTypeSyntax (Sql92ColumnConstraintMatchTypeSyntax constraint) , Typeable (Sql92ColumnConstraintExpressionSyntax constraint) , Typeable constraint ) => IsSql92ColumnConstraintSyntax constraint where - type Sql92ColumnConstraintMatchTypeSyntax constraint :: Type - type Sql92ColumnConstraintReferentialActionSyntax constraint :: Type - type Sql92ColumnConstraintExpressionSyntax constraint :: Type + type Sql92ColumnConstraintMatchTypeSyntax constraint :: * + type Sql92ColumnConstraintReferentialActionSyntax constraint :: * + type Sql92ColumnConstraintExpressionSyntax constraint :: * notNullConstraintSyntax :: constraint uniqueColumnConstraintSyntax :: constraint diff --git a/beam-migrate/Database/Beam/Migrate/SQL/Tables.hs b/beam-migrate/Database/Beam/Migrate/SQL/Tables.hs index d4cd077b9..ccf60814a 100644 --- a/beam-migrate/Database/Beam/Migrate/SQL/Tables.hs +++ b/beam-migrate/Database/Beam/Migrate/SQL/Tables.hs @@ -51,7 +51,6 @@ import Data.Text (Text) import Data.Typeable import qualified Data.Kind as Kind (Constraint) -import GHC.Types (Type) import GHC.TypeLits import Lens.Micro ((^.)) @@ -331,7 +330,7 @@ instance ( BeamMigrateSqlBackend be, HasDataTypeCreatedCheck (BeamMigrateSqlBack where checks = [ FieldCheck (\tbl field'' -> SomeDatabasePredicate (TableHasColumn tbl field'' ty :: TableHasColumn be)) ] ++ map (\cns -> FieldCheck (\tbl field'' -> SomeDatabasePredicate (TableColumnHasConstraint tbl field'' cns :: TableColumnHasConstraint be))) constraints -type family IsNotNull (x :: Type) :: Kind.Constraint where +type family IsNotNull (x :: *) :: Kind.Constraint where IsNotNull (Maybe x) = TypeError ('Text "You used Database.Beam.Migrate.notNull on a column with type" ':$$: 'ShowType (Maybe x) ':$$: 'Text "Either remove 'notNull' from your migration or 'Maybe' from your table") diff --git a/beam-migrate/Database/Beam/Migrate/Serialization.hs b/beam-migrate/Database/Beam/Migrate/Serialization.hs index 88a5e32ef..b8c87a21b 100644 --- a/beam-migrate/Database/Beam/Migrate/Serialization.hs +++ b/beam-migrate/Database/Beam/Migrate/Serialization.hs @@ -39,7 +39,6 @@ import Control.Applicative import Control.Monad import Data.Aeson -import qualified Data.Aeson.Key as AKey import Data.Aeson.Types (Parser) import qualified Data.Dependent.Map as D import qualified Data.GADT.Compare as D @@ -323,7 +322,7 @@ sql92Deserializers = mconcat , beamDeserializer deserializeSql92Attributes ] where parseSub nm o key parse = - withObject (unpack (nm <> "." <> key)) parse =<< o .: (AKey.fromText key) + withObject (unpack (nm <> "." <> key)) parse =<< o .: key deserializeSql92DataType :: BeamDeserializers be' -> Value -> Parser (BeamSqlBackendDataTypeSyntax be) diff --git a/beam-migrate/Database/Beam/Migrate/Types/CheckedEntities.hs b/beam-migrate/Database/Beam/Migrate/Types/CheckedEntities.hs index 3a2d145b1..6274f78e5 100644 --- a/beam-migrate/Database/Beam/Migrate/Types/CheckedEntities.hs +++ b/beam-migrate/Database/Beam/Migrate/Types/CheckedEntities.hs @@ -34,7 +34,7 @@ class IsDatabaseEntity be entity => IsCheckedDatabaseEntity be entity where -- | The type of the descriptor for this checked entity. Usually this wraps -- the corresponding 'DatabaseEntityDescriptor' from 'IsDatabaseEntity', along -- with some mechanism for generating 'DatabasePredicate's. - data CheckedDatabaseEntityDescriptor be entity :: Type + data CheckedDatabaseEntityDescriptor be entity :: * -- | Like 'DatabaseEntityDefaultRequirements' but for checked entities type CheckedDatabaseEntityDefaultRequirements be entity :: Constraint @@ -55,7 +55,7 @@ class IsDatabaseEntity be entity => IsCheckedDatabaseEntity be entity where => Text -> CheckedDatabaseEntityDescriptor be entity -- | Like 'DatabaseEntity' but for checked databases -data CheckedDatabaseEntity be (db :: (Type -> Type) -> Type) entityType where +data CheckedDatabaseEntity be (db :: (* -> *) -> *) entityType where CheckedDatabaseEntity :: IsCheckedDatabaseEntity be entityType => CheckedDatabaseEntityDescriptor be entityType -> [ SomeDatabasePredicate ] diff --git a/beam-migrate/beam-migrate.cabal b/beam-migrate/beam-migrate.cabal index 894205933..420e32d60 100644 --- a/beam-migrate/beam-migrate.cabal +++ b/beam-migrate/beam-migrate.cabal @@ -59,30 +59,30 @@ library Database.Beam.Migrate.Types.CheckedEntities Database.Beam.Migrate.Types.Predicates - build-depends: base , - beam-core , - text , - aeson , - bytestring , - free , - time , - mtl , - scientific , - vector , - containers , - unordered-containers , - hashable , - microlens , - parallel , - deepseq , - ghc-prim , - containers , - haskell-src-exts , - pretty , - dependent-map , - dependent-sum , - pqueue , - uuid-types + build-depends: base >=4.9 && <5.0, + beam-core >=0.9 && <0.10, + text >=1.2 && <1.3, + aeson >=0.11 && <1.6, + bytestring >=0.10 && <0.11, + free >=4.12 && <5.2, + time >=1.6 && <1.10, + mtl >=2.2 && <2.3, + scientific >=0.3 && <0.4, + vector >=0.11 && <0.13, + containers >=0.5 && <0.7, + unordered-containers >=0.2 && <0.3, + hashable >=1.2 && <1.5, + microlens >=0.4 && <0.5, + parallel >=3.2 && <3.3, + deepseq >=1.4 && <1.5, + ghc-prim >=0.5 && <0.6, + containers >=0.5 && <0.7, + haskell-src-exts >=1.18 && <1.24, + pretty >=1.1 && <1.2, + dependent-map >=0.2 && <0.5, + dependent-sum >=0.4 && <0.8, + pqueue >=1.3 && <1.5, + uuid-types >=1.0 && <1.1 default-language: Haskell2010 default-extensions: KindSignatures, OverloadedStrings, TypeFamilies, FlexibleContexts, StandaloneDeriving, GADTs, DeriveFunctor, RankNTypes, ScopedTypeVariables, diff --git a/beam-postgres/Database/Beam/Postgres/Connection.hs b/beam-postgres/Database/Beam/Postgres/Connection.hs index 29ed354e5..0fd135261 100644 --- a/beam-postgres/Database/Beam/Postgres/Connection.hs +++ b/beam-postgres/Database/Beam/Postgres/Connection.hs @@ -293,13 +293,7 @@ data PgF next where FromBackendRow Postgres x => (Maybe x -> next) -> PgF next PgLiftWithHandle :: (Pg.Connection -> IO a) -> (a -> next) -> PgF next - -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 +deriving instance Functor PgF -- | 'MonadBeam' in which we can run Postgres commands. See the documentation -- for 'MonadBeam' on examples of how to use. diff --git a/beam-postgres/Database/Beam/Postgres/Full.hs b/beam-postgres/Database/Beam/Postgres/Full.hs index 883a122f6..035ff777f 100644 --- a/beam-postgres/Database/Beam/Postgres/Full.hs +++ b/beam-postgres/Database/Beam/Postgres/Full.hs @@ -70,8 +70,6 @@ import qualified Data.Text as T import Data.Semigroup #endif -import GHC.Types (Type) - -- * @SELECT@ -- | An explicit lock against some tables. You can create a value of this type using the 'locked_' @@ -231,7 +229,7 @@ runPgInsertReturningList = \case -- | What to do when an @INSERT@ statement inserts a row into the table @tbl@ -- that violates a constraint. -newtype PgInsertOnConflict (tbl :: (Type -> Type) -> Type) = +newtype PgInsertOnConflict (tbl :: (* -> *) -> *) = PgInsertOnConflict (tbl (QField QInternal) -> PgInsertOnConflictSyntax) -- | Postgres @LATERAL JOIN@ support @@ -398,7 +396,7 @@ runPgDeleteReturningList (PgDeleteReturning syntax) = runReturningList $ PgComma -- * General @RETURNING@ support class PgReturning cmd where - type PgReturningType cmd :: Type -> Type + type PgReturningType cmd :: * -> * returning :: (Beamable tbl, Projectible Postgres a) => cmd Postgres tbl -> (tbl (QExpr Postgres PostgresInaccessible) -> a) diff --git a/beam-postgres/Database/Beam/Postgres/PgSpecific.hs b/beam-postgres/Database/Beam/Postgres/PgSpecific.hs index da0d56e8b..4f8bf0f15 100644 --- a/beam-postgres/Database/Beam/Postgres/PgSpecific.hs +++ b/beam-postgres/Database/Beam/Postgres/PgSpecific.hs @@ -151,7 +151,6 @@ import qualified Database.PostgreSQL.Simple.ToField as Pg import qualified Database.PostgreSQL.Simple.TypeInfo.Static as Pg import qualified Database.PostgreSQL.Simple.Range as Pg -import GHC.Types (Type) import GHC.TypeLits import GHC.Exts hiding (toList) @@ -291,10 +290,10 @@ arrayDims_ :: BeamSqlBackendIsString Postgres text -> QGenExpr context Postgres s text arrayDims_ (QExpr v) = QExpr (fmap (\(PgExpressionSyntax v') -> PgExpressionSyntax (emit "array_dims(" <> v' <> emit ")")) v) -type family CountDims (v :: Type) :: Nat where +type family CountDims (v :: *) :: Nat where CountDims (V.Vector a) = 1 + CountDims a CountDims a = 0 -type family WithinBounds (dim :: Nat) (v :: Type) :: Constraint where +type family WithinBounds (dim :: Nat) (v :: *) :: Constraint where WithinBounds dim v = If ((dim <=? CountDims v) && (1 <=? dim)) (() :: Constraint) @@ -469,7 +468,7 @@ unbounded = PgRangeBound Exclusive Nothing -- -- A reasonable example might be @Range PgInt8Range Int64@. -- This represents a range of Haskell @Int64@ values stored as a range of 'bigint' in Postgres. -data PgRange (n :: Type) a +data PgRange (n :: *) a = PgEmptyRange | PgRange (PgRangeBound a) (PgRangeBound a) deriving (Eq, Show, Generic) @@ -772,7 +771,7 @@ instance Beamable (PgJSONElement a) -- section on -- . -- -class IsPgJSON (json :: Type -> Type) where +class IsPgJSON (json :: * -> *) where -- | The @json_each@ or @jsonb_each@ function. Values returned as @json@ or -- @jsonb@ respectively. Use 'pgUnnest' to join against the result pgJsonEach :: QGenExpr ctxt Postgres s (json a) @@ -1366,7 +1365,7 @@ pgRegexpSplitToTable (QExpr s) (QExpr re) = -- ** Set-valued functions -data PgSetOf (tbl :: (Type -> Type) -> Type) +data PgSetOf (tbl :: (* -> *) -> *) pgUnnest' :: forall tbl db s . Beamable tbl diff --git a/beam-postgres/Database/Beam/Postgres/Syntax.hs b/beam-postgres/Database/Beam/Postgres/Syntax.hs index 96d2fbc93..fce05885e 100644 --- a/beam-postgres/Database/Beam/Postgres/Syntax.hs +++ b/beam-postgres/Database/Beam/Postgres/Syntax.hs @@ -440,7 +440,7 @@ instance IsSql92DeleteSyntax PgDeleteSyntax where type Sql92DeleteExpressionSyntax PgDeleteSyntax = PgExpressionSyntax type Sql92DeleteTableNameSyntax PgDeleteSyntax = PgTableNameSyntax - deleteStmt tbl alias where_ = + deleteStmt tbl alias where_ _= PgDeleteSyntax $ emit "DELETE FROM " <> fromPgTableName tbl <> maybe mempty (\alias_ -> emit " AS " <> pgQuotedIdentifier alias_) alias <> diff --git a/beam-postgres/beam-postgres.cabal b/beam-postgres/beam-postgres.cabal index f837131b3..81106a509 100644 --- a/beam-postgres/beam-postgres.cabal +++ b/beam-postgres/beam-postgres.cabal @@ -29,35 +29,35 @@ library Database.Beam.Postgres.PgSpecific Database.Beam.Postgres.Types - build-depends: base , - beam-core , - beam-migrate , + build-depends: base >=4.9 && <5.0, + beam-core >=0.9 && <0.10, + beam-migrate >=0.5 && <0.6, - postgresql-libpq , - postgresql-simple , + postgresql-libpq >=0.8 && <0.10, + postgresql-simple >=0.5 && <0.7, - text , - bytestring , + text >=1.0 && <1.3, + bytestring >=0.10 && <0.11, - attoparsec , - hashable , - lifted-base , - free , - time , - monad-control , - mtl , - conduit , - aeson , - uuid-types , - case-insensitive , - scientific , - vector , - network-uri , - unordered-containers , - tagged , - haskell-src-exts , - clock , - ghc-prim + attoparsec >=0.13 && <0.14, + hashable >=1.1 && <1.5, + lifted-base >=0.2 && <0.3, + free >=4.12 && <5.2, + time >=1.6 && <1.10, + monad-control >=1.0 && <1.1, + mtl >=2.1 && <2.3, + conduit >=1.2 && <1.4, + aeson >=0.11 && <1.6, + uuid-types >=1.0 && <1.1, + case-insensitive >=1.2 && <1.3, + scientific >=0.3 && <0.4, + vector >=0.11 && <0.13, + network-uri >=2.6 && <2.7, + unordered-containers >= 0.2 && <0.3, + tagged >=0.8 && <0.9, + + haskell-src-exts >=1.18 && <1.24, + clock default-language: Haskell2010 default-extensions: ScopedTypeVariables, OverloadedStrings, MultiParamTypeClasses, RankNTypes, FlexibleInstances, DeriveDataTypeable, DeriveGeneric, StandaloneDeriving, TypeFamilies, GADTs, OverloadedStrings, diff --git a/beam-sqlite/Database/Beam/Sqlite/Syntax.hs b/beam-sqlite/Database/Beam/Sqlite/Syntax.hs index 44a6e18e0..e69c7ae37 100644 --- a/beam-sqlite/Database/Beam/Sqlite/Syntax.hs +++ b/beam-sqlite/Database/Beam/Sqlite/Syntax.hs @@ -4,7 +4,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE CPP #-} @@ -93,7 +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 newtype (Eq) + deriving Eq instance Show SqliteSyntax where show (SqliteSyntax s d) = @@ -902,11 +901,12 @@ instance IsSql92DeleteSyntax SqliteDeleteSyntax where type Sql92DeleteTableNameSyntax SqliteDeleteSyntax = SqliteTableNameSyntax type Sql92DeleteExpressionSyntax SqliteDeleteSyntax = SqliteExpressionSyntax - deleteStmt tbl Nothing where_ = + deleteStmt tbl Nothing where_ limit = SqliteDeleteSyntax $ emit "DELETE FROM " <> fromSqliteTableName tbl <> - maybe mempty (\where_ -> emit " WHERE " <> fromSqliteExpression where_) where_ - deleteStmt _ (Just _) _ = + maybe mempty (\where_ -> emit " WHERE " <> fromSqliteExpression where_) where_ <> + maybe mempty (emit . fromString . (" LIMIT " <>) . show) limit + deleteStmt _ (Just _) _ _ = error "beam-sqlite: invariant failed: DELETE must not have a table alias" spaces, parens :: SqliteSyntax -> SqliteSyntax diff --git a/beam-sqlite/beam-sqlite.cabal b/beam-sqlite/beam-sqlite.cabal index 7ac769420..065099fbd 100644 --- a/beam-sqlite/beam-sqlite.cabal +++ b/beam-sqlite/beam-sqlite.cabal @@ -23,21 +23,23 @@ library Database.Beam.Sqlite.Connection Database.Beam.Sqlite.Migrate other-modules: Database.Beam.Sqlite.SqliteSpecific - build-depends: base , - beam-core , - beam-migrate , - sqlite-simple , - text , - bytestring , - hashable , - time , - dlist , - mtl , - free , - scientific , - network-uri , - aeson , - attoparsec + build-depends: base >=4.7 && <5, + + beam-core >=0.9 && <0.10, + beam-migrate >=0.5 && <0.6, + + sqlite-simple >=0.4 && <0.5, + text >=1.0 && <1.3, + bytestring >=0.10 && <0.11, + hashable >=1.2 && <1.5, + time >=1.6 && <1.10, + dlist >=0.8 && <0.9, + mtl >=2.1 && <2.3, + free >=4.12 && <5.2, + scientific >=0.3 && <0.4, + network-uri >=2.6 && <2.7, + aeson >=0.11 && <1.6, + attoparsec >=0.13 && <0.14 default-language: Haskell2010 default-extensions: ScopedTypeVariables, OverloadedStrings, MultiParamTypeClasses, RankNTypes, FlexibleInstances, DeriveDataTypeable, DeriveGeneric, StandaloneDeriving, TypeFamilies, GADTs, OverloadedStrings, diff --git a/build.nix b/build.nix new file mode 100644 index 000000000..bbf35706d --- /dev/null +++ b/build.nix @@ -0,0 +1,47 @@ +{ devShell ? false, inCI ? false }: +let + flake-compat = fetchTarball { + url = "https://github.com/edolstra/flake-compat/archive/19576c2aea7f074ff0da818b21a8b0950ff6ec86.tar.gz"; + sha256 = "13jf267qvd4fvph27flp5slrn6w2q26mhpakr8bj2ppqgyjamb79"; + }; + + nix-inclusive = fetchTarball { + url = "https://github.com/juspay/nix-inclusive/archive/2ca1706029bfcf4bb7eaf17b4f32e49f436a148e.tar.gz"; + sha256 = "1y3vhqnbh5kg906fpw22h670ppl8238xwv0dx7zdcp22212zdjnx"; + }; + + filter = import "${nix-inclusive}/inclusive.nix" { lib = (import {}).lib; }; + path = + filter ./. [ + ./flake.nix + ./flake.lock + ./nix/overlay.nix + ./beam-core/beam-core.cabal + ./beam-core/Database + ./beam-core/LICENSE + ./beam-migrate/beam-migrate.cabal + ./beam-migrate/Database + ./beam-migrate/tools + ./beam-migrate/LICENSE + ./beam-migrate-cli/beam-migrate-cli.cabal + ./beam-migrate-cli/Database + ./beam-migrate-cli/BeamMigrate.hs + ./beam-migrate-cli/LICENSE + ./beam-postgres/beam-postgres.cabal + ./beam-postgres/Database + ./beam-postgres/test + ./beam-postgres/LICENSE + ./beam-sqlite/beam-sqlite.cabal + ./beam-sqlite/Database + ./beam-sqlite/examples + ./beam-sqlite/LICENSE + ]; + attr = if devShell then "devShell" else "defaultPackage"; + compat-attr = if devShell then "shellNix" else "defaultNix"; + + flake-drv = + if inCI + then (import flake-compat { src = path; }).${compat-attr} + else (builtins.getFlake (toString (builtins.unsafeDiscardStringContext path))); +in +flake-drv.${attr}.${builtins.currentSystem} diff --git a/euler.yaml b/euler.yaml new file mode 100644 index 000000000..53737f50c --- /dev/null +++ b/euler.yaml @@ -0,0 +1,50 @@ +name: beam +projects: + beam-core: + location: beam-core + allowed-paths: + - beam-core.cabal + - Database + - LICENSE + beam-migrate: + location: beam-migrate + allowed-paths: + - beam-migrate.cabal + - Database + - tools + - LICENSE + beam-migrate-cli: + location: beam-migrate-cli + allowed-paths: + - beam-migrate-cli.cabal + - Database + - BeamMigrate.hs + - LICENSE + beam-postgres: + location: beam-postgres + allowed-paths: + - beam-postgres.cabal + - Database + - test + - LICENSE + beam-sqlite: + location: beam-sqlite + allowed-paths: + - beam-sqlite.cabal + - Database + - examples + - LICENSE + +default-project: beam-core +dependencies: + euler-build: + branch: master + revision: 90f393f7f91e1bb9d7b3c0ece1aa919797d1987b +overrides: + haskell-src-exts: + source: hackage + version: 1.21.1 + sha256: 06b37iis7hfnc770gb3jn12dy3yngqcfdraynbvy3n7s0hlv2hcw + enable-profiling: true + haskell-src-meta: + enable-profiling: true diff --git a/flake.lock b/flake.lock index dce924ae8..591b775b5 100644 --- a/flake.lock +++ b/flake.lock @@ -1,77 +1,93 @@ { "nodes": { - "flake-parts": { + "euler-build": { "inputs": { - "nixpkgs-lib": "nixpkgs-lib" + "flake-utils": "flake-utils", + "nix-inclusive": "nix-inclusive", + "nixpkgs": "nixpkgs" }, "locked": { - "lastModified": 1690933134, - "narHash": "sha256-ab989mN63fQZBFrkk4Q8bYxQCktuHmBIBqUG1jl6/FQ=", - "owner": "hercules-ci", - "repo": "flake-parts", - "rev": "59cf3f1447cfc75087e7273b04b31e689a8599fb", - "type": "github" + "lastModified": 1618838162, + "narHash": "sha256-MjEvoyBUPRY5xrbUmAhvismwrK4nIYy3jf2g81ijJsU=", + "ref": "master", + "rev": "90f393f7f91e1bb9d7b3c0ece1aa919797d1987b", + "revCount": 33, + "type": "git", + "url": "ssh://git@ssh.bitbucket.juspay.net/jbiz/euler-build" }, "original": { - "owner": "hercules-ci", - "repo": "flake-parts", - "type": "github" + "id": "euler-build", + "type": "indirect" } }, - "haskell-flake": { + "flake-utils": { "locked": { - "lastModified": 1692741689, - "narHash": "sha256-CbNpheNJMTM9Wz5iTzdXmMtvfH9KvH/jNfv6N9roaqs=", - "owner": "srid", - "repo": "haskell-flake", - "rev": "c8622c8a259e18e0a1919462ce885380108a723c", + "lastModified": 1600209923, + "narHash": "sha256-zoOWauTliFEjI++esk6Jzk7QO5EKpddWXQm9yQK24iM=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "3cd06d3c1df6879c9e41cb2c33113df10566c760", "type": "github" }, "original": { - "owner": "srid", - "repo": "haskell-flake", + "owner": "numtide", + "repo": "flake-utils", "type": "github" } }, - "nixpkgs": { + "nix-inclusive": { + "inputs": { + "stdlib": "stdlib" + }, "locked": { - "lastModified": 1693145325, - "narHash": "sha256-Gat9xskErH1zOcLjYMhSDBo0JTBZKfGS0xJlIRnj6Rc=", - "owner": "nixos", - "repo": "nixpkgs", - "rev": "cddebdb60de376c1bdb7a4e6ee3d98355453fe56", + "lastModified": 1604413592, + "narHash": "sha256-3cr2RRBCXNb+6Q1s3tEQiN4LjoFC8OsMSG8WuCyGe/g=", + "owner": "juspay", + "repo": "nix-inclusive", + "rev": "2ca1706029bfcf4bb7eaf17b4f32e49f436a148e", "type": "github" }, "original": { - "owner": "nixos", - "ref": "nixpkgs-unstable", - "repo": "nixpkgs", + "owner": "juspay", + "repo": "nix-inclusive", + "rev": "2ca1706029bfcf4bb7eaf17b4f32e49f436a148e", "type": "github" } }, - "nixpkgs-lib": { + "nixpkgs": { "locked": { - "dir": "lib", - "lastModified": 1690881714, - "narHash": "sha256-h/nXluEqdiQHs1oSgkOOWF+j8gcJMWhwnZ9PFabN6q0=", + "lastModified": 1618072958, + "narHash": "sha256-QDKj58ECixtb4EJMWV5D5Lb2xdCgab1Opi4zjQWbDOg=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "9e1960bc196baf6881340d53dccb203a951745a2", + "rev": "a73020b2a150322c9832b50baeb0296ba3b13dd7", "type": "github" }, "original": { - "dir": "lib", "owner": "NixOS", - "ref": "nixos-unstable", "repo": "nixpkgs", + "rev": "a73020b2a150322c9832b50baeb0296ba3b13dd7", "type": "github" } }, "root": { "inputs": { - "flake-parts": "flake-parts", - "haskell-flake": "haskell-flake", - "nixpkgs": "nixpkgs" + "euler-build": "euler-build" + } + }, + "stdlib": { + "locked": { + "lastModified": 1590026685, + "narHash": "sha256-E5INrVvYX/P/UpcoUFDAsuHem+lsqT+/teBs9O7oc9Q=", + "owner": "manveru", + "repo": "nix-lib", + "rev": "99088cf7febcdb21afd375a335dcafa959bef3ed", + "type": "github" + }, + "original": { + "owner": "manveru", + "repo": "nix-lib", + "type": "github" } } }, diff --git a/flake.nix b/flake.nix index e777b57bf..805bfb824 100644 --- a/flake.nix +++ b/flake.nix @@ -1,27 +1,35 @@ +# Autogenerated from euler.yaml. Do not edit. + { + description = "beam"; inputs = { - nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable"; - flake-parts.url = "github:hercules-ci/flake-parts"; - haskell-flake.url = "github:srid/haskell-flake"; + # Laziness of nix allows us to be lazy here and avoid resolving deps + # The downside is that most of this .follows are redundant + }; - outputs = inputs@{ self, nixpkgs, flake-parts, ... }: - flake-parts.lib.mkFlake { inherit inputs; } ({ withSystem, ... }: { - systems = nixpkgs.lib.systems.flakeExposed; - imports = [ - inputs.haskell-flake.flakeModule + outputs = flakeInputs@{ self, euler-build, ... }: + euler-build.mkEulerFlake { + overlayPath = ./nix/overlay.nix; + extraOverlayPaths = [ + ]; - perSystem = { self', pkgs, lib, config, ... }: { - haskellProjects.default = { - projectFlakeName = "beam"; - basePackages = pkgs.haskell.packages.ghc927; - autoWire = ["packages" "checks" "devShells" "apps"]; - settings = { - pretty-simple = { - check = false; - }; - }; - }; + mkConfig = { nixpkgs }: { + flakeName = "beam"; + defaultPackageName = "beam-core"; + exportPackages = [ + "beam-core" + "beam-migrate" + "beam-migrate-cli" + "beam-postgres" + "beam-sqlite" + ]; + shellTools = with nixpkgs; [ + + ]; + # shellAttrs = { + # }; }; - }); -} + inputs = flakeInputs; + }; +} diff --git a/nix/haskell-src-exts.nix b/nix/haskell-src-exts.nix new file mode 100644 index 000000000..670f5b00b --- /dev/null +++ b/nix/haskell-src-exts.nix @@ -0,0 +1,19 @@ +{ mkDerivation, array, base, containers, directory, filepath +, ghc-prim, happy, mtl, pretty, pretty-show, smallcheck, stdenv +, tasty, tasty-golden, tasty-smallcheck +}: +mkDerivation { + pname = "haskell-src-exts"; + version = "1.21.1"; + sha256 = "0q1y8n3d82gid9bcx8wxsqqmj9mq11fg3gp5yzpfbw958dhi3j9f"; + libraryHaskellDepends = [ array base ghc-prim pretty ]; + libraryToolDepends = [ happy ]; + testHaskellDepends = [ + base containers directory filepath mtl pretty-show smallcheck tasty + tasty-golden tasty-smallcheck + ]; + doCheck = false; + homepage = "https://github.com/haskell-suite/haskell-src-exts"; + description = "Manipulating Haskell source: abstract syntax, lexer, parser, and pretty-printer"; + license = stdenv.lib.licenses.bsd3; +} diff --git a/nix/overlay.nix b/nix/overlay.nix new file mode 100644 index 000000000..22e9d3e84 --- /dev/null +++ b/nix/overlay.nix @@ -0,0 +1,89 @@ +# Autogenerated from euler.yaml. Do not edit. + +self: super: +let + beam-core-src = super.eulerBuild.allowedPaths { + root = ../beam-core; + paths = [ + ../beam-core/beam-core.cabal + ../beam-core/Database + ../beam-core/LICENSE + ]; + }; + + beam-migrate-src = super.eulerBuild.allowedPaths { + root = ../beam-migrate; + paths = [ + ../beam-migrate/beam-migrate.cabal + ../beam-migrate/Database + ../beam-migrate/tools + ../beam-migrate/LICENSE + ]; + }; + + beam-migrate-cli-src = super.eulerBuild.allowedPaths { + root = ../beam-migrate-cli; + paths = [ + ../beam-migrate-cli/beam-migrate-cli.cabal + ../beam-migrate-cli/Database + ../beam-migrate-cli/BeamMigrate.hs + ../beam-migrate-cli/LICENSE + ]; + }; + + beam-postgres-src = super.eulerBuild.allowedPaths { + root = ../beam-postgres; + paths = [ + ../beam-postgres/beam-postgres.cabal + ../beam-postgres/Database + ../beam-postgres/test + ../beam-postgres/LICENSE + ]; + }; + + beam-sqlite-src = super.eulerBuild.allowedPaths { + root = ../beam-sqlite; + paths = [ + ../beam-sqlite/beam-sqlite.cabal + ../beam-sqlite/Database + ../beam-sqlite/examples + ../beam-sqlite/LICENSE + ]; + }; + + +in +super.eulerBuild.mkEulerHaskellOverlay self super + (hself: hsuper: { + haskell-src-exts = self.eulerBuild.fastBuildExternal { + drv = super.haskell.lib.unmarkBroken (hself.callHackageDirect { + pkg = "haskell-src-exts"; + ver = "1.21.1"; + sha256 = "06b37iis7hfnc770gb3jn12dy3yngqcfdraynbvy3n7s0hlv2hcw"; + } { }); + overrides = { + enableProfiling = true; + }; + }; + haskell-src-meta = self.eulerBuild.fastBuildExternal { + drv = super.haskell.lib.unmarkBroken (hsuper.haskell-src-meta); + overrides = { + enableProfiling = true; + }; + }; + beam-core = self.eulerBuild.fastBuild { + drv = super.haskell.lib.unmarkBroken (hself.callCabal2nix "beam-core" beam-core-src { }); + }; + beam-migrate = self.eulerBuild.fastBuild { + drv = super.haskell.lib.unmarkBroken (hself.callCabal2nix "beam-migrate" beam-migrate-src { }); + }; + beam-migrate-cli = self.eulerBuild.fastBuild { + drv = super.haskell.lib.unmarkBroken (hself.callCabal2nix "beam-migrate-cli" beam-migrate-cli-src { }); + }; + beam-postgres = self.eulerBuild.fastBuild { + drv = super.haskell.lib.unmarkBroken (hself.callCabal2nix "beam-postgres" beam-postgres-src { }); + }; + beam-sqlite = self.eulerBuild.fastBuild { + drv = super.haskell.lib.unmarkBroken (hself.callCabal2nix "beam-sqlite" beam-sqlite-src { }); + }; + }) diff --git a/release.nix b/release.nix new file mode 100644 index 000000000..6b8ca0ac7 --- /dev/null +++ b/release.nix @@ -0,0 +1,65 @@ +{ nixpkgs ? import ((import {}).fetchFromGitHub { + owner = "NixOS"; + repo = "nixpkgs"; + rev = "48723f48ab92381f0afd50143f38e45cf3080405"; + sha256 = "0h3b3l867j3ybdgimfn76lw7w6yjhszd5x02pq5827l659ihcf53"; + }) {} +}: with nixpkgs; + +let + beamPackages = [ + "beam-core" + "beam-migrate" + "beam-migrate-cli" + "beam-postgres" + "beam-sqlite" + ]; + ghcVersions = [ + "ghc844" + "ghc865" + "ghc883" + ]; + hackageVersions = { + hashable = "1.3.0.0"; + network = "2.6.3.1"; + postgresql-libpq = "0.9.4.2"; + vector-sized = "1.4.0.0"; + }; + hackageDirectVersions = { + sqlite-simple = { + version = "0.4.18.0"; + sha256 = "1crp86argxqv5ryfiyj5v17a3wb8ngnb1zbhhx6d99i83skm5i86"; + }; + }; + + composeExtensionList = lib.foldr lib.composeExtensions (_: _: {}); + mergeMaps = lib.foldr (a: b: a // b) {}; + applyToPackages = f: packages: _: super: lib.genAttrs packages + (name: f super."${name}"); + + mkPackageSet = ghc: ghc.extend (composeExtensionList [ + (self: _: lib.mapAttrs (n: v: self.callHackage n v {}) hackageVersions) + (self: _: lib.mapAttrs (n: v: self.callHackageDirect { + pkg = n; + ver = v.version; + sha256 = v.sha256; + } {}) hackageDirectVersions) + (self: _: lib.genAttrs beamPackages (name: + self.callCabal2nix name (./. + "/${name}") {} + )) + (applyToPackages haskell.lib.dontCheck [ + "aeson" + "network" + ]) + (_: super: { + # Add postgresql binaries for tests: + beam-postgres = haskell.lib.addBuildTool super.beam-postgres postgresql; + }) + ]); + mkPrefixedPackages = version: lib.mapAttrs' + (name: value: lib.nameValuePair "${version}_${name}" value) + (lib.genAttrs beamPackages + (name: (mkPackageSet haskell.packages."${version}")."${name}") + ); + +in mergeMaps (map mkPrefixedPackages ghcVersions)