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 -> Maybe Int -> ByteString -> IO Pool
B.acquire forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
size forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
acquisitionTimeout forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String) -> Parser ByteString
connectionSettings String -> String
updatedName
  where
    size :: Parser Int
size =
      forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
        [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"pool-size"),
          forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
1,
          forall a (f :: * -> *). Show a => Mod f a
showDefault,
          forall (f :: * -> *) a. String -> Mod f a
help String
"Amount of connections in the pool"
        ]
    acquisitionTimeout :: Parser (Maybe Int)
acquisitionTimeout =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
* Int
1000000) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
        [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"pool-acquisition-timeout"),
          forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
10,
          forall a (f :: * -> *). Show a => Mod f a
showDefault,
          forall (f :: * -> *) a. String -> Mod f a
help String
"How long it takes until the attempt to connect is considered timed out. In seconds"
        ]

-- | 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 ByteString
connectionSettings String -> String
updatedName =
  ByteString
-> Word16 -> ByteString -> ByteString -> ByteString -> ByteString
A.settings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
host forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
port forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
user forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
password forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
database
  where
    host :: Parser ByteString
host =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
        forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"host")
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"127.0.0.1"
            forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Server host"
    port :: Parser Word16
port =
      forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"port")
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Word16
5432
          forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Server port"
    user :: Parser ByteString
user =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
        forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"user")
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"postgres"
            forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Username"
    password :: Parser ByteString
password =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
        forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"password")
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
""
            forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Password"
    database :: Parser ByteString
database =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
        forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"database")
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Database name"