diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,4 @@ +# 0.8 + +- Migrated to hasql-pool-1. The option names remained the same. +- Revised the exports, exposing connection settings. diff --git a/hasql-optparse-applicative.cabal b/hasql-optparse-applicative.cabal --- a/hasql-optparse-applicative.cabal +++ b/hasql-optparse-applicative.cabal @@ -1,19 +1,20 @@ -cabal-version: 3.0 -name: hasql-optparse-applicative -version: 0.7.1.3 -synopsis: "optparse-applicative" parsers for "hasql" -category: Hasql, Database, PostgreSQL, Options +cabal-version: 3.0 +name: hasql-optparse-applicative +version: 0.7.2 +synopsis: "optparse-applicative" parsers for "hasql" +category: Hasql, Database, PostgreSQL, Options homepage: https://github.com/nikita-volkov/hasql-optparse-applicative bug-reports: https://github.com/nikita-volkov/hasql-optparse-applicative/issues -author: Nikita Volkov -maintainer: Nikita Volkov -copyright: (c) 2016, Sannsyn AS -license: MIT -license-file: LICENSE +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2016, Sannsyn AS +license: MIT +license-file: LICENSE +extra-source-files: CHANGELOG.md source-repository head type: git @@ -67,6 +68,8 @@ , attoparsec >=0.14 && <0.15 , attoparsec-time >=1.0.3 && <1.1 , base >=4.11 && <5 + , bytestring >=0.10 && <0.13 , hasql >=1.6 && <1.7 - , hasql-pool >=0.10 && <0.11 - , optparse-applicative >=0.17 && <0.19 + , hasql-pool >=1 && <1.1 + , optparse-applicative >=0.18 && <0.19 + , time >=1.10 && <2 diff --git a/library/Hasql/OptparseApplicative.hs b/library/Hasql/OptparseApplicative.hs --- a/library/Hasql/OptparseApplicative.hs +++ b/library/Hasql/OptparseApplicative.hs @@ -1,117 +1,162 @@ module Hasql.OptparseApplicative - ( poolSettings, - attoparsedOption, + ( poolConfig, + poolSettings, + connectionSettings, ) where -import qualified Attoparsec.Time.Text as C -import qualified Data.Attoparsec.Text as D -import qualified Hasql.Connection as A +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 as B +import qualified Hasql.Pool.Config as Pool.Config import Options.Applicative +-- * Pool + -- | 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 updatedName = - B.acquire - <$> size - <*> acquisitionTimeout - <*> connectionLifetime - <*> connectionIdleTime - <*> connectionSettings updatedName - where - size = - option auto - . mconcat - $ [ long (updatedName "pool-size"), - value 1, - showDefault, - help "Amount of connections in the pool" - ] - acquisitionTimeout = - attoparsedOption C.diffTime - . mconcat - $ [ long (updatedName "pool-acquisition-timeout"), - value 10, - showDefault, - help "How long it takes until the attempt to connect is considered timed out" - ] - connectionLifetime = - attoparsedOption C.diffTime - . mconcat - $ [ long (updatedName "pool-connection-lifetime"), - value (fromIntegral (24 * 60 * 60)), - showDefault, - help "Maximal lifetime for connections. Allows to periodically clean up the connection resources to avoid server-side leaks" - ] - connectionIdleTime = - attoparsedOption C.diffTime - . mconcat - $ [ long (updatedName "pool-connection-idle-time"), - value (fromIntegral (5 * 60)), - showDefault, - help "Maximal connection idle time" - ] +-- 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 modifyName = + Pool.Config.settings <$> poolSettings 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 modifyName = + sequenceA + [ Pool.Config.size <$> poolSize modifyName, + Pool.Config.acquisitionTimeout <$> acquisitionTimeout modifyName, + Pool.Config.agingTimeout <$> connectionLifetime modifyName, + Pool.Config.idlenessTimeout <$> connectionIdleTime modifyName, + Pool.Config.staticConnectionSettings <$> connectionSettings modifyName + ] + +poolSize :: (String -> String) -> Parser Int +poolSize modifyName = + option auto + . mconcat + $ [ long (modifyName "pool-size"), + value 1, + showDefault, + help "Amount of connections in the pool" + ] + +acquisitionTimeout :: (String -> String) -> Parser DiffTime +acquisitionTimeout modifyName = + attoparsedOption AttoparsecTime.diffTime + . mconcat + $ [ long (modifyName "pool-acquisition-timeout"), + value 10, + showDefault, + help "How long it takes until the attempt to connect is considered timed out" + ] + +connectionLifetime :: (String -> String) -> Parser DiffTime +connectionLifetime modifyName = + attoparsedOption AttoparsecTime.diffTime + . mconcat + $ [ long (modifyName "pool-connection-lifetime"), + value (fromIntegral (24 * 60 * 60)), + showDefault, + help "Maximal lifetime for connections. Allows to periodically clean up the connection resources to avoid server-side leaks" + ] + +connectionIdleTime :: (String -> String) -> Parser DiffTime +connectionIdleTime modifyName = + attoparsedOption AttoparsecTime.diffTime + . mconcat + $ [ long (modifyName "pool-connection-idle-time"), + value (fromIntegral (5 * 60)), + showDefault, + help "Maximal connection idle time" + ] + +-- * Connection + -- | 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 updatedName = - A.settings <$> host <*> port <*> user <*> password <*> database - where - host = - fmap fromString - $ strOption - $ long (updatedName "host") - <> value "127.0.0.1" - <> showDefault - <> help "Server host" - port = - option auto - $ long (updatedName "port") - <> value 5432 - <> showDefault - <> help "Server port" - user = - fmap fromString - $ strOption - $ long (updatedName "user") - <> value "postgres" - <> showDefault - <> help "Username" - password = - fmap fromString - $ strOption - $ long (updatedName "password") - <> value "" - <> showDefault - <> help "Password" - database = - fmap fromString - $ strOption - $ long (updatedName "database") - <> help "Database name" +-- 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 modifyName = + Connection.settings + <$> host modifyName + <*> port modifyName + <*> user modifyName + <*> password modifyName + <*> database modifyName --- * Helpers +host :: (String -> String) -> Parser ByteString +host modifyName = + fmap fromString + $ strOption + $ mconcat + [ long (modifyName "host"), + value "127.0.0.1", + showDefault, + help "Server host" + ] --- 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 $ +port :: (String -> String) -> Parser Word16 +port modifyName = + option auto + $ mconcat + [ long (modifyName "port"), + value 5432, + showDefault, + help "Server port" + ] -attoparsedOption :: D.Parser a -> Mod OptionFields a -> Parser a +user :: (String -> String) -> Parser ByteString +user modifyName = + fmap fromString + $ strOption + $ mconcat + [ long (modifyName "user"), + value "postgres", + showDefault, + help "Username" + ] + +password :: (String -> String) -> Parser ByteString +password modifyName = + fmap fromString + $ strOption + $ mconcat + [ long (modifyName "password"), + value "", + showDefault, + help "Password" + ] + +database :: (String -> String) -> Parser ByteString +database modifyName = + fmap fromString + $ strOption + $ mconcat + [ long (modifyName "database"), + help "Database name" + ] + +-- * Helpers + +attoparsedOption :: Attoparsec.Parser a -> Mod OptionFields a -> Parser a attoparsedOption parser = - option $ eitherReader $ D.parseOnly (parser <* D.endOfInput) . fromString + option $ eitherReader $ Attoparsec.parseOnly (parser <* Attoparsec.endOfInput) . fromString diff --git a/library/Hasql/OptparseApplicative/Prelude.hs b/library/Hasql/OptparseApplicative/Prelude.hs --- a/library/Hasql/OptparseApplicative/Prelude.hs +++ b/library/Hasql/OptparseApplicative/Prelude.hs @@ -16,6 +16,7 @@ import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports +import Data.ByteString as Exports (ByteString) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports @@ -39,6 +40,7 @@ import Data.Ratio as Exports import Data.STRef as Exports import Data.String as Exports +import Data.Time as Exports import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports