content: -----------------------------------------------------------
  -- |
  -- Module      :  Database.HaskellDB.WX
  -- Copyright   :  HWT Group 2003, 
  --                Bjorn Bringert 2005-2006
  -- License     :  BSD-style
  -- 
  -- Maintainer  :  haskelldb-users@lists.sourceforge.net
  -- Stability   :  experimental
  -- Portability :  non-portable
  --
  -- WxHaskell <http://wxhaskell.sourceforge.net/> 
  -- interface for HaskellDB
  --
  -----------------------------------------------------------
  
  module Database.HaskellDB.WX (
  			      WXOptions(..), wxConnect,
                                DriverInterface(..), driver
  			     ) where
  
  import Data.Maybe
  import Control.Exception (catch, throwIO)
  import Control.Monad
  import System.IO.Unsafe (unsafeInterleaveIO)
  import System.Time
  
  
  import Database.HaskellDB
  import Database.HaskellDB.DriverAPI
  import Database.HaskellDB.Database
  import Database.HaskellDB.Sql.Generate (SqlGenerator)
  import Database.HaskellDB.Sql.Print
  import Database.HaskellDB.PrimQuery
  import Database.HaskellDB.Query
  import Database.HaskellDB.FieldType
  
  import Graphics.UI.WXCore.WxcClasses (Db)
  import Graphics.UI.WXCore.Db (DbRow, ColumnInfo(..),TableInfo(..),SqlType(..))
  import qualified Graphics.UI.WXCore.Db as WX
  
  type Connection = Db ()
  
  data WXOptions = WXOptions { 
                              dsn :: String, -- ^ name binding in ODBC
                              uid :: String, -- ^ user id
                              pwd :: String  -- ^ password
                    	   }
  
  -- | Run an action and close the connection.
  wxConnect :: SqlGenerator -> WXOptions -> (Database -> IO a) -> IO a
  wxConnect gen WXOptions{dsn=d,uid=u,pwd=p} action = 
      handleDbError (WX.dbWithConnection d u p (action . mkDatabase gen))
  
  wxConnectOpts :: [(String,String)] -> (Database -> IO a) -> IO a
  wxConnectOpts opts f = 
      do
      [a,b,c] <- getOptions ["dsn","uid","pwd"] opts
      gen <- getGenerator opts
      wxConnect gen (PostgreSQLOptions {dsn = a, uid = b, pwd = c}) f
  
  driver :: DriverInterface
  driver = defaultdriver {connect = wxConnectOpts}
  
  
  handleDbError :: IO a -> IO a
  handleDbError io = WX.catchDbError io (fail . WX.dbErrorMsg)
  
  mkDatabase :: SqlGenerator -> Connection -> Database
  mkDatabase gen connection
      = Database { dbQuery	= wxQuery       gen connection,
      		 dbInsert	= wxInsert      gen connection,
  		 dbInsertQuery 	= wxInsertQuery gen connection,
  		 dbDelete	= wxDelete      gen connection,
  		 dbUpdate	= wxUpdate      gen connection,
  		 dbTables       = wxTables          connection,
  		 dbDescribe     = wxDescribe        connection,
  		 dbTransaction  = wxTransaction     connection,
  		 dbCreateDB     = wxCreateDB    gen connection,
  		 dbCreateTable  = wxCreateTable gen connection,
  		 dbDropDB       = wxDropDB      gen connection,
  		 dbDropTable    = wxDropTable   gen connection
  	       }
  
  wxQuery :: GetRec er vr => SqlGenerator -> Connection -> PrimQuery -> Rel er -> IO [Record vr]
  wxQuery gen connection qtree rel = wxPrimQuery connection sql scheme rel
      where
        sql = show $ ppSql $ sqlQuery gen qtree
        scheme = attributes qtree
  
  wxInsert gen conn table assoc = 
      wxPrimExecute conn $ show $ ppInsert $ sqlInsert gen table assoc
  	  
  wxInsertQuery gen conn table assoc = 
      wxPrimExecute conn $ show $ ppInsert $ sqlInsertQuery gen table assoc
  	  
  wxDelete gen conn table exprs = 
      wxPrimExecute conn $ show $ ppDelete $ sqlDelete gen table exprs
  
  wxUpdate gen conn table criteria assigns = 
      wxPrimExecute conn $ show $ ppUpdate $ sqlUpdate gen table criteria assigns
  
  wxTables :: Connection -> IO [TableName]
  wxTables conn = 
      handleDbError $ liftM (map tableName . WX.dbTables) (WX.dbGetInfo conn)
  
  wxDescribe :: Connection -> TableName -> IO [(Attribute,FieldDesc)]
  wxDescribe conn table = 
      do
      i <- handleDbError $ WX.dbGetTableInfo conn table
      return $ map toFieldDesc $ tableColumns i
      where 
      toFieldDesc ColumnInfo {columnName = name, 
  			    columnSize = size,
  			    columnSqlType = sqlType, 
  			    columnNullable = nullable}
  	= (name, (toFieldType size sqlType, nullable))
  
  wxCreateDB :: SqlGenerator -> Connection -> String -> IO ()
  wxCreateDB gen conn name 
      = wxPrimExecute conn $ show $ ppCreate $ sqlCreateDB gen name
  
  wxCreateTable :: SqlGenerator -> Connection -> TableName -> [(Attribute,FieldDesc)] -> IO ()
  wxCreateTable gen conn name as
      = wxPrimExecute conn $ show $ ppCreate $ sqlCreateTable gen name as
  
  wxDropDB :: SqlGenerator -> Connection -> String -> IO ()
  wxDropDB gen conn name 
      = wxPrimExecute conn $ show $ ppDrop $ sqlDropDB gen name
  
  wxDropTable :: SqlGenerator -> Connection -> TableName -> IO ()
  wxDropTable gen conn name
      = wxPrimExecute conn $ show $ ppDrop $ sqlDropTable gen name
  
  toFieldType :: Int -> SqlType -> FieldType
  toFieldType _ SqlDecimal   = DoubleT
  toFieldType _ SqlNumeric   = DoubleT
  toFieldType _ SqlReal      = DoubleT
  toFieldType _ SqlFloat     = DoubleT
  toFieldType _ SqlDouble    = DoubleT
  toFieldType _ SqlSmallInt  = IntT
  toFieldType _ SqlInteger   = IntT
  toFieldType _ SqlTinyInt   = IntT
  toFieldType _ SqlBigInt    = IntegerT
  toFieldType _ SqlDate      = CalendarTimeT
  toFieldType _ SqlTime      = CalendarTimeT
  toFieldType _ SqlTimeStamp = CalendarTimeT
  -- toFieldType _ SqlBit       = BoolT
  toFieldType n SqlChar      = BStrT n
  toFieldType n SqlVarChar   = BStrT n
  toFieldType n SqlBinary    = BStrT n
  toFieldType n SqlVarBinary = BStrT n
  toFieldType _ _            = StringT
  
  
  -- | WxHaskell implementation of 'Database.dbTransaction'.
  wxTransaction :: Connection -> IO a -> IO a
  wxTransaction conn action = handleDbError $ WX.dbTransaction conn action
  
  
  -----------------------------------------------------------
  -- Primitive operations
  -----------------------------------------------------------
  
  -- | Primitive query
  wxPrimQuery :: GetRec er vr => 
  	       Connection -- ^ Database connection.
  	    -> String     -- ^ SQL query
  	    -> Scheme     -- ^ List of field names to retrieve
  	    -> Rel er     -- ^ Phantom argument to get the return type right.
  	    -> IO [Record vr]    -- ^ Query results
  wxPrimQuery connection sql scheme rel = 
      handleDbError $ WX.dbQuery connection sql getResults
  	where getResults = getRec wxGetInstances rel scheme
  
  -- | Primitive execute
  --   FIXME: WxHaskell docs says to always wrap dbExecute in dbTransaction
  wxPrimExecute :: Connection -- ^ Database connection.
  		-> String     -- ^ SQL query.
  		-> IO ()
  wxPrimExecute connection sql = handleDbError $ WX.dbExecute connection sql
  
  
  -----------------------------------------------------------
  -- Getting data from a statement
  -----------------------------------------------------------
  
  wxGetInstances :: GetInstances (DbRow a)
  wxGetInstances = 
      GetInstances {
  		   getString       = WX.dbRowGetStringMb
  		 , getInt          = WX.dbRowGetIntMb
  		 , getInteger      = WX.dbRowGetIntegerMb
  		 , getDouble       = WX.dbRowGetDoubleMb
  		 , getBool         = WX.dbRowGetBoolMb
  		 , getCalendarTime = wxGetCalendarTime
  		 }
  
  wxGetCalendarTime :: DbRow a -> String -> IO (Maybe CalendarTime)
  wxGetCalendarTime r f = WX.dbRowGetClockTimeMb r f >>= mkIOMBCalendarTime
  
  mkIOMBCalendarTime :: Maybe ClockTime -> IO (Maybe CalendarTime)
  mkIOMBCalendarTime Nothing = return Nothing
  mkIOMBCalendarTime (Just c) = return (Just (toUTCTime c))
  