{-# LANGUAGE
DataKinds
, DeriveGeneric
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, GADTs
, LambdaCase
, MultiParamTypeClasses
, OverloadedLabels
, OverloadedStrings
, PolyKinds
, QuantifiedConstraints
, RankNTypes
, TypeApplications
, TypeOperators
#-}
module Squeal.PostgreSQL.Session.Migration
(
Migration (..)
, Migratory (..)
, migrate
, migrateUp
, migrateDown
, MigrationsTable
, mainMigrate
, mainMigrateIso
, IsoQ (..)
) where
import Control.Category
import Control.Category.Free
import Control.Monad
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import Data.Foldable (traverse_)
import Data.Function ((&))
import Data.List ((\\))
import Data.Quiver
import Data.Quiver.Functor
import Data.Text (Text)
import Data.Time (UTCTime)
import Prelude hiding ((.), id)
import System.Environment
import qualified Data.Text.IO as Text (putStrLn)
import qualified Generics.SOP as SOP
import qualified GHC.Generics as GHC
import Squeal.PostgreSQL.Definition
import Squeal.PostgreSQL.Definition.Constraint
import Squeal.PostgreSQL.Definition.Table
import Squeal.PostgreSQL.Expression.Comparison
import Squeal.PostgreSQL.Expression.Default
import Squeal.PostgreSQL.Expression.Parameter
import Squeal.PostgreSQL.Expression.Time
import Squeal.PostgreSQL.Expression.Type
import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Manipulation.Delete
import Squeal.PostgreSQL.Manipulation.Insert
import Squeal.PostgreSQL.Session
import Squeal.PostgreSQL.Session.Decode
import Squeal.PostgreSQL.Session.Encode
import Squeal.PostgreSQL.Session.Indexed
import Squeal.PostgreSQL.Session.Monad
import Squeal.PostgreSQL.Session.Result
import Squeal.PostgreSQL.Session.Statement
import Squeal.PostgreSQL.Session.Transaction.Unsafe
import Squeal.PostgreSQL.Query.From
import Squeal.PostgreSQL.Query.Select
import Squeal.PostgreSQL.Query.Table
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Type.Schema
data Migration def db0 db1 = Migration
{ forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> Text
migrationName :: Text
, forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> def db0 db1
migrationDef :: def db0 db1
} deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (def :: k -> k -> *) (db0 :: k) (db1 :: k) x.
Rep (Migration def db0 db1) x -> Migration def db0 db1
forall k k (def :: k -> k -> *) (db0 :: k) (db1 :: k) x.
Migration def db0 db1 -> Rep (Migration def db0 db1) x
$cto :: forall k k (def :: k -> k -> *) (db0 :: k) (db1 :: k) x.
Rep (Migration def db0 db1) x -> Migration def db0 db1
$cfrom :: forall k k (def :: k -> k -> *) (db0 :: k) (db1 :: k) x.
Migration def db0 db1 -> Rep (Migration def db0 db1) x
GHC.Generic)
instance QFunctor Migration where
qmap :: forall (p :: k2 -> k3 -> *) (q :: k2 -> k3 -> *) (x :: k2)
(y :: k3).
(forall (x1 :: k2) (y1 :: k3). p x1 y1 -> q x1 y1)
-> Migration p x y -> Migration q x y
qmap forall (x1 :: k2) (y1 :: k3). p x1 y1 -> q x1 y1
f (Migration Text
n p x y
i) = forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Text -> def db0 db1 -> Migration def db0 db1
Migration Text
n (forall (x1 :: k2) (y1 :: k3). p x1 y1 -> q x1 y1
f p x y
i)
class (Category def, Category run) => Migratory def run | def -> run where
runMigrations :: Path (Migration def) db0 db1 -> run db0 db1
instance Migratory (Indexed PQ IO ()) (Indexed PQ IO ()) where
runMigrations :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Path (Migration (Indexed PQ IO ())) db0 db1
-> Indexed PQ IO () db0 db1
runMigrations Path (Migration (Indexed PQ IO ())) db0 db1
path = forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
t i j m r -> Indexed t m r i j
Indexed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (tx :: * -> *) (db :: [(Symbol, [(Symbol, SchemumType)])])
x.
(MonadMask tx, MonadPQ db tx) =>
tx x -> tx x
transactionally_ forall a b. (a -> b) -> a -> b
$ do
forall (pq :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> (* -> *) -> * -> *)
(io :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
(IndexedMonadTransPQ pq, MonadIO io) =>
Definition db0 db1 -> pq db0 db1 io ()
define Definition MigrationsSchemas MigrationsSchemas
createMigrations
forall {k} (c :: (k -> k -> *) -> k -> k -> *) m (p :: k -> k -> *)
(x :: k) (y :: k).
(QFoldable c, Monoid m) =>
(forall (x1 :: k) (y1 :: k). p x1 y1 -> m) -> c p x y -> m
qtoMonoid forall {m :: * -> *} {a}
{db0 :: [(Symbol, [(Symbol, SchemumType)])]}
{db1 :: [(Symbol, [(Symbol, SchemumType)])]}.
MonadIO m =>
Migration (Indexed PQ m a) db0 db1
-> PQ
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
m
()
upMigration Path (Migration (Indexed PQ IO ())) db0 db1
path
where
upMigration :: Migration (Indexed PQ m a) db0 db1
-> PQ
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
m
()
upMigration Migration (Indexed PQ m a) db0 db1
step = do
Row
executed <- do
Result UTCTime
result <- forall (db :: [(Symbol, [(Symbol, SchemumType)])]) (pq :: * -> *) x
y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams Statement MigrationsSchemas Text UTCTime
selectMigration (forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> Text
migrationName Migration (Indexed PQ m a) db0 db1
step)
forall (m :: * -> *) y. MonadResult m => Result y -> m Row
ntuples (Result UTCTime
result :: Result UTCTime)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Row
executed forall a. Eq a => a -> a -> Bool
== Row
1) forall a b. (a -> b) -> a -> b
$ do
a
_ <- forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
Indexed t m r i j -> t i j m r
runIndexed forall a b. (a -> b) -> a -> b
$ forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> def db0 db1
migrationDef Migration (Indexed PQ m a) db0 db1
step
forall (db :: [(Symbol, [(Symbol, SchemumType)])]) (pq :: * -> *)
x.
MonadPQ db pq =>
Statement db x () -> x -> pq ()
executeParams_ Statement MigrationsSchemas Text ()
insertMigration (forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> Text
migrationName Migration (Indexed PQ m a) db0 db1
step)
instance Migratory Definition (Indexed PQ IO ()) where
runMigrations :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Path (Migration Definition) db0 db1 -> Indexed PQ IO () db0 db1
runMigrations = forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Definition db0 db1 -> Indexed PQ IO () db0 db1
ixDefine)
instance Migratory (OpQ (Indexed PQ IO ())) (OpQ (Indexed PQ IO ())) where
runMigrations :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Path (Migration (OpQ (Indexed PQ IO ()))) db0 db1
-> OpQ (Indexed PQ IO ()) db0 db1
runMigrations Path (Migration (OpQ (Indexed PQ IO ()))) db0 db1
path = forall {k} {k1} (c :: k -> k1 -> *) (x :: k1) (y :: k).
c y x -> OpQ c x y
OpQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
t i j m r -> Indexed t m r i j
Indexed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (tx :: * -> *) (db :: [(Symbol, [(Symbol, SchemumType)])])
x.
(MonadMask tx, MonadPQ db tx) =>
tx x -> tx x
transactionally_ forall a b. (a -> b) -> a -> b
$ do
forall (pq :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> (* -> *) -> * -> *)
(io :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
(IndexedMonadTransPQ pq, MonadIO io) =>
Definition db0 db1 -> pq db0 db1 io ()
define Definition MigrationsSchemas MigrationsSchemas
createMigrations
forall {k} (c :: (k -> k -> *) -> k -> k -> *) m (p :: k -> k -> *)
(x :: k) (y :: k).
(QFoldable c, Monoid m) =>
(forall (x1 :: k) (y1 :: k). p x1 y1 -> m) -> c p x y -> m
qtoMonoid @FoldPath forall {m :: * -> *} {a}
{db1 :: [(Symbol, [(Symbol, SchemumType)])]}
{db0 :: [(Symbol, [(Symbol, SchemumType)])]}.
MonadIO m =>
OpQ (Migration (OpQ (Indexed PQ m a))) db1 db0
-> PQ
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
m
()
downMigration (forall {k} (c :: (k -> k -> *) -> k -> k -> *)
(path :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *) (x :: k)
(y :: k).
(QFoldable c, CFree path) =>
c p x y -> path (OpQ p) y x
reversePath Path (Migration (OpQ (Indexed PQ IO ()))) db0 db1
path)
where
downMigration :: OpQ (Migration (OpQ (Indexed PQ m a))) db1 db0
-> PQ
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
'["public" ::: '["schema_migrations" ::: 'Table MigrationsTable]]
m
()
downMigration (OpQ Migration (OpQ (Indexed PQ m a)) db0 db1
step) = do
Row
executed <- do
Result UTCTime
result <- forall (db :: [(Symbol, [(Symbol, SchemumType)])]) (pq :: * -> *) x
y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams Statement MigrationsSchemas Text UTCTime
selectMigration (forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> Text
migrationName Migration (OpQ (Indexed PQ m a)) db0 db1
step)
forall (m :: * -> *) y. MonadResult m => Result y -> m Row
ntuples (Result UTCTime
result :: Result UTCTime)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Row
executed forall a. Eq a => a -> a -> Bool
== Row
0) forall a b. (a -> b) -> a -> b
$ do
a
_ <- forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
Indexed t m r i j -> t i j m r
runIndexed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k1} {k2} (c :: k1 -> k2 -> *) (x :: k2) (y :: k1).
OpQ c x y -> c y x
getOpQ forall a b. (a -> b) -> a -> b
$ forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> def db0 db1
migrationDef Migration (OpQ (Indexed PQ m a)) db0 db1
step
forall (db :: [(Symbol, [(Symbol, SchemumType)])]) (pq :: * -> *)
x.
MonadPQ db pq =>
Statement db x () -> x -> pq ()
executeParams_ Statement MigrationsSchemas Text ()
deleteMigration (forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> Text
migrationName Migration (OpQ (Indexed PQ m a)) db0 db1
step)
instance Migratory (OpQ Definition) (OpQ (Indexed PQ IO ())) where
runMigrations :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Path (Migration (OpQ Definition)) db0 db1
-> OpQ (Indexed PQ IO ()) db0 db1
runMigrations = forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Definition db0 db1 -> Indexed PQ IO () db0 db1
ixDefine))
instance Migratory
(IsoQ (Indexed PQ IO ()))
(IsoQ (Indexed PQ IO ())) where
runMigrations :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Path (Migration (IsoQ (Indexed PQ IO ()))) db0 db1
-> IsoQ (Indexed PQ IO ()) db0 db1
runMigrations Path (Migration (IsoQ (Indexed PQ IO ()))) db0 db1
path = forall {k} (c :: k -> k -> *) (x :: k) (y :: k).
c x y -> c y x -> IsoQ c x y
IsoQ
(forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap forall {k} (c :: k -> k -> *) (x :: k) (y :: k).
IsoQ c x y -> c x y
up) Path (Migration (IsoQ (Indexed PQ IO ()))) db0 db1
path))
(forall {k1} {k2} (c :: k1 -> k2 -> *) (x :: k2) (y :: k1).
OpQ c x y -> c y x
getOpQ (forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} (c :: k -> k1 -> *) (x :: k1) (y :: k).
c y x -> OpQ c x y
OpQ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (c :: k -> k -> *) (x :: k) (y :: k).
IsoQ c x y -> c y x
down)) Path (Migration (IsoQ (Indexed PQ IO ()))) db0 db1
path)))
instance Migratory (IsoQ Definition) (IsoQ (Indexed PQ IO ())) where
runMigrations :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Path (Migration (IsoQ Definition)) db0 db1
-> IsoQ (Indexed PQ IO ()) db0 db1
runMigrations = forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap (forall {k} {k1} {k2} {k3} (c :: (k -> k1 -> *) -> k2 -> k3 -> *)
(p :: k -> k1 -> *) (q :: k -> k1 -> *) (x :: k2) (y :: k3).
QFunctor c =>
(forall (x1 :: k) (y1 :: k1). p x1 y1 -> q x1 y1)
-> c p x y -> c q x y
qmap forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Definition db0 db1 -> Indexed PQ IO () db0 db1
ixDefine))
unsafePQ :: (Functor m) => PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ :: forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ (PQ K Connection db0 -> m (K x db1)
pq) = forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) (m :: * -> *) x.
(K Connection db0 -> m (K x db1)) -> PQ db0 db1 m x
PQ forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a (b :: k). a -> K a b
SOP.K forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} a (b :: k). K a b -> a
SOP.unK) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. K Connection db0 -> m (K x db1)
pq forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k a (b :: k). a -> K a b
SOP.K forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} a (b :: k). K a b -> a
SOP.unK
migrate
:: Migratory def (Indexed PQ IO ())
=> Path (Migration def) db0 db1
-> PQ db0 db1 IO ()
migrate :: forall (def :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> *)
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Migratory def (Indexed PQ IO ()) =>
Path (Migration def) db0 db1 -> PQ db0 db1 IO ()
migrate = forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
Indexed t m r i j -> t i j m r
runIndexed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations
migrateUp
:: Migratory def (IsoQ (Indexed PQ IO ()))
=> Path (Migration def) db0 db1
-> PQ db0 db1 IO ()
migrateUp :: forall (def :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> *)
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Migratory def (IsoQ (Indexed PQ IO ())) =>
Path (Migration def) db0 db1 -> PQ db0 db1 IO ()
migrateUp = forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
Indexed t m r i j -> t i j m r
runIndexed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (c :: k -> k -> *) (x :: k) (y :: k).
IsoQ c x y -> c x y
up forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations
migrateDown
:: Migratory def (IsoQ (Indexed PQ IO ()))
=> Path (Migration def) db0 db1
-> PQ db1 db0 IO ()
migrateDown :: forall (def :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> *)
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Migratory def (IsoQ (Indexed PQ IO ())) =>
Path (Migration def) db0 db1 -> PQ db1 db0 IO ()
migrateDown = forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
Indexed t m r i j -> t i j m r
runIndexed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (c :: k -> k -> *) (x :: k) (y :: k).
IsoQ c x y -> c y x
down forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations
ixDefine :: Definition db0 db1 -> Indexed PQ IO () db0 db1
ixDefine :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Definition db0 db1 -> Indexed PQ IO () db0 db1
ixDefine = forall (pq :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> (* -> *) -> * -> *)
(io :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
(IndexedMonadTransPQ pq, MonadIO io) =>
Definition db0 db1 -> Indexed pq io () db0 db1
indexedDefine
type MigrationsTable =
'[ "migrations_unique_name" ::: 'Unique '["name"]] :=>
'[ "name" ::: 'NoDef :=> 'NotNull 'PGtext
, "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
]
data MigrationRow =
MigrationRow { MigrationRow -> Text
name :: Text
, MigrationRow -> UTCTime
executed_at :: UTCTime }
deriving (forall x. Rep MigrationRow x -> MigrationRow
forall x. MigrationRow -> Rep MigrationRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MigrationRow x -> MigrationRow
$cfrom :: forall x. MigrationRow -> Rep MigrationRow x
GHC.Generic, Int -> MigrationRow -> ShowS
[MigrationRow] -> ShowS
MigrationRow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationRow] -> ShowS
$cshowList :: [MigrationRow] -> ShowS
show :: MigrationRow -> String
$cshow :: MigrationRow -> String
showsPrec :: Int -> MigrationRow -> ShowS
$cshowsPrec :: Int -> MigrationRow -> ShowS
Show)
instance SOP.Generic MigrationRow
instance SOP.HasDatatypeInfo MigrationRow
type MigrationsSchema = '["schema_migrations" ::: 'Table MigrationsTable]
type MigrationsSchemas = Public MigrationsSchema
createMigrations :: Definition MigrationsSchemas MigrationsSchemas
createMigrations :: Definition MigrationsSchemas MigrationsSchemas
createMigrations =
forall (sch :: Symbol) (tab :: Symbol)
(columns :: [(Symbol, ColumnType)]) (col :: (Symbol, ColumnType))
(cols :: [(Symbol, ColumnType)])
(constraints :: [(Symbol, TableConstraint)])
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(schema0 :: [(Symbol, SchemumType)])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
(KnownSymbol sch, KnownSymbol tab, columns ~ (col : cols),
SListI columns, SListI constraints, Has sch db0 schema0,
db1
~ Alter
sch
(CreateIfNotExists tab ('Table (constraints :=> columns)) schema0)
db0) =>
QualifiedAlias sch tab
-> NP (Aliased (ColumnTypeExpression db0)) columns
-> NP (Aliased (TableConstraintExpression sch tab db1)) constraints
-> Definition db0 db1
createTableIfNotExists forall a. IsLabel "schema_migrations" a => a
#schema_migrations
( (forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(null :: PGType -> NullType).
TypeExpression db (null 'PGtext)
text forall a b. a -> (a -> b) -> b
& forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(null :: PGType -> NullType) (ty :: PGType).
TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
notNullable) `as` forall a. IsLabel "name" a => a
#name forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:*
(forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(null :: PGType -> NullType).
TypeExpression db (null 'PGtimestamptz)
timestampWithTimeZone forall a b. a -> (a -> b) -> b
& forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(null :: PGType -> NullType) (ty :: PGType).
TypeExpression db (null ty)
-> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)
notNullable forall a b. a -> (a -> b) -> b
& forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(ty :: NullType).
Expression 'Ungrouped '[] '[] db '[] '[] ty
-> ColumnTypeExpression db ('NoDef :=> ty)
-> ColumnTypeExpression db ('Def :=> ty)
default_ forall (null :: PGType -> NullType). Expr (null 'PGtimestamptz)
currentTimestamp)
`as` forall a. IsLabel "executed_at" a => a
#executed_at )
( forall (sch :: Symbol) (db :: [(Symbol, [(Symbol, SchemumType)])])
(schema :: [(Symbol, SchemumType)]) (tab :: Symbol)
(table :: TableType) (aliases :: [Symbol])
(subcolumns :: [(Symbol, NullType)]).
(Has sch db schema, Has tab schema ('Table table),
HasAll aliases (TableToRow table) subcolumns) =>
NP Alias aliases
-> TableConstraintExpression sch tab db ('Unique aliases)
unique forall a. IsLabel "name" a => a
#name `as` forall a. IsLabel "migrations_unique_name" a => a
#migrations_unique_name )
insertMigration :: Statement MigrationsSchemas Text ()
insertMigration :: Statement MigrationsSchemas Text ()
insertMigration = forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(tab :: [NullType]) (row :: [(Symbol, NullType)]) x y.
(All (OidOfNull db) tab, SListI row) =>
EncodeParams db tab x
-> DecodeRow row y
-> Manipulation '[] db tab row
-> Statement db x y
Manipulation forall (db :: [(Symbol, [(Symbol, SchemumType)])]) x
(ty :: NullType).
(ToParam db ty x, ty ~ NullPG x) =>
EncodeParams db '[ty] x
aParam forall (row :: [(Symbol, NullType)]) y (ys :: RecordCode).
GenericRow row y ys =>
DecodeRow row y
genericRow forall a b. (a -> b) -> a -> b
$
forall (sch :: Symbol) (db :: [(Symbol, [(Symbol, SchemumType)])])
(schema :: [(Symbol, SchemumType)]) (tab0 :: Symbol)
(table :: TableType) (tab :: Symbol) (with :: FromType)
(params :: [NullType]).
(Has sch db schema, Has tab0 schema ('Table table),
SListI (TableToColumns table)) =>
Aliased (QualifiedAlias sch) (tab ::: tab0)
-> QueryClause with db params (TableToColumns table)
-> Manipulation with db params '[]
insertInto_ forall a. IsLabel "schema_migrations" a => a
#schema_migrations forall a b. (a -> b) -> a -> b
$
forall (columns :: [(Symbol, ColumnType)]) (with :: FromType)
(db :: [(Symbol, [(Symbol, SchemumType)])]) (params :: [NullType])
(from :: FromType).
SListI columns =>
NP
(Aliased
(Optional (Expression 'Ungrouped '[] with db params from)))
columns
-> QueryClause with db params columns
Values_ (forall {k} (expr :: k -> *) (tab :: k) (row :: Optionality).
expr tab -> Optional expr (row :=> tab)
Set (forall (n :: Nat) (ty :: NullType) (lat :: FromType)
(with :: FromType) (db :: [(Symbol, [(Symbol, SchemumType)])])
(params :: [NullType]) (from :: FromType) (grp :: Grouping).
(NullTyped db ty, HasParameter n params ty) =>
Expression grp lat with db params from ty
param @1) `as` forall a. IsLabel "name" a => a
#name forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (expr :: k -> *) (tab :: k).
Optional expr ('Def :=> tab)
Default `as` forall a. IsLabel "executed_at" a => a
#executed_at)
deleteMigration :: Statement MigrationsSchemas Text ()
deleteMigration :: Statement MigrationsSchemas Text ()
deleteMigration = forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(tab :: [NullType]) (row :: [(Symbol, NullType)]) x y.
(All (OidOfNull db) tab, SListI row) =>
EncodeParams db tab x
-> DecodeRow row y
-> Manipulation '[] db tab row
-> Statement db x y
Manipulation forall (db :: [(Symbol, [(Symbol, SchemumType)])]) x
(ty :: NullType).
(ToParam db ty x, ty ~ NullPG x) =>
EncodeParams db '[ty] x
aParam forall (row :: [(Symbol, NullType)]) y (ys :: RecordCode).
GenericRow row y ys =>
DecodeRow row y
genericRow forall a b. (a -> b) -> a -> b
$
forall (sch :: Symbol) (db :: [(Symbol, [(Symbol, SchemumType)])])
(schema :: [(Symbol, SchemumType)]) (tab0 :: Symbol)
(table :: TableType) (tab :: Symbol) (with :: FromType)
(params :: [NullType]).
(Has sch db schema, Has tab0 schema ('Table table)) =>
Aliased (QualifiedAlias sch) (tab ::: tab0)
-> Condition
'Ungrouped '[] with db params '[tab ::: TableToRow table]
-> Manipulation with db params '[]
deleteFrom_ forall a. IsLabel "schema_migrations" a => a
#schema_migrations (forall a. IsLabel "name" a => a
#name forall {k} (null0 :: k -> NullType) (ty :: k)
(null1 :: k -> NullType).
Operator (null0 ty) (null1 ty) ('Null 'PGbool)
.== forall (n :: Nat) (ty :: NullType) (lat :: FromType)
(with :: FromType) (db :: [(Symbol, [(Symbol, SchemumType)])])
(params :: [NullType]) (from :: FromType) (grp :: Grouping).
(NullTyped db ty, HasParameter n params ty) =>
Expression grp lat with db params from ty
param @1)
selectMigration :: Statement MigrationsSchemas Text UTCTime
selectMigration :: Statement MigrationsSchemas Text UTCTime
selectMigration = forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(tab :: [NullType]) (row :: [(Symbol, NullType)]) x y.
(All (OidOfNull db) tab, SListI row) =>
EncodeParams db tab x
-> DecodeRow row y -> Query '[] '[] db tab row -> Statement db x y
Query forall (db :: [(Symbol, [(Symbol, SchemumType)])]) x
(ty :: NullType).
(ToParam db ty x, ty ~ NullPG x) =>
EncodeParams db '[ty] x
aParam forall a. IsLabel "executed_at" a => a
#executed_at forall a b. (a -> b) -> a -> b
$
forall (row :: [(Symbol, NullType)]) (x :: (Symbol, NullType))
(xs :: [(Symbol, NullType)]) (grp :: Grouping) (lat :: FromType)
(with :: FromType) (db :: [(Symbol, [(Symbol, SchemumType)])])
(params :: [NullType]) (from :: FromType).
(SListI row, row ~ (x : xs)) =>
NP (Aliased (Expression grp lat with db params from)) row
-> TableExpression grp lat with db params from
-> Query lat with db params row
select_ forall a. IsLabel "executed_at" a => a
#executed_at
forall a b. (a -> b) -> a -> b
$ forall (lat :: FromType) (with :: FromType)
(db :: [(Symbol, [(Symbol, SchemumType)])]) (params :: [NullType])
(from :: FromType).
FromClause lat with db params from
-> TableExpression 'Ungrouped lat with db params from
from (forall (sch :: Symbol) (db :: [(Symbol, [(Symbol, SchemumType)])])
(schema :: [(Symbol, SchemumType)]) (tab :: Symbol)
(table :: TableType) (alias :: Symbol) (lat :: FromType)
(with :: FromType) (params :: [NullType]).
(Has sch db schema, Has tab schema ('Table table)) =>
Aliased (QualifiedAlias sch) (alias ::: tab)
-> FromClause lat with db params '[alias ::: TableToRow table]
table (forall a. IsLabel "schema_migrations" a => a
#schema_migrations))
forall a b. a -> (a -> b) -> b
& forall (lat :: FromType) (with :: FromType)
(db :: [(Symbol, [(Symbol, SchemumType)])]) (params :: [NullType])
(from :: FromType) (grp :: Grouping).
Condition 'Ungrouped lat with db params from
-> TableExpression grp lat with db params from
-> TableExpression grp lat with db params from
where_ (forall a. IsLabel "name" a => a
#name forall {k} (null0 :: k -> NullType) (ty :: k)
(null1 :: k -> NullType).
Operator (null0 ty) (null1 ty) ('Null 'PGbool)
.== forall (n :: Nat) (ty :: NullType) (lat :: FromType)
(with :: FromType) (db :: [(Symbol, [(Symbol, SchemumType)])])
(params :: [NullType]) (from :: FromType) (grp :: Grouping).
(NullTyped db ty, HasParameter n params ty) =>
Expression grp lat with db params from ty
param @1)
selectMigrations :: Statement MigrationsSchemas () MigrationRow
selectMigrations :: Statement MigrationsSchemas () MigrationRow
selectMigrations = forall (db :: [(Symbol, [(Symbol, SchemumType)])])
(params :: [NullType]) x (xs :: [*]) (row :: [(Symbol, NullType)])
y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Query '[] '[] db params row -> Statement db x y
query forall a b. (a -> b) -> a -> b
$ forall (row :: [(Symbol, NullType)]) (x :: (Symbol, NullType))
(xs :: [(Symbol, NullType)]) (grp :: Grouping) (lat :: FromType)
(with :: FromType) (db :: [(Symbol, [(Symbol, SchemumType)])])
(params :: [NullType]) (from :: FromType).
(SListI row, row ~ (x : xs)) =>
Selection grp lat with db params from row
-> TableExpression grp lat with db params from
-> Query lat with db params row
select forall (tab :: Symbol) (from :: FromType)
(row :: [(Symbol, NullType)]) (lat :: FromType) (with :: FromType)
(db :: [(Symbol, [(Symbol, SchemumType)])]) (params :: [NullType]).
HasUnique tab from row =>
Selection 'Ungrouped lat with db params from row
Star (forall (lat :: FromType) (with :: FromType)
(db :: [(Symbol, [(Symbol, SchemumType)])]) (params :: [NullType])
(from :: FromType).
FromClause lat with db params from
-> TableExpression 'Ungrouped lat with db params from
from (forall (sch :: Symbol) (db :: [(Symbol, [(Symbol, SchemumType)])])
(schema :: [(Symbol, SchemumType)]) (tab :: Symbol)
(table :: TableType) (alias :: Symbol) (lat :: FromType)
(with :: FromType) (params :: [NullType]).
(Has sch db schema, Has tab schema ('Table table)) =>
Aliased (QualifiedAlias sch) (alias ::: tab)
-> FromClause lat with db params '[alias ::: TableToRow table]
table forall a. IsLabel "schema_migrations" a => a
#schema_migrations))
mainMigrate
:: Migratory p (Indexed PQ IO ())
=> ByteString
-> Path (Migration p) db0 db1
-> IO ()
mainMigrate :: forall (p :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> *)
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Migratory p (Indexed PQ IO ()) =>
ByteString -> Path (Migration p) db0 db1 -> IO ()
mainMigrate ByteString
connectTo Path (Migration p) db0 db1
migrations = do
[String]
command <- IO [String]
getArgs
[String] -> IO ()
performCommand [String]
command
where
performCommand :: [String] -> IO ()
performCommand :: [String] -> IO ()
performCommand = \case
[String
"status"] -> forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) (io :: * -> *) x.
(MonadIO io, MonadMask io) =>
ByteString -> PQ db0 db1 io x -> io x
withConnection ByteString
connectTo forall a b. (a -> b) -> a -> b
$
forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
suppressNotices forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
migrateStatus
[String
"migrate"] -> forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) (io :: * -> *) x.
(MonadIO io, MonadMask io) =>
ByteString -> PQ db0 db1 io x -> io x
withConnection ByteString
connectTo forall a b. (a -> b) -> a -> b
$
forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
suppressNotices
forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(j :: k) (k :: k) y (i :: k) x.
(IndexedMonadTrans t, Monad m) =>
t j k m y -> t i j m x -> t i k m y
pqThen (forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
Indexed t m r i j -> t i j m r
runIndexed (forall {k} (def :: k -> k -> *) (run :: k -> k -> *) (db0 :: k)
(db1 :: k).
Migratory def run =>
Path (Migration def) db0 db1 -> run db0 db1
runMigrations Path (Migration p) db0 db1
migrations))
forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(j :: k) (k :: k) y (i :: k) x.
(IndexedMonadTrans t, Monad m) =>
t j k m y -> t i j m x -> t i k m y
pqThen forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
migrateStatus
[String]
args -> [String] -> IO ()
displayUsage [String]
args
migrateStatus :: PQ schema schema IO ()
migrateStatus :: forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
migrateStatus = forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ forall a b. (a -> b) -> a -> b
$ do
[Text]
runNames <- forall (db0 :: [(Symbol, [(Symbol, SchemumType)])]).
PQ db0 db0 IO [Text]
getRunMigrationNames
let names :: [Text]
names = forall {k} (c :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *) a
(x :: k) (y :: k).
QFoldable c =>
(forall (x1 :: k) (y1 :: k). p x1 y1 -> a) -> c p x y -> [a]
qtoList forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> Text
migrationName Path (Migration p) db0 db1
migrations
unrunNames :: [Text]
unrunNames = [Text]
names forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
runNames
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Text] -> IO ()
displayRunned [Text]
runNames forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> IO ()
displayUnrunned [Text]
unrunNames
suppressNotices :: PQ schema schema IO ()
suppressNotices :: forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
suppressNotices = forall (db :: [(Symbol, [(Symbol, SchemumType)])]) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ forall a b. (a -> b) -> a -> b
$
forall (with :: FromType)
(db :: [(Symbol, [(Symbol, SchemumType)])]) (params :: [NullType])
(columns :: [(Symbol, NullType)]).
ByteString -> Manipulation with db params columns
UnsafeManipulation ByteString
"SET client_min_messages TO WARNING;"
displayUsage :: [String] -> IO ()
displayUsage :: [String] -> IO ()
displayUsage [String]
args = do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Invalid command: \"" forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [String]
args forall a. Semigroup a => a -> a -> a
<> String
"\". Use:"
String -> IO ()
putStrLn String
"migrate to run all available migrations"
String -> IO ()
putStrLn String
"rollback to rollback all available migrations"
mainMigrateIso
:: Migratory (IsoQ def) (IsoQ (Indexed PQ IO ()))
=> ByteString
-> Path (Migration (IsoQ def)) db0 db1
-> IO ()
mainMigrateIso :: forall (def :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> *)
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Migratory (IsoQ def) (IsoQ (Indexed PQ IO ())) =>
ByteString -> Path (Migration (IsoQ def)) db0 db1 -> IO ()
mainMigrateIso ByteString
connectTo Path (Migration (IsoQ def)) db0 db1
migrations = [String] -> IO ()
performCommand forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs
where
performCommand :: [String] -> IO ()
performCommand :: [String] -> IO ()
performCommand = \case
[String
"status"] -> forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) (io :: * -> *) x.
(MonadIO io, MonadMask io) =>
ByteString -> PQ db0 db1 io x -> io x
withConnection ByteString
connectTo forall a b. (a -> b) -> a -> b
$
forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
suppressNotices forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
migrateStatus
[String
"migrate"] -> forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) (io :: * -> *) x.
(MonadIO io, MonadMask io) =>
ByteString -> PQ db0 db1 io x -> io x
withConnection ByteString
connectTo forall a b. (a -> b) -> a -> b
$
forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
suppressNotices
forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(j :: k) (k :: k) y (i :: k) x.
(IndexedMonadTrans t, Monad m) =>
t j k m y -> t i j m x -> t i k m y
pqThen (forall (def :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> *)
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Migratory def (IsoQ (Indexed PQ IO ())) =>
Path (Migration def) db0 db1 -> PQ db0 db1 IO ()
migrateUp Path (Migration (IsoQ def)) db0 db1
migrations)
forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(j :: k) (k :: k) y (i :: k) x.
(IndexedMonadTrans t, Monad m) =>
t j k m y -> t i j m x -> t i k m y
pqThen forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
migrateStatus
[String
"rollback"] -> forall (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) (io :: * -> *) x.
(MonadIO io, MonadMask io) =>
ByteString -> PQ db0 db1 io x -> io x
withConnection ByteString
connectTo forall a b. (a -> b) -> a -> b
$
forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
suppressNotices
forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(j :: k) (k :: k) y (i :: k) x.
(IndexedMonadTrans t, Monad m) =>
t j k m y -> t i j m x -> t i k m y
pqThen (forall (def :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> *)
(db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
Migratory def (IsoQ (Indexed PQ IO ())) =>
Path (Migration def) db0 db1 -> PQ db1 db0 IO ()
migrateDown Path (Migration (IsoQ def)) db0 db1
migrations)
forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(j :: k) (k :: k) y (i :: k) x.
(IndexedMonadTrans t, Monad m) =>
t j k m y -> t i j m x -> t i k m y
pqThen forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
migrateStatus
[String]
args -> [String] -> IO ()
displayUsage [String]
args
migrateStatus :: PQ schema schema IO ()
migrateStatus :: forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
migrateStatus = forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ forall a b. (a -> b) -> a -> b
$ do
[Text]
runNames <- forall (db0 :: [(Symbol, [(Symbol, SchemumType)])]).
PQ db0 db0 IO [Text]
getRunMigrationNames
let names :: [Text]
names = forall {k} (c :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *) a
(x :: k) (y :: k).
QFoldable c =>
(forall (x1 :: k) (y1 :: k). p x1 y1 -> a) -> c p x y -> [a]
qtoList forall {k} {k} (def :: k -> k -> *) (db0 :: k) (db1 :: k).
Migration def db0 db1 -> Text
migrationName Path (Migration (IsoQ def)) db0 db1
migrations
unrunNames :: [Text]
unrunNames = [Text]
names forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
runNames
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Text] -> IO ()
displayRunned [Text]
runNames forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> IO ()
displayUnrunned [Text]
unrunNames
suppressNotices :: PQ schema schema IO ()
suppressNotices :: forall (schema :: [(Symbol, [(Symbol, SchemumType)])]).
PQ schema schema IO ()
suppressNotices = forall (db :: [(Symbol, [(Symbol, SchemumType)])]) (pq :: * -> *).
MonadPQ db pq =>
Manipulation '[] db '[] '[] -> pq ()
manipulate_ forall a b. (a -> b) -> a -> b
$
forall (with :: FromType)
(db :: [(Symbol, [(Symbol, SchemumType)])]) (params :: [NullType])
(columns :: [(Symbol, NullType)]).
ByteString -> Manipulation with db params columns
UnsafeManipulation ByteString
"SET client_min_messages TO WARNING;"
displayUsage :: [String] -> IO ()
displayUsage :: [String] -> IO ()
displayUsage [String]
args = do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Invalid command: \"" forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [String]
args forall a. Semigroup a => a -> a -> a
<> String
"\". Use:"
String -> IO ()
putStrLn String
"migrate to run all available migrations"
String -> IO ()
putStrLn String
"rollback to rollback all available migrations"
String -> IO ()
putStrLn String
"status to display migrations run and migrations left to run"
getRunMigrationNames :: PQ db0 db0 IO [Text]
getRunMigrationNames :: forall (db0 :: [(Symbol, [(Symbol, SchemumType)])]).
PQ db0 db0 IO [Text]
getRunMigrationNames =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MigrationRow -> Text
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall (m :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]) x
(db0' :: [(Symbol, [(Symbol, SchemumType)])])
(db1' :: [(Symbol, [(Symbol, SchemumType)])]).
Functor m =>
PQ db0 db1 m x -> PQ db0' db1' m x
unsafePQ (forall (pq :: [(Symbol, [(Symbol, SchemumType)])]
-> [(Symbol, [(Symbol, SchemumType)])] -> (* -> *) -> * -> *)
(io :: * -> *) (db0 :: [(Symbol, [(Symbol, SchemumType)])])
(db1 :: [(Symbol, [(Symbol, SchemumType)])]).
(IndexedMonadTransPQ pq, MonadIO io) =>
Definition db0 db1 -> pq db0 db1 io ()
define Definition MigrationsSchemas MigrationsSchemas
createMigrations
forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(j :: k) (k :: k) y (i :: k) x.
(IndexedMonadTrans t, Monad m) =>
t j k m y -> t i j m x -> t i k m y
pqThen (forall (db :: [(Symbol, [(Symbol, SchemumType)])]) (pq :: * -> *)
y.
MonadPQ db pq =>
Statement db () y -> pq (Result y)
execute Statement MigrationsSchemas () MigrationRow
selectMigrations)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) y. MonadResult m => Result y -> m [y]
getRows)
displayListOfNames :: [Text] -> IO ()
displayListOfNames :: [Text] -> IO ()
displayListOfNames [] = Text -> IO ()
Text.putStrLn Text
" None"
displayListOfNames [Text]
xs =
let singleName :: Text -> IO ()
singleName Text
n = Text -> IO ()
Text.putStrLn forall a b. (a -> b) -> a -> b
$ Text
" - " forall a. Semigroup a => a -> a -> a
<> Text
n
in forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
singleName [Text]
xs
displayUnrunned :: [Text] -> IO ()
displayUnrunned :: [Text] -> IO ()
displayUnrunned [Text]
unrunned =
Text -> IO ()
Text.putStrLn Text
"Migrations left to run:"
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> IO ()
displayListOfNames [Text]
unrunned
displayRunned :: [Text] -> IO ()
displayRunned :: [Text] -> IO ()
displayRunned [Text]
runned =
Text -> IO ()
Text.putStrLn Text
"Migrations already run:"
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> IO ()
displayListOfNames [Text]
runned