migrant-postgresql-simple (empty) → 0.1.0.0

raw patch · 6 files changed

+219/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, migrant-core, migrant-postgresql-simple, postgresql-simple, process, random, tasty, tasty-hunit, tasty-quickcheck, text

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• migrant-postgresql-simple.cabal +46/−0
• src/Database/Migrant/Driver/PostgreSQL.hs +33/−0
• test/Database/Migrant/Driver/PostgreSQL_Tests.hs +92/−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,46 @@+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-postgresql-simple+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.PostgreSQL+  -- other-extensions:+  build-depends: base ^>=4.12.0.0+               , migrant-core+               , postgresql-simple >=0.6.3 && <0.7+               , text >=1.2.4.0 && <1.3+  hs-source-dirs: src+  default-language: Haskell2010++test-suite migrant-postgresql-simple-test+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules: Database.Migrant.Driver.PostgreSQL_Tests+  build-depends: base ^>=4.12.0.0+               , migrant-core+               , migrant-postgresql-simple+               , HUnit >=1.6.1.0 && <1.7+               , QuickCheck >=2.14.2 && <2.15+               , postgresql-simple >=0.6.3 && <0.7+               , 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,33 @@+{-#LANGUAGE OverloadedStrings #-}+module Database.Migrant.Driver.PostgreSQL+where++import Database.Migrant.Driver.Class+import Database.Migrant.MigrationName+import qualified Database.PostgreSQL.Simple as PostgreSQL+import Control.Monad (void)++instance Driver PostgreSQL.Connection where+  withTransaction action conn = PostgreSQL.withTransaction conn (action conn)++  initMigrations conn =+    void $+    PostgreSQL.execute_ conn+      "CREATE TABLE IF NOT EXISTS _migrations (id SERIAL PRIMARY KEY, name TEXT)"++  markUp name conn =+    void $+    PostgreSQL.execute conn+      "INSERT INTO _migrations (name) VALUES (?)"+      [unpackMigrationName name]++  markDown name conn =+    void $+    PostgreSQL.execute conn+      "DELETE FROM _migrations WHERE name = ?"+      [unpackMigrationName name]++  getMigrations conn = do+    result <- PostgreSQL.query_ conn+      "SELECT name FROM _migrations ORDER BY id"+    return [ MigrationName name | PostgreSQL.Only name <- result ]

@@ -0,0 +1,92 @@+{-#LANGUAGE OverloadedStrings #-}+{-#LANGUAGE ScopedTypeVariables #-}+module Database.Migrant.Driver.PostgreSQL_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.PostgreSQL.Simple as PostgreSQL+import System.Process (callProcess)+import Control.Exception (catch, bracket)+import System.Random++import Database.Migrant+import Database.Migrant.Driver.PostgreSQL++tests :: TestTree+tests = testGroup "PostgreSQL"+  [ testCase "Setup/init" testPostgreSQLSetup+  , testCase "Up" testPostgreSQLUp+  , testCase "Down" testPostgreSQLDown+  ]++withTestDB :: (PostgreSQL.Connection -> IO a) -> IO a+withTestDB action = do+  i <- randomRIO (1000000, 9999999)+  let dbname = "_migrant_test_" <> show (i :: Int)+  callProcess "createdb" [dbname]+  let dsn = "dbname=" <> dbname+  bracket+    (PostgreSQL.connectPostgreSQL $ Text.encodeUtf8 . Text.pack $ dsn)+    (\conn -> do+        PostgreSQL.close conn+        callProcess "dropdb" [dbname] `catch` (\(e :: IOError) -> return ())+    )+    action++testPostgreSQLSetup :: Assertion+testPostgreSQLSetup = withTestDB $ \conn -> do+  migrate [] undefined undefined conn+  actual <- PostgreSQL.query_ conn "SELECT name FROM _migrations ORDER BY id"+  let expected = [] :: [PostgreSQL.Only Text]+  assertEqual "Migration table exists" expected actual++testPostgreSQLUp :: Assertion+testPostgreSQLUp = do+  let up "foo" conn =+        void $ PostgreSQL.execute_ conn "CREATE TABLE foo (id INTEGER PRIMARY KEY)"+      up name _ = error ("Invalid name " <> show name)+      down "foo" conn =+        void $ PostgreSQL.execute_ conn "DROP TABLE foo"+      down name _ = error ("Invalid name " <> show name)+  withTestDB $ \conn -> do+    migrate ["foo"] up down conn++    actual <- PostgreSQL.query_ conn "SELECT name FROM _migrations ORDER BY id"+    let expected = [PostgreSQL.Only ("foo" :: Text)]+    assertEqual "Up migration logged" expected actual++    actual <- PostgreSQL.query_ conn "SELECT COUNT(1) FROM information_schema.tables WHERE table_schema = 'public' AND table_name = 'foo'"+    let expected = [PostgreSQL.Only (1 :: Int)]+    assertEqual "Up migration happened" expected actual++testPostgreSQLDown :: Assertion+testPostgreSQLDown = do+  let up "foo" conn =+        void $ PostgreSQL.execute_ conn "CREATE TABLE foo (id INTEGER PRIMARY KEY)"+      up name _ = error ("Invalid name " <> show name)+      down "foo" conn =+        void $ PostgreSQL.execute_ conn "DROP TABLE foo"+      down name _ = error ("Invalid name " <> show name)++  withTestDB $ \conn -> do+    migrate ["foo"] up down conn+    migrate [] up down conn++    actual <- PostgreSQL.query_ conn "SELECT name FROM _migrations ORDER BY id"+    let expected = [] :: [PostgreSQL.Only Text]+    assertEqual "Down migration logged" expected actual++    actual <- PostgreSQL.query_ conn "SELECT COUNT(1) FROM information_schema.tables WHERE table_schema = 'public' AND table_name = 'foo'"+    let expected = [PostgreSQL.Only (0 :: Int)]+    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.PostgreSQL_Tests++main :: IO ()+main = defaultMain $+  testGroup "Migrant"+    [ Database.Migrant.Driver.PostgreSQL_Tests.tests+    ]