{-| A postgresql connection options type and related functions. -}

module Database.PostgreSQL.Simple.Options
  ( Options(..)
  , defaultOptions
  , toConnectionString
  , parseConnectionString
  ) where
import Data.Maybe (Maybe, maybeToList)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Data.Monoid.Generic
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Text.Read (readMaybe)
import URI.ByteString as URI
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Monoid
import Control.Monad ((<=<), foldM)
import Control.Applicative

-- | A postgresql connection options type.
data Options = Options
  { Options -> Last String
host                    :: Last String
  , Options -> Last String
hostaddr                :: Last String
  , Options -> Last Int
port                    :: Last Int
  , Options -> Last String
user                    :: Last String
  , Options -> Last String
password                :: Last String
  , Options -> Last String
dbname                  :: Last String
  , Options -> Last Int
connectTimeout          :: Last Int
  , Options -> Last String
clientEncoding          :: Last String
  , Options -> Last String
options                 :: Last String
  , Options -> Last String
fallbackApplicationName :: Last String
  , Options -> Last Int
keepalives              :: Last Int
  , Options -> Last Int
keepalivesIdle          :: Last Int
  , Options -> Last Int
keepalivesCount         :: Last Int
  , Options -> Last String
sslmode                 :: Last String
  , Options -> Last Int
requiressl              :: Last Int
  , Options -> Last Int
sslcompression          :: Last Int
  , Options -> Last String
sslcert                 :: Last String
  , Options -> Last String
sslkey                  :: Last String
  , Options -> Last String
sslrootcert             :: Last String
  , Options -> Last String
requirepeer             :: Last String
  , Options -> Last String
krbsrvname              :: Last String
  , Options -> Last String
gsslib                  :: Last String
  , Options -> Last String
service                 :: Last String
  } deriving stock (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show, Options -> Options -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, ReadPrec [Options]
ReadPrec Options
Int -> ReadS Options
ReadS [Options]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Options]
$creadListPrec :: ReadPrec [Options]
readPrec :: ReadPrec Options
$creadPrec :: ReadPrec Options
readList :: ReadS [Options]
$creadList :: ReadS [Options]
readsPrec :: Int -> ReadS Options
$creadsPrec :: Int -> ReadS Options
Read, Eq Options
Options -> Options -> Bool
Options -> Options -> Ordering
Options -> Options -> Options
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Options -> Options -> Options
$cmin :: Options -> Options -> Options
max :: Options -> Options -> Options
$cmax :: Options -> Options -> Options
>= :: Options -> Options -> Bool
$c>= :: Options -> Options -> Bool
> :: Options -> Options -> Bool
$c> :: Options -> Options -> Bool
<= :: Options -> Options -> Bool
$c<= :: Options -> Options -> Bool
< :: Options -> Options -> Bool
$c< :: Options -> Options -> Bool
compare :: Options -> Options -> Ordering
$ccompare :: Options -> Options -> Ordering
Ord, forall x. Rep Options x -> Options
forall x. Options -> Rep Options x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Options x -> Options
$cfrom :: forall x. Options -> Rep Options x
Generic, Typeable)
    deriving NonEmpty Options -> Options
Options -> Options -> Options
forall b. Integral b => b -> Options -> Options
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Options -> Options
$cstimes :: forall b. Integral b => b -> Options -> Options
sconcat :: NonEmpty Options -> Options
$csconcat :: NonEmpty Options -> Options
<> :: Options -> Options -> Options
$c<> :: Options -> Options -> Options
Semigroup via GenericSemigroup Options
    deriving Semigroup Options
Options
[Options] -> Options
Options -> Options -> Options
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Options] -> Options
$cmconcat :: [Options] -> Options
mappend :: Options -> Options -> Options
$cmappend :: Options -> Options -> Options
mempty :: Options
$cmempty :: Options
Monoid    via GenericMonoid Options

-- | Make a key value postgresql option string.
toConnectionString :: Options -> ByteString
toConnectionString :: Options -> ByteString
toConnectionString Options {Last Int
Last String
service :: Last String
gsslib :: Last String
krbsrvname :: Last String
requirepeer :: Last String
sslrootcert :: Last String
sslkey :: Last String
sslcert :: Last String
sslcompression :: Last Int
requiressl :: Last Int
sslmode :: Last String
keepalivesCount :: Last Int
keepalivesIdle :: Last Int
keepalives :: Last Int
fallbackApplicationName :: Last String
options :: Last String
clientEncoding :: Last String
connectTimeout :: Last Int
dbname :: Last String
password :: Last String
user :: Last String
port :: Last Int
hostaddr :: Last String
host :: Last String
service :: Options -> Last String
gsslib :: Options -> Last String
krbsrvname :: Options -> Last String
requirepeer :: Options -> Last String
sslrootcert :: Options -> Last String
sslkey :: Options -> Last String
sslcert :: Options -> Last String
sslcompression :: Options -> Last Int
requiressl :: Options -> Last Int
sslmode :: Options -> Last String
keepalivesCount :: Options -> Last Int
keepalivesIdle :: Options -> Last Int
keepalives :: Options -> Last Int
fallbackApplicationName :: Options -> Last String
options :: Options -> Last String
clientEncoding :: Options -> Last String
connectTimeout :: Options -> Last Int
dbname :: Options -> Last String
password :: Options -> Last String
user :: Options -> Last String
port :: Options -> Last Int
hostaddr :: Options -> Last String
host :: Options -> Last String
..} = String -> ByteString
BSC.pack forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, String
v) -> String
k forall a. Semigroup a => a -> a -> a
<> String
"=" forall a. Semigroup a => a -> a -> a
<> String
v)
  forall a b. (a -> b) -> a -> b
$  String -> Last String -> [(String, String)]
maybeToPairStr String
"host" Last String
host
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"hostaddr" Last String
hostaddr
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"dbname" Last String
dbname
  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"port" Last Int
port
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"password" Last String
password
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"user" Last String
user
  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"connect_timeout" Last Int
connectTimeout
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"client_encoding" Last String
clientEncoding
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"options" Last String
options
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"fallback_applicationName" Last String
fallbackApplicationName
  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"keepalives" Last Int
keepalives
  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"keepalives_idle" Last Int
keepalivesIdle
  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"keepalives_count" Last Int
keepalivesCount
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslmode" Last String
sslmode
  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"requiressl" Last Int
requiressl
  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"sslcompression" Last Int
sslcompression
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslcert" Last String
sslcert
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslkey" Last String
sslkey
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslrootcert" Last String
sslrootcert
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"requirepeer" Last String
requirepeer
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"krbsrvname" Last String
krbsrvname
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"gsslib" Last String
gsslib
  forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"service" Last String
service
  where
  maybeToPairStr :: String -> Last String -> [(String, String)]
  maybeToPairStr :: String -> Last String -> [(String, String)]
maybeToPairStr String
k Last String
mv = (String
k,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> [a]
maybeToList (forall a. Last a -> Maybe a
getLast Last String
mv)

  maybeToPair :: Show a => String -> Last a -> [(String, String)]
  maybeToPair :: forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
k Last a
mv = (\a
v -> (String
k, forall a. Show a => a -> String
show a
v)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> [a]
maybeToList (forall a. Last a -> Maybe a
getLast Last a
mv)

{-| Default options.

 @
   defaultOptions :: Options
   defaultOptions = mempty
    { host     = pure "localhost"
    , port     = pure 5432
    , user     = pure "postgres"
    , dbname   = pure "postgres"
    }
 @
-}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = forall a. Monoid a => a
mempty
  { host :: Last String
host     = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"localhost"
  , port :: Last Int
port     = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
5432
  , user :: Last String
user     = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"postgres"
  , dbname :: Last String
dbname   = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"postgres"
  }

userInfoToptions :: UserInfo -> Options
userInfoToptions :: UserInfo -> Options
userInfoToptions UserInfo {ByteString
uiUsername :: UserInfo -> ByteString
uiPassword :: UserInfo -> ByteString
uiPassword :: ByteString
uiUsername :: ByteString
..} = forall a. Monoid a => a
mempty { user :: Last String
user = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
uiUsername } forall a. Semigroup a => a -> a -> a
<> if ByteString -> Bool
BS.null ByteString
uiPassword
  then forall a. Monoid a => a
mempty
  else forall a. Monoid a => a
mempty { password :: Last String
password = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
uiPassword }

authorityToOptions :: Authority -> Options
authorityToOptions :: Authority -> Options
authorityToOptions Authority {Maybe Port
Maybe UserInfo
Host
authorityUserInfo :: Authority -> Maybe UserInfo
authorityHost :: Authority -> Host
authorityPort :: Authority -> Maybe Port
authorityPort :: Maybe Port
authorityHost :: Host
authorityUserInfo :: Maybe UserInfo
..} = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty UserInfo -> Options
userInfoToptions Maybe UserInfo
authorityUserInfo forall a. Semigroup a => a -> a -> a
<>
  forall a. Monoid a => a
mempty { host :: Last String
host = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack forall a b. (a -> b) -> a -> b
$ Host -> ByteString
hostBS Host
authorityHost } forall a. Semigroup a => a -> a -> a
<>
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Port
p -> forall a. Monoid a => a
mempty { port :: Last Int
port = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Port -> Int
portNumber Port
p }) Maybe Port
authorityPort

pathToptions :: ByteString -> Options
pathToptions :: ByteString -> Options
pathToptions ByteString
path = case forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
path of
  String
"" -> forall a. Monoid a => a
mempty
  String
x  -> forall a. Monoid a => a
mempty {dbname :: Last String
dbname = forall (m :: * -> *) a. Monad m => a -> m a
return String
x }

parseInt :: String -> String -> Either String Int
parseInt :: String -> String -> Either String Int
parseInt String
msg String
v = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left (String
msg forall a. Semigroup a => a -> a -> a
<> String
" value of: " forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
" is not a number")) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
      forall a. Read a => String -> Maybe a
readMaybe String
v

parseString :: String -> Maybe String
parseString :: String -> Maybe String
parseString String
x = forall a. Read a => String -> Maybe a
readMaybe String
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
unSingleQuote String
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just String
x

unSingleQuote :: String -> Maybe String
unSingleQuote :: String -> Maybe String
unSingleQuote (Char
x : xs :: String
xs@(Char
_ : String
_))
  | Char
x forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
&& forall a. [a] -> a
last String
xs forall a. Eq a => a -> a -> Bool
== Char
'\'' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init String
xs
  | Bool
otherwise                    = forall a. Maybe a
Nothing
unSingleQuote String
_                  = forall a. Maybe a
Nothing

keywordToptions :: String -> String -> Either String Options
keywordToptions :: String -> String -> Either String Options
keywordToptions String
k String
v = case String
k of
  String
"host" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { host :: Last String
host = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"hostaddress" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { hostaddr :: Last String
hostaddr = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"port" -> do
    Int
portValue <- String -> String -> Either String Int
parseInt String
"port" String
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { port :: Last Int
port = forall (m :: * -> *) a. Monad m => a -> m a
return Int
portValue }
  String
"user" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { user :: Last String
user = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"password" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { password :: Last String
password = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"dbname" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { dbname :: Last String
dbname = forall (m :: * -> *) a. Monad m => a -> m a
return String
v}
  String
"connect_timeout" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"connect_timeout" String
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { connectTimeout :: Last Int
connectTimeout = forall (m :: * -> *) a. Monad m => a -> m a
return Int
x }
  String
"client_encoding" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { clientEncoding :: Last String
clientEncoding = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"options" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { options :: Last String
options = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"fallback_applicationName" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { fallbackApplicationName :: Last String
fallbackApplicationName = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"keepalives" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"keepalives" String
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { keepalives :: Last Int
keepalives = forall (m :: * -> *) a. Monad m => a -> m a
return Int
x }
  String
"keepalives_idle" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"keepalives_idle" String
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { keepalivesIdle :: Last Int
keepalivesIdle = forall (m :: * -> *) a. Monad m => a -> m a
return Int
x }
  String
"keepalives_count" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"keepalives_count" String
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { keepalivesCount :: Last Int
keepalivesCount = forall (m :: * -> *) a. Monad m => a -> m a
return Int
x }
  String
"sslmode" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslmode :: Last String
sslmode = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"requiressl" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"requiressl" String
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { requiressl :: Last Int
requiressl = forall (m :: * -> *) a. Monad m => a -> m a
return Int
x }
  String
"sslcompression" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"sslcompression" String
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslcompression :: Last Int
sslcompression = forall (m :: * -> *) a. Monad m => a -> m a
return Int
x }
  String
"sslcert" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslcert :: Last String
sslcert = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"sslkey" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslkey :: Last String
sslkey = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"sslrootcert" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslrootcert :: Last String
sslrootcert = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"requirepeer" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { requirepeer :: Last String
requirepeer = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"krbsrvname" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { krbsrvname :: Last String
krbsrvname = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"gsslib" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { gsslib :: Last String
gsslib = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }
  String
"service" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { service :: Last String
service = forall (m :: * -> *) a. Monad m => a -> m a
return String
v }

  String
x -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecongnized option: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
x

queryToptions :: URI.Query -> Either String Options
queryToptions :: Query -> Either String Options
queryToptions Query {[(ByteString, ByteString)]
queryPairs :: Query -> [(ByteString, ByteString)]
queryPairs :: [(ByteString, ByteString)]
..} = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Options
acc (ByteString
k, ByteString
v) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend Options
acc) forall a b. (a -> b) -> a -> b
$ String -> String -> Either String Options
keywordToptions (ByteString -> String
BSC.unpack ByteString
k) forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
v) forall a. Monoid a => a
mempty [(ByteString, ByteString)]
queryPairs

uriToptions :: URIRef Absolute -> Either String Options
uriToptions :: URIRef Absolute -> Either String Options
uriToptions URI {Maybe ByteString
Maybe Authority
ByteString
Scheme
Query
uriScheme :: URIRef Absolute -> Scheme
uriAuthority :: URIRef Absolute -> Maybe Authority
uriPath :: URIRef Absolute -> ByteString
uriQuery :: URIRef Absolute -> Query
uriFragment :: URIRef Absolute -> Maybe ByteString
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
..} = case Scheme -> ByteString
schemeBS Scheme
uriScheme of
  ByteString
"postgresql" -> do
    Options
queryParts <- Query -> Either String Options
queryToptions Query
uriQuery
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Authority -> Options
authorityToOptions Maybe Authority
uriAuthority forall a. Semigroup a => a -> a -> a
<>
      ByteString -> Options
pathToptions ByteString
uriPath forall a. Semigroup a => a -> a -> a
<> Options
queryParts

  ByteString
x -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Wrong protocol. Expected \"postgresql\" but got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
x

parseURIStr :: String -> Either String (URIRef Absolute)
parseURIStr :: String -> Either String (URIRef Absolute)
parseURIStr = forall {t} {a} {b}. (t -> a) -> Either t b -> Either a b
left forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack where
  left :: (t -> a) -> Either t b -> Either a b
left t -> a
f = \case
    Left t
x -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ t -> a
f t
x
    Right b
x -> forall a b. b -> Either a b
Right b
x

parseKeywords :: String -> Either String Options
parseKeywords :: String -> Either String Options
parseKeywords [] = forall a b. a -> Either a b
Left String
"Failed to parse keywords"
parseKeywords String
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Either String Options
keywordToptions forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [String] -> Either String (String, String)
toTuple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"=") forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
x where
  toTuple :: [String] -> Either String (String, String)
toTuple [String
k, String
v] = forall (m :: * -> *) a. Monad m => a -> m a
return (String
k, String
v)
  toTuple [String]
xs = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"invalid opts:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. [a] -> [[a]] -> [a]
intercalate String
"=" [String]
xs)

-- | Parse a connection string. Can be in URI or keyword format.
parseConnectionString :: String -> Either String Options
parseConnectionString :: String -> Either String Options
parseConnectionString String
url = do
  String
url' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"failed to parse as string") forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> Maybe String
parseString String
url
  forall {a} {b}. Either a b -> Either a b -> Either a b
or (String -> Either String Options
parseKeywords String
url') (URIRef Absolute -> Either String Options
uriToptions forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Either String (URIRef Absolute)
parseURIStr String
url')
  where
    or :: Either a b -> Either a b -> Either a b
or (Left a
_) Either a b
n = Either a b
n
    or Either a b
m        Either a b
_ = Either a b
m