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 -> DatabaseName -> DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig ServerConfig (PersistenceStrategy -> Bool -> DatabaseName -> DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) -> Parser PersistenceStrategy -> Parser (Bool -> DatabaseName -> DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser PersistenceStrategy parsePersistenceStrategy Parser (Bool -> DatabaseName -> DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) -> Parser Bool -> Parser (DatabaseName -> DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Bool parseCheckFS Parser (DatabaseName -> DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) -> Parser DatabaseName -> Parser (DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser DatabaseName parseDatabaseName Parser (DatabaseName -> Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) -> Parser DatabaseName -> Parser (Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> DatabaseName -> Parser DatabaseName parseHostname (ServerConfig -> DatabaseName bindHost ServerConfig defaults) Parser (Port -> [DatabaseName] -> Int -> Bool -> ServerConfig) -> Parser Port -> Parser ([DatabaseName] -> Int -> Bool -> ServerConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Port -> Parser Port parsePort (ServerConfig -> Port bindPort ServerConfig defaults) Parser ([DatabaseName] -> Int -> Bool -> ServerConfig) -> Parser [DatabaseName] -> Parser (Int -> Bool -> ServerConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser DatabaseName -> Parser [DatabaseName] forall (f :: * -> *) a. Alternative f => f a -> f [a] many Parser DatabaseName parseGhcPkgPath Parser (Int -> Bool -> ServerConfig) -> Parser Int -> Parser (Bool -> ServerConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Int -> Parser Int parseTimeout (ServerConfig -> Int perRequestTimeout ServerConfig defaults) Parser (Bool -> ServerConfig) -> Parser Bool -> Parser ServerConfig forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Bool parseTestMode parsePersistenceStrategy :: Parser PersistenceStrategy parsePersistenceStrategy :: Parser PersistenceStrategy parsePersistenceStrategy = DatabaseName -> PersistenceStrategy CrashSafePersistence (DatabaseName -> PersistenceStrategy) -> Parser DatabaseName -> Parser PersistenceStrategy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Parser DatabaseName dbdirOpt Parser DatabaseName -> Parser Bool -> Parser DatabaseName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Parser Bool fsyncOpt) Parser PersistenceStrategy -> Parser PersistenceStrategy -> Parser PersistenceStrategy forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> DatabaseName -> PersistenceStrategy MinimalPersistence (DatabaseName -> PersistenceStrategy) -> Parser DatabaseName -> Parser PersistenceStrategy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser DatabaseName dbdirOpt Parser PersistenceStrategy -> Parser PersistenceStrategy -> Parser PersistenceStrategy forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> PersistenceStrategy -> Parser PersistenceStrategy forall (f :: * -> *) a. Applicative f => a -> f a pure PersistenceStrategy NoPersistence where dbdirOpt :: Parser DatabaseName dbdirOpt = Mod OptionFields DatabaseName -> Parser DatabaseName forall s. IsString s => Mod OptionFields s -> Parser s strOption (Char -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'd' Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "database-directory" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "DIRECTORY" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> (DatabaseName -> DatabaseName) -> Mod OptionFields DatabaseName forall a (f :: * -> *). (a -> DatabaseName) -> Mod f a showDefaultWith DatabaseName -> DatabaseName forall a. Show a => a -> DatabaseName show ) fsyncOpt :: Parser Bool fsyncOpt = Mod FlagFields Bool -> Parser Bool switch (Char -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'f' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "fsync" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod FlagFields Bool forall (f :: * -> *) a. DatabaseName -> Mod f a help DatabaseName "Fsync all new transactions.") parseTestMode :: Parser Bool parseTestMode :: Parser Bool parseTestMode = Bool -> Bool -> Mod FlagFields Bool -> Parser Bool forall a. a -> a -> Mod FlagFields a -> Parser a flag Bool True Bool False (DatabaseName -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "test-mode" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool forall a. Semigroup a => a -> a -> a <> Mod FlagFields Bool forall (f :: * -> *) a. Mod f a hidden) parseCheckFS :: Parser Bool parseCheckFS :: Parser Bool parseCheckFS = Bool -> Bool -> Mod FlagFields Bool -> Parser Bool forall a. a -> a -> Mod FlagFields a -> Parser a flag Bool True Bool False (DatabaseName -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "disable-fscheck" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod FlagFields Bool forall (f :: * -> *) a. DatabaseName -> Mod f a help DatabaseName "Disable filesystem check for journaling.") parseDatabaseName :: Parser DatabaseName parseDatabaseName :: Parser DatabaseName parseDatabaseName = Mod OptionFields DatabaseName -> Parser DatabaseName forall s. IsString s => Mod OptionFields s -> Parser s strOption (Char -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'n' Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "database" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "DATABASE_NAME") parseHostname :: Hostname -> Parser Hostname parseHostname :: DatabaseName -> Parser DatabaseName parseHostname DatabaseName defHostname = Mod OptionFields DatabaseName -> Parser DatabaseName forall s. IsString s => Mod OptionFields s -> Parser s strOption (Char -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'h' Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "hostname" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "HOST_NAME" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasValue f => a -> Mod f a value DatabaseName defHostname) parsePort :: Port -> Parser Port parsePort :: Port -> Parser Port parsePort Port defPort = ReadM Port -> Mod OptionFields Port -> Parser Port forall a. ReadM a -> Mod OptionFields a -> Parser a option ReadM Port forall a. Read a => ReadM a auto (Char -> Mod OptionFields Port forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'p' Mod OptionFields Port -> Mod OptionFields Port -> Mod OptionFields Port forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields Port forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "port" Mod OptionFields Port -> Mod OptionFields Port -> Mod OptionFields Port forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields Port forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "PORT_NUMBER" Mod OptionFields Port -> Mod OptionFields Port -> Mod OptionFields Port forall a. Semigroup a => a -> a -> a <> Port -> Mod OptionFields Port forall (f :: * -> *) a. HasValue f => a -> Mod f a value Port defPort) parseGhcPkgPath :: Parser String parseGhcPkgPath :: Parser DatabaseName parseGhcPkgPath = Mod OptionFields DatabaseName -> Parser DatabaseName forall s. IsString s => Mod OptionFields s -> Parser s strOption (DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "ghc-pkg-dir" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "GHC_PACKAGE_DIRECTORY") parseTimeout :: Int -> Parser Int parseTimeout :: Int -> Parser Int parseTimeout Int defTimeout = ReadM Int -> Mod OptionFields Int -> Parser Int forall a. ReadM a -> Mod OptionFields a -> Parser a option ReadM Int forall a. Read a => ReadM a auto (DatabaseName -> Mod OptionFields Int forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "timeout" Mod OptionFields Int -> Mod OptionFields Int -> Mod OptionFields Int forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields Int forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "MICROSECONDS" Mod OptionFields Int -> Mod OptionFields Int -> Mod OptionFields Int forall a. Semigroup a => a -> a -> a <> Int -> Mod OptionFields Int 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 = ParserInfo ServerConfig -> IO ServerConfig forall a. ParserInfo a -> IO a execParser (Parser ServerConfig -> InfoMod ServerConfig -> ParserInfo ServerConfig forall a. Parser a -> InfoMod a -> ParserInfo a info (ServerConfig -> Parser ServerConfig parseArgsWithDefaults ServerConfig defaults Parser ServerConfig -> Parser (ServerConfig -> ServerConfig) -> Parser ServerConfig forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b <**> Parser (ServerConfig -> ServerConfig) forall a. Parser (a -> a) helpOption) InfoMod ServerConfig forall m. Monoid m => m idm) parseWSConfigWithDefaults :: ServerConfig -> IO WebsocketServerConfig parseWSConfigWithDefaults :: ServerConfig -> IO WebsocketServerConfig parseWSConfigWithDefaults ServerConfig defaults = ParserInfo WebsocketServerConfig -> IO WebsocketServerConfig forall a. ParserInfo a -> IO a execParser (Parser WebsocketServerConfig -> InfoMod WebsocketServerConfig -> ParserInfo WebsocketServerConfig forall a. Parser a -> InfoMod a -> ParserInfo a info (ServerConfig -> Parser WebsocketServerConfig parseWSArgsWithDefaults ServerConfig defaults Parser WebsocketServerConfig -> Parser (WebsocketServerConfig -> WebsocketServerConfig) -> Parser WebsocketServerConfig forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b <**> Parser (WebsocketServerConfig -> WebsocketServerConfig) forall a. Parser (a -> a) helpOption) InfoMod WebsocketServerConfig forall m. Monoid m => m idm) parseWSArgsWithDefaults :: ServerConfig -> Parser WebsocketServerConfig parseWSArgsWithDefaults :: ServerConfig -> Parser WebsocketServerConfig parseWSArgsWithDefaults ServerConfig defaults = ServerConfig -> Maybe DatabaseName -> Maybe DatabaseName -> WebsocketServerConfig WebsocketServerConfig (ServerConfig -> Maybe DatabaseName -> Maybe DatabaseName -> WebsocketServerConfig) -> Parser ServerConfig -> Parser (Maybe DatabaseName -> Maybe DatabaseName -> WebsocketServerConfig) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ServerConfig -> Parser ServerConfig parseArgsWithDefaults ServerConfig defaults Parser (Maybe DatabaseName -> Maybe DatabaseName -> WebsocketServerConfig) -> Parser (Maybe DatabaseName) -> Parser (Maybe DatabaseName -> WebsocketServerConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser (Maybe DatabaseName) parseTlsCertificatePath Parser (Maybe DatabaseName -> WebsocketServerConfig) -> Parser (Maybe DatabaseName) -> Parser WebsocketServerConfig forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser (Maybe DatabaseName) parseTlsKeyPath parseTlsCertificatePath :: Parser (Maybe String) parseTlsCertificatePath :: Parser (Maybe DatabaseName) parseTlsCertificatePath = Parser DatabaseName -> Parser (Maybe DatabaseName) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Parser DatabaseName -> Parser (Maybe DatabaseName)) -> Parser DatabaseName -> Parser (Maybe DatabaseName) forall a b. (a -> b) -> a -> b $ Mod OptionFields DatabaseName -> Parser DatabaseName forall s. IsString s => Mod OptionFields s -> Parser s strOption (DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "tls-certificate-path" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "TLS_CERTIFICATE_PATH") parseTlsKeyPath :: Parser (Maybe String) parseTlsKeyPath :: Parser (Maybe DatabaseName) parseTlsKeyPath = Parser DatabaseName -> Parser (Maybe DatabaseName) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Parser DatabaseName -> Parser (Maybe DatabaseName)) -> Parser DatabaseName -> Parser (Maybe DatabaseName) forall a b. (a -> b) -> a -> b $ Mod OptionFields DatabaseName -> Parser DatabaseName forall s. IsString s => Mod OptionFields s -> Parser s strOption (DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "tls-key-path" Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName -> Mod OptionFields DatabaseName forall a. Semigroup a => a -> a -> a <> DatabaseName -> Mod OptionFields DatabaseName forall (f :: * -> *) a. HasMetavar f => DatabaseName -> Mod f a metavar DatabaseName "TLS_KEY_PATH") helpOption :: Parser (a -> a) helpOption :: Parser (a -> a) helpOption = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a) forall a. ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a) abortOption ParseError helpText (Mod OptionFields (a -> a) -> Parser (a -> a)) -> Mod OptionFields (a -> a) -> Parser (a -> a) forall a b. (a -> b) -> a -> b $ [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a) forall a. Monoid a => [a] -> a mconcat [ DatabaseName -> Mod OptionFields (a -> a) forall (f :: * -> *) a. HasName f => DatabaseName -> Mod f a long DatabaseName "help" , DatabaseName -> Mod OptionFields (a -> a) forall (f :: * -> *) a. DatabaseName -> Mod f a help DatabaseName "Show this help text" , Mod OptionFields (a -> a) forall (f :: * -> *) a. Mod f a hidden ] where #if MIN_VERSION_optparse_applicative(0,16,0) helpText :: ParseError helpText = Maybe DatabaseName -> ParseError ShowHelpText Maybe DatabaseName forall a. Maybe a Nothing #else helpText = ShowHelpText #endif