Add getFieldsWithMap tests

This commit is contained in:
krdlab 2014-08-17 08:30:46 +09:00
parent efba911d20
commit bb83384388
2 changed files with 17 additions and 3 deletions

View File

@ -5,9 +5,9 @@
import Test.Hspec
import Prelude hiding (id)
import Language.Haskell.TH (runQ)
import Data.Int (Int32)
import Data.Time (LocalTime)
import Database.HDBC.Session (withConnectionIO)
import Database.HDBC.Record.Query (runQuery')
import Database.Record.TH (derivingShow)
@ -19,9 +19,10 @@ import Database.Relational.Query ( query
, value
, relationalQuery
)
import Database.HDBC.Schema.Driver (getPrimaryKey)
import Database.HDBC.Schema.Driver (getPrimaryKey, getFieldsWithMap)
import Database.HDBC.Schema.MySQL (driverMySQL)
import Prelude hiding (id)
import qualified DB.Source as DB
-- TODO: get and define
@ -39,6 +40,16 @@ main = hspec $ do
keys <- withConnectionIO DB.connect $ \c -> getPrimaryKey driverMySQL c "TEST" "test_pk2"
keys `shouldBe` ["a", "b"]
describe "getFieldsWithMap" $ do
it "returns 'NOT NULL' column positions" $ do
( _, ps) <- withConnectionIO DB.connect $ \c -> getFieldsWithMap driverMySQL [] c "TEST" "test_nn1"
ps `shouldBe` [0, 2, 4]
it "returns column types" $ do
(tm, _) <- withConnectionIO DB.connect $ \c -> getFieldsWithMap driverMySQL [] c "TEST" "test_nn1"
types <- mapM (runQ . snd) tm
expect <- mapM runQ [[t|Int32|], [t|Maybe Int32|], [t|String|], [t|Maybe String|], [t|LocalTime|]]
types `shouldBe` expect
describe "basic tests" $
it "returns data types" $ do
decs <- runQ $ DB.defineTable [] "TEST" "user" []

View File

@ -5,6 +5,9 @@ CREATE TABLE TEST.test_pk1 (a INT, b VARCHAR(32) NOT NULL, PRIMARY KEY (a));
DROP TABLE IF EXISTS TEST.test_pk2;
CREATE TABLE TEST.test_pk2 (a INT, b INT, c VARCHAR(32) NOT NULL, PRIMARY KEY (a, b));
DROP TABLE IF EXISTS TEST.test_nn1;
CREATE TABLE TEST.test_nn1 (a INT, b INT, c VARCHAR(32) NOT NULL, d TEXT, e DATETIME NOT NULL, PRIMARY KEY (a));
DROP TABLE IF EXISTS TEST.user;
CREATE TABLE TEST.user (
id BIGINT PRIMARY KEY