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

import qualified Attoparsec.Time.Text as AttoparsecTime
import qualified Data.Attoparsec.Text as Attoparsec
import qualified Hasql.Connection as Connection
import Hasql.OptparseApplicative.Prelude
import qualified Hasql.Pool.Config as Pool.Config
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,
      ByteString -> Setting
Pool.Config.staticConnectionSettings (ByteString -> Setting) -> Parser ByteString -> Parser Setting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser ByteString
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
1,
        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
10,
        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 (Integer -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
24 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60)),
        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 (Integer -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
5 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60)),
        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.Settings
connectionSettings :: (String -> String) -> Parser ByteString
connectionSettings String -> String
modifyName =
  ByteString
-> Word16 -> ByteString -> ByteString -> ByteString -> ByteString
Connection.settings
    (ByteString
 -> Word16 -> ByteString -> ByteString -> ByteString -> ByteString)
-> Parser ByteString
-> Parser
     (Word16 -> ByteString -> ByteString -> ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> Parser ByteString
host String -> String
modifyName
    Parser
  (Word16 -> ByteString -> ByteString -> ByteString -> ByteString)
-> Parser Word16
-> Parser (ByteString -> ByteString -> ByteString -> ByteString)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String) -> Parser Word16
port String -> String
modifyName
    Parser (ByteString -> ByteString -> ByteString -> ByteString)
-> Parser ByteString
-> Parser (ByteString -> ByteString -> ByteString)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String) -> Parser ByteString
user String -> String
modifyName
    Parser (ByteString -> ByteString -> ByteString)
-> Parser ByteString -> Parser (ByteString -> ByteString)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String) -> Parser ByteString
password String -> String
modifyName
    Parser (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String) -> Parser ByteString
database String -> String
modifyName

host :: (String -> String) -> Parser ByteString
host :: (String -> String) -> Parser ByteString
host String -> String
modifyName =
  (String -> ByteString) -> Parser String -> Parser ByteString
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser ByteString)
-> Parser String -> Parser ByteString
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 ByteString
user :: (String -> String) -> Parser ByteString
user String -> String
modifyName =
  (String -> ByteString) -> Parser String -> Parser ByteString
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser ByteString)
-> Parser String -> Parser ByteString
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 ByteString
password :: (String -> String) -> Parser ByteString
password String -> String
modifyName =
  (String -> ByteString) -> Parser String -> Parser ByteString
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser ByteString)
-> Parser String -> Parser ByteString
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 ByteString
database :: (String -> String) -> Parser ByteString
database String -> String
modifyName =
  (String -> ByteString) -> Parser String -> Parser ByteString
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
forall a. IsString a => String -> a
fromString
    (Parser String -> Parser ByteString)
-> Parser String -> Parser ByteString
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"
      ]

-- * 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