Postgres examples

README.md

@@ -120,3 +120,7 @@ to
       enabled_backends:
         - beam-sqlite
 ```
+
+## Pagila example
+
+See [Pagila example in `beam-postgres/examples`](beam-postgres/examples/).

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

@@ -6,6 +6,7 @@ module Database.Beam.Migrate.Simple
   , simpleSchema
   , simpleMigration
   , runSimpleMigration
+  , backendMigrationStepsScript
   , backendMigrationScript
 
   , VerificationResult(..)
@@ -338,15 +339,25 @@ runSimpleMigration :: MonadBeam be m
 runSimpleMigration runner hdl =
   runner hdl . mapM_ runNoReturn
 
+-- | Given a function to convert a command to a 'String', produce a script that
+-- will execute the given migration steps. Usually, the function you provide
+-- eventually calls 'displaySyntax' to render the command.
+backendMigrationStepsScript :: BeamSqlBackend be
+                            => (BeamSqlBackendSyntax be -> String)
+                            -> MigrationSteps be () a
+                            -> String
+backendMigrationStepsScript render migSteps =
+  migrateScript ((++"\n") . T.unpack) ((++"\n") . render) migSteps
+
 -- | Given a function to convert a command to a 'String', produce a script that
 -- will execute the given migration. Usually, the function you provide
--- eventually calls 'displaySyntax' to rendere the command.
+-- eventually calls 'displaySyntax' to render the command.
 backendMigrationScript :: BeamSqlBackend be
                        => (BeamSqlBackendSyntax be -> String)
                        -> Migration be a
                        -> String
 backendMigrationScript render mig =
-  migrateScript ((++"\n") . T.unpack) ((++"\n") . render) (migrationStep "Migration Script" (\() -> mig))
+  backendMigrationStepsScript render (migrationStep "Migration Script" (\() -> mig))
 
 -- | Given a 'BeamMigrationBackend', get a string representing a Haskell module
 -- that would be a good starting point for further development.

beam-postgres/examples/app/Main.hs

@@ -0,0 +1,26 @@
+module Main where
+
+import Database.Beam.Migrate (stepNames)
+import Database.Beam.Migrate.Simple (backendMigrationStepsScript)
+import Database.Beam.Postgres.Syntax (pgRenderSyntaxScript, fromPgCommand, pgCommandType)
+import Database.Beam.Postgres (Postgres)
+import Database.Beam.Backend.SQL ( BeamSqlBackendSyntax )
+import qualified Data.Text.Lazy             as TL
+import qualified Data.Text.Lazy.Encoding    as TL
+import Data.Text (unpack)
+import Pagila.Schema (allMigrationSteps)
+
+main :: IO ()
+main = do
+  putStrLn "Migration steps:"
+  mapM_ (putStrLn . unpack) (stepNames allMigrationSteps)
+  putStrLn "-------------"
+  putStrLn "For each migration step, the sequence of SQL scripts:"
+  let
+    renderer :: BeamSqlBackendSyntax Postgres -> String
+    renderer syntax = "SQL command type: " <> commandType <> "\n"
+      <> "SQL script: \n" <> sqlScript
+      where
+      commandType = show . pgCommandType $ syntax
+      sqlScript = TL.unpack . TL.decodeUtf8 . pgRenderSyntaxScript . fromPgCommand $ syntax
+  putStrLn $ backendMigrationStepsScript renderer allMigrationSteps

beam-postgres/examples/app/RunMigration.hs

@@ -0,0 +1,27 @@
+module RunMigration where
+
+import Prelude
+import Database.PostgreSQL.Simple (connect, close, ConnectInfo(..))
+import Pagila.Schema (migrateDB)
+
+-- https://hackage.haskell.org/package/postgresql-simple-0.7.0.0/docs/Database-PostgreSQL-Simple.html#t:ConnectInfo
+connInfo :: ConnectInfo
+connInfo = ConnectInfo "localhost" (read "5432") "postgres" "foo" "postgres"
+
+main :: IO ()
+main = do
+  putStrLn "Pagila migration"
+
+  putStrLn "**This will overwrite data in your Postgres instance**"
+  putStrLn "Type 'migrate' to proceed."
+  x <- getLine
+
+  if x == "migrate" then do
+    putStrLn "Running migration..."
+    c <- connect connInfo
+
+    _ <- migrateDB c
+
+    close c
+  else do
+    putStrLn "Input was not 'migrate'; quitting"

beam-postgres/examples/pagila.cabal

@@ -22,12 +22,42 @@ library
                       scientific,
                       bytestring,
                       text,
+                      generic-random,
+                      QuickCheck,
+                      quickcheck-instances,
                       postgresql-simple,
                       beam-core,
                       beam-postgres,
                       beam-migrate
     hs-source-dirs:   src
-
+
+executable pagila-print
+    import:           warnings
+    main-is:          Main.hs
+    build-depends:    base,
+                      pagila,
+                      text,
+                      bytestring,
+                      beam-core,
+                      beam-postgres,
+                      beam-migrate
+    hs-source-dirs:   app
+    default-language: Haskell2010
+
+executable pagila-migration
+    import:           warnings
+    main-is:          RunMigration.hs
+    ghc-options:      -main-is RunMigration
+    build-depends:    base,
+                      pagila,
+                      text,
+                      bytestring,
+                      beam-core,
+                      beam-postgres,
+                      beam-migrate,
+                      postgresql-simple
+    hs-source-dirs:   app
+    default-language: Haskell2010
 
 test-suite pagila-test
     import:           warnings

beam-postgres/examples/readme.md

@@ -0,0 +1,30 @@
+# Pagila example
+
+There are two executables:
+
+### 1. `cabal run pagila-print`
+`cabal run pagila-print` to see rendering of Postgres migration. This converts the Haskell to SQL statements and prints these to the console.
+
+### 2. Destructive: apply migration to Postgres instance
+
+Hard-code your Postgres connection parameters into `app/RunMigration.hs` `connInfo`.
+Then `cabal run pagila-migration`. *This will overwrite your Postgres data*.
+
+The result will be the Pagila database schema in your Postgres instance:
+```
+postgres=# \d
+                      List of relations
+ Schema |             Name              |   Type   |  Owner
+--------+-------------------------------+----------+----------
+ public | actor                         | table    | postgres
+ public | actor_actor_id_seq            | sequence | postgres
+ public | address                       | table    | postgres
+ public | address_address_id_seq        | sequence | postgres
+ public | beam_migration                | table    | postgres
+ public | beam_version                  | table    | postgres
+ public | category                      | table    | postgres
+.
+.
+.
+```
+

beam-postgres/examples/src/Pagila/Schema.hs

@@ -1,23 +1,82 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Pagila.Schema
   ( module Pagila.Schema.V0002
-  , migration, db ) where
+  , allMigrationSteps, migrateDB, dbSettings, dbSettings' ) where
+
+import           Database.PostgreSQL.Simple
 
 import Pagila.Schema.V0002 hiding (migration)
 
-import qualified Pagila.Schema.V0001 as V0001 (migration)
-import qualified Pagila.Schema.V0002 as V0002 (migration)
+import qualified Pagila.Schema.V0001 as V0001
+import qualified Pagila.Schema.V0002 as V0002
 
 import Control.Arrow ( (>>>) )
 
-import Database.Beam (DatabaseSettings)
+import Test.QuickCheck.Gen (Gen, sample')
+import Test.QuickCheck.Arbitrary (arbitrary)
+
+import Database.Beam (DatabaseSettings, liftIO, insert, insertValues, runInsert)
 import Database.Beam.Migrate.Types ( CheckedDatabaseSettings, MigrationSteps, unCheckDatabase
                                    , evaluateDatabase, migrationStep)
-import Database.Beam.Postgres (Postgres)
+import Database.Beam.Postgres (Postgres, runBeamPostgresDebug)
+import Database.Beam.Migrate.Simple (BringUpToDateHooks, bringUpToDateWithHooks, defaultUpToDateHooks, runIrreversibleHook)
+import qualified Database.Beam.Postgres.Migrate as Pg
+
+firstMigrationStep :: MigrationSteps Postgres () (CheckedDatabaseSettings Postgres V0001.PagilaDb)
+firstMigrationStep = migrationStep "Initial commit" V0001.migration
+
+secondMigrationStep :: MigrationSteps Postgres (CheckedDatabaseSettings Postgres V0001.PagilaDb) (CheckedDatabaseSettings Postgres V0002.PagilaDb)
+secondMigrationStep = migrationStep "Add film actor, inventory, rental table" V0002.migration
+
+allMigrationSteps :: MigrationSteps Postgres () (CheckedDatabaseSettings Postgres V0002.PagilaDb)
+allMigrationSteps = firstMigrationStep >>> secondMigrationStep
+
+dbSettings :: DatabaseSettings Postgres V0001.PagilaDb
+dbSettings = unCheckDatabase (evaluateDatabase firstMigrationStep)
+
+dbSettings' :: DatabaseSettings Postgres V0002.PagilaDb
+dbSettings' = unCheckDatabase (evaluateDatabase allMigrationSteps)
+
+allowDestructive :: (MonadFail m) => BringUpToDateHooks m
+allowDestructive =
+  defaultUpToDateHooks
+    { runIrreversibleHook = return True
+    }
+
+{- |
+  Run two migrations: V0001 and V0002.
+  After V0001 migration, insert randomly generated countries and staff.
+  This demonstrates the V0002 migration will not delete that data.
+-}
+migrateDB :: Connection -> IO (Maybe (CheckedDatabaseSettings Postgres V0002.PagilaDb))
+migrateDB conn = runBeamPostgresDebug putStrLn conn $ do
+
+  -- Run migration V0001
+  mx :: Maybe (CheckedDatabaseSettings Postgres V0001.PagilaDb) <- bringUpToDateWithHooks allowDestructive Pg.migrationBackend firstMigrationStep
+
+  case mx of
+    -- if migration V0001 succeeded, proceed.
+    Just (_ :: CheckedDatabaseSettings Postgres V0001.PagilaDb) -> do
+      -- generate random countries
+      randomCountries :: [V0001.Country] <- liftIO
+        . fmap (zipWith (\i country -> country { V0001.countryId = i }) [1..])
+        $ sample' (arbitrary :: Gen V0001.Country)
+      runInsert $ insert (V0001.country dbSettings) $ insertValues randomCountries
+
+      -- generate random V0001 Staff
+      randomStaff :: [V0001.Staff] <- 
+        liftIO
+        . fmap (zipWith (\i staff -> staff { V0001.staffId = i }) [1..])
+        . fmap (fmap (\staffMember -> staffMember { V0001.staffPicture = Nothing } ))  -- overwrite picture with null
+        $ sample' (arbitrary :: Gen V0001.Staff)
 
-migration :: MigrationSteps Postgres () (CheckedDatabaseSettings Postgres Pagila.Schema.V0002.PagilaDb)
-migration = migrationStep "Initial commit" V0001.migration >>>
-            migrationStep "Add film actor, inventory, rental table" V0002.migration
+      runInsert $ insert (V0001.staff dbSettings) $ insertValues randomStaff
 
-db :: DatabaseSettings Postgres Pagila.Schema.V0002.PagilaDb
-db = unCheckDatabase (evaluateDatabase migration)
+      {- Run migrations V0001 (redundantly) and V0002.
+         The V0002 migration will add staff `salary` field, among other changes.
+         See 'Pagila.Schema.V0002.migrateToNewStaffWithSalary'.
+      -}
+      bringUpToDateWithHooks allowDestructive Pg.migrationBackend allMigrationSteps
+    Nothing ->
+      pure Nothing