on bda2cfc help sign in
61 lines 2.3 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2import TutorialD.Interpreter
3import ProjectM36.Base
4import ProjectM36.Client
5import System.IO
6import Options.Applicative
7import System.Exit
9parseArgs :: Parser InterpreterConfig
10parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <|>
11 RemoteInterpreterConfig <$> parseNodeId <*> parseDatabaseName
13parsePersistenceStrategy :: Parser PersistenceStrategy
14parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>
15 MinimalPersistence <$> dbdirOpt <|>
16 pure NoPersistence
17 where
18 dbdirOpt = strOption (short 'd' <>
19 long "database-directory" <>
20 metavar "DIRECTORY" <>
21 showDefaultWith show
22 )
23 fsyncOpt = switch (short 'f' <>
24 long "fsync" <>
25 help "Fsync all new transactions.")
27parseDatabaseName :: Parser DatabaseName
28parseDatabaseName = strOption (long "database" <>
29 help "Remote database name")
31parseNodeId :: Parser NodeId
32parseNodeId = createNodeId <$>
33 strOption (long "host" <>
34 short 'h' <>
35 help "Remote host name" <>
36 value "127.0.0.1") <*>
37 option auto (long "port" <>
38 short 'p' <>
39 help "Remote port" <>
40 value defaultServerPort)
42opts :: ParserInfo InterpreterConfig
43opts = info parseArgs idm
45connectionInfoForConfig :: InterpreterConfig -> ConnectionInfo
46connectionInfoForConfig (LocalInterpreterConfig pStrategy) = InProcessConnectionInfo pStrategy
47connectionInfoForConfig (RemoteInterpreterConfig remoteNodeId remoteDBName) = RemoteProcessConnectionInfo remoteDBName remoteNodeId
49main :: IO ()
50main = do
51 interpreterConfig <- execParser opts
52 let connInfo = connectionInfoForConfig interpreterConfig
53 dbconn <- connectProjectM36 connInfo
54 case dbconn of
55 Left err -> do
56 hPutStrLn stderr ("Failed to create database connection: " ++ show err)
57 exitFailure
58 Right conn -> do
59 _ <- reprLoop interpreterConfig conn
60 return ()