Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Patch following changes in dbmigrations repo #2

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions dbmigrations-mysql.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,8 @@ Library
base >= 4 && < 5,
dbmigrations >= 2,
time >= 1.4,
text >= 1.2.3.0,
string-conversions >= 0.4,
mysql >= 0.1.2,
mysql-simple >= 0.2.2.5,
split >= 0.2.2
Expand Down Expand Up @@ -75,7 +77,6 @@ test-suite dbmigrations-mysql-tests

other-modules:
BackendTest
TestDriver

if impl(ghc >= 6.12.0)
ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields
Expand All @@ -84,4 +85,4 @@ test-suite dbmigrations-mysql-tests
ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields

Hs-Source-Dirs: test
Main-is: TestDriver.hs
Main-is: Main.hs
41 changes: 22 additions & 19 deletions src/Database/Schema/Migrations/Backend/MySQL.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
module Database.Schema.Migrations.Backend.MySQL
( connectMySQL
, mysqlBackend) where
Expand All @@ -11,6 +12,8 @@ import Database.Schema.Migrations.Migration
import Data.List.Split (wordsBy)
import Data.Char (isSpace, toLower)
import Data.Time.Clock (getCurrentTime)
import Data.Text (Text)
import Data.String.Conversions (cs, (<>))
import Data.String (fromString)
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Database.MySQL.Base as Base
Expand Down Expand Up @@ -46,8 +49,8 @@ mysqlBackend conn =
Backend {isBootstrapped =
fmap ((Just migrationTableName ==) . listToMaybe . fmap fromOnly)
(query conn
(fromString "SELECT table_name FROM information_schema.tables WHERE table_name = ? AND table_schema = database()")
(Only migrationTableName) :: IO [Only String])
("SELECT table_name FROM information_schema.tables WHERE table_name = ? AND table_schema = database()")
(Only migrationTableName) :: IO [Only Text])
,getBootstrapMigration =
do ts <- getCurrentTime
return ((newMigration rootMigrationName) {mApply = createSql
Expand All @@ -58,12 +61,12 @@ mysqlBackend conn =
,mTimestamp = Just ts})
,applyMigration =
\m ->
do execute_ conn (fromString (mApply m))
do _ <- execute_ conn (fromString . cs $ mApply m)
discardResults conn
execute conn
(fromString
("INSERT INTO " ++
migrationTableName ++
_ <- execute conn
(fromString . cs $
("INSERT INTO " <>
migrationTableName <>
" (migration_id) VALUES (?)"))
(Only (mId m))
return ()
Expand All @@ -72,22 +75,22 @@ mysqlBackend conn =
do case mRevert m of
Nothing -> return ()
Just sql ->
do execute_ conn (fromString sql)
do _ <- execute_ conn (fromString . cs $ sql)
return ()
discardResults conn
-- Remove migration from installed_migrations in either case.
execute
_ <- execute
conn
(fromString
("DELETE FROM " ++
migrationTableName ++ " WHERE migration_id = ?"))
(fromString . cs $
("DELETE FROM " <>
migrationTableName <> " WHERE migration_id = ?"))
(Only (mId m))
return ()
,getMigrations =
do results <-
query_ conn
(fromString
("SELECT migration_id FROM " ++ migrationTableName))
(fromString . cs $
("SELECT migration_id FROM " <> migrationTableName))
return (map fromOnly results)
,commitBackend = commit conn
,rollbackBackend = rollback conn
Expand All @@ -98,11 +101,11 @@ discardResults conn =
do more <- Base.nextResult conn
when more (discardResults conn)

migrationTableName :: String
migrationTableName :: Text
migrationTableName = "installed_migrations"

createSql :: String
createSql = "CREATE TABLE " ++ migrationTableName ++ " (migration_id TEXT)"
createSql :: Text
createSql = "CREATE TABLE " <> migrationTableName <> " (migration_id TEXT)"

revertSql :: String
revertSql = "DROP TABLE " ++ migrationTableName
revertSql :: Text
revertSql = "DROP TABLE " <> migrationTableName
File renamed without changes.