@@ -7,38 +7,47 @@ import TutorialD.Interpreter.Base
77import qualified Data.Text as T
88import Text.Megaparsec hiding (option)
99import Data.Monoid
10−import qualified Data.Map as M
1110import System.Directory
1211import Control.Monad
1312
14−type OpenCloseCount = Int
15−
16−type TransactionCount = Int
17−
18−type DbDir = String
19−
20−data HandlesArgs = HandlesArgs OpenCloseCount TransactionCount DbDir
13+data HandlesArgs = HandlesArgs {
14+ openCloseCount :: Int,
15+ transactionCount :: Int,
16+ dbdir :: FilePath,
17+ tutdSetup :: String,
18+ tutdIterate :: String
19+ }
2120
2221parseArgs :: Parser HandlesArgs
23−parseArgs = HandlesArgs <$> parseOpenAndCloseCount <*> parseTransactionCount <*> parseDbDir
22+parseArgs = HandlesArgs <$> parseOpenAndCloseCount <*> parseTransactionCount <*> parseDbDir <*> parseTutdSetup <*> parseTutdIterate
2423
25−parseOpenAndCloseCount :: Parser OpenCloseCount
24+parseOpenAndCloseCount :: Parser Int
2625parseOpenAndCloseCount = option auto (short 'o' <> long "open-close-count")
2726
28−parseTransactionCount :: Parser TransactionCount
27+parseTransactionCount :: Parser Int
2928parseTransactionCount = option auto (short 't' <> long "transaction-count")
3029
31−parseDbDir :: Parser DbDir
30+parseDbDir :: Parser FilePath
3231parseDbDir = strOption (short 'd' <> long "dbdir")
3332
33+parseTutdSetup :: Parser String
34+parseTutdSetup = strOption (short 's' <> long "setup-tutd" <> value "x:=relation{tuple{v t}}")
35+
36+parseTutdIterate :: Parser String
37+parseTutdIterate = strOption (short 'i' <> long "iterate-tutd" <> value "update x (v:=not(@v))")
38+
3439main :: IO ()
3540main = do
36− (HandlesArgs ocCount tCount dbdir) <- execParser $ info (helper <*> parseArgs) fullDesc
37− replicateM_ ocCount (runOpenClose tCount dbdir)
41+ args <- execParser $ info (helper <*> parseArgs) fullDesc
42+ replicateM_ (openCloseCount args) (runOpenClose
43+ (T.pack (tutdSetup args))
44+ (T.pack (tutdIterate args))
45+ (transactionCount args)
46+ (dbdir args))
3847
39−runOpenClose :: TransactionCount -> DbDir -> IO ()
40−runOpenClose tCount dbdir = do
41− let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir) emptyNotificationCallback []
48+runOpenClose :: T.Text -> T.Text -> Int -> FilePath -> IO ()
49+runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do
50+ let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir') emptyNotificationCallback []
4251 eConn <- connectProjectM36 connInfo
4352 case eConn of
4453 Left err -> error (show err)
@@ -48,19 +57,22 @@ runOpenClose tCount dbdir = do
4857 Left err -> error (show err)
4958 Right session -> do
5059 --database setup
51− eErr <- executeDatabaseContextExpr session conn (Assign "x" (MakeRelationFromExprs Nothing [TupleExpr (M.singleton "v" (NakedAtomExpr (BoolAtom True)))]))
52− case eErr of
60+ case parseTutorialD tutdSetup' of
5361 Left err -> error (show err)
54− Right _ -> do
55− replicateM_ tCount (runTransaction session conn)
56− close conn
57− printFdCount
62+ Right parsed -> do
63+ res <- evalTutorialD session conn UnsafeEvaluation parsed
64+ case res of
65+ DisplayErrorResult err -> error (T.unpack err)
66+ DisplayParseErrorResult _ err -> error (parseErrorPretty err)
67+ _ -> do
68+ replicateM_ tCount (runTransaction tutdIterate' session conn)
69+ close conn
70+ printFdCount
5871
59−runTransaction :: SessionId -> Connection -> IO ()
60−runTransaction sess conn = do
72+runTransaction :: T.Text -> SessionId -> Connection -> IO ()
73+runTransaction tutdIterate' sess conn = do
6174 --run tutd on every iteration
62− let tutd = "update x (v:=not(@v))"
63− case parseTutorialD tutd of
75+ case parseTutorialD tutdIterate' of
6476 Left err -> error (show err)
6577 Right parsed -> do
6678 res <- evalTutorialD sess conn UnsafeEvaluation parsed