{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Structured model of PostgreSQL connection string, with a DSL for construction, access, parsing and rendering.
--
-- It supports both the URI format (@postgresql:\/\/@ and @postgres:\/\/@) and the keyword\/value format
-- as specified in the PostgreSQL documentation:
-- <https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING>
--
-- = Usage
--
-- == Parsing Connection Strings
--
-- Parse a connection string from 'Text', validate it and access its components:
--
-- >>> toDbname <$> parse "postgresql://user:password@localhost:5432/mydb"
-- Right (Just "mydb")
--
-- Or use its 'IsString' instance for convenience (ignoring parse errors):
--
-- >>> toDbname "postgresql://user:password@localhost:5432/mydb"
-- Just "mydb"
--
-- == Constructing Connection Strings
--
-- Build connection strings using the 'Semigroup' instance and constructor functions:
--
-- >>> let connStr = mconcat [user "myuser", password "secret", hostAndPort "localhost" 5432, dbname "mydb"]
-- >>> toUrl connStr :: Text
-- "postgresql://myuser:secret@localhost:5432/mydb"
--
-- == Converting Between Formats
--
-- Convert to URI format:
--
-- >>> toUrl "host=localhost port=5432 user=user password=password dbname=mydb"
-- "postgresql://user:password@localhost:5432/mydb"
--
-- Convert to keyword\/value format (for use with libpq's PQconnectdb):
--
-- >>> toKeyValueString "postgresql://user:password@localhost:5432/mydb"
-- "host=localhost port=5432 user=user password=password dbname=mydb"
--
-- Note that these examples use the 'IsString' instance for brevity.
module PostgresqlConnectionString
  ( -- * Data Types
    ConnectionString,

    -- * Parsing
    parse,
    megaparsecOf,
    Parsers.fromKeyValueParams,

    -- * Rendering
    toUrl,
    toKeyValueString,

    -- * Accessors
    toHosts,
    toUser,
    toPassword,
    toDbname,
    toParams,

    -- * Transformations
    interceptParam,

    -- * Constructors
    host,
    hostAndPort,
    user,
    password,
    dbname,
    param,
  )
where

import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified PercentEncoding
import Platform.Prelude
import qualified PostgresqlConnectionString.Parsers as Parsers
import PostgresqlConnectionString.Types
import qualified Text.Megaparsec as Megaparsec
import qualified TextBuilder

instance IsString ConnectionString where
  fromString :: String -> ConnectionString
fromString =
    (Text -> ConnectionString)
-> (ConnectionString -> ConnectionString)
-> Either Text ConnectionString
-> ConnectionString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> ConnectionString
forall {a} {b}. Monoid a => b -> a
fromError ConnectionString -> ConnectionString
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Either Text ConnectionString -> ConnectionString)
-> (String -> Either Text ConnectionString)
-> String
-> ConnectionString
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
. Text -> Either Text ConnectionString
parse (Text -> Either Text ConnectionString)
-> (String -> Text) -> String -> Either Text ConnectionString
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
    where
      fromError :: b -> a
fromError = a -> b -> a
forall a b. a -> b -> a
const a
forall a. Monoid a => a
mempty

instance Show ConnectionString where
  showsPrec :: Int -> ConnectionString -> ShowS
showsPrec Int
d = Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (Text -> ShowS)
-> (ConnectionString -> Text) -> ConnectionString -> ShowS
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
. ConnectionString -> Text
toUrl

-- * Accessors

-- | Extract the list of hosts and their optional ports from a connection string.
--
-- Each tuple contains a host (domain name or IP address) and an optional port number.
-- If no port is specified, 'Nothing' is returned for that host.
--
-- Examples:
--
-- >>> toHosts (hostAndPort "localhost" 5432)
-- [("localhost", Just 5432)]
--
-- >>> toHosts (mconcat [host "host1", hostAndPort "host2" 5433])
-- [("host1", Nothing), ("host2", Just 5433)]
toHosts :: ConnectionString -> [(Text, Maybe Word16)]
toHosts :: ConnectionString -> [(Text, Maybe Word16)]
toHosts (ConnectionString Maybe Text
_ Maybe Text
_ [Host]
hostspec Maybe Text
_ Map Text Text
_) =
  (Host -> (Text, Maybe Word16)) -> [Host] -> [(Text, Maybe Word16)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Host Text
host Maybe Word16
port) -> (Text
host, Maybe Word16
port)) [Host]
hostspec

-- | Extract the username from a connection string, if present.
--
-- Examples:
--
-- >>> toUser (user "myuser")
-- Just "myuser"
--
-- >>> toUser mempty
-- Nothing
toUser :: ConnectionString -> Maybe Text
toUser :: ConnectionString -> Maybe Text
toUser (ConnectionString Maybe Text
user Maybe Text
_ [Host]
_ Maybe Text
_ Map Text Text
_) = Maybe Text
user

-- | Extract the password from a connection string, if present.
--
-- Examples:
--
-- >>> toPassword (password "secret")
-- Just "secret"
--
-- >>> toPassword mempty
-- Nothing
toPassword :: ConnectionString -> Maybe Text
toPassword :: ConnectionString -> Maybe Text
toPassword (ConnectionString Maybe Text
_ Maybe Text
password [Host]
_ Maybe Text
_ Map Text Text
_) = Maybe Text
password

-- | Extract the database name from a connection string, if present.
--
-- Examples:
--
-- >>> toDbname (dbname "mydb")
-- Just "mydb"
--
-- >>> toDbname mempty
-- Nothing
toDbname :: ConnectionString -> Maybe Text
toDbname :: ConnectionString -> Maybe Text
toDbname (ConnectionString Maybe Text
_ Maybe Text
_ [Host]
_ Maybe Text
dbname Map Text Text
_) = Maybe Text
dbname

-- | Extract the connection parameters as a 'Map' of key-value pairs.
--
-- These correspond to the query string parameters in the URI format,
-- or additional connection parameters in the keyword\/value format.
--
-- Examples:
--
-- >>> toParams (param "application_name" "myapp")
-- fromList [("application_name","myapp")]
--
-- >>> toParams (mconcat [param "connect_timeout" "10", param "application_name" "myapp"])
-- fromList [("application_name","myapp"),("connect_timeout","10")]
toParams :: ConnectionString -> Map.Map Text Text
toParams :: ConnectionString -> Map Text Text
toParams (ConnectionString Maybe Text
_ Maybe Text
_ [Host]
_ Maybe Text
_ Map Text Text
paramspec) = Map Text Text
paramspec

-- | Convert a connection string to the PostgreSQL URI format.
--
-- This produces a connection string in the form:
--
-- @
-- postgresql:\/\/[userspec\@][hostspec][\/dbname][?paramspec]
-- @
--
-- where:
--
-- * @userspec@ is @user[:password]@
-- * @hostspec@ is a comma-separated list of @host[:port]@ specifications
-- * @dbname@ is the database name
-- * @paramspec@ is a query string of connection parameters
--
-- All components are percent-encoded as necessary.
--
-- Examples:
--
-- >>> toUrl (mconcat [user "myuser", hostAndPort "localhost" 5432, dbname "mydb"])
-- "postgresql://myuser@localhost:5432/mydb"
--
-- >>> toUrl (mconcat [user "user", password "secret", host "localhost"])
-- "postgresql://user:secret@localhost"
--
-- >>> toUrl (mconcat [hostAndPort "host1" 5432, hostAndPort "host2" 5433, dbname "mydb"])
-- "postgresql://host1:5432,host2:5433/mydb"
toUrl :: ConnectionString -> Text
toUrl :: ConnectionString -> Text
toUrl = TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text)
-> (ConnectionString -> TextBuilder) -> ConnectionString -> Text
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
. ConnectionString -> TextBuilder
renderConnectionString
  where
    renderConnectionString :: ConnectionString -> TextBuilder
renderConnectionString (ConnectionString Maybe Text
user Maybe Text
password [Host]
hostspec Maybe Text
dbname Map Text Text
paramspec) =
      -- postgresql://[userspec@][hostspec][/dbname][?paramspec]
      [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
        [ TextBuilder
"postgresql://",
          Maybe Text -> Maybe Text -> TextBuilder
forall {t :: * -> *}.
Foldable t =>
Maybe Text -> t Text -> TextBuilder
renderUserspec Maybe Text
user Maybe Text
password,
          TextBuilder -> (Host -> TextBuilder) -> [Host] -> TextBuilder
forall (f :: * -> *) a.
Foldable f =>
TextBuilder -> (a -> TextBuilder) -> f a -> TextBuilder
TextBuilder.intercalateMap TextBuilder
"," Host -> TextBuilder
renderHost [Host]
hostspec,
          (Text -> TextBuilder) -> Maybe Text -> TextBuilder
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TextBuilder -> TextBuilder -> TextBuilder
forall a. Monoid a => a -> a -> a
mappend TextBuilder
"/" (TextBuilder -> TextBuilder)
-> (Text -> TextBuilder) -> Text -> TextBuilder
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
. Text -> TextBuilder
PercentEncoding.encodeText) Maybe Text
dbname,
          Map Text Text -> TextBuilder
renderParamspec Map Text Text
paramspec
        ]

    renderUserspec :: Maybe Text -> t Text -> TextBuilder
renderUserspec Maybe Text
user t Text
password =
      case Maybe Text
user of
        Maybe Text
Nothing -> TextBuilder
forall a. Monoid a => a
mempty
        Just Text
user ->
          [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
            [ Text -> TextBuilder
PercentEncoding.encodeText Text
user,
              (Text -> TextBuilder) -> t Text -> TextBuilder
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TextBuilder -> TextBuilder -> TextBuilder
forall a. Monoid a => a -> a -> a
mappend TextBuilder
":" (TextBuilder -> TextBuilder)
-> (Text -> TextBuilder) -> Text -> TextBuilder
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
. Text -> TextBuilder
PercentEncoding.encodeText) t Text
password,
              TextBuilder
"@"
            ]

    renderHost :: Host -> TextBuilder
renderHost (Host Text
host Maybe Word16
port) =
      [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
        [ Text -> TextBuilder
PercentEncoding.encodeText Text
host,
          (Word16 -> TextBuilder) -> Maybe Word16 -> TextBuilder
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word16 -> TextBuilder
forall {a}. Integral a => a -> TextBuilder
renderPort Maybe Word16
port
        ]

    renderPort :: a -> TextBuilder
renderPort a
port =
      [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
        [ TextBuilder
":",
          a -> TextBuilder
forall {a}. Integral a => a -> TextBuilder
TextBuilder.decimal a
port
        ]

    renderParamspec :: Map Text Text -> TextBuilder
renderParamspec Map Text Text
paramspec =
      case Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
paramspec of
        [] -> TextBuilder
forall a. Monoid a => a
mempty
        [(Text, Text)]
list ->
          [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
            [ TextBuilder
"?",
              TextBuilder
-> ((Text, Text) -> TextBuilder) -> [(Text, Text)] -> TextBuilder
forall (f :: * -> *) a.
Foldable f =>
TextBuilder -> (a -> TextBuilder) -> f a -> TextBuilder
TextBuilder.intercalateMap TextBuilder
"&" (Text, Text) -> TextBuilder
renderParam [(Text, Text)]
list
            ]

    renderParam :: (Text, Text) -> TextBuilder
renderParam (Text
key, Text
value) =
      [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
        [ Text -> TextBuilder
PercentEncoding.encodeText Text
key,
          TextBuilder
"=",
          Text -> TextBuilder
PercentEncoding.encodeText Text
value
        ]

-- | Convert a connection string to the PostgreSQL keyword/value format.
--
-- The keyword/value format is a space-separated list of key=value pairs.
-- Values containing spaces, quotes, backslashes, or equals signs are automatically
-- quoted with single quotes, and backslashes and single quotes within values are
-- escaped with backslashes.
--
-- Note: Only the first host from the hostspec is included, as the keyword/value
-- format does not support multiple hosts in the same way as the URI format.
--
-- Examples:
--
-- >>> toKeyValueString (mconcat [hostAndPort "localhost" 5432, user "postgres"])
-- "host=localhost port=5432 user=postgres"
--
-- >>> toKeyValueString (password "secret pass")
-- "password='secret pass'"
--
-- >>> toKeyValueString (password "it's a secret")
-- "password='it\\'s a secret'"
toKeyValueString :: ConnectionString -> Text
toKeyValueString :: ConnectionString -> Text
toKeyValueString (ConnectionString Maybe Text
user Maybe Text
password [Host]
hostspec Maybe Text
dbname Map Text Text
paramspec) =
  (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text)
-> ([TextBuilder] -> TextBuilder) -> [TextBuilder] -> Text
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
. TextBuilder
-> (TextBuilder -> TextBuilder) -> [TextBuilder] -> TextBuilder
forall (f :: * -> *) a.
Foldable f =>
TextBuilder -> (a -> TextBuilder) -> f a -> TextBuilder
TextBuilder.intercalateMap TextBuilder
" " TextBuilder -> TextBuilder
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
    ( [Maybe TextBuilder] -> [TextBuilder]
forall a. [Maybe a] -> [a]
catMaybes
        [ (Host -> TextBuilder) -> Maybe Host -> Maybe TextBuilder
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Host
h -> Text -> TextBuilder -> TextBuilder
renderKeyValue Text
"host" (Host -> TextBuilder
renderHostForKeyValue Host
h)) ([Host] -> Maybe Host
forall a. [a] -> Maybe a
listToMaybe [Host]
hostspec),
          (Word16 -> TextBuilder) -> Maybe Word16 -> Maybe TextBuilder
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word16
p -> Text -> TextBuilder -> TextBuilder
renderKeyValue Text
"port" (Word16 -> TextBuilder
forall {a}. Integral a => a -> TextBuilder
TextBuilder.decimal Word16
p)) ([Host] -> Maybe Host
forall a. [a] -> Maybe a
listToMaybe [Host]
hostspec Maybe Host -> (Host -> Maybe Word16) -> Maybe Word16
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Host Text
_ Maybe Word16
p) -> Maybe Word16
p),
          (Text -> TextBuilder) -> Maybe Text -> Maybe TextBuilder
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> TextBuilder -> TextBuilder
renderKeyValue Text
"user" (TextBuilder -> TextBuilder)
-> (Text -> TextBuilder) -> Text -> TextBuilder
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
. Text -> TextBuilder
TextBuilder.text) Maybe Text
user,
          (Text -> TextBuilder) -> Maybe Text -> Maybe TextBuilder
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> TextBuilder -> TextBuilder
renderKeyValue Text
"password" (TextBuilder -> TextBuilder)
-> (Text -> TextBuilder) -> Text -> TextBuilder
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
. Text -> TextBuilder
TextBuilder.text) Maybe Text
password,
          (Text -> TextBuilder) -> Maybe Text -> Maybe TextBuilder
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> TextBuilder -> TextBuilder
renderKeyValue Text
"dbname" (TextBuilder -> TextBuilder)
-> (Text -> TextBuilder) -> Text -> TextBuilder
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
. Text -> TextBuilder
TextBuilder.text) Maybe Text
dbname
        ]
        [TextBuilder] -> [TextBuilder] -> [TextBuilder]
forall a. Semigroup a => a -> a -> a
<> ((Text, Text) -> TextBuilder) -> [(Text, Text)] -> [TextBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> Text -> TextBuilder -> TextBuilder
renderKeyValue Text
k (Text -> TextBuilder
TextBuilder.text Text
v)) (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
paramspec)
    )
  where
    renderHostForKeyValue :: Host -> TextBuilder
renderHostForKeyValue (Host Text
host Maybe Word16
_) = Text -> TextBuilder
TextBuilder.text Text
host

    renderKeyValue :: Text -> TextBuilder -> TextBuilder
renderKeyValue Text
key TextBuilder
value =
      [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
        [ Text -> TextBuilder
TextBuilder.text Text
key,
          TextBuilder
"=",
          TextBuilder -> TextBuilder
escapeValue TextBuilder
value
        ]

    -- Escape values according to the keyword/value format rules
    escapeValue :: TextBuilder -> TextBuilder
    escapeValue :: TextBuilder -> TextBuilder
escapeValue TextBuilder
valueBuilder =
      let value :: Text
value = TextBuilder -> Text
TextBuilder.toText TextBuilder
valueBuilder
       in if Text -> Bool
needsQuoting Text
value
            then [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat [TextBuilder
"'", Text -> TextBuilder
TextBuilder.text (Text -> Text
escapeForQuoted Text
value), TextBuilder
"'"]
            else Text -> TextBuilder
TextBuilder.text Text
value

    -- Check if a value needs quoting
    needsQuoting :: Text -> Bool
    needsQuoting :: Text -> Bool
needsQuoting Text
value =
      Text -> Bool
Text.null Text
value
        Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
Text.any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
value

    -- Escape backslashes and single quotes for quoted values
    escapeForQuoted :: Text -> Text
    escapeForQuoted :: Text -> Text
escapeForQuoted = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
escapeChar
      where
        escapeChar :: Char -> Text
escapeChar Char
'\\' = Text
"\\\\"
        escapeChar Char
'\'' = Text
"\\'"
        escapeChar Char
c = Char -> Text
Text.singleton Char
c

-- * Transformations

-- | Extract a parameter by key and remove it from the connection string.
--
-- If the parameter is found, returns 'Just' with a tuple of the parameter's value
-- and the updated connection string (with the parameter removed).
-- If the parameter is not found, returns 'Nothing'.
--
-- This is useful for extracting connection parameters that need special handling
-- before passing the connection string to PostgreSQL.
--
-- Examples:
--
-- >>> let connStr = mconcat [param "application_name" "myapp", param "connect_timeout" "10"]
-- >>> interceptParam "application_name" connStr
-- Just ("myapp", "postgresql://?connect_timeout=10")
--
-- >>> interceptParam "nonexistent" connStr
-- Nothing
interceptParam ::
  -- | The key of the parameter to intercept.
  Text ->
  ConnectionString ->
  Maybe (Text, ConnectionString)
interceptParam :: Text -> ConnectionString -> Maybe (Text, ConnectionString)
interceptParam Text
key (ConnectionString Maybe Text
user Maybe Text
password [Host]
hostspec Maybe Text
dbname Map Text Text
paramspec) =
  let (Maybe Text
foundValue, Map Text Text
updatedParamspec) =
        (Maybe Text -> (Maybe Text, Maybe Text))
-> Text -> Map Text Text -> (Maybe Text, Map Text Text)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF
          ( \case
              Just Text
value -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
value, Maybe Text
forall a. Maybe a
Nothing)
              Maybe Text
Nothing -> (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing)
          )
          Text
key
          Map Text Text
paramspec
   in do
        Text
value <- Maybe Text
foundValue
        pure (Text
value, Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString Maybe Text
user Maybe Text
password [Host]
hostspec Maybe Text
dbname Map Text Text
updatedParamspec)

-- * Parsing

-- | Parse a connection string from 'Text'.
--
-- Supports both URI format and keyword\/value format connection strings:
--
-- URI format examples:
--
-- >>> parse "postgresql://localhost"
-- Right ...
--
-- >>> parse "postgresql://user:password@localhost:5432/mydb"
-- Right ...
--
-- >>> parse "postgres://host1:5432,host2:5433/mydb?connect_timeout=10"
-- Right ...
--
-- Keyword\/value format examples:
--
-- >>> parse "host=localhost port=5432 user=postgres"
-- Right ...
--
-- >>> parse "host=localhost dbname=mydb"
-- Right ...
--
-- Returns 'Left' with an error message if parsing fails:
--
-- >>> parse "invalid://connection"
-- Left ...
--
-- The error message is quite detailed (it is produced by Megaparsec):
--
-- >>> parse "invalid://connection=" & either id (const "") & Data.Text.IO.putStrLn
-- 1:8:
--   |
-- 1 | invalid://connection=
--   |        ^
-- unexpected ':'
-- expecting '=' or Key
parse :: Text -> Either Text ConnectionString
parse :: Text -> Either Text ConnectionString
parse Text
input =
  Parsec Void Text ConnectionString
-> String
-> Text
-> Either (ParseErrorBundle Text Void) ConnectionString
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse Parsec Void Text ConnectionString
megaparsecOf String
"" Text
input
    Either (ParseErrorBundle Text Void) ConnectionString
-> (Either (ParseErrorBundle Text Void) ConnectionString
    -> Either Text ConnectionString)
-> Either Text ConnectionString
forall a b. a -> (a -> b) -> b
& (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) ConnectionString
-> Either Text ConnectionString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
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
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty)

-- | Get the Megaparsec parser of connection strings.
--
-- This allows you to use the connection string parser as part of a larger
-- Megaparsec parser combinator setup.
--
-- The parser accepts both URI format (@postgresql:\/\/@ or @postgres:\/\/@)
-- and keyword\/value format connection strings.
megaparsecOf :: Megaparsec.Parsec Void Text ConnectionString
megaparsecOf :: Parsec Void Text ConnectionString
megaparsecOf = Parsec Void Text ConnectionString
Parsers.getConnectionString

-- * Constructors

-- | Create a connection string with a single host and without specifying a port.
--
-- Multiple hosts can be specified by combining multiple 'host' or 'hostAndPort' values
-- using the 'Semigroup' instance.
--
-- When you need to specify a port, use 'hostAndPort' instead.
--
-- Examples:
--
-- >>> host "localhost"
-- "postgresql://localhost"
host :: Text -> ConnectionString
host :: Text -> ConnectionString
host Text
hostname =
  Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    [Text -> Maybe Word16 -> Host
Host Text
hostname Maybe Word16
forall a. Maybe a
Nothing]
    Maybe Text
forall a. Maybe a
Nothing
    Map Text Text
forall k a. Map k a
Map.empty

-- | Create a connection string with a single host and port.
--
-- Multiple hosts can be specified by combining multiple 'hostAndPort' or 'host' values
-- using the 'Semigroup' instance.
--
-- Examples:
--
-- >>> hostAndPort "localhost" 5432
-- "postgresql://localhost:5432"
--
-- >>> mconcat [hostAndPort "host1" 5432, hostAndPort "host2" 5433]
-- "postgresql://host1:5432,host2:5433"
hostAndPort :: Text -> Word16 -> ConnectionString
hostAndPort :: Text -> Word16 -> ConnectionString
hostAndPort Text
host Word16
port =
  Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    [Text -> Maybe Word16 -> Host
Host Text
host (Word16 -> Maybe Word16
forall a. a -> Maybe a
Just Word16
port)]
    Maybe Text
forall a. Maybe a
Nothing
    Map Text Text
forall k a. Map k a
Map.empty

-- | Create a connection string with a username.
--
-- Examples:
--
-- >>> user "myuser"
-- "postgresql://myuser@"
--
-- >>> mconcat [user "myuser", host "localhost"]
-- "postgresql://myuser@localhost"
user :: Text -> ConnectionString
user :: Text -> ConnectionString
user Text
username =
  Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString
    (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
username)
    Maybe Text
forall a. Maybe a
Nothing
    []
    Maybe Text
forall a. Maybe a
Nothing
    Map Text Text
forall k a. Map k a
Map.empty

-- | Create a connection string with a password.
--
-- Note: Passwords are typically used together with usernames.
--
-- Examples:
--
-- >>> mconcat [user "myuser", password "secret"]
-- "postgresql://myuser:secret@"
--
-- >>> mconcat [user "myuser", password "secret", host "localhost"]
-- "postgresql://myuser:secret@localhost"
password :: Text -> ConnectionString
password :: Text -> ConnectionString
password Text
pwd =
  Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString
    Maybe Text
forall a. Maybe a
Nothing
    (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pwd)
    []
    Maybe Text
forall a. Maybe a
Nothing
    Map Text Text
forall k a. Map k a
Map.empty

-- | Create a connection string with a database name.
--
-- Examples:
--
-- >>> dbname "mydb"
-- "postgresql:///mydb"
--
-- >>> mconcat [host "localhost", dbname "mydb"]
-- "postgresql://localhost/mydb"
dbname :: Text -> ConnectionString
dbname :: Text -> ConnectionString
dbname Text
db =
  Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    []
    (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
db)
    Map Text Text
forall k a. Map k a
Map.empty

-- | Create a connection string with a single connection parameter.
--
-- Connection parameters are arbitrary key-value pairs that configure
-- the PostgreSQL connection. Common parameters include:
--
-- * @application_name@ - Sets the application name
-- * @connect_timeout@ - Connection timeout in seconds
-- * @options@ - Command-line options for the server
-- * @sslmode@ - SSL mode (@disable@, @require@, @verify-ca@, @verify-full@)
--
-- See the PostgreSQL documentation for a complete list:
-- <https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-PARAMKEYWORDS>
--
-- Examples:
--
-- >>> param "application_name" "myapp"
-- "postgresql://?application_name=myapp"
--
-- >>> mconcat [host "localhost", param "connect_timeout" "10"]
-- "postgresql://localhost?connect_timeout=10"
--
-- >>> mconcat [param "application_name" "myapp", param "connect_timeout" "10"]
-- "postgresql://?application_name=myapp&connect_timeout=10"
param :: Text -> Text -> ConnectionString
param :: Text -> Text -> ConnectionString
param Text
key Text
value =
  Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    []
    Maybe Text
forall a. Maybe a
Nothing
    (Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
key Text
value)