Commit 35ea15b8 authored by Sophie Herold's avatar Sophie Herold 🌼

Adds tests for serial types

parent 1ffb2b77
Pipeline #827 passed with stage
in 3 minutes and 52 seconds
......@@ -17,6 +17,5 @@ cabal.sandbox.config
test/coverage
test/docs
test/tmp
hamsql.tix
hamsql-stmt-log.sql
*.tix
.cache
......@@ -127,7 +127,7 @@ instance ToSqlStmts (SqlContext (Schema, Table, Column)) where
maybePrefix " ON DELETE " (columnOnRefDelete c)
-- CREATE SEQUENCE (for type SERIAL)
stmtsSerialSequence
| columnIsSerial = toSqlStmts context serialSequenceContext
| columnIsSerial /= Nothing = toSqlStmts context serialSequenceContext
| otherwise = [Nothing]
-- Helpers
stmtAlterColumn t x =
......@@ -135,17 +135,24 @@ instance ToSqlStmts (SqlContext (Schema, Table, Column)) where
"ALTER TABLE " <> tblId <> " ALTER COLUMN " <> toSqlCode (columnName c) <>
" " <>
x
-- TODO: there is also smallserial and bigserial
columnIsSerial = toSqlCode (columnType rawColumn) == "SERIAL"
c
| columnIsSerial =
rawColumn
{ columnType = SqlType "integer"
, columnDefault =
Just $
"nextval('" <> toSqlCode (sqlId serialSequenceContext) <> "')"
}
| otherwise = rawColumn
columnIsSerial =
let serialKey = T.toLower $ toSqlCode $ columnType rawColumn
in lookup
serialKey
[ ("smallserial", "smallint")
, ("serial", "integer")
, ("bigserial", "bigint")
]
c =
case columnIsSerial of
Just sType ->
rawColumn
{ columnType = SqlType sType
, columnDefault =
Just $
"nextval('" <> toSqlCode (sqlId serialSequenceContext) <> "')"
}
Nothing -> rawColumn
tblId = sqlIdCode tbl
tbl = SqlContext (schema, table)
serialSequenceContext =
......
......@@ -7,6 +7,7 @@ import Control.Monad.Trans.Reader (runReaderT)
import Data.Monoid ((<>))
import qualified Data.Text.Lazy as T
import Data.List (sort)
import Data.Maybe (catMaybes, fromMaybe)
import Database.PostgreSQL.Simple (Connection)
import System.Exit
......@@ -37,12 +38,15 @@ main =
[ testCase "domain.yml" $ installSetup "test/setups/domain.yml"
, testGroup
"self-test.yml"
[ selfTestStmt
[ selfTestStmt "test/setups/self-test.yml"
, selfTestStruct
, selfTestUpgrade "test/setups/self-test.yml"
, selfTestUpgradeDelete "test/setups/self-test-empty.yml"
, selfTestUpgrade "test/setups/self-test.yml"
]
, testGroup
"self test stmt only"
[selfTestStmt "test/setups/self-test-stmt.yml"]
]
]
......@@ -61,16 +65,15 @@ integrationTests =
r @? "Should fail"
--pPrint schemasDb
selfTestStmt :: TestTree
selfTestStmt =
testCaseSteps "stmt" $ \step -> do
(schemasDb, setupLocal) <-
deploy step installSetup "test/setups/self-test.yml"
selfTestStmt :: String -> TestTree
selfTestStmt file =
testCaseSteps ("stmt " ++ file) $ \step -> do
(schemasDb, setupLocal) <- deploy step installSetup file
mapM_ (doWrite "/tmp/testout" . schemaToDirTree) schemasDb
step "check statement diff"
assertNoDiff
(pgsqlGetFullStatements (newSetup schemasDb))
(pgsqlGetFullStatements setupLocal)
(sort $ pgsqlGetFullStatements (newSetup schemasDb))
(sort $ pgsqlGetFullStatements setupLocal)
selfTestStruct :: TestTree
selfTestStruct =
......
schemas:
- self-test-stmt
role_prefix: hamsql-test_
name: self-test-stmt
description: Self tests that only validate on stmt level
name: A_serial
description: With serial
primary_key: [y1]
columns:
- name: y1
type: SERial
description: PostgreSQL serial
- name: y2
type: bigserial
description: PostgreSQL serial
- name: y3
type: smallserial
description: PostgreSQL serial
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment