{-# language OverloadedStrings #-}

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 :: [MigrationName]
-> (MigrationName -> SQLite ())
-> (MigrationName -> SQLite ())
-> SQLite ()
migrate [MigrationName]
migrations MigrationName -> SQLite ()
migrateUp MigrationName -> SQLite ()
migrateDown = forall a. (SQLiteStuff -> IO a) -> SQLite a
Sqlite.SQLite forall a b. (a -> b) -> a -> b
$ \(Sqlite.SQLiteStuff Database
database Maybe Int
_) ->
  forall d.
Driver d =>
[MigrationName]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
Migrant.migrate
    [MigrationName]
migrations
    (\MigrationName
name Database
db -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Database -> SQLite a -> IO a
Sqlite.withDatabase Database
db forall a b. (a -> b) -> a -> b
$ MigrationName -> SQLite ()
migrateUp MigrationName
name)
    (\MigrationName
name Database
db -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Database -> SQLite a -> IO a
Sqlite.withDatabase Database
db forall a b. (a -> b) -> a -> b
$ MigrationName -> SQLite ()
migrateDown MigrationName
name)
    Database
database

instance Driver Sqlite.Database where
  withTransaction :: forall a. (Database -> IO a) -> Database -> IO a
withTransaction Database -> IO a
action Database
conn = forall a. Database -> IO a -> IO a
Sqlite.asTransaction' Database
conn (Database -> IO a
action Database
conn)

  initMigrations :: Database -> IO ()
initMigrations Database
conn = do
    [] <- forall a. Database -> SQLite a -> IO a
Sqlite.withDatabase Database
conn forall a b. (a -> b) -> a -> b
$
      SQL -> SQLite [[SQLData]]
Sqlite.run
        SQL
"CREATE TABLE IF NOT EXISTS _migrations (id INTEGER PRIMARY KEY, name TEXT)"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  markUp :: MigrationName -> Database -> IO ()
markUp MigrationName
name Database
conn = do
    [] <- forall a. Database -> SQLite a -> IO a
Sqlite.withDatabase Database
conn forall a b. (a -> b) -> a -> b
$
      SQL -> [SQLData] -> SQLite [[SQLData]]
Sqlite.runWith
        SQL
"INSERT INTO _migrations (name) VALUES (?)"
        [Text -> SQLData
Sqlite.SQLText forall a b. (a -> b) -> a -> b
$ MigrationName -> Text
unpackMigrationName MigrationName
name]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  markDown :: MigrationName -> Database -> IO ()
markDown MigrationName
name Database
conn = do
    [] <- forall a. Database -> SQLite a -> IO a
Sqlite.withDatabase Database
conn forall a b. (a -> b) -> a -> b
$
      SQL -> [SQLData] -> SQLite [[SQLData]]
Sqlite.runWith
        SQL
"DELETE FROM _migrations WHERE name = ?"
        [Text -> SQLData
Sqlite.SQLText forall a b. (a -> b) -> a -> b
$ MigrationName -> Text
unpackMigrationName MigrationName
name]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  getMigrations :: Database -> IO [MigrationName]
getMigrations Database
conn = do
    [[SQLData]]
result <- forall a. Database -> SQLite a -> IO a
Sqlite.withDatabase Database
conn forall a b. (a -> b) -> a -> b
$
      SQL -> SQLite [[SQLData]]
Sqlite.run
        SQL
"SELECT name FROM _migrations ORDER BY id"
    forall (m :: * -> *) a. Monad m => a -> m a
return [ Text -> MigrationName
MigrationName Text
name | [Sqlite.SQLText Text
name] <- [[SQLData]]
result ]