Skip to content

Commit 8f85577

Browse files
committed
Added test case for table constraints
1 parent 09d1e31 commit 8f85577

File tree

7 files changed

+118
-25
lines changed

7 files changed

+118
-25
lines changed

example/test.sql

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,11 @@ CREATE TABLE emails (
1515
coverage_description text
1616
);
1717

18+
CREATE TABLE distributors (
19+
did integer PRIMARY KEY GENERATED BY DEFAULT AS IDENTITY,
20+
name varchar(40) NOT NULL CHECK (name <> '')
21+
);
22+
1823
CREATE TABLE threads (
1924
thread_id SERIAL UNIQUE PRIMARY KEY,
2025
thread_topic VARCHAR(100),

src/Sql2er/Common/Types.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ data ColumnConstraint =
5151
| Null
5252
| Default Text
5353
| ReferencesColumn TableName (Maybe ColumnName)
54+
| Check Text
5455
deriving (Show, Eq)
5556

5657
data Column = Column

src/Sql2er/Parser/AlterTable.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ parseAddColumn = do
5151
, parseDefaultVForCol
5252
, parseReferenceForCol
5353
, parseNullForCol
54+
, parseCheckForCol
5455
]
5556
t <- many (string "constraint" *> parseWordAndComma *> choice (try <$> [
5657
parsePrimaryKeyForCol
@@ -59,6 +60,7 @@ parseAddColumn = do
5960
, parseDefaultVForCol
6061
, parseReferenceForCol
6162
, parseNullForCol
63+
, parseCheckForCol
6264
]))
6365
return $
6466
AddColumn $

src/Sql2er/Parser/Common.hs

Lines changed: 46 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,8 @@ parseWordForAlter = lexeme (takeWhile1P Nothing (`notElem` (" \t\n;," :: String)
2424

2525
parseDefaultValue :: Parser Text
2626
parseDefaultValue =
27-
lexeme (char '\'' *> takeWhile1P Nothing (/= '\'') <* char '\'') <|> parseWordWithoutParenthesis
27+
lexeme (char '\'' *> takeWhile1P Nothing (/= '\'') <* char '\'')
28+
<|> parseWordWithoutParenthesis
2829

2930
parseTableConstraint :: Parser TableConstraint
3031
parseTableConstraint = do
@@ -45,25 +46,26 @@ uniqueConstraint = do
4546
between
4647
(char '(')
4748
(char ')')
48-
( lexeme
49-
( takeWhile1P
50-
Nothing
51-
(`notElem` (" \t\n;,)" :: String))
52-
)
53-
`sepBy1` lexeme (char ',')
54-
)
49+
( lexeme $
50+
(lexeme $ takeWhile1P Nothing (`notElem` (",)" :: String)))
51+
`sepBy` lexeme (char ',')
52+
)
5553
return $ UniqueConstraint cols
5654

5755
primaryKeyConstraint :: Parser TableConstraint
5856
primaryKeyConstraint = do
5957
_ <- lexeme (string "primary") *> lexeme (string "key")
60-
col <- between (char '(') (char ')') (takeWhile1P Nothing (/= ')'))
58+
col <- between (lexeme $ char '(') (lexeme $ char ')') (takeWhile1P Nothing (/= ')'))
6159
return $ PrimaryKeyConstraint col
6260

6361
checkConstraint :: Parser TableConstraint
6462
checkConstraint = do
6563
_ <- lexeme (string "check")
66-
expr <- lexeme (takeWhile1P Nothing (`notElem` (";," :: String)))
64+
expr <-
65+
lexeme (char '(')
66+
*> lexeme (takeWhile1P Nothing (/= ')'))
67+
<* lexeme (char ')')
68+
_ <- optional $ lexeme (string "no") *> lexeme (string "inherit")
6769
return $ CheckConstraint expr
6870

6971
foreignKeyConstraint :: Parser TableConstraint
@@ -72,7 +74,19 @@ foreignKeyConstraint = do
7274
col <- between (lexeme (char '(')) (lexeme (char ')')) (takeWhile1P Nothing (/= ')'))
7375
_ <- lexeme (string "references")
7476
refTable <- parseWord
75-
refColumn <- optional (between (char '(') (char ')') (takeWhile1P Nothing (/= ')')))
77+
refColumn <-
78+
optional
79+
( between
80+
(lexeme $ char '(')
81+
(lexeme $ char ')')
82+
(takeWhile1P Nothing (/= ')'))
83+
)
84+
_ <-
85+
try $
86+
optional $
87+
lexeme (string "on")
88+
*> (lexeme (string "delete") <|> lexeme (string "update"))
89+
*> lexeme (string "cascade")
7690
return $ ForeignKeyConstraint col refTable refColumn
7791

7892
excludeConstraint :: Parser TableConstraint
@@ -91,6 +105,16 @@ parseDefaultVal =
91105
<|> (char '\'' *> takeWhile1P Nothing (/= '\"') <* char '\"')
92106
<|> takeWhile1P Nothing (`notElem` (" " :: String))
93107

108+
parseCheckForCol :: Parser ColumnConstraint
109+
parseCheckForCol = do
110+
_ <- lexeme (string "check")
111+
expr <-
112+
lexeme (char '(')
113+
*> lexeme (takeWhile1P Nothing (/= ')'))
114+
<* lexeme (char ')')
115+
_ <- optional $ lexeme (string "no") *> lexeme (string "inherit")
116+
return $ Check expr
117+
94118
parsePrimaryKeyForCol :: Parser ColumnConstraint
95119
parsePrimaryKeyForCol = PrimaryKey <$ (lexeme (string "primary") *> lexeme (string "key"))
96120

@@ -110,7 +134,12 @@ parseReferenceForCol :: Parser ColumnConstraint
110134
parseReferenceForCol = do
111135
_ <- lexeme (string "references")
112136
refTable <- parseWord
113-
refCol <- optional (lexeme (char '(') *> lexeme (takeWhile1P Nothing (/= ')')) <* lexeme (char ')'))
137+
refCol <-
138+
optional
139+
( lexeme (char '(')
140+
*> lexeme (takeWhile1P Nothing (/= ')'))
141+
<* lexeme (char ')')
142+
)
114143
_ <-
115144
try $
116145
optional $
@@ -161,6 +190,10 @@ parseSqlType =
161190
, PGtimestamptz <$ lexeme (string "timestamptz")
162191
, PGtimestamp
163192
<$ lexeme (string "timestamp")
164-
<* optional (lexeme (string "without") *> lexeme (string "time") *> lexeme (string "zone"))
193+
<* optional
194+
( lexeme (string "without")
195+
*> lexeme (string "time")
196+
*> lexeme (string "zone")
197+
)
165198
, SomeType <$ lexeme (takeWhile1P Nothing (/= ' '))
166199
]

src/Sql2er/Parser/CreateTable.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ parseColumn = do
2020
, parseDefaultVForCol
2121
, parseReferenceForCol
2222
, parseNullForCol
23+
, parseCheckForCol
2324
]
2425
t <- many (lexeme (string "constraint") *> parseWordAndComma *> choice (try <$> [
2526
parsePrimaryKeyForCol
@@ -28,6 +29,7 @@ parseColumn = do
2829
, parseDefaultVForCol
2930
, parseReferenceForCol
3031
, parseNullForCol
32+
, parseCheckForCol
3133
]))
3234
void $ optional ignoreConstraints
3335
return
@@ -107,9 +109,8 @@ parseCreateTable = do
107109
_ <- optional (try (string "global") <|> try (string "local"))
108110
_ <- optional (string "temporary" <|> string "temp")
109111
_ <- optional (string "unlogged")
110-
_ <- optional $ lexeme (string "or") *> lexeme (string "replace")
111112
_ <- lexeme (string "table")
112-
_ <- optional (string "if not exists")
113+
_ <- optional $ lexeme (string "if") *> lexeme (string "not") *> lexeme (string "exists")
113114
tName <- lexeme (takeWhile1P Nothing (`notElem` (" \t\n)(" :: String)))
114115
items <-
115116
between (lexeme (char '(')) (lexeme (char ')')) (parseColumnOrConstraint `sepBy` lexeme (char ','))

test/ExamplesForTests.hs

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,9 +5,30 @@ module ExamplesForTests where
55
import Data.Text (Text)
66
import Sql2er.Common.Types
77

8+
tableConstraint :: Table
9+
tableConstraint =
10+
Table
11+
{ tableName = "x"
12+
, columns =
13+
[ Column
14+
{ columnName = "y"
15+
, columnType = PGvarchar (Just 3)
16+
, cConstraints = [Unique]
17+
}
18+
, Column {columnName = "z", columnType = PGinteger, cConstraints = []}
19+
]
20+
, tableConstraints =
21+
[ UniqueConstraint ["z"]
22+
, PrimaryKeyConstraint "y"
23+
, ForeignKeyConstraint "z" "sometable" (Just "z")
24+
, CheckConstraint "z > 23"
25+
, UniqueConstraint ["y","z"]
26+
]
27+
}
28+
829
simpleTable1String :: Text
930
simpleTable1String =
10-
"CREATE or replace TABLE films (\n\
31+
"CREATE TABLE films (\n\
1132
\code char(5) CONSTRAINT firstkey PRIMARY KEY,\
1233
\title varchar(40) NOT NULL,\
1334
\did integer NOT NULL,\

test/Spec.hs

Lines changed: 39 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ testParse inputText parsingFunc expectedOp failureMsg = do
2121
parsingFunc
2222
""
2323
inputText
24+
print eRes
2425
case eRes of
2526
Left _ -> assertFailure failureMsg
2627
Right r -> expectedOp @=? r
@@ -49,10 +50,10 @@ ignoreStatementTests =
4950

5051
testCreateOrReplaceTable :: TestTree
5152
testCreateOrReplaceTable =
52-
testCase "test create or replace table statement" $ do
53-
let eRes = runParser parseCreateTable "" (T.toLower "create or replace table x (y int)")
53+
testCase "test create table if not exists statement" $ do
54+
let eRes = runParser parseCreateTable "" (T.toLower "create table if not exists x (y int)")
5455
case eRes of
55-
Left _ -> assertFailure "parsing failed for create or replace"
56+
Left _ -> assertFailure "parsing failed for create if not exist"
5657
Right r -> simpleTable0 @=? r
5758

5859
testColumnConstraint :: TestTree
@@ -62,17 +63,17 @@ testColumnConstraint =
6263
[ testCase "column with constraint name" $
6364
testParse
6465
( T.toLower
65-
"create or replace \
66-
\table x (y varchar(3) CONSTRAINT \
66+
"create \
67+
\table if not exists x (y varchar(3) CONSTRAINT \
6768
\cName primary key, z int)")
6869
parseCreateTable
6970
Ex.constraintNamePK
7071
"parsing failed for column constraint"
7172
, testCase "column with Null and Not Null constraints" $
7273
testParse
7374
( T.toLower
74-
"create or replace \
75-
\table x (y varchar(3) Not NULL\
75+
"create \
76+
\table if not exists x (y varchar(3) Not NULL\
7677
\, z int NULL)"
7778
)
7879
parseCreateTable
@@ -81,8 +82,8 @@ testColumnConstraint =
8182
, testCase "column with unique constraint" $
8283
testParse
8384
( T.toLower
84-
"create or replace \
85-
\table x (y varchar(3) unique\
85+
"create \
86+
\table if not exists x (y varchar(3) unique\
8687
\, z int\
8788
\, constraint zUnique unique (z))"
8889
)
@@ -91,12 +92,41 @@ testColumnConstraint =
9192
"parsing failed for unique column constraint"
9293
]
9394

95+
{-
96+
"create table if not exists x (y varchar(3) unique\
97+
\, z int, constraint zunique unique (z),\
98+
\constraint asd primary key (y), constraint fKey foreign key (z) references\
99+
\sometable (z) on update cascade, check (z > 23),\
100+
\constraint uniquex unique (y))"
101+
102+
-}
103+
104+
testTableConstraint :: TestTree
105+
testTableConstraint =
106+
testGroup
107+
"table constraints"
108+
[
109+
testCase "table constraints" $
110+
testParse
111+
( T.toLower
112+
"create table if not exists x (y varchar(3) unique\
113+
\, z int, constraint zunique unique (z),\
114+
\constraint asd primary key (y), constraint fKey foreign key (z) references\
115+
\ sometable (z) on update cascade, check (z > 23),\
116+
\constraint uniquex unique (y,z))"
117+
)
118+
parseCreateTable
119+
Ex.tableConstraint
120+
"Parsing failed for table constraints"
121+
]
122+
94123
createStatementTests :: TestTree
95124
createStatementTests =
96125
testGroup
97126
"Create statement tests"
98127
[ testCreateOrReplaceTable
99128
, testColumnConstraint
129+
, testTableConstraint
100130
]
101131

102132
testSqlScripts :: Text -> TestTree

0 commit comments

Comments
 (0)