{-# OPTIONS_GHC -Wno-unused-do-bind #-}

module PostgresqlConnectionString.Parsers where

import qualified Data.CharSet as CharSet
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified PercentEncoding
import Platform.Prelude hiding (many, some, try)
import qualified PostgresqlConnectionString.Charsets as Charsets
import PostgresqlConnectionString.Types
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer

type P = Parsec Void Text

getConnectionString :: P ConnectionString
getConnectionString :: P ConnectionString
getConnectionString =
  [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ P ConnectionString
getUriConnectionString,
      P ConnectionString
getKeyValueConnectionString
    ]

getUriConnectionString :: P ConnectionString
getUriConnectionString :: P ConnectionString
getUriConnectionString = do
  [ParsecT Void Text Identity (Tokens Text)]
-> ParsecT Void Text Identity (Tokens Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"postgresql://"),
      ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"postgres://")
    ]
  [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ do
        Text
unqualifiedWord <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
getWord
        [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ do
              ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':')
              -- We still don't know if this is user:password@ or host:port
              [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
                [ do
                    -- Empty password: user:@host
                    ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@')
                    let user :: Text
user = Text
unqualifiedWord
                    Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromHostspec (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
user) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") [],
                  do
                    Text
password <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
                      String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Password" ParsecT Void Text Identity Text
getWord ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@'
                    -- Definitely user:password@ pattern
                    let user :: Text
user = Text
unqualifiedWord
                    Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromHostspec (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
user) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
password) [],
                  do
                    Word16
port <- ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity Word16
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
                      Word16
p <- ParsecT Void Text Identity Word16
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT Void Text Identity Word16
-> String -> ParsecT Void Text Identity Word16
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Port"
                      -- Ensure we're followed by valid continuation (not more alphanumeric)
                      ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
                      return Word16
p
                    let host :: Text
host = Text
unqualifiedWord
                    Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueAfterHostspec 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)]
                ],
            do
              ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@')
              -- Definitely user@ pattern
              let user :: Text
user = Text
unqualifiedWord
              Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromHostspec (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
user) Maybe Text
forall a. Maybe a
Nothing [],
            do
              -- Definitely host pattern
              let host :: Text
host = Text
unqualifiedWord
              Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueAfterHostspec Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [Text -> Maybe Word16 -> Host
Host Text
host Maybe Word16
forall a. Maybe a
Nothing]
          ],
      do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/')
        Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromDbname Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [],
      do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?')
        Maybe Text
-> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString
continueFromParams Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [] Maybe Text
forall a. Maybe a
Nothing,
      ConnectionString -> P ConnectionString
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 Map Text Text
forall k a. Map k a
Map.empty)
    ]

getKeyValueConnectionString :: P ConnectionString
getKeyValueConnectionString :: P ConnectionString
getKeyValueConnectionString =
  Map Text Text -> ConnectionString
fromKeyValueParams (Map Text Text -> ConnectionString)
-> ParsecT Void Text Identity (Map Text Text) -> P ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Map Text Text)
getKeyValueParams

fromKeyValueParams :: Map.Map Text Text -> ConnectionString
fromKeyValueParams :: Map Text Text -> ConnectionString
fromKeyValueParams Map Text Text
params =
  -- Extract known connection parameters
  let user :: Maybe Text
user = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"user" Map Text Text
params
      password :: Maybe Text
password = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"password" Map Text Text
params
      dbname :: Maybe Text
dbname = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"dbname" Map Text Text
params
      hostText :: Maybe Text
hostText = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"host" Map Text Text
params
      portText :: Maybe Text
portText = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"port" Map Text Text
params
      -- Remove extracted params from the map
      remainingParams :: Map Text Text
remainingParams =
        ( Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"user"
            (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text 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
. Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"password"
            (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text 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
. Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"dbname"
            (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text 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
. Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"host"
            (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text 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
. Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"port"
        )
          Map Text Text
params

      -- Parse hosts if present - handle comma-separated hosts and ports
      hosts :: [Host]
hosts = case Maybe Text
hostText of
        Maybe Text
Nothing -> []
        Just Text
h ->
          let hostList :: [Text]
hostList = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"," Text
h
              portList :: [Text]
portList = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
",") Maybe Text
portText
              -- Pair up hosts with ports, padding with Nothing if needed
              pairs :: [(Text, Maybe Text)]
pairs = (Text -> Maybe Text -> (Text, Maybe Text))
-> [Text] -> [Maybe Text] -> [(Text, Maybe Text)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
host Maybe Text
mPort -> (Text
host, Maybe Text
mPort)) [Text]
hostList ((Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Text
forall a. a -> Maybe a
Just [Text]
portList [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Maybe Text]
forall a. a -> [a]
repeat Maybe Text
forall a. Maybe a
Nothing)
           in ((Text, Maybe Text) -> Host) -> [(Text, Maybe Text)] -> [Host]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
host, Maybe Text
mPortText) -> Text -> Maybe Word16 -> Host
Host Text
host (Maybe Text
mPortText Maybe Text -> (Text -> 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
>>= Text -> Maybe Word16
parsePort)) [(Text, Maybe Text)]
pairs

  in Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
dbname Map Text Text
remainingParams
  where
    parsePort :: Text -> Maybe Word16
    parsePort :: Text -> Maybe Word16
parsePort Text
t = case ReadS Word16
forall a. Read a => ReadS a
reads (Text -> String
Text.unpack Text
t) of
      [(Word16
n, String
"")] -> Word16 -> Maybe Word16
forall a. a -> Maybe a
Just Word16
n
      [(Word16, String)]
_ -> Maybe Word16
forall a. Maybe a
Nothing

getKeyValueParams :: P (Map.Map Text Text)
getKeyValueParams :: ParsecT Void Text Identity (Map Text Text)
getKeyValueParams = do
  (Text, Text)
firstParam <- ParsecT Void Text Identity (Text, Text)
getKeyValueParam
  [(Text, Text)]
restParams <- ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity [(Text, Text)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many do
    ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
    ParsecT Void Text Identity (Text, Text)
getKeyValueParam
  pure ([(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Text, Text)
firstParam (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
restParams))

getKeyValueParam :: P (Text, Text)
getKeyValueParam :: ParsecT Void Text Identity (Text, Text)
getKeyValueParam = do
  Text
key <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
    ParsecT Void Text Identity Text
getKeyValueKey
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  Text
value <- ParsecT Void Text Identity Text
getKeyValueParamValue
  pure (Text
key, Text
value)

getKeyValueKey :: P Text
getKeyValueKey :: ParsecT Void Text Identity Text
getKeyValueKey =
  Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"Key") \Token Text
c -> Char -> CharSet -> Bool
CharSet.member Char
Token Text
c CharSet
Charsets.keyName

getKeyValueParamValue :: P Text
getKeyValueParamValue :: ParsecT Void Text Identity Text
getKeyValueParamValue =
  -- TODO: Optimize to avoid intermediate String allocation
  [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ do
        -- Quoted value
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'')
        String
chars <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many do
          [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity Char
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
            [ do
                -- Escaped quote
                ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\\'")
                pure Char
'\'',
              do
                -- Escaped backslash
                ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\\\\")
                pure Char
'\\',
              (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\'')
            ]
        Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\''
        pure (String -> Text
forall a. IsString a => String -> a
fromString String
chars),
      -- Unquoted value
      String -> Text
forall a. IsString a => String -> a
fromString (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
    ]

getWord :: P Text
getWord :: ParsecT Void Text Identity Text
getWord = (Char -> Bool) -> ParsecT Void Text Identity Text
PercentEncoding.parser ((Char -> CharSet -> Bool) -> CharSet -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> CharSet -> Bool
CharSet.member CharSet
Charsets.control)

getParamValue :: P Text
getParamValue :: ParsecT Void Text Identity Text
getParamValue = (Char -> Bool) -> ParsecT Void Text Identity Text
PercentEncoding.parser ((Char -> CharSet -> Bool) -> CharSet -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> CharSet -> Bool
CharSet.member CharSet
Charsets.paramControl)

continueAfterHostspec :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueAfterHostspec :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueAfterHostspec Maybe Text
user Maybe Text
password [Host]
hosts = do
  [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/')
        Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromDbname Maybe Text
user Maybe Text
password [Host]
hosts,
      do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?')
        Maybe Text
-> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString
continueFromParams Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
forall a. Maybe a
Nothing,
      do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',')
        Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromHostspec Maybe Text
user Maybe Text
password [Host]
hosts,
      ConnectionString -> P ConnectionString
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
forall a. Maybe a
Nothing Map Text Text
forall k a. Map k a
Map.empty)
    ]

continueFromHostspec :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromHostspec :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromHostspec Maybe Text
user Maybe Text
password [Host]
hosts = do
  -- Check if there's actually a host to parse
  [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/')
        Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromDbname Maybe Text
user Maybe Text
password [Host]
hosts,
      do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?')
        Maybe Text
-> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString
continueFromParams Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
forall a. Maybe a
Nothing,
      do
        -- Parse first host
        Host
firstHost <- ParsecT Void Text Identity Host
getHost

        -- Parse additional hosts (comma-separated)
        [Host]
moreHosts <- ParsecT Void Text Identity Host
-> ParsecT Void Text Identity [Host]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many do
          ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',')
          ParsecT Void Text Identity Host
getHost

        let allHosts :: [Host]
allHosts = [Host]
hosts [Host] -> [Host] -> [Host]
forall a. Semigroup a => a -> a -> a
<> [Host
firstHost] [Host] -> [Host] -> [Host]
forall a. Semigroup a => a -> a -> a
<> [Host]
moreHosts

        [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ do
              ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/')
              Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromDbname Maybe Text
user Maybe Text
password [Host]
allHosts,
            do
              ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?')
              Maybe Text
-> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString
continueFromParams Maybe Text
user Maybe Text
password [Host]
allHosts Maybe Text
forall a. Maybe a
Nothing,
            ConnectionString -> P ConnectionString
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString Maybe Text
user Maybe Text
password [Host]
allHosts Maybe Text
forall a. Maybe a
Nothing Map Text Text
forall k a. Map k a
Map.empty)
          ],
      ConnectionString -> P ConnectionString
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
forall a. Maybe a
Nothing Map Text Text
forall k a. Map k a
Map.empty)
    ]

getHost :: P Host
getHost :: ParsecT Void Text Identity Host
getHost = do
  Text
host <- ParsecT Void Text Identity Text
getWord
  Maybe Word16
port <- ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity (Maybe Word16)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
    -- Try to parse as numeric port
    ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
      Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
    String
-> ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity Word16
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Port" ParsecT Void Text Identity Word16
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Word16
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
  pure (Text -> Maybe Word16 -> Host
Host Text
host Maybe Word16
port)

continueFromDbname :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromDbname :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString
continueFromDbname Maybe Text
user Maybe Text
password [Host]
hosts = do
  Maybe Text
dbname <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
getWord
  [P ConnectionString] -> P ConnectionString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?')
        Maybe Text
-> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString
continueFromParams Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
dbname,
      ConnectionString -> P ConnectionString
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
dbname Map Text Text
forall k a. Map k a
Map.empty)
    ]

continueFromParams :: Maybe Text -> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString
continueFromParams :: Maybe Text
-> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString
continueFromParams Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
dbname = do
  Map Text Text
params <- ParsecT Void Text Identity (Map Text Text)
getParams
  pure (Maybe Text
-> Maybe Text
-> [Host]
-> Maybe Text
-> Map Text Text
-> ConnectionString
ConnectionString Maybe Text
user Maybe Text
password [Host]
hosts Maybe Text
dbname Map Text Text
params)

getParams :: P (Map.Map Text Text)
getParams :: ParsecT Void Text Identity (Map Text Text)
getParams = do
  (Text, Text)
firstParam <- ParsecT Void Text Identity (Text, Text)
getParam
  [(Text, Text)]
restParams <- ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity [(Text, Text)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many do
    Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'&'
    ParsecT Void Text Identity (Text, Text)
getParam
  pure ([(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Text, Text)
firstParam (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
restParams))

getParam :: P (Text, Text)
getParam :: ParsecT Void Text Identity (Text, Text)
getParam = do
  Text
key <- ParsecT Void Text Identity Text
getWord
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  Text
value <- ParsecT Void Text Identity Text
getParamValue
  pure (Text
key, Text
value)