module Main where
 
import Database.HDBC
import Database.HDBC.ODBC
import Data.Pool
import Control.Concurrent
import Data.Time.Clock      (NominalDiffTime)
 
-- 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 pool 10
          check pool
          
-- Prints active connections
check :: Pool Connection -> IO ()
check pool = do putStr "Active Connections: "
                res <- query' pool "show status like 'Threads_conn%'" []
                mapM_ (\val->putStrLn $ fromSql $ last val) res
                threadDelay 200000
                check pool
                
-- Starts n workers in new threads, one each second, then dies
startWorker :: Pool Connection -> Int -> IO ()
startWorker _    0 = return ()
startWorker pool n = do threadDelay 1000000
                        forkIO $ worker pool 100
                        startWorker pool (n-1)
                
-- The workers
-- Does n queries then dies
worker :: Pool Connection -> Int -> IO ()
worker _    0 = return ()
worker pool n = do res <- query' pool "SELECT * FROM login" []
                   worker pool (n-1)
 
-- 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 = 2 :: Int             -- Number of connection threads to run
  let idleTime = 2 :: NominalDiffTime   -- Time until idle connection dies, in seconds
  let maxResources = 3 :: 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)