@@ -30,22 +30,62 @@ Person
3030|]
3131
3232testList :: Test
33−testList = TestList [testBasicInProcessConnection]
33+testList = TestList $ map mkInProcessTest [testGetBy, testDeleteBy]
3434
3535main :: IO ()
3636main = do
3737 tcounts <- runTestTT testList
3838 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
3939
40−testBasicInProcessConnection :: Test
41−testBasicInProcessConnection = TestCase $ do
42− let connSettings = InProcessConnectionInfo NoPersistence
43− withProjectM36Conn connSettings $ runProjectM36Conn $ do
44− conn <- ask
45− _ <- liftIO $ C.executeDatabaseContextExpr conn (Define "person" (attributesFromList [Attribute "name" StringAtomType, Attribute "age" IntAtomType, Attribute "id" StringAtomType]))
46− m <- insert $ Person "Michael" 26
47− michael <- getBy $ UniqueName "Michael"
48− liftIO $ putStrLn (show michael)
49− liftIO $ assertBool "poop" False
50− return ()
51−
40+inProcSettings :: ConnectionInfo
41+inProcSettings = InProcessConnectionInfo NoPersistence
42+
43+defPersonRel :: Connection -> IO ()
44+defPersonRel conn = do
45+ maybeErr <- C.executeDatabaseContextExpr conn (Define "person" (attributesFromList [Attribute "name" StringAtomType, Attribute "age" IntAtomType, Attribute "id" StringAtomType]))
46+ case maybeErr of
47+ Nothing -> return ()
48+ Just err -> assertFailure $ "defPersonRel" ++ show err
49+
50+mkInProcessTest :: ReaderT C.Connection IO () -> Test
51+mkInProcessTest m = TestCase $ do
52+ withProjectM36Conn inProcSettings $ runProjectM36Conn $ do
53+ conn <- ask
54+ liftIO (defPersonRel conn)
55+ m
56+
57+-- insert a person, getBy to check he is there
58+testGetBy :: ReaderT ProjectM36Backend IO ()
59+testGetBy = do
60+ let name = "Michael"
61+ age = 26
62+ m <- insert $ Person name age
63+ michael <- getBy $ UniqueName name
64+ case michael of
65+ Nothing -> liftIO $ assertFailure "no person found"
66+ Just michael' -> do
67+ liftIO $ assertEqual "name equality" (personName $ entityVal michael') name
68+ liftIO $ assertEqual "age equality" (personAge $ entityVal michael') age
69+ return ()
70+
71+--insert two people, delete one, check one remains
72+testDeleteBy :: ReaderT ProjectM36Backend IO ()
73+testDeleteBy = do
74+ let name1 = "Michael"
75+ age1 = 26
76+ name2 = "John"
77+ age2 = 30
78+ m1 <- insert $ Person name1 age1
79+ m2 <- insert $ Person name2 age2
80+ deleteBy $ UniqueName name1 --delete michael
81+ nom1 <- getBy $ UniqueName name1
82+ --check that m1 was deleted
83+ case nom1 of
84+ Just m -> liftIO $ assertFailure "deleteBy failure"
85+ Nothing -> return ()
86+ --check that m2 still exists
87+ m2check <- getBy $ UniqueName name2
88+ case m2check of
89+ Nothing -> liftIO $ assertFailure "deleteBy failure2"
90+ Just m -> return ()
91+ return ()