@@ -18,6 +18,7 @@ import Database.Persist
1818import Database.Persist.TH
1919import Language.Haskell.TH.Syntax
2020import Control.Monad.Reader
21+import Control.Exception (throwIO)
2122
2223let projectM36PersistSettings = mkPersistSettings (ConT ''ProjectM36Backend)
2324 in
@@ -30,7 +31,7 @@ Person
3031|]
3132
3233testList :: Test
33−testList = TestList $ map mkInProcessTest [testGetBy, testDeleteBy]
34+testList = TestList $ map mkInProcessTest [testGetBy, testDelete, testUpdate, testCount]
3435
3536main :: IO ()
3637main = do
@@ -53,6 +54,16 @@ mkInProcessTest m = TestCase $ do
5354 conn <- ask
5455 liftIO (defPersonRel conn)
5556 m
57+
58+entityFromMaybe :: (PersistEntity val) => Maybe (Entity val) -> IO (Entity val)
59+entityFromMaybe may = case may of
60+ Nothing -> assertFailure "expected entity not found" >> throwIO (PersistError "not found")
61+ Just ent -> return ent
62+
63+valFromMaybe :: (PersistEntity val) => Maybe val -> IO val
64+valFromMaybe may = case may of
65+ Nothing -> assertFailure "expected value not found" >> throwIO (PersistError "not found")
66+ Just val -> return val
5667
5768-- insert a person, getBy to check he is there
5869testGetBy :: ReaderT ProjectM36Backend IO ()
@@ -61,16 +72,14 @@ testGetBy = do
6172 age = 26
6273 m <- insert $ Person name age
6374 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
75+ michael <- liftIO $ entityFromMaybe michael
76+ liftIO $ assertEqual "name equality" name (personName $ entityVal michael)
77+ liftIO $ assertEqual "age equality" age (personAge $ entityVal michael)
6978 return ()
7079
7180--insert two people, delete one, check one remains
72−testDeleteBy :: ReaderT ProjectM36Backend IO ()
73−testDeleteBy = do
81+testDelete :: ReaderT ProjectM36Backend IO ()
82+testDelete = do
7483 let name1 = "Michael"
7584 age1 = 26
7685 name2 = "John"
@@ -88,4 +97,50 @@ testDeleteBy = do
8897 case m2check of
8998 Nothing -> liftIO $ assertFailure "deleteBy failure2"
9099 Just m -> return ()
91− return ()
100+ --delete m2
101+ deleteWhere [PersonName ==. name2]
102+ m2del <- get m2
103+ case m2del of
104+ Just m -> liftIO $ assertFailure "deleteBy failure m2"
105+ Nothing -> return ()
106+ return ()
107+
108+--insert two people, update one-at-a-time, confirm update
109+testUpdate :: ReaderT ProjectM36Backend IO ()
110+testUpdate = do
111+ let name1 = "Michael"
112+ age1 = 26
113+ name2 = "John"
114+ age2 = 30
115+ name3 = "Dracula"
116+ m1 <- insert $ Person name1 age1
117+ m2 <- insert $ Person name2 age2
118+ update m1 [PersonAge =. 35] -- update m1's age
119+ updateWhere [PersonName ==. name2] [PersonName =. name3] --update m2's name
120+ m1up <- get m1
121+ m1up <- liftIO $ valFromMaybe m1up
122+ m2up <- get m2
123+ m2up <- liftIO $ valFromMaybe m2up
124+ liftIO $ assertEqual "m1 update" name1 (personName m1up)
125+ liftIO $ assertEqual "m1 update" 35 (personAge m1up)
126+ liftIO $ assertEqual "m2 update" name3 (personName m2up)
127+ liftIO $ assertEqual "m2 update" age2 (personAge m2up)
128+ return ()
129+
130+testCount :: ReaderT ProjectM36Backend IO ()
131+testCount = do
132+ let name1 = "Michael"
133+ age1 = 26
134+ name2 = "John"
135+ age2 = 30
136+ m1 <- insert $ Person name1 age1
137+ m2 <- insert $ Person name2 age2
138+ c1 <- count [PersonAge ==. 26]
139+ liftIO $ assertEqual "count age" 1 c1
140+ c2 <- count [PersonAge !=. 400]
141+ liftIO $ assertEqual "count age2" 2 c2
142+
143+
144+
145+
146+