module Hasql.OptparseApplicative
  ( poolSettings,
    attoparsedOption,
  )
where

import qualified Attoparsec.Time.Text as C
import qualified Data.Attoparsec.Text as D
import qualified Hasql.Connection as A
import Hasql.OptparseApplicative.Prelude
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 -> DiffTime -> DiffTime -> DiffTime -> 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 DiffTime
acquisitionTimeout
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DiffTime
connectionLifetime
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DiffTime
connectionIdleTime
    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 DiffTime
acquisitionTimeout =
      forall a. Parser a -> Mod OptionFields a -> Parser a
attoparsedOption Parser DiffTime
C.diffTime 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 DiffTime
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"
        ]
    connectionLifetime :: Parser DiffTime
connectionLifetime =
      forall a. Parser a -> Mod OptionFields a -> Parser a
attoparsedOption Parser DiffTime
C.diffTime 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-connection-lifetime"),
          forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
24 forall a. Num a => a -> a -> a
* Integer
60 forall a. Num a => a -> a -> a
* Integer
60)),
          forall a (f :: * -> *). Show a => Mod f a
showDefault,
          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 :: Parser DiffTime
connectionIdleTime =
      forall a. Parser a -> Mod OptionFields a -> Parser a
attoparsedOption Parser DiffTime
C.diffTime 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-connection-idle-time"),
          forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
5 forall a. Num a => a -> a -> a
* Integer
60)),
          forall a (f :: * -> *). Show a => Mod f a
showDefault,
          forall (f :: * -> *) a. String -> Mod f a
help String
"Maximal connection idle time"
        ]

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

-- * Helpers

-- timeout name def help =
--   attoparsedOption C.diffTime mconcat $
--     [ long name,
--       value def,
--       showDefault,
--       help "How long it takes until the attempt to connect is considered timed out. In seconds"
--     ]
--   where
--     reader = eitherReader $

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