git.iko.soy/project-m36
on master help sign in
WIP refactor persistent tests
b2fbc13AgentM
project-m36.cabal+1−1
compare with master
unifiedsplit
@@ -7,7 +7,7 @@ Category: Relational Algebra
7Cabal-Version: >= 1.2
7Cabal-Version: >= 1.2
8
8
9Library
9Library
10− Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava ==0.4.*,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel,transformers,gnuplot,binary,filepath,directory,vector-binary-instances,unix,temporary,stm,time,hashable-time,old-locale,attoparsec,either, persistent,persistent-template,aeson,path-pieces
10+ Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava ==0.4.*,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel,transformers,gnuplot,binary,filepath,directory,vector-binary-instances,unix,temporary,stm,time,hashable-time,old-locale,attoparsec,either, persistent,persistent-template,aeson,path-pieces,conduit,resourcet
11--required for persistent db driver
11--required for persistent db driver
12 Exposed-Modules: ProjectM36.Error,
12 Exposed-Modules: ProjectM36.Error,
13 ProjectM36.Transaction,
13 ProjectM36.Transaction,
test/persistent-driver/test.hs+53−13
@@ -30,22 +30,62 @@ Person
30|]
30|]
31
31
32testList :: Test
32testList :: Test
33−testList = TestList [testBasicInProcessConnection]
33+testList = TestList $ map mkInProcessTest [testGetBy, testDeleteBy]
34
34
35main :: IO ()
35main :: IO ()
36main = do
36main = do
37 tcounts <- runTestTT testList
37 tcounts <- runTestTT testList
38 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
38 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
39
39
40−testBasicInProcessConnection :: Test
40+inProcSettings :: ConnectionInfo
41−testBasicInProcessConnection = TestCase $ do
42− let connSettings = InProcessConnectionInfo NoPersistence
41+inProcSettings = InProcessConnectionInfo NoPersistence
43− withProjectM36Conn connSettings $ runProjectM36Conn $ do
42+
44− conn <- ask
43+defPersonRel :: Connection -> IO ()
44+defPersonRel conn = do
45− _ <- liftIO $ C.executeDatabaseContextExpr conn (Define "person" (attributesFromList [Attribute "name" StringAtomType, Attribute "age" IntAtomType, Attribute "id" StringAtomType]))
45+ maybeErr <- C.executeDatabaseContextExpr conn (Define "person" (attributesFromList [Attribute "name" StringAtomType, Attribute "age" IntAtomType, Attribute "id" StringAtomType]))
46− m <- insert $ Person "Michael" 26
46+ case maybeErr of
47− michael <- getBy $ UniqueName "Michael"
47+ Nothing -> return ()
48− liftIO $ putStrLn (show michael)
48+ Just err -> assertFailure $ "defPersonRel" ++ show err
49− liftIO $ assertBool "poop" False
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"
50− return ()
90+ Just m -> return ()
51−
91+ return ()