{-#LANGUAGE OverloadedStrings #-}
module Database.Sqlite.Easy.Migrant
  ( module Database.Migrant.Driver.Class
  )
  where

import Database.Migrant.Driver.Class
import Database.Migrant.MigrationName
import qualified Database.Sqlite.Easy.Internal as Sqlite
import qualified Database.SQLite3 as Sqlite

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
    [] <- SQL -> Database -> IO [[SQLData]]
Sqlite.run
      SQL
"CREATE TABLE IF NOT EXISTS _migrations (id INTEGER PRIMARY KEY, name TEXT)"
      Database
conn
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  markUp :: MigrationName -> Database -> IO ()
markUp MigrationName
name Database
conn = do
    [] <- SQL -> [SQLData] -> Database -> IO [[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]
      Database
conn
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  markDown :: MigrationName -> Database -> IO ()
markDown MigrationName
name Database
conn = do
    [] <- SQL -> [SQLData] -> Database -> IO [[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]
      Database
conn
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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