module Main where
import Database.HDBC
import Database.HDBC.ODBC
import Data.Pool
import Control.Concurrent
import Data.Time.Clock (NominalDiffTime)
data SQL = SQL (Pool Connection)
-- The function run at start
-- Jumps to check
main :: IO ()
main = do let conn = connect "127.0.0.1" "3306" "ro_main" "hathena" "haskell"
pool <- connectionPool conn
check (SQL pool)
-- Prints active connections
check :: SQL -> IO ()
check (SQL pool) = do putStr "Active Connections: "
res <- query' pool "show status like 'Threads_conn%'" []
mapM_ (\val->putStrLn $ fromSql $ last val) res
threadDelay 100000
check (SQL pool)
-- Create database resource
-- OPTION=262144 | Disable transactions. Use if the tables aren't using InnoDB
connect :: String -> String -> String -> String -> String -> IO Connection
connect host port database user pass = do
connectODBC $ unwords [ "DRIVER={MySQL ODBC 5.1 Driver};",
"OPTION=262144;",
"SERVER=" ++ host ++ ";",
"PORT=" ++ port ++ ";",
"DATABASE=" ++ database ++ ";",
"USER=" ++ user ++ ";",
"PASSWORD=" ++ pass ]
-- Create database pool
-- Config the connections here
connectionPool :: IO Connection -> IO (Pool Connection)
connectionPool conn = do
let numStripes = 1 :: Int -- Number of connection threads to run
let idleTime = 10 :: NominalDiffTime -- Time until idle connection dies, in seconds
let maxResources = 100 :: Int -- Number of connections per thread
createPool conn disconnect numStripes idleTime maxResources
-- Run a query on the connection
query, query' :: Pool Connection -> String -> [SqlValue] -> IO [[SqlValue]]
query pool query values = withResource pool (\conn->quickQuery conn query values)
query' pool query values = withResource pool (\conn->quickQuery' conn query values)