{-#LANGUAGE OverloadedStrings #-}
module Database.Migrant.Driver.PostgreSQL
where

import Database.Migrant.Driver.Class
import Database.Migrant.MigrationName
import qualified Database.PostgreSQL.Simple as PostgreSQL
import Control.Monad (void)

instance Driver PostgreSQL.Connection where
  withTransaction :: (Connection -> IO a) -> Connection -> IO a
withTransaction Connection -> IO a
action Connection
conn = Connection -> IO a -> IO a
forall a. Connection -> IO a -> IO a
PostgreSQL.withTransaction Connection
conn (Connection -> IO a
action Connection
conn)

  initMigrations :: Connection -> IO ()
initMigrations Connection
conn =
    IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> IO Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> IO Int64
PostgreSQL.execute_ Connection
conn
      Query
"CREATE TABLE IF NOT EXISTS _migrations (id SERIAL PRIMARY KEY, name TEXT)"

  markUp :: MigrationName -> Connection -> IO ()
markUp MigrationName
name Connection
conn =
    IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> IO Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> [Text] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PostgreSQL.execute Connection
conn
      Query
"INSERT INTO _migrations (name) VALUES (?)"
      [MigrationName -> Text
unpackMigrationName MigrationName
name]

  markDown :: MigrationName -> Connection -> IO ()
markDown MigrationName
name Connection
conn =
    IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> IO Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> [Text] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PostgreSQL.execute Connection
conn
      Query
"DELETE FROM _migrations WHERE name = ?"
      [MigrationName -> Text
unpackMigrationName MigrationName
name]

  getMigrations :: Connection -> IO [MigrationName]
getMigrations Connection
conn = do
    [Only Text]
result <- Connection -> Query -> IO [Only Text]
forall r. FromRow r => Connection -> Query -> IO [r]
PostgreSQL.query_ Connection
conn
      Query
"SELECT name FROM _migrations ORDER BY id"
    [MigrationName] -> IO [MigrationName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Text -> MigrationName
MigrationName Text
name | PostgreSQL.Only Text
name <- [Only Text]
result ]