Update to beam v0.10.1.0

.github/workflows/build.yaml

@@ -7,8 +7,8 @@ jobs:
     runs-on: ubuntu-latest
     steps:
     - uses: actions/checkout@v2
-    - uses: cachix/install-nix-action@v12
-    - uses: cachix/cachix-action@v10
+    - uses: cachix/install-nix-action@v21
+    - uses: cachix/cachix-action@v12
       with:
         name: beam-ci
         signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'

beam-core/ChangeLog.md

@@ -1,3 +1,21 @@
+# 0.10.1.0
+
+# Added features
+
+ * Allow embedding database types
+ * Loosen some version bounds
+
+# 0.10.0.0
+
+# Bug fixes
+
+ * Make sure lateral join names do not overlap
+
+# Addded features
+
+ * Add `runSelectReturningFirst`
+ * `IN (SELECT ...)` syntax via `inQuery_`
+
 # 0.9.2.1
 
 ## Added features

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

@@ -20,6 +20,7 @@ import           Database.Beam.Backend.Types
 
 import           Control.Applicative
 import           Control.Exception (Exception)
+import           Control.Monad
 import           Control.Monad.Free.Church
 import           Control.Monad.Identity
 import           Data.Kind (Type)

beam-core/Database/Beam/Query/CTE.hs

@@ -8,6 +8,7 @@ import Database.Beam.Backend.SQL
 import Database.Beam.Query.Internal
 import Database.Beam.Query.Types
 
+import Control.Monad.Fix
 import Control.Monad.Free.Church
 import Control.Monad.Writer hiding ((<>))
 import Control.Monad.State.Strict

beam-core/Database/Beam/Schema/Lenses.hs

@@ -10,6 +10,7 @@ import Database.Beam.Schema.Tables
 
 import Control.Monad.Identity
 
+import Data.Function
 import Data.Kind (Type)
 import Data.Proxy
 

beam-core/Database/Beam/Schema/Tables.hs

@@ -25,7 +25,7 @@ module Database.Beam.Schema.Tables
     , withTableModification, modifyTable, modifyEntityName
     , setEntityName, modifyTableFields, fieldNamed
     , modifyEntitySchema, setEntitySchema
-    , defaultDbSettings
+    , defaultDbSettings, embedDatabase
 
     , RenamableWithRule(..), RenamableField(..)
     , FieldRenamer(..)
@@ -76,6 +76,7 @@ import           Data.Char (isUpper, toLower)
 import           Data.Foldable (fold)
 import           Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
+import           Data.Monoid
 import           Data.Proxy
 import           Data.String (IsString(..))
 import           Data.Text (Text)
@@ -210,7 +211,6 @@ withTableModification mods tbl =
   runIdentity $ zipBeamFieldsM (\(Columnar' field :: Columnar' f a) (Columnar' (FieldModification fieldFn :: FieldModification f a)) ->
                                   pure (Columnar' (fieldFn field))) tbl mods
 
-
 -- | Provide an 'EntityModification' for 'TableEntity's. Allows you to modify
 --   the name of the table and provide a modification for each field in the
 --   table. See the examples for 'withDbModification' for more.
@@ -236,6 +236,14 @@ setEntityName nm = modifyEntityName (\_ -> nm)
 setEntitySchema :: IsDatabaseEntity be entity => Maybe Text -> EntityModification (DatabaseEntity be db) be entity
 setEntitySchema nm = modifyEntitySchema (\_ -> nm)
 
+-- | Embed database settings in a larger database
+embedDatabase :: forall be embedded db. Database be embedded => DatabaseSettings be embedded -> embedded (EntityModification (DatabaseEntity be db) be)
+embedDatabase db =
+    runIdentity $
+    zipTables (Proxy @be)
+              (\(DatabaseEntity x) _ -> pure (EntityModification (Endo (\_ -> DatabaseEntity x))))
+              db db
+
 -- | Construct an 'EntityModification' to rename the fields of a 'TableEntity'
 modifyTableFields :: tbl (FieldModification (TableField tbl)) -> EntityModification (DatabaseEntity be db) be (TableEntity tbl)
 modifyTableFields modFields = EntityModification (Endo (\(DatabaseEntity tbl@(DatabaseTable {})) -> DatabaseEntity tbl { dbTableSettings = withTableModification modFields (dbTableSettings tbl) }))
@@ -406,6 +414,16 @@ instance ( Selector f, IsDatabaseEntity be x, DatabaseEntityDefaultRequirements
   GAutoDbSettings (S1 f (K1 Generic.R (DatabaseEntity be db x)) p) where
   autoDbSettings' = M1 (K1 (DatabaseEntity (dbEntityAuto (name :| []))))
     where name = T.pack (selName (undefined :: S1 f (K1 Generic.R (DatabaseEntity be db x)) p))
+instance ( Database be embedded
+         , Generic (DatabaseSettings be embedded)
+         , GAutoDbSettings (Rep (DatabaseSettings be embedded) ()) ) =>
+    GAutoDbSettings (S1 f (K1 Generic.R (embedded (DatabaseEntity be super))) p) where
+  autoDbSettings' =
+    M1 . K1 . runIdentity $
+    zipTables (Proxy @be)
+              (\(DatabaseEntity x) _ -> pure (DatabaseEntity x))
+              db db
+    where db = defaultDbSettings @be
 
 instance ( Selector f
          , Generic (DatabaseSettings be innerDb)
@@ -446,6 +464,11 @@ instance (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) =>
 
   gZipDatabase _ combine ~(K1 x) ~(K1 y) =
     K1 <$> combine x y
+instance Database be db =>
+    GZipDatabase be f g h (K1 Generic.R (db f)) (K1 Generic.R (db g)) (K1 Generic.R (db h)) where
+
+  gZipDatabase _ combine ~(K1 x) ~(K1 y) =
+      K1 <$> zipTables (Proxy @be) combine x y
 
 instance Database be db =>
   GZipDatabase be f g h (K1 Generic.R (db f)) (K1 Generic.R (db g)) (K1 Generic.R (db h)) where

beam-core/beam-core.cabal

@@ -2,7 +2,7 @@
 -- see http://haskell.org/cabal/users-guide/
 
 name:                beam-core
-version:             0.10.0.0
+version:             0.10.1.0
 synopsis:            Type-safe, feature-complete SQL query and manipulation interface for Haskell
 description:         Beam is a Haskell library for type-safe querying and manipulation of SQL databases.
                      Beam is modular and supports various backends. In order to use beam, you will need to use
@@ -64,17 +64,17 @@ library
                        aeson        >=0.11    && <2.2,
                        text         >=1.2.2.0 && <2.1,
                        bytestring   >=0.10    && <0.12,
-                       mtl          >=2.2.1   && <2.3,
+                       mtl          >=2.2.1   && <2.4,
                        microlens    >=0.4     && <0.5,
-                       ghc-prim     >=0.5     && <0.10,
-                       free         >=4.12    && <5.2,
+                       ghc-prim     >=0.5     && <0.11,
+                       free         >=4.12    && <5.3,
                        dlist        >=0.7.1.2 && <1.1,
                        time         >=1.6     && <1.13,
                        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       >=0.11    && <0.14,
                        vector-sized >=0.5     && <1.6,
                        tagged       >=0.8     && <0.9
 
@@ -101,7 +101,7 @@ test-suite beam-core-tests
   hs-source-dirs: test
   main-is: Main.hs
   other-modules: Database.Beam.Test.Schema Database.Beam.Test.SQL
-  build-depends: base, beam-core, text, bytestring, time, tasty, tasty-hunit
+  build-depends: base, beam-core, text, bytestring, time, tasty, tasty-hunit, microlens
   default-language: Haskell2010
   default-extensions: OverloadedStrings, FlexibleInstances, FlexibleContexts, GADTs, TypeFamilies,
                       DeriveGeneric, DefaultSignatures, RankNTypes, StandaloneDeriving, KindSignatures,

beam-core/test/Database/Beam/Test/Schema.hs

@@ -23,6 +23,8 @@ import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Time.Clock (UTCTime)
 
+import           Lens.Micro.Extras (view)
+
 import           Test.Tasty
 import           Test.Tasty.HUnit
 
@@ -34,9 +36,8 @@ tests = testGroup "Schema Tests"
                   , parametricAndFixedNestedBeamsAreEquivalent
 --                  , automaticNestedFieldsAreUnset
 --                  , nullableForeignKeysGivenMaybeType
-                  , underscoresAreHandledGracefully ]
---                  , dbSchemaGeneration ]
---                  , dbSchemaModification ]
+                  , underscoresAreHandledGracefully
+                  , embeddedDatabases ]
 
 data DummyBackend
 
@@ -315,34 +316,38 @@ employeeDbSettingsRuleMods = defaultDbSettings `withDbModification`
                                                   Nothing -> defName
                                                   Just _ -> "pfx_" <> defName)
 
--- employeeDbSettingsModified :: DatabaseSettings EmployeeDb
--- employeeDbSettingsModified =
---   defaultDbSettings `withDbModifications`
---   (modifyingDb { _employees = tableModification (\_ -> "emps") tableFieldsModification
---                , _departments = tableModification (\_ -> "depts")
---                                                   (tableFieldsModification
---                                                     { _departmentName = fieldModification (\_ -> "depts_name") id }) })
-
--- dbSchemaGeneration :: TestTree
--- dbSchemaGeneration =
---   testCase "Database schema generation" $
---   do let names = allTables (\(DatabaseTable _ nm _) -> nm) employeeDbSettings
---      names @?= [ "employees"
---                , "departments"
---                , "roles"
---                , "funny" ]
-
--- dbSchemaModification :: TestTree
--- dbSchemaModification =
---   testCase "Database schema modification" $
---   do let names = allTables (\(DatabaseTable _ nm _ ) -> nm) employeeDbSettingsModified
---      names @?= [ "emps"
---                , "depts"
---                , "roles"
---                , "funny" ]
-
---      let DatabaseTable _ _ departmentT = _departments employeeDbSettingsModified
---      departmentT @?= DepartmentT (TableField "depts_name" (DummyField False False DummyFieldText))
---                                  (EmployeeId (TableField "head__first_name" (DummyField True False (DummyFieldMaybe DummyFieldText)))
---                                              (TableField "head__last_name" (DummyField True False (DummyFieldMaybe DummyFieldText)))
---                                              (TableField "head__created" (DummyField True False (DummyFieldMaybe DummyFieldUTCTime))))
+data VehicleDb f
+    = VehicleDb
+    { _vdbVehiculesA :: f (TableEntity ADepartmentVehiculeT)
+    , _vdbVehiculesB :: f (TableEntity BDepartmentVehiculeT)
+    } deriving Generic
+instance Database be VehicleDb
+
+data SuperDb f
+    = SuperDb
+    { _embedEmployeeDb :: EmployeeDb f
+    , _embedVehicleDb  :: VehicleDb f
+    } deriving Generic
+instance Database be SuperDb
+
+superDbSettingsDefault :: DatabaseSettings be SuperDb
+superDbSettingsDefault = defaultDbSettings
+
+superDbSettingsCustom :: DatabaseSettings be SuperDb
+superDbSettingsCustom = defaultDbSettings `withDbModification` dbModification { _embedVehicleDb = embedDatabase customVehicleDb }
+
+customVehicleDb :: DatabaseSettings be VehicleDb
+customVehicleDb = defaultDbSettings `withDbModification` dbModification
+                  { _vdbVehiculesA = setEntityName "something_random" }
+
+
+embeddedDatabases :: TestTree
+embeddedDatabases =
+    testGroup "Embedded databases"
+      [ testCase "Databases can be embedded" $ do
+          view (dbEntityDescriptor . dbEntityName) (_vdbVehiculesA (_embedVehicleDb superDbSettingsDefault)) @?= "vehicules_a"
+          view (dbEntityDescriptor . dbEntityName) (_vdbVehiculesB (_embedVehicleDb superDbSettingsDefault)) @?= "vehicules_b"
+      , testCase "Databases can be customized when embedded" $ do
+          view (dbEntityDescriptor . dbEntityName) (_vdbVehiculesA (_embedVehicleDb superDbSettingsCustom)) @?= "something_random"
+      ]
+

beam-migrate-cli/beam-migrate-cli.cabal

@@ -33,7 +33,7 @@ executable beam-migrate
                        text                 >=1.2      && <2.1,
                        bytestring           >=0.10     && <0.12,
                        time                 >=1.6      && <1.13,
-                       optparse-applicative >=0.13     && <0.17,
+                       optparse-applicative >=0.13     && <0.18,
                        directory            >=1.2      && <1.4,
                        filepath             >=1.4      && <1.5,
                        largeword            >=1.2      && <1.3,

beam-migrate/ChangeLog.md

@@ -1,3 +1,15 @@
+# 0.5.2.1
+
+# Added features
+
+ * Loosen some version bounds
+
+# 0.5.2.0
+
+# Addded features
+
+ * `IN (SELECT ...)` syntax via `inSelectE`
+
 # 0.5.1.2
 
 ## Added features

beam-migrate/Database/Beam/Migrate/SQL/Tables.hs

@@ -44,6 +44,7 @@ import Database.Beam.Migrate.SQL.Types
 import Database.Beam.Migrate.SQL.SQL92
 
 import Control.Applicative
+import Control.Monad
 import Control.Monad.Identity
 import Control.Monad.Writer.Strict
 import Control.Monad.State

beam-migrate/Database/Beam/Migrate/Simple.hs

@@ -49,7 +49,7 @@ import           Control.Monad.Writer
 import           Control.Monad.State
 
 import qualified Data.HashSet as HS
-import           Data.Semigroup (Max(..))
+import           Data.Semigroup (Max(..), Any(..))
 import           Data.Typeable
 import           Data.Functor
 import qualified Data.Text as T

beam-migrate/Database/Beam/Migrate/Types/CheckedEntities.hs

@@ -16,6 +16,7 @@ import Control.Monad.Writer
 import Control.Monad.Identity
 
 import Data.Maybe
+import Data.Monoid
 import Data.Proxy
 import Data.Text (Text)
 import Data.String

beam-migrate/beam-migrate.cabal

@@ -1,5 +1,5 @@
 name:                beam-migrate
-version:             0.5.2.0
+version:             0.5.2.1
 synopsis:            SQL DDL support and migrations support library for Beam
 description:         This package provides type classes to allow backends to implement
                      SQL DDL support for beam. This allows you to use beam syntax to
@@ -64,18 +64,18 @@ library
                        text                 >=1.2     && <2.1,
                        aeson                >=0.11    && <2.2,
                        bytestring           >=0.10    && <0.12,
-                       free                 >=4.12    && <5.2,
+                       free                 >=4.12    && <5.3,
                        time                 >=1.6     && <1.13,
-                       mtl                  >=2.2     && <2.3,
+                       mtl                  >=2.2     && <2.4,
                        scientific           >=0.3     && <0.4,
-                       vector               >=0.11    && <0.13,
+                       vector               >=0.11    && <0.14,
                        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.10,
+                       ghc-prim             >=0.5     && <0.11,
                        containers           >=0.5     && <0.7,
                        haskell-src-exts     >=1.18    && <1.24,
                        pretty               >=1.1     && <1.2,

beam-postgres/ChangeLog.md

@@ -1,3 +1,21 @@
+# 0.5.3.1
+
+# Added features
+
+ * Loosen some version bounds
+
+# 0.5.3.0
+
+# Bug fixes
+
+ * Make sure lateral join names do not overlap
+ * Fix `bool_or`
+
+# Addded features
+
+ * Add `runSelectReturningFirst`
+ * `IN (SELECT ...)` syntax via `inQuery_`
+
 # 0.5.2.1
 
 ## Added features

beam-postgres/beam-postgres.cabal

@@ -1,5 +1,5 @@
 name:                 beam-postgres
-version:              0.6.0.0
+version:              0.5.3.1
 synopsis:             Connection layer between beam and postgres
 description:          Beam driver for <https://www.postgresql.org/ PostgreSQL>, an advanced open-source RDBMS
 homepage:             https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres
@@ -46,7 +46,7 @@ library
                       base16-bytestring    >=0.1.1 && <1.1,
                       hashable             >=1.1  && <1.5,
                       lifted-base          >=0.2  && <0.3,
-                      free                 >=4.12 && <5.2,
+                      free                 >=4.12 && <5.3,
                       time                 >=1.6  && <1.13,
                       monad-control        >=1.0  && <1.1,
                       mtl                  >=2.1  && <2.3,
@@ -55,7 +55,7 @@ library
                       uuid-types           >=1.0  && <1.1,
                       case-insensitive     >=1.2  && <1.3,
                       scientific           >=0.3  && <0.4,
-                      vector               >=0.11 && <0.13,
+                      vector               >=0.11 && <0.14,
                       network-uri          >=2.6  && <2.7,
                       unordered-containers >= 0.2 && <0.3,
                       tagged               >=0.8  && <0.9,