mirror of
https://github.com/ilyakooo0/squeal.git
synced 2024-09-11 13:57:29 +03:00
parent
383e27799a
commit
045aae6d11
@ -38,9 +38,10 @@ Now we can define some `Migration`s to make our tables.
|
||||
|
||||
>>> :{
|
||||
let
|
||||
makeUsers :: Migration (Iso Definition) (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]
|
||||
makeUsers = Migration "make users table" Iso
|
||||
{ up = createTable #users
|
||||
makeUsers :: Migration Definition (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]
|
||||
makeUsers = Migration
|
||||
{ name = "make users table"
|
||||
, up = createTable #users
|
||||
( serial `as` #id :*
|
||||
notNullable text `as` #name )
|
||||
( primaryKey #id `as` #pk_users )
|
||||
@ -50,10 +51,11 @@ let
|
||||
|
||||
>>> :{
|
||||
let
|
||||
makeEmails :: Migration (Iso Definition) '["public" ::: '["users" ::: 'Table UsersTable]]
|
||||
makeEmails :: Migration Definition '["public" ::: '["users" ::: 'Table UsersTable]]
|
||||
'["public" ::: '["users" ::: 'Table UsersTable, "emails" ::: 'Table EmailsTable]]
|
||||
makeEmails = Migration "make emails table" Iso
|
||||
{ up = createTable #emails
|
||||
makeEmails = Migration
|
||||
{ name = "make emails table"
|
||||
, up = createTable #emails
|
||||
( serial `as` #id :*
|
||||
notNullable int `as` #user_id :*
|
||||
nullable text `as` #email )
|
||||
@ -83,9 +85,9 @@ withConnection "host=localhost port=5432 dbname=exampledb" $
|
||||
Migrate
|
||||
Rollback
|
||||
|
||||
We can also create a simple executable using `mainMigrateIso`.
|
||||
We can also create a simple executable using `defaultMain`.
|
||||
|
||||
>>> let main = mainMigrateIso "host=localhost port=5432 dbname=exampledb" migrations
|
||||
>>> let main = defaultMain "host=localhost port=5432 dbname=exampledb" migrations
|
||||
|
||||
>>> withArgs [] main
|
||||
Invalid command: "". Use:
|
||||
@ -140,12 +142,10 @@ module Squeal.PostgreSQL.Migration
|
||||
Migration (..)
|
||||
, Migratory (..)
|
||||
, Terminally (..)
|
||||
, Iso (..)
|
||||
, terminally
|
||||
, pureMigration
|
||||
, pureMigrationIso
|
||||
, MigrationsTable
|
||||
, mainMigrateIso
|
||||
, defaultMain
|
||||
) where
|
||||
|
||||
import Control.Category
|
||||
@ -187,7 +187,8 @@ import Squeal.PostgreSQL.Transaction
|
||||
data Migration p schemas0 schemas1 = Migration
|
||||
{ name :: Text -- ^ The `name` of a `Migration`.
|
||||
-- Each `name` in a `Migration` should be unique.
|
||||
, instruction :: p schemas0 schemas1 -- ^ The instruction of a `Migration`.
|
||||
, up :: p schemas0 schemas1 -- ^ The `up` instruction of a `Migration`.
|
||||
, down :: p schemas1 schemas0 -- ^ The `down` instruction of a `Migration`.
|
||||
} deriving (GHC.Generic)
|
||||
|
||||
{- |
|
||||
@ -197,10 +198,6 @@ SQL `Definition`s and the category of impure `Terminally` `PQ` `IO` actions.
|
||||
-}
|
||||
class Category p => Migratory p where
|
||||
|
||||
migrate
|
||||
:: Path (Migration p) schemas0 schemas1
|
||||
-> PQ schemas0 schemas1 IO ()
|
||||
|
||||
{- |
|
||||
Run a `Path` of `Migration`s.
|
||||
Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
|
||||
@ -208,7 +205,7 @@ class Category p => Migratory p where
|
||||
if not, `up` the `Migration` and insert its `name` in the `MigrationsTable`.
|
||||
-}
|
||||
migrateUp
|
||||
:: Path (Migration (Iso p)) schemas0 schemas1
|
||||
:: Path (Migration p) schemas0 schemas1
|
||||
-> PQ schemas0 schemas1 IO ()
|
||||
|
||||
{- |
|
||||
@ -218,13 +215,12 @@ class Category p => Migratory p where
|
||||
if so, `down` the `Migration` and delete its `name` in the `MigrationsTable`.
|
||||
-}
|
||||
migrateDown
|
||||
:: Path (Migration (Iso p)) schemas0 schemas1
|
||||
:: Path (Migration p) schemas0 schemas1
|
||||
-> PQ schemas1 schemas0 IO ()
|
||||
|
||||
instance Migratory Definition where
|
||||
migrate = migrate . cmap pureMigration
|
||||
migrateUp = migrateUp . cmap pureMigrationIso
|
||||
migrateDown = migrateDown . cmap pureMigrationIso
|
||||
migrateUp = migrateUp . cmap pureMigration
|
||||
migrateDown = migrateDown . cmap pureMigration
|
||||
|
||||
{- | `Terminally` turns an indexed monad transformer and the monad it transforms
|
||||
into a category by restricting the return type to @()@ and permuting the type variables.
|
||||
@ -236,11 +232,6 @@ newtype Terminally trans monad x0 x1 = Terminally
|
||||
{ runTerminally :: trans x0 x1 monad () }
|
||||
deriving GHC.Generic
|
||||
|
||||
data Iso c x y = Iso
|
||||
{ up :: c x y
|
||||
, down :: c y x
|
||||
} deriving GHC.Generic
|
||||
|
||||
instance
|
||||
( IndexedMonadTransPQ trans
|
||||
, Monad monad
|
||||
@ -265,26 +256,13 @@ pureMigration
|
||||
-> Migration (Terminally PQ IO) schemas0 schemas1
|
||||
pureMigration migration = Migration
|
||||
{ name = name migration
|
||||
, instruction = terminally . define $ instruction migration
|
||||
}
|
||||
|
||||
-- | A `pureMigrationIso` turns a reversible `Migration`
|
||||
-- involving only pure SQL
|
||||
-- `Definition`s into a `Migration` that may be combined with arbitrary `IO`.
|
||||
pureMigrationIso
|
||||
:: Migration (Iso Definition) schemas0 schemas1
|
||||
-> Migration (Iso (Terminally PQ IO)) schemas0 schemas1
|
||||
pureMigrationIso migration = Migration
|
||||
{ name = name migration
|
||||
, instruction = Iso
|
||||
{ up = terminally . define . up $ instruction migration
|
||||
, down = terminally . define . down $ instruction migration
|
||||
}
|
||||
, up = terminally . define $ up migration
|
||||
, down = terminally . define $ down migration
|
||||
}
|
||||
|
||||
instance Migratory (Terminally PQ IO) where
|
||||
|
||||
migrate migration = unsafePQ . transactionally_ $ do
|
||||
migrateUp migration = unsafePQ . transactionally_ $ do
|
||||
define createMigrations
|
||||
upMigrations migration
|
||||
|
||||
@ -303,7 +281,7 @@ instance Migratory (Terminally PQ IO) where
|
||||
upMigration step = do
|
||||
executed <- queryExecuted step
|
||||
unless (executed == 1) $ do
|
||||
unsafePQ . runTerminally $ instruction step
|
||||
unsafePQ . runTerminally $ up step
|
||||
manipulateParams_ insertMigration (Only (name step))
|
||||
|
||||
queryExecuted
|
||||
@ -313,8 +291,6 @@ instance Migratory (Terminally PQ IO) where
|
||||
result <- runQueryParams selectMigration (Only (name step))
|
||||
ntuples result
|
||||
|
||||
migrateUp = migrate . cmap (\(Migration n iso) -> Migration n (up iso))
|
||||
|
||||
migrateDown migrations = unsafePQ . transactionally_ $ do
|
||||
define createMigrations
|
||||
downMigrations migrations
|
||||
@ -322,23 +298,23 @@ instance Migratory (Terminally PQ IO) where
|
||||
where
|
||||
|
||||
downMigrations
|
||||
:: Path (Migration (Iso (Terminally PQ IO))) schemas0 schemas1
|
||||
:: Path (Migration (Terminally PQ IO)) schemas0 schemas1
|
||||
-> PQ MigrationsSchemas MigrationsSchemas IO ()
|
||||
downMigrations = \case
|
||||
Done -> return ()
|
||||
step :>> steps -> downMigrations steps >> downMigration step
|
||||
|
||||
downMigration
|
||||
:: Migration (Iso (Terminally PQ IO)) schemas0 schemas1
|
||||
:: Migration (Terminally PQ IO) schemas0 schemas1
|
||||
-> PQ MigrationsSchemas MigrationsSchemas IO ()
|
||||
downMigration step = do
|
||||
executed <- queryExecuted step
|
||||
unless (executed == 0) $ do
|
||||
unsafePQ . runTerminally . down $ instruction step
|
||||
unsafePQ . runTerminally $ down step
|
||||
manipulateParams_ deleteMigration (Only (name step))
|
||||
|
||||
queryExecuted
|
||||
:: Migration (Iso (Terminally PQ IO)) schemas0 schemas1
|
||||
:: Migration (Terminally PQ IO) schemas0 schemas1
|
||||
-> PQ MigrationsSchemas MigrationsSchemas IO Row
|
||||
queryExecuted step = do
|
||||
result <- runQueryParams selectMigration (Only (name step))
|
||||
@ -403,16 +379,16 @@ data MigrateCommand
|
||||
| MigrateUp
|
||||
| MigrateDown deriving (GHC.Generic, Show)
|
||||
|
||||
{- | `mainMigrateIso` creates a simple executable
|
||||
{- | `defaultMain` creates a simple executable
|
||||
from a connection string and a list of `Migration`s. -}
|
||||
mainMigrateIso
|
||||
defaultMain
|
||||
:: Migratory p
|
||||
=> ByteString
|
||||
-- ^ connection string
|
||||
-> Path (Migration (Iso p)) db0 db1
|
||||
-> Path (Migration p) db0 db1
|
||||
-- ^ migrations
|
||||
-> IO ()
|
||||
mainMigrateIso connectTo migrations = do
|
||||
defaultMain connectTo migrations = do
|
||||
command <- readCommandFromArgs
|
||||
maybe (pure ()) performCommand command
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user