module Hasql.OptparseApplicative
  ( poolConfig,
    poolSettings,
    connectionSettings,
  )
where

import qualified Attoparsec.Time.Text as AttoparsecTime
import qualified Data.Attoparsec.Text as Attoparsec
import Data.Text (Text)
import qualified Hasql.Connection.Setting as Connection.Setting
import qualified Hasql.Connection.Setting.Connection as Connection.Setting.Connection
import qualified Hasql.Connection.Setting.Connection.Param as Connection.Setting.Connection.Param
import Hasql.OptparseApplicative.Prelude
import qualified Hasql.Pool.Config as Pool.Config
import qualified Hasql.Pool.Config.Defaults as Pool.Config.Defaults
import Options.Applicative

-- * Pool

-- | Given a function, which updates the long names, produces a parser of
-- a compiled config.
poolConfig ::
  -- | Option long name modifier.
  --
  -- You can use this function to prefix the name or you can just specify 'id',
  -- if you don't want it changed.
  (String -> String) ->
  Parser Pool.Config.Config
poolConfig :: (String -> String) -> Parser Config
poolConfig String -> String
modifyName =
  [Setting] -> Config
Pool.Config.settings ([Setting] -> Config) -> Parser [Setting] -> Parser Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser [Setting]
poolSettings String -> String
modifyName

-- | Given a function, which updates the long names, produces a parser of
-- a list of settings, which you can extend upon or override, and compile to 'Pool.Config.Config' on your own.
poolSettings ::
  -- | Option long name modifier.
  --
  -- You can use this function to prefix the name or you can just specify 'id',
  -- if you don't want it changed.
  (String -> String) ->
  Parser [Pool.Config.Setting]
poolSettings :: (String -> String) -> Parser [Setting]
poolSettings String -> String
modifyName =
  [Parser Setting] -> Parser [Setting]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
    [ Int -> Setting
Pool.Config.size (Int -> Setting) -> Parser Int -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser Int
poolSize String -> String
modifyName,
      DiffTime -> Setting
Pool.Config.acquisitionTimeout (DiffTime -> Setting) -> Parser DiffTime -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser DiffTime
acquisitionTimeout String -> String
modifyName,
      DiffTime -> Setting
Pool.Config.agingTimeout (DiffTime -> Setting) -> Parser DiffTime -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser DiffTime
connectionLifetime String -> String
modifyName,
      DiffTime -> Setting
Pool.Config.idlenessTimeout (DiffTime -> Setting) -> Parser DiffTime -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser DiffTime
connectionIdleTime String -> String
modifyName,
      [Setting] -> Setting
Pool.Config.staticConnectionSettings ([Setting] -> Setting) -> Parser [Setting] -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser [Setting]
connectionSettings String -> String
modifyName
    ]

poolSize :: (String -> String) -> Parser Int
poolSize :: (String -> String) -> Parser Int
poolSize String -> String
modifyName =
  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] -> Mod OptionFields Int)
-> [Mod OptionFields Int]
-> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
    ([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
modifyName String
"pool-size"),
        Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
Pool.Config.Defaults.size,
        Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Amount of connections in the pool"
      ]

acquisitionTimeout :: (String -> String) -> Parser DiffTime
acquisitionTimeout :: (String -> String) -> Parser DiffTime
acquisitionTimeout String -> String
modifyName =
  Parser DiffTime -> Mod OptionFields DiffTime -> Parser DiffTime
forall a. Parser a -> Mod OptionFields a -> Parser a
attoparsedOption Parser DiffTime
AttoparsecTime.diffTime
    (Mod OptionFields DiffTime -> Parser DiffTime)
-> ([Mod OptionFields DiffTime] -> Mod OptionFields DiffTime)
-> [Mod OptionFields DiffTime]
-> Parser DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Mod OptionFields DiffTime] -> Mod OptionFields DiffTime
forall a. Monoid a => [a] -> a
mconcat
    ([Mod OptionFields DiffTime] -> Parser DiffTime)
-> [Mod OptionFields DiffTime] -> Parser DiffTime
forall a b. (a -> b) -> a -> b
$ [ String -> Mod OptionFields DiffTime
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"pool-acquisition-timeout"),
        DiffTime -> Mod OptionFields DiffTime
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value DiffTime
Pool.Config.Defaults.acquisitionTimeout,
        Mod OptionFields DiffTime
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields DiffTime
forall (f :: * -> *) a. String -> Mod f a
help String
"How long it takes until the attempt to connect is considered timed out"
      ]

connectionLifetime :: (String -> String) -> Parser DiffTime
connectionLifetime :: (String -> String) -> Parser DiffTime
connectionLifetime String -> String
modifyName =
  Parser DiffTime -> Mod OptionFields DiffTime -> Parser DiffTime
forall a. Parser a -> Mod OptionFields a -> Parser a
attoparsedOption Parser DiffTime
AttoparsecTime.diffTime
    (Mod OptionFields DiffTime -> Parser DiffTime)
-> ([Mod OptionFields DiffTime] -> Mod OptionFields DiffTime)
-> [Mod OptionFields DiffTime]
-> Parser DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Mod OptionFields DiffTime] -> Mod OptionFields DiffTime
forall a. Monoid a => [a] -> a
mconcat
    ([Mod OptionFields DiffTime] -> Parser DiffTime)
-> [Mod OptionFields DiffTime] -> Parser DiffTime
forall a b. (a -> b) -> a -> b
$ [ String -> Mod OptionFields DiffTime
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"pool-connection-lifetime"),
        DiffTime -> Mod OptionFields DiffTime
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value DiffTime
Pool.Config.Defaults.agingTimeout,
        Mod OptionFields DiffTime
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields DiffTime
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximal lifetime for connections. Allows to periodically clean up the connection resources to avoid server-side leaks"
      ]

connectionIdleTime :: (String -> String) -> Parser DiffTime
connectionIdleTime :: (String -> String) -> Parser DiffTime
connectionIdleTime String -> String
modifyName =
  Parser DiffTime -> Mod OptionFields DiffTime -> Parser DiffTime
forall a. Parser a -> Mod OptionFields a -> Parser a
attoparsedOption Parser DiffTime
AttoparsecTime.diffTime
    (Mod OptionFields DiffTime -> Parser DiffTime)
-> ([Mod OptionFields DiffTime] -> Mod OptionFields DiffTime)
-> [Mod OptionFields DiffTime]
-> Parser DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Mod OptionFields DiffTime] -> Mod OptionFields DiffTime
forall a. Monoid a => [a] -> a
mconcat
    ([Mod OptionFields DiffTime] -> Parser DiffTime)
-> [Mod OptionFields DiffTime] -> Parser DiffTime
forall a b. (a -> b) -> a -> b
$ [ String -> Mod OptionFields DiffTime
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"pool-connection-idle-time"),
        DiffTime -> Mod OptionFields DiffTime
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value DiffTime
Pool.Config.Defaults.idlenessTimeout,
        Mod OptionFields DiffTime
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields DiffTime
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximal connection idle time"
      ]

-- * Connection

-- | Given a function, which updates the long names produces a parser
-- of @Hasql.Connection.'Connection.Settings'@.
connectionSettings ::
  -- | Option long name modifier.
  --
  -- You can use this function to prefix the name or you can just specify 'id',
  -- if you don't want it changed.
  (String -> String) ->
  Parser [Connection.Setting.Setting]
connectionSettings :: (String -> String) -> Parser [Setting]
connectionSettings String -> String
modifyName =
  [Parser Setting] -> Parser [Setting]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
    [ Connection -> Setting
Connection.Setting.connection
        (Connection -> Setting)
-> ([Param] -> Connection) -> [Param] -> Setting
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Param] -> Connection
Connection.Setting.Connection.params
        ([Param] -> Setting) -> Parser [Param] -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Param] -> Parser [Param]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
          [ Text -> Param
Connection.Setting.Connection.Param.host (Text -> Param) -> Parser Text -> Parser Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser Text
host String -> String
modifyName,
            Word16 -> Param
Connection.Setting.Connection.Param.port (Word16 -> Param) -> Parser Word16 -> Parser Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser Word16
port String -> String
modifyName,
            Text -> Param
Connection.Setting.Connection.Param.user (Text -> Param) -> Parser Text -> Parser Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser Text
user String -> String
modifyName,
            Text -> Param
Connection.Setting.Connection.Param.password (Text -> Param) -> Parser Text -> Parser Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser Text
password String -> String
modifyName,
            Text -> Param
Connection.Setting.Connection.Param.dbname (Text -> Param) -> Parser Text -> Parser Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser Text
database String -> String
modifyName
          ],
      Bool -> Setting
Connection.Setting.usePreparedStatements (Bool -> Setting) -> Parser Bool -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser Bool
usePreparedStatements String -> String
modifyName
    ]

host :: (String -> String) -> Parser Text
host :: (String -> String) -> Parser Text
host String -> String
modifyName =
  (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser Text) -> Parser String -> Parser Text
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
$ [Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"host"),
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"127.0.0.1",
        Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Server host"
      ]

port :: (String -> String) -> Parser Word16
port :: (String -> String) -> Parser Word16
port String -> String
modifyName =
  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
$ [Mod OptionFields Word16] -> Mod OptionFields Word16
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"port"),
        Word16 -> Mod OptionFields Word16
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Word16
5432,
        Mod OptionFields Word16
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields Word16
forall (f :: * -> *) a. String -> Mod f a
help String
"Server port"
      ]

user :: (String -> String) -> Parser Text
user :: (String -> String) -> Parser Text
user String -> String
modifyName =
  (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser Text) -> Parser String -> Parser Text
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
$ [Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"user"),
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"postgres",
        Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Username"
      ]

password :: (String -> String) -> Parser Text
password :: (String -> String) -> Parser Text
password String -> String
modifyName =
  (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser Text) -> Parser String -> Parser Text
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
$ [Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"password"),
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"",
        Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault,
        String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Password"
      ]

database :: (String -> String) -> Parser Text
database :: (String -> String) -> Parser Text
database String -> String
modifyName =
  (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser Text) -> Parser String -> Parser Text
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
$ [Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"database"),
        String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Database name"
      ]

usePreparedStatements :: (String -> String) -> Parser Bool
usePreparedStatements :: (String -> String) -> Parser Bool
usePreparedStatements String -> String
modifyName =
  (Bool -> Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not
    (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
switch
    (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> String
modifyName String
"no-prepared-statements"),
        String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Avoid using prepared statements",
        Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
      ]

-- * Helpers

attoparsedOption :: Attoparsec.Parser a -> Mod OptionFields a -> Parser a
attoparsedOption :: forall a. Parser a -> Mod OptionFields a -> Parser a
attoparsedOption Parser a
parser =
  ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (ReadM a -> Mod OptionFields a -> Parser a)
-> ReadM a -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$ (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String a) -> ReadM a)
-> (String -> Either String a) -> ReadM a
forall a b. (a -> b) -> a -> b
$ Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
Attoparsec.parseOnly (Parser a
parser Parser a -> Parser Text () -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
Attoparsec.endOfInput) (Text -> Either String a)
-> (String -> Text) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a. IsString a => String -> a
fromString