ta-0.1: Database/TA/Core/MapaBase.hs
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PatternGuards #-}
{-# language DeriveDataTypeable #-}
-- Versión 0.0.3 Leonel Fonseca. 2010/06/22
{-
db2hs es para descripciones devueltas por el diccionario de
datos.
OracleTypeCode, intToTypeCode, typeCodetoInt y dbTC2hs
se usan con información devuelta por dbms_sql.parse y
dbms_sql.describe_columns.
dbms_describe.describe_procedure tiene codificaciones
distintas manejadas por ODTC (OracleDescribeTypeCode),
intToODTC, odtcToInt y odtc2hs. (añadidas en la versión 0.0.3).
-}
{-
Mapea los tipos básicos de una base de datos Oracle a Haskell
y viceversa.
Creación:
Autor: Leonel Fonseca Loría
Fecha: 26/abr/2010
-}
module Database.TA.Core.MapaBase
( db2hs
, dbTC2hs
, intToNUMBER
, floatToNUMBER
, stringToVARCHAR2
, utcTimeToDATE
, OracleTypeCode (..) -- para dbms_sql
, intToTypeCode
, typeCodeToInt
, ODTC (..) -- para dbms_describe
, intToODTC
, odtcToInt
, HSTC (..)
)
where
import Language.Haskell.TH
import Data.Time
import Data.Typeable
{-
Para traducir un tipo Oracle a un tipo Haskell son necesarios
dos datos:
Primero, el nombre del tipo de una columna o función.
Segundo, la escala utilizada. Es un número que puede ser cero
o puede tener otro valor cuando se describe un tipo
TIMESTAMP o NUMBER.
db2hs aplica para descripciones devueltas por el diccionario de
datos.
-}
db2hs :: String -> Int -> Either String TypeQ
db2hs tipo escala
| tipo == "VARCHAR2" = Right [t| String |]
| tipo == "TIMESTAMP" = Right [t| UTCTime |]
| tipo == "TIMESTAMP(9)" = Right [t| UTCTime |]
| tipo == "TIMESTAMP(6)" = Right [t| UTCTime |]
| tipo == "DATE" = Right [t| UTCTime |]
| tipo == "NUMBER"
, escala == 0 = Right [t| Int |]
| tipo == "NUMBER" = Right [t| Float |]
| tipo == "" = Left "db2hs no puede traducir un tipo nulo."
| otherwise = Left $ "db2hs no sabe como traducir el tipo "
++ tipo
{-
En la dirección hs2db se necesitan más parámetros.
Así que se especializan las funciones por tipo, en lugar
de tener una sola función compleja.
Por dualidad, sospecho que podría ser más apropiada
alguna de estas dos signaturas:
TypeQ -> p1 -> ... pn -> TypeQ
TypeQ -> p1 -> ... pn -> String
-}
-- Recibe el tamaño del NUMBER(n) resultante.
intToNUMBER :: Int -> Either String String
intToNUMBER n
| n == 0 = Right "NUMBER"
| n > 0 = Right $ "NUMBER(" ++ show n ++ ")"
| n < 0 = Left $ "Para traducir un Int, indique la cantidad\
\ de bytes. Use algo así: intToNUMBER n.\
\ El valor recibido para n fue: " ++ show n ++ "."
-- Recibe la precisión y la escala para dar NUMBER(precisión,escala)
floatToNUMBER :: Int -> Int -> Either String String
floatToNUMBER p e
| p > 0
, e > 0 = Right $ "NUMBER(" ++ show p ++ "," ++ show e ++ ")"
| otherwise = Left $ "Para traducir un Float, indique la\
\ cantidad de enteros y la cantidad de decimales.\
\ Use algo así: floatToNUMBER ent dec.\
\ El valor recibido para p fue: " ++ show p ++
" , el valor de e fue: " ++ show e ++ "."
-- Recibe la cantidad de bytes para dar VARCHAR2(n)
stringToVARCHAR2 :: Int -> Either String String
stringToVARCHAR2 n
| n > 0 = Right $ "VARCHAR2(" ++ show n ++ ")"
| otherwise = Left $ "Para traducir un String, indique\
\ la cantidad de bytes para la hilera. Use\
\ algo así: stringToVARCHAR2 n. \
\ El valor recibido para n fue: "
++ show n ++ "."
-- Recibe un número que puede ser 0, 6 o 9 que dará como resultado
-- alguno de estos tres tipos: DATE o TIMESTAMP(6) o TIMESTAMP(9).
utcTimeToDATE :: Int -> Either String String
utcTimeToDATE n
| n == 0 = Right "DATE"
| n == 6 = Right "TIMESTAMP(6)"
| n == 9 = Right "TIMESTAMP(9)"
| otherwise = Left $ "Para traducir un UTCTime, indique\
\ utcTimeToDate 0 para DATE,\
\ utcTimeToDate 6 para TIMESTAMP(6),\
\ utcTimeToDate 0 para TIMESTAMP(9).\
\ El valor recibido para n fue: " ++ show n
++ "."
-- OracleTypeCode, intToTypeCode, typeCodetoInt y dbTC2hs
-- se usan con información devuelta por dbms_sql.parse y
-- dbms_sql.describe_columns.
-- | El procedimiento de descripción de columnas devuelve un entero
-- que codifica alguno de los siguientes tipos Oracle.
data OracleTypeCode
= NO_DATA -- devuelto por operaciones de iteración.
| SUCCESS -- devuelto por operaciones de iteración.
| TYPECODE_BDOUBLE
| TYPECODE_BFILE
| TYPECODE_BFLOAT
| TYPECODE_BLOB
| TYPECODE_CFILE
| TYPECODE_CHAR
| TYPECODE_CLOB
| TYPECODE_DATE
| TYPECODE_INTERVAL_DS
| TYPECODE_INTERVAL_YM
| TYPECODE_MLSLABEL
| TYPECODE_NAMEDCOLLECTION
| TYPECODE_NCHAR
| TYPECODE_NCLOB
| TYPECODE_NUMBER
| TYPECODE_NVARCHAR2
| TYPECODE_OBJECT
| TYPECODE_OPAQUE
| TYPECODE_RAW
| TYPECODE_REF
| TYPECODE_TABLE
| TYPECODE_TIMESTAMP
| TYPECODE_TIMESTAMP_LTZ
| TYPECODE_TIMESTAMP_TZ
| TYPECODE_UROWID
| TYPECODE_VARCHAR2
| TYPECODE_VARCHAR
| TYPECODE_VARRAY
deriving (Show, Read, Eq, Ord)
-- | El 100 tiene asociado dos TYPECODES:
-- TYPECODE_SUCCESS y TYPECODE_BFLOAT.
-- Asumimos que siempre interrogaremos en un contexto de tipos
-- y no de operaciones.
intToTypeCode :: Int -> OracleTypeCode
intToTypeCode i = case i of
101 -> TYPECODE_BDOUBLE
114 -> TYPECODE_BFILE
100 -> TYPECODE_BFLOAT
113 -> TYPECODE_BLOB
115 -> TYPECODE_CFILE
96 -> TYPECODE_CHAR
112 -> TYPECODE_CLOB
12 -> TYPECODE_DATE
190 -> TYPECODE_INTERVAL_DS
189 -> TYPECODE_INTERVAL_YM
105 -> TYPECODE_MLSLABEL
122 -> TYPECODE_NAMEDCOLLECTION
286 -> TYPECODE_NCHAR
288 -> TYPECODE_NCLOB
2 -> TYPECODE_NUMBER
287 -> TYPECODE_NVARCHAR2
108 -> TYPECODE_OBJECT
58 -> TYPECODE_OPAQUE
95 -> TYPECODE_RAW
110 -> TYPECODE_REF
248 -> TYPECODE_TABLE
187 -> TYPECODE_TIMESTAMP
232 -> TYPECODE_TIMESTAMP_LTZ
188 -> TYPECODE_TIMESTAMP_TZ
104 -> TYPECODE_UROWID
9 -> TYPECODE_VARCHAR2
1 -> TYPECODE_VARCHAR
247 -> TYPECODE_VARRAY
otherwise -> error $
"En TAMapaBase.intToTypeCode el código " ++ show i ++
" no tiene asociado ningún tipo Oracle."
typeCodeToInt :: OracleTypeCode -> Int
typeCodeToInt tc = case tc of
TYPECODE_BDOUBLE -> 101
TYPECODE_BFILE -> 114
TYPECODE_BFLOAT -> 100
TYPECODE_BLOB -> 113
TYPECODE_CFILE -> 115
TYPECODE_CHAR -> 96
TYPECODE_CLOB -> 112
TYPECODE_DATE -> 12
TYPECODE_INTERVAL_DS -> 190
TYPECODE_INTERVAL_YM -> 189
TYPECODE_MLSLABEL -> 105
TYPECODE_NAMEDCOLLECTION -> 122
TYPECODE_NCHAR -> 286
TYPECODE_NCLOB -> 288
TYPECODE_NUMBER -> 2
TYPECODE_NVARCHAR2 -> 287
TYPECODE_OBJECT -> 108
TYPECODE_OPAQUE -> 58
TYPECODE_RAW -> 95
TYPECODE_REF -> 110
TYPECODE_TABLE -> 248
TYPECODE_TIMESTAMP -> 187
TYPECODE_TIMESTAMP_LTZ -> 232
TYPECODE_TIMESTAMP_TZ -> 188
TYPECODE_UROWID -> 104
TYPECODE_VARCHAR2 -> 9
TYPECODE_VARCHAR -> 1
TYPECODE_VARRAY -> 247
otherwise -> error $
"En TAMapaBase.typeCodeToInt el tipo " ++ show tc ++
" no tiene asociado ninguna representación numérica."
{-
Versión que usa OracleTypeCodes para traducir una columna.
Para traducir un tipo Oracle a un tipo Haskell son necesarios
dos datos:
Primero, el nombre del tipo de una columna o función.
Segundo, la escala utilizada. Es un número que puede ser cero
o puede tener otro valor cuando se describe un tipo
TIMESTAMP o NUMBER.
-}
dbTC2hs :: Int -> Int -> Either String TypeQ
dbTC2hs tipo escala =
let tc = intToTypeCode tipo
in case tc of
TYPECODE_BFLOAT -> Right [t| Float |]
TYPECODE_CHAR -> Right [t| String |] -- What oracle says!
TYPECODE_DATE -> Right [t| UTCTime |]
TYPECODE_NCHAR -> Right [t| Char |]
TYPECODE_NVARCHAR2 -> Right [t| String |]
TYPECODE_TIMESTAMP -> Right [t| UTCTime |]
TYPECODE_TIMESTAMP_LTZ -> Right [t| UTCTime |]
TYPECODE_TIMESTAMP_TZ -> Right [t| UTCTime |]
TYPECODE_NUMBER ->
case escala of
0 -> Right [t| Int |]
otherwise -> Right [t| Float |]
TYPECODE_VARCHAR2 -> Right [t| String |]
TYPECODE_VARCHAR -> Right [t| String |]
otherwise -> Left $
"dbTC2hs no sabe como traducir el tipo "
++ show tc
{-
dbms_describe.describe_procedure tiene codificaciones
distintas manejadas por ODTC (OracleDescribeTypeCode),
intToODTC, odtcToInt y odtc2hs. (añadidas en la versión 0.0.3).
-}
-- OracleDescribeTypeCode
data ODTC
= ODTCNoArgs
| ODTCVarchar2
| ODTCNumber
| ODTCPlsInteger
| ODTCLong
| ODTCRowId
| ODTCDate
| ODTCRaw
| ODTCLong_raw
| ODTCOpaque_type
| ODTCChar
| ODTCMlslabel
| ODTCObject
| ODTCNested_table
| ODTCVarray
| ODTCTime
| ODTCTime_tz
| ODTCTimestamp
| ODTCTimestamp_tz
| ODTCTimestamp_ltz
| ODTCPlsql_record
| ODTCPlsql_table
| ODTCPlsql_boolean
deriving (Show, Read, Eq, Ord, Typeable)
intToODTC :: Int -> ODTC
intToODTC x = case x of
0 -> ODTCNoArgs -- procs with no arguments
1 -> ODTCVarchar2 -- varchar, varchar, string
2 -> ODTCNumber -- number, integer, smallint, real,
-- float, decimal
3 -> ODTCPlsInteger -- binary_integer, pls_integer, positive,
-- natural
8 -> ODTCLong -- long
11 -> ODTCRowId -- rowid
12 -> ODTCDate -- date
23 -> ODTCRaw -- raw
24 -> ODTCLong_raw -- long raw
58 -> ODTCOpaque_type -- opaque type
96 -> ODTCChar -- char (ansi fixed char), character
106 -> ODTCMlslabel -- mlslabel
121 -> ODTCObject -- object
122 -> ODTCNested_table -- nested table
123 -> ODTCVarray -- varray
178 -> ODTCTime -- time
179 -> ODTCTime_tz -- time with time zone
180 -> ODTCTimestamp -- timestamp
181 -> ODTCTimestamp_tz -- timestamp with time zone
231 -> ODTCTimestamp_ltz -- timestamp with local time zone
250 -> ODTCPlsql_record -- pl/sql record
251 -> ODTCPlsql_table -- pl/sql table
252 -> ODTCPlsql_boolean -- pl/sql boolean
_ -> error $ "TAMapaBase.intToODTC: el codigo de tipo "
++ show x ++ " carece de traducción."
odtcToInt :: ODTC -> Int
odtcToInt x = case x of
ODTCNoArgs -> 0
ODTCVarchar2 -> 1
ODTCNumber -> 2
ODTCPlsInteger -> 3
ODTCLong -> 8
ODTCRowId -> 11
ODTCDate -> 12
ODTCRaw -> 23
ODTCLong_raw -> 24
ODTCOpaque_type -> 58
ODTCChar -> 96
ODTCMlslabel -> 106
ODTCObject -> 121
ODTCNested_table -> 122
ODTCVarray -> 123
ODTCTime -> 178
ODTCTime_tz -> 179
ODTCTimestamp -> 180
ODTCTimestamp_tz -> 181
ODTCTimestamp_ltz -> 231
ODTCPlsql_record -> 250
ODTCPlsql_table -> 251
ODTCPlsql_boolean -> 252
-- odtc2hs : pendiente de escritura
-- Haskell TypeCodes. The resulting mixture with Oracle types.
-- This will be used by a serialiser written for PL/SQL
-- structures.
data HSTC
= HSTCBool Bool
| HSTCChar Char
| HSTCString String
| HSTCInt Int
| HSTCFloat Float
| HSTCUTCTime UTCTime
| HSTCUnit -- () for ODTCNoArgs.
| HSTCList [HSTC] -- Varray,Nested Table,PLSQL Table
| HSTCRecord [HSTC] -- for Oracle records
| HSTCObject [HSTC] -- for Oracle Objects
| HSTCOpaque_type -- for Oracle opaque types.
| HSTCBinary [HSTC] -- for Long, Raw, Long_Raw
deriving (Show, Read, Eq, Ord, Typeable)
-- eof