{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Database.PSQL.Config
( PSQL (..)
, genPSQLPool
) where
import Data.Aeson (FromJSON, parseJSON, withObject,
(.!=), (.:), (.:?))
import Data.Pool (Pool, createPool)
import Data.Time (NominalDiffTime)
import Database.PostgreSQL.Simple (ConnectInfo (..), Connection,
close, connect, defaultConnectInfo)
import GHC.Word (Word16)
data PSQL = PSQL
{ psqlDBName :: String
, psqlHost :: String
, psqlPort :: Word16
, psqlUser :: String
, psqlPass :: String
, psqlPoolNumStrips :: Int
, psqlPoolIdleTime :: NominalDiffTime
, psqlPoolMaxResources :: Int
, psqlHaxlNumThreads :: Int
}
deriving (Show)
instance FromJSON PSQL where
parseJSON = withObject "PSQL" $ \o -> do
psqlDBName <- o .: "db"
psqlHost <- o .:? "host" .!= "127.0.0.1"
psqlPort <- o .:? "port" .!= 5432
psqlUser <- o .:? "user" .!= "postgre"
psqlPass <- o .:? "pass" .!= ""
psqlPoolNumStrips <- o .:? "numStripes" .!= 1
psqlPoolIdleTime <- o .:? "idleTime" .!= 0.5
psqlPoolMaxResources <- o .:? "maxResources" .!= 1
psqlHaxlNumThreads <- o .:? "numThreads" .!= 1
return PSQL{..}
genPSQLPool :: PSQL -> IO (Pool Connection)
genPSQLPool conf = createPool conn close numStripes idleTime maxResources
where conn = connect defaultConnectInfo
{ connectDatabase = dbName
, connectHost = dbHost
, connectPort = dbPort
, connectUser = dbUser
, connectPassword = dbPass
}
dbName = psqlDBName conf
dbHost = psqlHost conf
dbPort = psqlPort conf
dbUser = psqlUser conf
dbPass = psqlPass conf
numStripes = psqlPoolNumStrips conf
idleTime = psqlPoolIdleTime conf
maxResources = psqlPoolMaxResources conf