1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
import Database.HaskellDB
import Database.HaskellDB.DBLayout
import TestConnect
import Random
-- create table test_tb1 (c11 int not null, c12 int null);
---------------------------------------------------------------------------
-- Tables
---------------------------------------------------------------------------
-------------------------------------
-- Table test_tb1
-------------------------------------
test_tb1 :: Table
(RecCons C11 (Expr Int)
(RecCons C12 (Expr (Maybe Int)) RecNil))
test_tb1 = baseTable "test_tb1" $
hdbMakeEntry C11 #
hdbMakeEntry C12
---------------------------------------------------------------------------
-- Fields
---------------------------------------------------------------------------
-------------------------------------
-- C11 Field
-------------------------------------
data C11 = C11
instance FieldTag C11 where fieldName _ = "c11"
c11 :: Attr C11 Int
c11 = mkAttr C11
-------------------------------------
-- C12 Field
-------------------------------------
data C12 = C12
instance FieldTag C12 where fieldName _ = "c12"
c12 :: Attr C12 (Maybe Int)
c12 = mkAttr C12
--
-- A simple query
--
q = do
tb1 <- table test_tb1
project (c11 << tb1!c11 # c12 << tb1!c12)
newRec x y = c11 << constant x # c12 << constant y
printResults rs = mapM_ (\row -> putStrLn (show (row!c11) ++ " " ++ show (row!c12))) rs
--
-- Testing db layout functions
--
listTables db = tables db >>= putStr . unlines
-- run 'describe'
describeTable table db = describe db table >>= putStr . unlines . map show
bigTest db = do
putStrLn "Tables:"
listTables db
cols <- describe db "test_tb1"
putStrLn "Columns in test_tb1"
putStrLn (unlines (map show cols))
putStrLn "Contents of test_tb1"
res <- query db q
printResults res
(x::Int) <- randomIO
(y::Int) <- randomIO
let my = if even y then Just y else Nothing
-- insertNew db test_tb1 (newRec x my)
-- insert db test_tb1 (project (newRec x my))
-- putStrLn $ "Contents of test_tb1 after inserting " ++ show (x,my)
putStrLn "Contents of test_tb1"
res <- query db q
printResults res
main = argConnect bigTest
|
