{-#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
_ ->
          -- ANSI SQL 2003 standard syntax
          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 ]