{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE CPP #-}
module Conferer.FromConfig.Hedis where
import Conferer.FromConfig
import Conferer.Config
import qualified Database.Redis as Redis
import Data.Text (Text, unpack)
import Text.Read (readMaybe)
import Data.Dynamic
instance FromConfig Redis.PortID where
fromConfig :: Key -> Config -> IO PortID
fromConfig = (Text -> Maybe PortID) -> Key -> Config -> IO PortID
forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO a
fetchFromConfigWith (\Text
t -> do
case String -> Maybe PortNumber
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe PortNumber) -> String -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t of
Just PortNumber
n -> PortID -> Maybe PortID
forall (m :: * -> *) a. Monad m => a -> m a
return (PortID -> Maybe PortID) -> PortID -> Maybe PortID
forall a b. (a -> b) -> a -> b
$ PortNumber -> PortID
Redis.PortNumber PortNumber
n
Maybe PortNumber
Nothing -> do
#ifdef mingw32_HOST_OS
Nothing
#else
PortID -> Maybe PortID
forall (m :: * -> *) a. Monad m => a -> m a
return (PortID -> Maybe PortID) -> PortID -> Maybe PortID
forall a b. (a -> b) -> a -> b
$ String -> PortID
Redis.UnixSocket (String -> PortID) -> String -> PortID
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t
#endif
)
deconstructConnInfoToDefaults :: Redis.ConnectInfo -> [(Key, Dynamic)]
deconstructConnInfoToDefaults :: ConnectInfo -> [(Key, Dynamic)]
deconstructConnInfoToDefaults Redis.ConnInfo{Int
Integer
String
Maybe ByteString
Maybe NominalDiffTime
Maybe ClientParams
PortID
NominalDiffTime
connectHost :: ConnectInfo -> String
connectPort :: ConnectInfo -> PortID
connectAuth :: ConnectInfo -> Maybe ByteString
connectDatabase :: ConnectInfo -> Integer
connectMaxConnections :: ConnectInfo -> Int
connectMaxIdleTime :: ConnectInfo -> NominalDiffTime
connectTimeout :: ConnectInfo -> Maybe NominalDiffTime
connectTLSParams :: ConnectInfo -> Maybe ClientParams
connectTLSParams :: Maybe ClientParams
connectTimeout :: Maybe NominalDiffTime
connectMaxIdleTime :: NominalDiffTime
connectMaxConnections :: Int
connectDatabase :: Integer
connectAuth :: Maybe ByteString
connectPort :: PortID
connectHost :: String
..} =
[ (Key
"host", String -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn String
connectHost)
, (Key
"port", PortID -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn PortID
connectPort)
, (Key
"auth", Maybe ByteString -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe ByteString
connectAuth)
, (Key
"database", Integer -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Integer
connectDatabase)
, (Key
"maxConnections", Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Int
connectMaxConnections)
, (Key
"maxIdleTime", NominalDiffTime -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn NominalDiffTime
connectMaxIdleTime)
, (Key
"timeout", Maybe NominalDiffTime -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe NominalDiffTime
connectTimeout)
#if MIN_VERSION_hedis(0,10,2)
, (Key
"tlsParams", Maybe ClientParams -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe ClientParams
connectTLSParams)
#endif
]
instance DefaultConfig Redis.ConnectInfo where
configDef :: ConnectInfo
configDef = ConnectInfo
Redis.defaultConnectInfo
instance FromConfig Redis.ConnectInfo where
fromConfig :: Key -> Config -> IO ConnectInfo
fromConfig Key
key Config
originalConfig = do
Config
firstConfig <- (ConnectInfo -> [(Key, Dynamic)]) -> Key -> Config -> IO Config
forall a.
Typeable a =>
(a -> [(Key, Dynamic)]) -> Key -> Config -> IO Config
addDefaultsAfterDeconstructingToDefaults ConnectInfo -> [(Key, Dynamic)]
deconstructConnInfoToDefaults Key
key Config
originalConfig
#if MIN_VERSION_hedis(0,10,0)
Config
config <-
Key -> Config -> IO (Maybe Text)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig @(Maybe Text) (Key
key Key -> Key -> Key
/. Key
"url") Config
firstConfig
IO (Maybe Text) -> (Maybe Text -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Text
connectionString -> do
case String -> Either String ConnectInfo
Redis.parseConnectInfo (String -> Either String ConnectInfo)
-> String -> Either String ConnectInfo
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
connectionString of
Right Redis.ConnInfo{Int
Integer
String
Maybe ByteString
Maybe NominalDiffTime
Maybe ClientParams
PortID
NominalDiffTime
connectTLSParams :: Maybe ClientParams
connectTimeout :: Maybe NominalDiffTime
connectMaxIdleTime :: NominalDiffTime
connectMaxConnections :: Int
connectDatabase :: Integer
connectAuth :: Maybe ByteString
connectPort :: PortID
connectHost :: String
connectHost :: ConnectInfo -> String
connectPort :: ConnectInfo -> PortID
connectAuth :: ConnectInfo -> Maybe ByteString
connectDatabase :: ConnectInfo -> Integer
connectMaxConnections :: ConnectInfo -> Int
connectMaxIdleTime :: ConnectInfo -> NominalDiffTime
connectTimeout :: ConnectInfo -> Maybe NominalDiffTime
connectTLSParams :: ConnectInfo -> Maybe ClientParams
..} -> do
Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$
Config
firstConfig
Config -> (Config -> Config) -> Config
forall a b. a -> (a -> b) -> b
& [(Key, Dynamic)] -> Config -> Config
addDefaults
[ (Key
key Key -> Key -> Key
/. Key
"host", String -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn String
connectHost)
, (Key
key Key -> Key -> Key
/. Key
"port", PortID -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn PortID
connectPort)
, (Key
key Key -> Key -> Key
/. Key
"auth", Maybe ByteString -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Maybe ByteString
connectAuth)
, (Key
key Key -> Key -> Key
/. Key
"database", Integer -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Integer
connectDatabase)
]
Left String
_e ->
Key -> Text -> IO Config
forall a b. Typeable a => Key -> Text -> IO b
throwConfigParsingError @Redis.ConnectInfo Key
key Text
connectionString
Maybe Text
Nothing -> do
Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
firstConfig
#else
config <- return firstConfig
#endif
String
connectHost <- Key -> Config -> IO String
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"host") Config
config
PortID
connectPort <- Key -> Config -> IO PortID
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"port") Config
config
Maybe ByteString
connectAuth <- Key -> Config -> IO (Maybe ByteString)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"auth") Config
config
Integer
connectDatabase <- Key -> Config -> IO Integer
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"database") Config
config
Int
connectMaxConnections <- Key -> Config -> IO Int
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"maxConnections") Config
config
NominalDiffTime
connectMaxIdleTime <- Key -> Config -> IO NominalDiffTime
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"maxIdleTime") Config
config
Maybe NominalDiffTime
connectTimeout <- Key -> Config -> IO (Maybe NominalDiffTime)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"timeout") Config
config
#if MIN_VERSION_hedis(0,10,2)
Maybe ClientParams
connectTLSParams <- Key -> Config -> IO (Maybe ClientParams)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig (Key
key Key -> Key -> Key
/. Key
"tlsParams") Config
config
#endif
ConnectInfo -> IO ConnectInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnInfo :: String
-> PortID
-> Maybe ByteString
-> Integer
-> Int
-> NominalDiffTime
-> Maybe NominalDiffTime
-> Maybe ClientParams
-> ConnectInfo
Redis.ConnInfo{Int
Integer
String
Maybe ByteString
Maybe NominalDiffTime
Maybe ClientParams
PortID
NominalDiffTime
connectTLSParams :: Maybe ClientParams
connectTimeout :: Maybe NominalDiffTime
connectMaxIdleTime :: NominalDiffTime
connectMaxConnections :: Int
connectDatabase :: Integer
connectAuth :: Maybe ByteString
connectPort :: PortID
connectHost :: String
connectHost :: String
connectPort :: PortID
connectAuth :: Maybe ByteString
connectDatabase :: Integer
connectMaxConnections :: Int
connectMaxIdleTime :: NominalDiffTime
connectTimeout :: Maybe NominalDiffTime
connectTLSParams :: Maybe ClientParams
..}