module Hasql.OptparseApplicative where

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


-- |
-- Given a function, which updates the long names produces a parser of @B.'B.Settings'@.
-- 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 B.Settings
poolSettings :: (String -> String) -> Parser Settings
poolSettings String -> String
updatedName =
  (,,) (Int -> NominalDiffTime -> Settings -> Settings)
-> Parser Int -> Parser (NominalDiffTime -> Settings -> Settings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
size Parser (NominalDiffTime -> Settings -> Settings)
-> Parser NominalDiffTime -> Parser (Settings -> Settings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NominalDiffTime
timeout Parser (Settings -> Settings) -> Parser Settings -> Parser Settings
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"
    timeout :: Parser NominalDiffTime
timeout =
      (Integer -> NominalDiffTime)
-> Parser Integer -> Parser NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Parser Integer -> Parser NominalDiffTime)
-> Parser Integer -> Parser NominalDiffTime
forall a b. (a -> b) -> a -> b
$
      ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Integer
forall a. Read a => ReadM a
auto (Mod OptionFields Integer -> Parser Integer)
-> Mod OptionFields Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$
        String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
updatedName String
"pool-timeout") Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<>
        Integer -> Mod OptionFields Integer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Integer
10 Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<>
        Mod OptionFields Integer
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
help String
"Amount of seconds for which the unused connections are kept open"

-- |
-- Given a function, which updates the long names produces a parser of @A.'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"