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