<commit_before>{-# LANGUAGE CPP #-}
--benchmark test for file handle leaks
import ProjectM36.Client
import Options.Applicative
import TutorialD.Interpreter
import TutorialD.Interpreter.Base
import qualified Data.Text as T
import Text.Megaparsec hiding (option)
import Data.Monoid
import qualified Data.Map as M
import System.Directory
import Control.Monad

type OpenCloseCount = Int 

type TransactionCount = Int

type DbDir = String

data HandlesArgs = HandlesArgs OpenCloseCount TransactionCount DbDir

parseArgs :: Parser HandlesArgs
parseArgs = HandlesArgs <$> parseOpenAndCloseCount <*> parseTransactionCount <*> parseDbDir

parseOpenAndCloseCount :: Parser OpenCloseCount
parseOpenAndCloseCount = option auto (short 'o' <> long "open-close-count")

parseTransactionCount :: Parser TransactionCount
parseTransactionCount = option auto (short 't' <> long "transaction-count")

parseDbDir :: Parser DbDir
parseDbDir = strOption (short 'd' <> long "dbdir")

main :: IO ()
main = do
  (HandlesArgs ocCount tCount dbdir) <- execParser $ info (helper <*> parseArgs) fullDesc
  replicateM_ ocCount (runOpenClose tCount dbdir)
  
runOpenClose :: TransactionCount -> DbDir -> IO ()  
runOpenClose tCount dbdir = do
  let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir) emptyNotificationCallback []
  eConn <- connectProjectM36 connInfo
  case eConn of
    Left err -> error (show err)
    Right conn -> do
      eSess <- createSessionAtHead conn "master"
      case eSess of
        Left err -> error (show err)
        Right session -> do
          --database setup
          eErr <- executeDatabaseContextExpr session conn (Assign "x" (MakeRelationFromExprs Nothing [TupleExpr (M.singleton "v" (NakedAtomExpr (BoolAtom True)))]))
          case eErr of
            Left err -> error (show err)
            Right _ -> do
              replicateM_ tCount (runTransaction session conn)
              close conn
              printFdCount
  
runTransaction :: SessionId -> Connection -> IO ()
runTransaction sess conn = do
  --run tutd on every iteration
  let tutd = "update x (v:=not(@v))"
  case parseTutorialD tutd of
    Left err -> error (show err)
    Right parsed -> do
      res <- evalTutorialD sess conn UnsafeEvaluation parsed
      case res of
        DisplayErrorResult err -> error (T.unpack err)
        DisplayParseErrorResult _ err -> error (parseErrorPretty err)
        _ -> do 
          eErr <- commit sess conn 
          case eErr of
            Left err -> error (show err)
            Right _ -> printFdCount
      
--prints out number of consumed file descriptors      
printFdCount :: IO ()
#if defined(linux_HOST_OS)
printFdCount = do
  fdc <- fdCount
  putStrLn ("Fd count: " ++ show fdc)
  --getLine >> pure ()
#else<commit_msg>update handles to take tutd setup and iteration commands<commit_after>{-# LANGUAGE CPP #-}
--benchmark test for file handle leaks
import ProjectM36.Client
import Options.Applicative
import TutorialD.Interpreter
import TutorialD.Interpreter.Base
import qualified Data.Text as T
import Text.Megaparsec hiding (option)
import Data.Monoid
import System.Directory
import Control.Monad

data HandlesArgs = HandlesArgs {
  openCloseCount :: Int,
  transactionCount :: Int,
  dbdir :: FilePath, 
  tutdSetup :: String,
  tutdIterate :: String
  }

parseArgs :: Parser HandlesArgs
parseArgs = HandlesArgs <$> parseOpenAndCloseCount <*> parseTransactionCount <*> parseDbDir <*> parseTutdSetup <*> parseTutdIterate

parseOpenAndCloseCount :: Parser Int
parseOpenAndCloseCount = option auto (short 'o' <> long "open-close-count")

parseTransactionCount :: Parser Int
parseTransactionCount = option auto (short 't' <> long "transaction-count")

parseDbDir :: Parser FilePath
parseDbDir = strOption (short 'd' <> long "dbdir")

parseTutdSetup :: Parser String
parseTutdSetup = strOption (short 's' <> long "setup-tutd" <> value "x:=relation{tuple{v t}}")

parseTutdIterate :: Parser String
parseTutdIterate = strOption (short 'i' <> long "iterate-tutd" <> value "update x (v:=not(@v))")

main :: IO ()
main = do
  args <- execParser $ info (helper <*> parseArgs) fullDesc
  replicateM_ (openCloseCount args) (runOpenClose 
                                     (T.pack (tutdSetup args))
                                     (T.pack (tutdIterate args))
                                     (transactionCount args) 
                                     (dbdir args))
  
runOpenClose :: T.Text -> T.Text -> Int -> FilePath -> IO ()  
runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do
  let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir') emptyNotificationCallback []
  eConn <- connectProjectM36 connInfo
  case eConn of
    Left err -> error (show err)
    Right conn -> do
      eSess <- createSessionAtHead conn "master"
      case eSess of
        Left err -> error (show err)
        Right session -> do
          --database setup
          case parseTutorialD tutdSetup' of
            Left err -> error (show err)
            Right parsed -> do
              res <- evalTutorialD session conn UnsafeEvaluation parsed
              case res of
                DisplayErrorResult err -> error (T.unpack err)
                DisplayParseErrorResult _ err -> error (parseErrorPretty err)
                _ -> do 
                  replicateM_ tCount (runTransaction tutdIterate' session conn)
                  close conn
                  printFdCount
  
runTransaction :: T.Text -> SessionId -> Connection -> IO ()
runTransaction tutdIterate' sess conn = do
  --run tutd on every iteration
  case parseTutorialD tutdIterate' of
    Left err -> error (show err)
    Right parsed -> do
      res <- evalTutorialD sess conn UnsafeEvaluation parsed
      case res of
        DisplayErrorResult err -> error (T.unpack err)
        DisplayParseErrorResult _ err -> error (parseErrorPretty err)
        _ -> do 
          eErr <- commit sess conn 
          case eErr of
            Left err -> error (show err)
            Right _ -> printFdCount
      
--prints out number of consumed file descriptors      
printFdCount :: IO ()
#if defined(linux_HOST_OS)
printFdCount = do
  fdc <- fdCount
  putStrLn ("Fd count: " ++ show fdc)
  --getLine >> pure ()
#else
{'fraction_non_alphanumeric': 0.08574181117533719, 'fraction_numerical': 0.0012845215157353885, 'mean_word_length': 2.786626139817629, 'pattern_counts': {'":': 0, '<': 37, '<?xml version=': 0, '>': 67, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '942635', 'n_tokens_mistral': 1820, 'n_tokens_neox': 1748, 'n_words': 585}