squeal-postgresql-0.2.1.0: Squeal PostgreSQL Library

Copyright(c) Eitan Chatav 2017
Maintainereitan@morphism.tech
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Squeal.PostgreSQL.Migration

Contents

Description

This module defines a Migration type to safely change the schema of your database over time. Let's see an example!

>>> :set -XDataKinds -XOverloadedLabels
>>> :set -XOverloadedStrings -XFlexibleContexts -XTypeOperators
>>> :{
type UsersTable =
  '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
  '[ "id" ::: 'Def :=> 'NotNull 'PGint4
   , "name" ::: 'NoDef :=> 'NotNull 'PGtext
   ]
:}
>>> :{
type EmailsTable =
  '[  "pk_emails" ::: 'PrimaryKey '["id"]
   , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
   ] :=>
  '[ "id" ::: 'Def :=> 'NotNull 'PGint4
   , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
   , "email" ::: 'NoDef :=> 'Null 'PGtext
   ]
:}
>>> :{
let
  makeUsers :: Migration IO '[] '["users" ::: UsersTable]
  makeUsers = Migration
    { name = "make users table"
    , up = void . define $
        createTable #users
        ( serial `As` #id :*
          (text & notNull) `As` #name :* Nil )
        ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )
    , down = void . define $ dropTable #users
    }
:}
>>> :{
let
  makeEmails :: Migration IO '["users" ::: UsersTable]
    '["users" ::: UsersTable, "emails" ::: EmailsTable]
  makeEmails = Migration
    { name = "make emails table"
    , up = void . define $
        createTable #emails
          ( serial `As` #id :*
            (int & notNull) `As` #user_id :*
            text `As` #email :* Nil )
          ( primaryKey (Column #id :* Nil) `As` #pk_emails :*
            foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
              OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )
    , down = void . define $ dropTable #emails
    }
:}

Now that we have a couple migrations we can chain them together.

>>> let migrations = makeUsers :>> makeEmails :>> Done
>>> :{
let
  numMigrations
    :: Has "schema_migrations" schema MigrationsTable
    => PQ schema schema IO ()
  numMigrations = do
    result <- runQuery (selectStar (from (table (#schema_migrations `As` #m))))
    num <- ntuples result
    liftBase $ print num
:}
>>> :{
withConnection "host=localhost port=5432 dbname=exampledb" $
  manipulate (UnsafeManipulation "SET client_min_messages TO WARNING;")
    -- suppress notices
  & pqThen (migrateUp migrations)
  & pqThen numMigrations
  & pqThen (migrateDown migrations)
  & pqThen numMigrations
:}
Row 2
Row 0

Synopsis

Migration

data Migration io schema0 schema1 Source #

A Migration should contain an inverse pair of up and down instructions and a unique name.

Constructors

Migration 

Fields

migrateUp Source #

Arguments

:: MonadBaseControl IO io 
=> AlignedList (Migration io) schema0 schema1

migrations to run

-> PQ (("schema_migrations" ::: MigrationsTable) ': schema0) (("schema_migrations" ::: MigrationsTable) ': schema1) io () 

Run Migrations by creating the MigrationsTable if it does not exist and then in a transaction, for each each Migration query to see if the Migration is executed. If not, then execute the Migration and insert its row in the MigrationsTable.

migrateDown Source #

Arguments

:: MonadBaseControl IO io 
=> AlignedList (Migration io) schema0 schema1

migrations to rewind

-> PQ (("schema_migrations" ::: MigrationsTable) ': schema1) (("schema_migrations" ::: MigrationsTable) ': schema0) io () 

Rewind Migrations by creating the MigrationsTable if it does not exist and then in a transaction, for each each Migration query to see if the Migration is executed. If it is, then rewind the Migration and delete its row in the MigrationsTable.

Aligned lists

data AlignedList p x0 x1 where Source #

An AlignedList is a type-aligned list or free category.

Constructors

Done :: AlignedList p x x 
(:>>) :: p x0 x1 -> AlignedList p x1 x2 -> AlignedList p x0 x2 infixr 7 

Instances

Category k (AlignedList k p) Source # 

Methods

id :: cat a a #

(.) :: cat b c -> cat a b -> cat a c #

single :: p x0 x1 -> AlignedList p x0 x1 Source #

A single step.

Migration table

type MigrationsTable = '["migrations_unique_name" ::: Unique '["name"]] :=> '["name" ::: (NoDef :=> NotNull PGtext), "executed_at" ::: (Def :=> NotNull PGtimestamptz)] Source #

The TableType for a Squeal migration.

createMigrations :: Has "schema_migrations" schema MigrationsTable => Definition schema schema Source #

Creates a MigrationsTable if it does not already exist.

insertMigration :: Has "schema_migrations" schema MigrationsTable => Manipulation schema '[NotNull PGtext] '[] Source #

Inserts a Migration into the MigrationsTable

deleteMigration :: Has "schema_migrations" schema MigrationsTable => Manipulation schema '[NotNull PGtext] '[] Source #

Deletes a Migration from the MigrationsTable

selectMigration :: Has "schema_migrations" schema MigrationsTable => Query schema '[NotNull PGtext] '["executed_at" ::: NotNull PGtimestamptz] Source #

Selects a Migration from the MigrationsTable, returning the time at which it was executed.