{-# OPTIONS -fglasgow-exts #-}
{-# LANGUAGE TemplateHaskell, BangPatterns #-}

-- Module tests different column types

module Util
where

import Database.MetaHDBC

import Language.Haskell.TH
import Language.Haskell.TH.Syntax as TH
import Data.Char

import Database.HDBC
import Database.HDBC.ODBC


loggedRunStmt :: String -> String -> ExpQ
loggedRunStmt dsn extendedSql =
    do parts <- makeExprParts dsn extendedSql
       let logMsg = 
             [| putStrLn ("Ran statment: " ++ extendedSql ++ " with parameters" ++
                          show $(tupE (map (varE . parmName) $ parameters parts))
                         )
              |]
           execStmt = [| do res <- $(runStmtRHS parts)
                            $(logMsg)
                            putStrLn ("Showing result: " ++ show res)
                            return res
                       |]
       runStmtLHS parts execStmt

loggedPreparedStmt :: String -> String -> ExpQ
loggedPreparedStmt dsn extendedSql =
    do parts <- makePrepStmtParts dsn extendedSql
       let logPrepare = noBindS
               [| putStrLn ("Prepares stmt: " ++ extendedSql) |]
           logMsg = noBindS
               [| putStrLn ("Ran statment: " ++ extendedSql ++ " with parameters" ++
                            show $(tupE (map (varE . parmName) $ parameters $ exprParts parts))
                           )
                |]
       prepStmtLHS parts [ logPrepare
                         , prepStmtQ parts
                         , returnExecPrepStmtLHS parts [logMsg, execPrepStmtRHS parts]
                         ]

runIOAtCompileTime :: IO a -> ExpQ
runIOAtCompileTime io =
    do runIO io
       [| return () |]

dropAllTables :: String -> IO ()
dropAllTables dsn =
    do conn   <- connectODBC dsn
       tables <- getTables conn
       mapM_ (\t -> run conn ("DROP TABLE " ++ t ++ ";") []) tables
       commit conn
       disconnect conn -- Nothing to retrieve from the DB. We can safely disconnect.
    `rethrowDoing` "Error dropping all tables"