git.iko.soy/project-m36
on master help sign in
update handles to take tutd setup and iteration commands
7e7cb57AgentM
src/bin/benchmark/Handles.hs+39−27
compare with master
unifiedsplit
@@ -7,38 +7,47 @@ import TutorialD.Interpreter.Base
7import qualified Data.Text as T
7import qualified Data.Text as T
8import Text.Megaparsec hiding (option)
8import Text.Megaparsec hiding (option)
9import Data.Monoid
9import Data.Monoid
10−import qualified Data.Map as M
11import System.Directory
10import System.Directory
12import Control.Monad
11import Control.Monad
13
12
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+ }
21
20
22parseArgs :: Parser HandlesArgs
21parseArgs :: Parser HandlesArgs
23−parseArgs = HandlesArgs <$> parseOpenAndCloseCount <*> parseTransactionCount <*> parseDbDir
22+parseArgs = HandlesArgs <$> parseOpenAndCloseCount <*> parseTransactionCount <*> parseDbDir <*> parseTutdSetup <*> parseTutdIterate
24
23
25−parseOpenAndCloseCount :: Parser OpenCloseCount
24+parseOpenAndCloseCount :: Parser Int
26parseOpenAndCloseCount = option auto (short 'o' <> long "open-close-count")
25parseOpenAndCloseCount = option auto (short 'o' <> long "open-close-count")
27
26
28−parseTransactionCount :: Parser TransactionCount
27+parseTransactionCount :: Parser Int
29parseTransactionCount = option auto (short 't' <> long "transaction-count")
28parseTransactionCount = option auto (short 't' <> long "transaction-count")
30
29
31−parseDbDir :: Parser DbDir
30+parseDbDir :: Parser FilePath
32parseDbDir = strOption (short 'd' <> long "dbdir")
31parseDbDir = strOption (short 'd' <> long "dbdir")
33
32
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+
34main :: IO ()
39main :: IO ()
35main = do
40main = do
36− (HandlesArgs ocCount tCount dbdir) <- execParser $ info (helper <*> parseArgs) fullDesc
41+ args <- execParser $ info (helper <*> parseArgs) fullDesc
37− replicateM_ ocCount (runOpenClose tCount dbdir)
42+ replicateM_ (openCloseCount args) (runOpenClose
43+ (T.pack (tutdSetup args))
44+ (T.pack (tutdIterate args))
45+ (transactionCount args)
46+ (dbdir args))
38
47
39−runOpenClose :: TransactionCount -> DbDir -> IO ()
48+runOpenClose :: T.Text -> T.Text -> Int -> FilePath -> IO ()
40−runOpenClose tCount dbdir = do
49+runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do
41− let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir) emptyNotificationCallback []
50+ let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir') emptyNotificationCallback []
42 eConn <- connectProjectM36 connInfo
51 eConn <- connectProjectM36 connInfo
43 case eConn of
52 case eConn of
44 Left err -> error (show err)
53 Left err -> error (show err)
@@ -48,19 +57,22 @@ runOpenClose tCount dbdir = do
48 Left err -> error (show err)
57 Left err -> error (show err)
49 Right session -> do
58 Right session -> do
50 --database setup
59 --database setup
51− eErr <- executeDatabaseContextExpr session conn (Assign "x" (MakeRelationFromExprs Nothing [TupleExpr (M.singleton "v" (NakedAtomExpr (BoolAtom True)))]))
60+ case parseTutorialD tutdSetup' of
52− case eErr of
53 Left err -> error (show err)
61 Left err -> error (show err)
54− Right _ -> do
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
55− replicateM_ tCount (runTransaction session conn)
68+ replicateM_ tCount (runTransaction tutdIterate' session conn)
56− close conn
69+ close conn
57− printFdCount
70+ printFdCount
58
71
59−runTransaction :: SessionId -> Connection -> IO ()
72+runTransaction :: T.Text -> SessionId -> Connection -> IO ()
60−runTransaction sess conn = do
73+runTransaction tutdIterate' sess conn = do
61 --run tutd on every iteration
74 --run tutd on every iteration
62− let tutd = "update x (v:=not(@v))"
63− case parseTutorialD tutd of
75+ case parseTutorialD tutdIterate' of
64 Left err -> error (show err)
76 Left err -> error (show err)
65 Right parsed -> do
77 Right parsed -> do
66 res <- evalTutorialD sess conn UnsafeEvaluation parsed
78 res <- evalTutorialD sess conn UnsafeEvaluation parsed