PageRenderTime 22ms CodeModel.GetById 13ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/Database/HDBC/PostgreSQL/PTypeConv.hsc

http://github.com/hdbc/hdbc-postgresql
Unknown | 85 lines | 71 code | 14 blank | 0 comment | 0 complexity | edd3916ba6e8fa686ea0bd36b026aa17 MD5 | raw file
 1-- -*- mode: haskell; -*-
 2module Database.HDBC.PostgreSQL.PTypeConv where
 3import Database.HDBC.ColTypes
 4import Data.Word
 5
 6#include "pgtypes.h"
 7#include <libpq-fe.h>
 8
 9
10colDescForPGAttr :: #{type Oid} -> Int -> String -> Bool -> SqlColDesc
11colDescForPGAttr atttypeid attlen formattedtype attnotnull =
12    let
13        coltype = oidToColType atttypeid
14
15        size = if attlen == -1 then maybeExtractFirstParenthesizedNumber formattedtype
16               else Just attlen
17
18        decDigs = if coltype == SqlNumericT then maybeExtractSecondParenthesizedNumber formattedtype
19                  else Nothing
20    in
21      SqlColDesc { colType = coltype,
22                   colSize = size,
23                   colOctetLength = Nothing, -- not available in postgres
24                   colDecDigits = decDigs,
25                   colNullable = Just attnotnull }
26    where
27      maybeExtractFirstParenthesizedNumber s = case extractParenthesizedInts s of n:_ -> Just n; _ -> Nothing
28
29      maybeExtractSecondParenthesizedNumber s = case extractParenthesizedInts s of _:n2:_ -> Just n2; _ -> Nothing
30
31      extractParenthesizedInts :: String -> [Int]
32      extractParenthesizedInts s =
33          case takeWhile (/=')') $ dropWhile (/='(') s of
34            '(':textBetweenParens ->
35                case map fst $ reads $ "[" ++ textBetweenParens ++ "]" of
36                  l:_ -> l
37                  [] -> []
38            _ -> []
39
40
41
42oidToColDef :: #{type Oid} -> SqlColDesc
43oidToColDef oid =
44    SqlColDesc {colType = (oidToColType oid),
45                colSize = Nothing,
46                colOctetLength = Nothing,
47                colDecDigits = Nothing,
48                colNullable = Nothing}
49
50oidToColType :: #{type Oid} -> SqlTypeId
51oidToColType oid =
52    case oid of
53      #{const PG_TYPE_CHAR} -> SqlCharT
54      #{const PG_TYPE_CHAR2} -> SqlCharT
55      #{const PG_TYPE_CHAR4} -> SqlCharT
56      #{const PG_TYPE_CHAR8} -> SqlCharT
57      #{const PG_TYPE_NAME} -> SqlVarCharT
58      #{const PG_TYPE_BPCHAR} -> SqlCharT
59      #{const PG_TYPE_VARCHAR} -> SqlVarCharT
60      #{const PG_TYPE_TEXT} -> SqlVarCharT
61      #{const PG_TYPE_XML} -> SqlVarCharT
62      #{const PG_TYPE_BYTEA} -> SqlVarBinaryT
63      #{const PG_TYPE_INT2} -> SqlSmallIntT
64      #{const PG_TYPE_OID} -> SqlIntegerT
65      #{const PG_TYPE_XID} -> SqlIntegerT
66      #{const PG_TYPE_INT4} -> SqlBigIntT
67      #{const PG_TYPE_INT8} -> SqlBigIntT
68      #{const PG_TYPE_NUMERIC} -> SqlNumericT
69      #{const PG_TYPE_FLOAT4} -> SqlRealT
70      #{const PG_TYPE_FLOAT8} -> SqlFloatT
71      #{const PG_TYPE_DATE} -> SqlDateT
72      #{const PG_TYPE_ABSTIME} -> SqlTimestampWithZoneT
73
74      #{const PG_TYPE_DATETIME} -> SqlTimestampWithZoneT
75      #{const PG_TYPE_TIMESTAMP_NO_TMZONE} -> SqlTimestampT
76      #{const PG_TYPE_TIMESTAMP} -> SqlTimestampT
77
78      #{const PG_TYPE_TIME} -> SqlTimeT
79      #{const PG_TYPE_TIME_WITH_TMZONE} -> SqlTimeWithZoneT
80
81      #{const PG_TYPE_TINTERVAL} -> SqlIntervalT SqlIntervalMonthT -- SqlIntervalMonthT chosen arbitrarily in these two. PG allows any parts
82      #{const PG_TYPE_RELTIME}   -> SqlIntervalT SqlIntervalMonthT -- of an interval (microsecond to millennium) to be specified together.
83      1186 -> SqlIntervalT SqlIntervalMonthT
84      #{const PG_TYPE_BOOL} -> SqlBitT
85      x -> SqlUnknownT (show x)