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 -- Runs startWorker as a new thread with SQL connection -- Jumps to check main :: IO () main = do let conn = connect "127.0.0.1" "3306" "ro_main" "hathena" "haskell" pool <- connectionPool conn -- forkIO $ startWorker (SQL pool) 1000 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)