module ProjectM36.Server.ParseArgs where
import ProjectM36.Base
import ProjectM36.Client
import Options.Applicative
import ProjectM36.Server.Config
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif

parseArgsWithDefaults :: ServerConfig -> Parser ServerConfig
parseArgsWithDefaults :: ServerConfig -> Parser ServerConfig
parseArgsWithDefaults ServerConfig
defaults = PersistenceStrategy
-> Bool
-> String
-> RemoteServerAddress
-> [String]
-> Int
-> Bool
-> ServerConfig
ServerConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 Parser PersistenceStrategy
parsePersistenceStrategy forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 Parser Bool
parseCheckFS forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 Parser String
parseDatabaseName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 Parser RemoteServerAddress
parseServerAddress forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser String
parseGhcPkgPath forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 Int -> Parser Int
parseTimeout (ServerConfig -> Int
perRequestTimeout ServerConfig
defaults) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 Parser Bool
parseTestMode

parsePersistenceStrategy :: Parser PersistenceStrategy
parsePersistenceStrategy :: Parser PersistenceStrategy
parsePersistenceStrategy = String -> PersistenceStrategy
CrashSafePersistence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String
dbdirOpt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Bool
fsyncOpt) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                           String -> PersistenceStrategy
MinimalPersistence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
dbdirOpt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                           forall (f :: * -> *) a. Applicative f => a -> f a
pure PersistenceStrategy
NoPersistence
  where
    dbdirOpt :: Parser String
dbdirOpt = forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd' forall a. Semigroup a => a -> a -> a
<>
                          forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"database-directory" forall a. Semigroup a => a -> a -> a
<>
                          forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIRECTORY" forall a. Semigroup a => a -> a -> a
<>
                          forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith forall a. Show a => a -> String
show
                         )
    fsyncOpt :: Parser Bool
fsyncOpt = Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' forall a. Semigroup a => a -> a -> a
<>
                    forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fsync" forall a. Semigroup a => a -> a -> a
<>
                    forall (f :: * -> *) a. String -> Mod f a
help String
"Fsync all new transactions.")

parseTestMode :: Parser Bool
parseTestMode :: Parser Bool
parseTestMode = forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"test-mode" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
hidden)

parseCheckFS :: Parser Bool
parseCheckFS :: Parser Bool
parseCheckFS = forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"disable-fscheck" forall a. Semigroup a => a -> a -> a
<>
                                forall (f :: * -> *) a. String -> Mod f a
help String
"Disable filesystem check for journaling.")

parseServerAddress :: Parser RemoteServerAddress
parseServerAddress :: Parser RemoteServerAddress
parseServerAddress =
  (String -> Port -> RemoteServerAddress
RemoteServerHostAddress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   String -> Parser String
parseHostname String
"127.0.0.1" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
   Port -> Parser Port
parsePort Port
6543)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (String -> RemoteServerAddress
RemoteServerUnixDomainSocketAddress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
parseUnixDomainSocketPath)

parseUnixDomainSocketPath :: Parser FilePath
parseUnixDomainSocketPath :: Parser String
parseUnixDomainSocketPath = forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'x' forall a. Semigroup a => a -> a -> a
<>
                                       forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"unix-domain-socket" forall a. Semigroup a => a -> a -> a
<>
                                       forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SOCKET_PATH")

parseDatabaseName :: Parser DatabaseName
parseDatabaseName :: Parser String
parseDatabaseName = forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' forall a. Semigroup a => a -> a -> a
<>
                               forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"database" forall a. Semigroup a => a -> a -> a
<>
                               forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DATABASE_NAME")

parseHostname :: Hostname -> Parser Hostname
parseHostname :: String -> Parser String
parseHostname String
defHostname = forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h' forall a. Semigroup a => a -> a -> a
<>
                           forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hostname" forall a. Semigroup a => a -> a -> a
<>
                           forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOST_NAME" forall a. Semigroup a => a -> a -> a
<>
                           forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
defHostname)

parsePort :: Port -> Parser Port
parsePort :: Port -> Parser Port
parsePort Port
defPort = forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' forall a. Semigroup a => a -> a -> a
<>
                         forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port" forall a. Semigroup a => a -> a -> a
<>
                         forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT_NUMBER" forall a. Semigroup a => a -> a -> a
<>
                         forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Port
defPort)

parseGhcPkgPath :: Parser String
parseGhcPkgPath :: Parser String
parseGhcPkgPath = forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghc-pkg-dir" forall a. Semigroup a => a -> a -> a
<>
                              forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"GHC_PACKAGE_DIRECTORY")

parseTimeout :: Int -> Parser Int
parseTimeout :: Int -> Parser Int
parseTimeout Int
defTimeout = forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"timeout" forall a. Semigroup a => a -> a -> a
<>
                            forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MICROSECONDS" forall a. Semigroup a => a -> a -> a
<>
                            forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
defTimeout)

parseConfig :: IO ServerConfig
parseConfig :: IO ServerConfig
parseConfig = ServerConfig -> IO ServerConfig
parseConfigWithDefaults ServerConfig
defaultServerConfig

parseConfigWithDefaults :: ServerConfig -> IO ServerConfig
parseConfigWithDefaults :: ServerConfig -> IO ServerConfig
parseConfigWithDefaults ServerConfig
defaults = forall a. ParserInfo a -> IO a
execParser (forall a. Parser a -> InfoMod a -> ParserInfo a
info (ServerConfig -> Parser ServerConfig
parseArgsWithDefaults ServerConfig
defaults forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helpOption) forall m. Monoid m => m
idm)

parseWSConfigWithDefaults :: ServerConfig -> IO WebsocketServerConfig
parseWSConfigWithDefaults :: ServerConfig -> IO WebsocketServerConfig
parseWSConfigWithDefaults ServerConfig
defaults = forall a. ParserInfo a -> IO a
execParser (forall a. Parser a -> InfoMod a -> ParserInfo a
info (ServerConfig -> Parser WebsocketServerConfig
parseWSArgsWithDefaults ServerConfig
defaults forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helpOption) forall m. Monoid m => m
idm)

parseWSArgsWithDefaults :: ServerConfig -> Parser WebsocketServerConfig
parseWSArgsWithDefaults :: ServerConfig -> Parser WebsocketServerConfig
parseWSArgsWithDefaults ServerConfig
defaults = ServerConfig
-> Maybe String -> Maybe String -> WebsocketServerConfig
WebsocketServerConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 ServerConfig -> Parser ServerConfig
parseArgsWithDefaults ServerConfig
defaults forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 Parser (Maybe String)
parseTlsCertificatePath forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                 Parser (Maybe String)
parseTlsKeyPath


parseTlsCertificatePath :: Parser (Maybe String)
parseTlsCertificatePath :: Parser (Maybe String)
parseTlsCertificatePath = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-certificate-path" forall a. Semigroup a => a -> a -> a
<>
                              forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TLS_CERTIFICATE_PATH")

parseTlsKeyPath :: Parser (Maybe String)
parseTlsKeyPath :: Parser (Maybe String)
parseTlsKeyPath = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-key-path" forall a. Semigroup a => a -> a -> a
<>
                              forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TLS_KEY_PATH")

helpOption :: Parser (a -> a)
helpOption :: forall a. Parser (a -> a)
helpOption = forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption ParseError
helpText forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
  [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"help"
  , forall (f :: * -> *) a. String -> Mod f a
help String
"Show this help text"
  , forall (f :: * -> *) a. Mod f a
hidden ]
  where
#if MIN_VERSION_optparse_applicative(0,16,0)
    helpText :: ParseError
helpText = Maybe String -> ParseError
ShowHelpText forall a. Maybe a
Nothing
#else
    helpText = ShowHelpText
#endif