migrant-hdbc (empty) → 0.1.0.0

raw patch · 6 files changed

+231/−0 lines, 6 filesdep +HDBCdep +HDBC-sqlite3dep +HUnitsetup-changed

Dependencies added: HDBC, HDBC-sqlite3, HUnit, QuickCheck, base, migrant-core, migrant-hdbc, process, random, tasty, tasty-hunit, tasty-quickcheck, text

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• migrant-hdbc.cabal +47/−0
• src/Database/Migrant/Driver/HDBC.hs +46/−0
• test/Database/Migrant/Driver/HDBC_Tests.hs +90/−0
• test/Spec.hs +16/−0

@@ -0,0 +1,30 @@+Copyright (c) 2020, Tobias Dammers++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tobias Dammers nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,47 @@+cabal-version: 2.4+-- Initial package description 'migrant.cabal' generated by 'cabal init'.+-- For further documentation, see http://haskell.org/cabal/users-guide/++name: migrant-hdbc+version: 0.1.0.0+synopsis: Semi-automatic database schema migrations+-- description:+homepage: https://github.com/tdammers/migrant+-- bug-reports:+license: BSD-3-Clause+license-file: LICENSE+author: Tobias Dammers+maintainer: tdammers@gmail.com+-- copyright:+category: Database+extra-source-files:++library+  exposed-modules: Database.Migrant.Driver.HDBC+  -- other-extensions:+  build-depends: base ^>=4.12.0.0+               , migrant-core+               , HDBC >=2.4.0.3 && <2.5+               , text >=1.2.4.0 && <1.3+  hs-source-dirs: src+  default-language: Haskell2010++test-suite migrant-hdbc-test+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules: Database.Migrant.Driver.HDBC_Tests+  build-depends: base ^>=4.12.0.0+               , migrant-core+               , migrant-hdbc+               , HUnit >=1.6.1.0 && <1.7+               , QuickCheck >=2.14.2 && <2.15+               , HDBC >=2.4.0.3 && <2.5+               , HDBC-sqlite3 >=2.3.3.1 && <2.4+               , process >=1.5 && <1.7+               , random >=1.2.0 && <1.3+               , tasty >=1.4 && <1.5+               , tasty-hunit >=0.10.0.2 && <0.11+               , tasty-quickcheck >=0.10.1.1 && <0.11+               , text >=1.2.4.0 && <1.3

@@ -0,0 +1,46 @@+{-#LANGUAGE OverloadedStrings #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE UndecidableInstances #-}+module Database.Migrant.Driver.HDBC+where++import Database.Migrant.Driver.Class+import Database.Migrant.MigrationName+import qualified Database.HDBC as HDBC+import Control.Monad (void)++instance Driver HDBC.ConnWrapper where+  withTransaction action conn = HDBC.withTransaction conn action++  initMigrations conn =+    void $+    HDBC.runRaw conn q+    where+      q = case HDBC.proxiedClientName conn of+        "postgresql" ->+          "CREATE TABLE IF NOT EXISTS _migrations (id SERIAL PRIMARY KEY, name TEXT NOT NULL)"+        "sqlite3" ->+          "CREATE TABLE IF NOT EXISTS _migrations (id INTEGER NOT NULL PRIMARY KEY, name TEXT NOT NULL)"+        "mysql" ->+          "CREATE TABLE IF NOT EXISTS _migrations (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(256) NOT NULL)"+        _ ->+          -- ANSI SQL 2003 standard syntax+          "CREATE TABLE IF NOT EXISTS _migrations (id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY, name VARCHAR(256) NOT NULL)"++  markUp name conn =+    void $+    HDBC.run conn+      "INSERT INTO _migrations (name) VALUES (?)"+      [HDBC.toSql $ unpackMigrationName name]++  markDown name conn =+    void $+    HDBC.quickQuery conn+      "DELETE FROM _migrations WHERE name = ?"+      [HDBC.toSql $ unpackMigrationName name]++  getMigrations conn = do+    result <- HDBC.quickQuery conn+      "SELECT name FROM _migrations ORDER BY id"+      []+    return [ MigrationName . HDBC.fromSql $ name | [name] <- result ]

@@ -0,0 +1,90 @@+{-#LANGUAGE OverloadedStrings #-}+{-#LANGUAGE TypeApplications #-}+{-#LANGUAGE ScopedTypeVariables #-}+module Database.Migrant.Driver.HDBC_Tests+( tests+)+where++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit+import Data.Text (Text)+import Control.Monad (void)+import System.Environment+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Database.HDBC as HDBC+import qualified Database.HDBC.Sqlite3 as Sqlite+import System.Process (callProcess)+import Control.Exception (catch, bracket)+import System.Random++import Database.Migrant+import Database.Migrant.Driver.HDBC++tests :: TestTree+tests = testGroup "SQLite"+  [ testCase "Setup/init" testHDBCSetup+  , testCase "Up" testHDBCUp+  , testCase "Down" testHDBCDown+  ]++withTestDB :: (HDBC.ConnWrapper -> IO a) -> IO a+withTestDB action = do+  bracket+    (Sqlite.connectSqlite3 ":memory:")+    HDBC.disconnect+    (action . HDBC.ConnWrapper)++testHDBCSetup :: Assertion+testHDBCSetup = withTestDB $ \conn -> do+  migrate [] undefined undefined conn+  actual <- HDBC.quickQuery' conn "SELECT name FROM _migrations ORDER BY id" []+  let expected = []+  assertEqual "Migration table exists" expected actual++testHDBCUp :: Assertion+testHDBCUp = do+  let up "foo" conn =+        void $ HDBC.run conn "CREATE TABLE foo (id INTEGER)" []+      up name _ = error ("Invalid name " <> show name)+      down "foo" conn =+        void $ HDBC.run conn "DROP TABLE foo" []+      down name _ = error ("Invalid name " <> show name)+  withTestDB $ \conn -> do+    migrate ["foo"] up down conn++    actual <- HDBC.quickQuery conn "SELECT name FROM _migrations ORDER BY id" []+    let expected = [[HDBC.toSql @Text "foo"]]+    assertEqual "Up migration logged" expected actual++    actual <- HDBC.quickQuery conn "SELECT COUNT(1) FROM foo" []+    let expected = [[HDBC.toSql @Int 0]]+    assertEqual "Up migration happened" expected actual++testHDBCDown :: Assertion+testHDBCDown = do+  let up "foo" conn =+        void $ HDBC.run conn "CREATE TABLE foo (id INTEGER)" []+      up name _ = error ("Invalid name " <> show name)+      down "foo" conn =+        void $ HDBC.run conn "DROP TABLE foo" []+      down name _ = error ("Invalid name " <> show name)++  withTestDB $ \conn -> do+    migrate ["foo"] up down conn+    migrate [] up down conn++    actual <- HDBC.quickQuery conn "SELECT name FROM _migrations ORDER BY id" []+    let expected = []+    assertEqual "Down migration logged" expected actual++    actual <-+      (HDBC.quickQuery conn "SELECT COUNT(1) FROM foo" [])+      `HDBC.catchSql`+      (\_ -> return [[HDBC.toSql @Int 12345]])+    let expected = [[HDBC.toSql @Int 12345]]+    assertEqual "Down migration happened" expected actual

@@ -0,0 +1,16 @@+module Main (main) where++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit++import Data.Text (Text)+import qualified Data.Text as Text++import qualified Database.Migrant.Driver.HDBC_Tests++main :: IO ()+main = defaultMain $+  testGroup "Migrant"+    [ Database.Migrant.Driver.HDBC_Tests.tests+    ]