module Hasql.OptparseApplicative where

import BasePrelude hiding (option)
import qualified Hasql.Connection as A
import qualified Hasql.Pool as B
import Options.Applicative

-- | Given a function, which updates the long names, produces a parser of
-- the @Hasql.Pool.'acquire'@ operation.
--
-- You can use this function to prefix the name or you can just specify 'id',
-- if you don't want it changed.
poolSettings :: (String -> String) -> Parser (IO B.Pool)
poolSettings :: (String -> String) -> Parser (IO Pool)
poolSettings String -> String
updatedName =
  Int -> Settings -> IO Pool
B.acquire (Int -> Settings -> IO Pool)
-> Parser Int -> Parser (Settings -> IO Pool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
size Parser (Settings -> IO Pool) -> Parser Settings -> Parser (IO Pool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String) -> Parser Settings
connectionSettings String -> String
updatedName
  where
    size :: Parser Int
size =
      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 (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
        String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"pool-size")
          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
1
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Amount of connections in the pool"

-- | Given a function, which updates the long names produces a parser
-- of @Hasql.Connection.'A.Settings'@.
--
-- You can use this function to prefix the name or you can just specify 'id',
-- if you don't want it changed.
connectionSettings :: (String -> String) -> Parser A.Settings
connectionSettings :: (String -> String) -> Parser Settings
connectionSettings String -> String
updatedName =
  Settings -> Word16 -> Settings -> Settings -> Settings -> Settings
A.settings (Settings
 -> Word16 -> Settings -> Settings -> Settings -> Settings)
-> Parser Settings
-> Parser (Word16 -> Settings -> Settings -> Settings -> Settings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Settings
host Parser (Word16 -> Settings -> Settings -> Settings -> Settings)
-> Parser Word16
-> Parser (Settings -> Settings -> Settings -> Settings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
port Parser (Settings -> Settings -> Settings -> Settings)
-> Parser Settings -> Parser (Settings -> Settings -> Settings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Settings
user Parser (Settings -> Settings -> Settings)
-> Parser Settings -> Parser (Settings -> Settings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Settings
password Parser (Settings -> Settings) -> Parser Settings -> Parser Settings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Settings
database
  where
    host :: Parser Settings
host =
      (String -> Settings) -> Parser String -> Parser Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Settings
forall a. IsString a => String -> a
fromString (Parser String -> Parser Settings)
-> Parser String -> Parser Settings
forall a b. (a -> b) -> a -> b
$
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
          String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"host")
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"127.0.0.1"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Server host"
    port :: Parser Word16
port =
      ReadM Word16 -> Mod OptionFields Word16 -> Parser Word16
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Word16
forall a. Read a => ReadM a
auto (Mod OptionFields Word16 -> Parser Word16)
-> Mod OptionFields Word16 -> Parser Word16
forall a b. (a -> b) -> a -> b
$
        String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"port")
          Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> Word16 -> Mod OptionFields Word16
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Word16
5432
          Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word16
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word16
forall (f :: * -> *) a. String -> Mod f a
help String
"Server port"
    user :: Parser Settings
user =
      (String -> Settings) -> Parser String -> Parser Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Settings
forall a. IsString a => String -> a
fromString (Parser String -> Parser Settings)
-> Parser String -> Parser Settings
forall a b. (a -> b) -> a -> b
$
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
          String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"user")
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"postgres"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Username"
    password :: Parser Settings
password =
      (String -> Settings) -> Parser String -> Parser Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Settings
forall a. IsString a => String -> a
fromString (Parser String -> Parser Settings)
-> Parser String -> Parser Settings
forall a b. (a -> b) -> a -> b
$
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
          String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"password")
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
""
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Password"
    database :: Parser Settings
database =
      (String -> Settings) -> Parser String -> Parser Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Settings
forall a. IsString a => String -> a
fromString (Parser String -> Parser Settings)
-> Parser String -> Parser Settings
forall a b. (a -> b) -> a -> b
$
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
          String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"database")
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Database name"