{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE UndecidableInstances #-}
module Database.Migrant.Driver.HDBC
where
import Database.Migrant.Driver.Class
import Database.Migrant.MigrationName
import qualified Database.HDBC as HDBC
import Control.Monad (void)
instance Driver HDBC.ConnWrapper where
withTransaction :: forall a. (ConnWrapper -> IO a) -> ConnWrapper -> IO a
withTransaction ConnWrapper -> IO a
action ConnWrapper
conn = forall conn a. IConnection conn => conn -> (conn -> IO a) -> IO a
HDBC.withTransaction ConnWrapper
conn ConnWrapper -> IO a
action
initMigrations :: ConnWrapper -> IO ()
initMigrations ConnWrapper
conn =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall conn. IConnection conn => conn -> String -> IO ()
HDBC.runRaw ConnWrapper
conn String
q
where
q :: String
q = case forall conn. IConnection conn => conn -> String
HDBC.proxiedClientName ConnWrapper
conn of
String
"postgresql" ->
String
"CREATE TABLE IF NOT EXISTS _migrations (id SERIAL PRIMARY KEY, name TEXT NOT NULL)"
String
"sqlite3" ->
String
"CREATE TABLE IF NOT EXISTS _migrations (id INTEGER NOT NULL PRIMARY KEY, name TEXT NOT NULL)"
String
"mysql" ->
String
"CREATE TABLE IF NOT EXISTS _migrations (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(256) NOT NULL)"
String
_ ->
String
"CREATE TABLE IF NOT EXISTS _migrations (id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY, name VARCHAR(256) NOT NULL)"
markUp :: MigrationName -> ConnWrapper -> IO ()
markUp MigrationName
name ConnWrapper
conn =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
HDBC.run ConnWrapper
conn
String
"INSERT INTO _migrations (name) VALUES (?)"
[forall a. Convertible a SqlValue => a -> SqlValue
HDBC.toSql forall a b. (a -> b) -> a -> b
$ MigrationName -> Text
unpackMigrationName MigrationName
name]
markDown :: MigrationName -> ConnWrapper -> IO ()
markDown MigrationName
name ConnWrapper
conn =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
HDBC.quickQuery ConnWrapper
conn
String
"DELETE FROM _migrations WHERE name = ?"
[forall a. Convertible a SqlValue => a -> SqlValue
HDBC.toSql forall a b. (a -> b) -> a -> b
$ MigrationName -> Text
unpackMigrationName MigrationName
name]
getMigrations :: ConnWrapper -> IO [MigrationName]
getMigrations ConnWrapper
conn = do
[[SqlValue]]
result <- forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
HDBC.quickQuery ConnWrapper
conn
String
"SELECT name FROM _migrations ORDER BY id"
[]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Text -> MigrationName
MigrationName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Convertible SqlValue a => SqlValue -> a
HDBC.fromSql forall a b. (a -> b) -> a -> b
$ SqlValue
name | [SqlValue
name] <- [[SqlValue]]
result ]