{-# OPTIONS_GHC -optc-D__HUGS__ #-} {-# INCLUDE #-} {-# INCLUDE #-} {-# INCLUDE #-} {-# LINE 1 "Database/HDBC/ODBC/TypeConv.hsc" #-} -- -*- mode: haskell; -*- {-# LINE 2 "Database/HDBC/ODBC/TypeConv.hsc" #-} {-# CFILES hdbc-odbc-helper.c #-} -- Above line for hugs {- Copyright (C) 2006 John Goerzen This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -} module Database.HDBC.ODBC.TypeConv(fromOTypeInfo, fromOTypeCol) where import Database.HDBC.Types import Database.HDBC import Database.HDBC.DriverUtils import Database.HDBC.ODBC.Types import Database.HDBC.ODBC.Utils import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Ptr import Control.Concurrent.MVar import Foreign.C.String import Foreign.Marshal import Foreign.Storable import Control.Monad import Data.List import Data.Word import Data.Int import Control.Exception import System.IO import Data.Maybe l _ = return () --l m = hPutStrLn stderr ("\n" ++ m) {-# LINE 48 "Database/HDBC/ODBC/TypeConv.hsc" #-} {-# LINE 49 "Database/HDBC/ODBC/TypeConv.hsc" #-} {-# LINE 50 "Database/HDBC/ODBC/TypeConv.hsc" #-} {-# LINE 51 "Database/HDBC/ODBC/TypeConv.hsc" #-} fromOTypeInfo :: String -- ^ Column name -> Int16 -- ^ Data type {-# LINE 54 "Database/HDBC/ODBC/TypeConv.hsc" #-} -> Word32 -- ^ Column size {-# LINE 55 "Database/HDBC/ODBC/TypeConv.hsc" #-} -> Int16 -- ^ Is it nullable {-# LINE 56 "Database/HDBC/ODBC/TypeConv.hsc" #-} -> (String, SqlColDesc) fromOTypeInfo colname datatype colsize nullable = (colname, SqlColDesc {colType = convdatatype datatype, colOctetLength = Nothing, colDecDigits = Nothing, colSize = Just (fromIntegral colsize), colNullable = case nullable of 0 -> Just False {-# LINE 65 "Database/HDBC/ODBC/TypeConv.hsc" #-} 1 -> Just True {-# LINE 66 "Database/HDBC/ODBC/TypeConv.hsc" #-} _ -> Nothing } ) fromOTypeCol (_:_:_:colname:datatype:_:colsize:buflen:decdig:precrad:nullable:_:_:_:subtype:octetlen:_) = fromOTypeInfo (fromSql colname) (fromIntegral ((fromSql datatype)::Int)) (fromSql colsize) (fromIntegral ((fromSql nullable)::Int)) fromOTypeCol x = error $ "fromOTypeCol: unexpected result set: " ++ show x convdatatype :: Int16 -> SqlTypeId {-# LINE 78 "Database/HDBC/ODBC/TypeConv.hsc" #-} convdatatype intype = case intype of 1 -> SqlCharT {-# LINE 81 "Database/HDBC/ODBC/TypeConv.hsc" #-} 12 -> SqlVarCharT {-# LINE 82 "Database/HDBC/ODBC/TypeConv.hsc" #-} -1 -> SqlLongVarCharT {-# LINE 83 "Database/HDBC/ODBC/TypeConv.hsc" #-} -8 -> SqlWCharT {-# LINE 84 "Database/HDBC/ODBC/TypeConv.hsc" #-} -9 -> SqlWVarCharT {-# LINE 85 "Database/HDBC/ODBC/TypeConv.hsc" #-} -10 -> SqlWLongVarCharT {-# LINE 86 "Database/HDBC/ODBC/TypeConv.hsc" #-} 3 -> SqlDecimalT {-# LINE 87 "Database/HDBC/ODBC/TypeConv.hsc" #-} 2 -> SqlNumericT {-# LINE 88 "Database/HDBC/ODBC/TypeConv.hsc" #-} 5 -> SqlSmallIntT {-# LINE 89 "Database/HDBC/ODBC/TypeConv.hsc" #-} 4 -> SqlIntegerT {-# LINE 90 "Database/HDBC/ODBC/TypeConv.hsc" #-} 7 -> SqlRealT {-# LINE 91 "Database/HDBC/ODBC/TypeConv.hsc" #-} 6 -> SqlFloatT {-# LINE 92 "Database/HDBC/ODBC/TypeConv.hsc" #-} 8 -> SqlDoubleT {-# LINE 93 "Database/HDBC/ODBC/TypeConv.hsc" #-} -7 -> SqlBitT {-# LINE 94 "Database/HDBC/ODBC/TypeConv.hsc" #-} -6 -> SqlTinyIntT {-# LINE 95 "Database/HDBC/ODBC/TypeConv.hsc" #-} -5 -> SqlBigIntT {-# LINE 96 "Database/HDBC/ODBC/TypeConv.hsc" #-} -2 -> SqlBinaryT {-# LINE 97 "Database/HDBC/ODBC/TypeConv.hsc" #-} -3 -> SqlVarBinaryT {-# LINE 98 "Database/HDBC/ODBC/TypeConv.hsc" #-} -4 -> SqlLongVarBinaryT {-# LINE 99 "Database/HDBC/ODBC/TypeConv.hsc" #-} 91 -> SqlDateT {-# LINE 100 "Database/HDBC/ODBC/TypeConv.hsc" #-} 92 -> SqlTimeT {-# LINE 101 "Database/HDBC/ODBC/TypeConv.hsc" #-} 93 -> SqlTimestampT {-# LINE 102 "Database/HDBC/ODBC/TypeConv.hsc" #-} -- ODBC libraries don't seem to define the UTC items -- {const SQL_TYPE_UTCDATETIME} -> SqlUTCDateTimeT -- {const SQL_TYPE_UTCTIME} -> SqlUTCTimeT 102 -> SqlIntervalT SqlIntervalMonthT {-# LINE 106 "Database/HDBC/ODBC/TypeConv.hsc" #-} 101 -> SqlIntervalT SqlIntervalYearT {-# LINE 107 "Database/HDBC/ODBC/TypeConv.hsc" #-} 107 -> SqlIntervalT SqlIntervalYearToMonthT {-# LINE 108 "Database/HDBC/ODBC/TypeConv.hsc" #-} 103 -> SqlIntervalT SqlIntervalDayT {-# LINE 109 "Database/HDBC/ODBC/TypeConv.hsc" #-} 104 -> SqlIntervalT SqlIntervalHourT {-# LINE 110 "Database/HDBC/ODBC/TypeConv.hsc" #-} 105 -> SqlIntervalT SqlIntervalMinuteT {-# LINE 111 "Database/HDBC/ODBC/TypeConv.hsc" #-} 106 -> SqlIntervalT SqlIntervalSecondT {-# LINE 112 "Database/HDBC/ODBC/TypeConv.hsc" #-} 108 -> SqlIntervalT SqlIntervalDayToHourT {-# LINE 113 "Database/HDBC/ODBC/TypeConv.hsc" #-} 109 -> SqlIntervalT SqlIntervalDayToMinuteT {-# LINE 114 "Database/HDBC/ODBC/TypeConv.hsc" #-} 110 -> SqlIntervalT SqlIntervalDayToSecondT {-# LINE 115 "Database/HDBC/ODBC/TypeConv.hsc" #-} 111 -> SqlIntervalT SqlIntervalHourToMinuteT {-# LINE 116 "Database/HDBC/ODBC/TypeConv.hsc" #-} 112 -> SqlIntervalT SqlIntervalHourToSecondT {-# LINE 117 "Database/HDBC/ODBC/TypeConv.hsc" #-} 113 -> SqlIntervalT SqlIntervalMinuteToSecondT {-# LINE 118 "Database/HDBC/ODBC/TypeConv.hsc" #-} -11 -> SqlGUIDT {-# LINE 119 "Database/HDBC/ODBC/TypeConv.hsc" #-} x -> SqlUnknownT (show x)