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)