git.iko.soy/project-m36
on ffe683a help sign in
project-m36/test/TransactionGraph/Persist.hs
62 lines 2.7 kB history raw
1{-# LANGUAGE OverloadedStrings,LambdaCase #-}
2import Test.HUnit
3import ProjectM36.Base
4import ProjectM36.Persist (DiskSync(NoDiskSync))
5import ProjectM36.TransactionGraph.Persist
6import ProjectM36.TransactionGraph
7import ProjectM36.RelationalExpression
8import ProjectM36.Transaction
9import System.IO.Temp
10import System.Exit
11import Data.Either
12import Data.UUID.V4 (nextRandom)
13import System.FilePath
14import TutorialD.Interpreter.DatabaseExpr
16main :: IO ()
17main = do
18 tcounts <- runTestTT testList
19 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
21testList :: Test
22testList = TestList [testBootstrapDB, testDBSimplePersistence]
24{- bootstrap a database, ensure that it can be read -}
25testBootstrapDB :: Test
26testBootstrapDB = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do
27 let dbdir = tempdir </> "dbdir"
28 freshUUID <- nextRandom
29 _ <- bootstrapDatabaseDir NoDiskSync dbdir (bootstrapTransactionGraph freshUUID dateExamples)
30 loadedGraph <- transactionGraphLoad dbdir emptyTransactionGraph
31 assertBool "transactionGraphLoad" $ isRight loadedGraph
33{- create a database with several transactions, ensure that all transactions can be read -}
34testDBSimplePersistence :: Test
35testDBSimplePersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do
36 let dbdir = tempdir </> "dbdir"
37 freshUUID <- nextRandom
38 let graph = bootstrapTransactionGraph freshUUID dateExamples
39 bootstrapDatabaseDir NoDiskSync dbdir graph
40 case transactionForHead "master" graph of
41 Nothing -> assertFailure "Failed to retrieve head transaction for master branch."
42 Just headTrans -> do
43 case interpretDatabaseExpr (transactionContext headTrans) "x:=S" of
44 Left err -> assertFailure (show err)
45 Right context' -> do
46 freshUUID' <- nextRandom
47 let newdiscon = newDisconnectedTransaction (transactionUUID headTrans) context'
48 addTrans = addDisconnectedTransaction freshUUID' "master" newdiscon graph
49 --add a transaction to the graph
50 case addTrans of
51 Left err -> assertFailure (show err)
52 Right (_, graph') -> do
53 --persist the new graph
54 transactionGraphPersist NoDiskSync dbdir graph'
55 --reload the graph from the filesystem and confirm that the transaction is present
56 graphErr <- transactionGraphLoad dbdir emptyTransactionGraph
57 case graphErr of
58 Left err -> assertFailure (show err)
59 Right graph'' -> assertBool "graph equality" $ graph'' == graph'