Migrant.hs

{-# language OverloadedStrings #-}

-- | Migrations support based on @migrant-core@.
module Database.Sqlite.Easy.Migrant
  ( module Database.Migrant.Driver.Class
  , migrate
  )
  where

import qualified Database.Migrant as Migrant
import Database.Migrant.Driver.Class
import Database.Migrant.MigrationName
import qualified Database.Sqlite.Easy.Internal as Sqlite
import qualified Database.SQLite3 as Sqlite
import Control.Monad (void)

-- | Execute a migration against the database.
--   A wrapper around migrant's 'Migrant.migrate' for SQLite.
migrate
  :: [MigrationName]
  -> (MigrationName -> Sqlite.SQLite ())
  -> (MigrationName -> Sqlite.SQLite ())
  -> Sqlite.SQLite ()
migrate migrations migrateUp migrateDown = Sqlite.SQLite $ \(Sqlite.SQLiteStuff database _) ->
  Migrant.migrate
    migrations
    (\name db -> void . Sqlite.withDatabase db $ migrateUp name)
    (\name db -> void . Sqlite.withDatabase db $ migrateDown name)
    database

instance Driver Sqlite.Database where
  withTransaction action conn = Sqlite.asTransaction' conn (action conn)

  initMigrations conn = do
    [] <- Sqlite.withDatabase conn $
      Sqlite.run
        "CREATE TABLE IF NOT EXISTS _migrations (id INTEGER PRIMARY KEY, name TEXT)"
    pure ()

  markUp name conn = do
    [] <- Sqlite.withDatabase conn $
      Sqlite.runWith
        "INSERT INTO _migrations (name) VALUES (?)"
        [Sqlite.SQLText $ unpackMigrationName name]
    pure ()

  markDown name conn = do
    [] <- Sqlite.withDatabase conn $
      Sqlite.runWith
        "DELETE FROM _migrations WHERE name = ?"
        [Sqlite.SQLText $ unpackMigrationName name]
    pure ()

  getMigrations conn = do
    result <- Sqlite.withDatabase conn $
      Sqlite.run
        "SELECT name FROM _migrations ORDER BY id"
    return [ MigrationName name | [Sqlite.SQLText name] <- result ]