PTypeConv.hs

{-# OPTIONS_GHC -optc-D__HUGS__ #-}
{-# INCLUDE "pgtypes.h" #-}
{-# INCLUDE <libpq-fe.h> #-}
{-# LINE 1 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
-- -*- mode: haskell; -*-
{-# LINE 2 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
{-
Copyright (C) 2006 John Goerzen <jgoerzen@complete.org>

    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.PostgreSQL.PTypeConv where
import Database.HDBC.ColTypes
import Data.Word
import Data.Int


{-# LINE 26 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}

{-# LINE 27 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}


colDescForPGAttr :: Word32 -> Int -> String -> Bool -> SqlColDesc
{-# LINE 30 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
colDescForPGAttr atttypeid attlen formattedtype attnotnull =
    let
        coltype = oidToColType atttypeid

        size = if attlen == -1 then maybeExtractFirstParenthesizedNumber formattedtype
               else Just attlen

        decDigs = if coltype == SqlNumericT then maybeExtractSecondParenthesizedNumber formattedtype
                  else Nothing
    in
      SqlColDesc { colType = coltype,
                   colSize = size,
                   colOctetLength = Nothing, -- not available in postgres
                   colDecDigits = decDigs,
                   colNullable = Just attnotnull }
    where
      maybeExtractFirstParenthesizedNumber s = case extractParenthesizedInts s of n:_ -> Just n; _ -> Nothing

      maybeExtractSecondParenthesizedNumber s = case extractParenthesizedInts s of n1:n2:_ -> Just n2; _ -> Nothing

      extractParenthesizedInts :: String -> [Int]
      extractParenthesizedInts s =
          case takeWhile (/=')') $ dropWhile (/='(') s of
            '(':textBetweenParens ->
                case map fst $ reads $ "[" ++ textBetweenParens ++ "]" of
                  l:_ -> l
                  [] -> []
            _ -> []



oidToColDef :: Word32 -> SqlColDesc
{-# LINE 62 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
oidToColDef oid =
    SqlColDesc {colType = (oidToColType oid),
                colSize = Nothing,
                colOctetLength = Nothing,
                colDecDigits = Nothing,
                colNullable = Nothing}

oidToColType :: Word32 -> SqlTypeId
{-# LINE 70 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
oidToColType oid =
    case oid of
      18 -> SqlCharT
{-# LINE 73 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      409 -> SqlCharT
{-# LINE 74 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      410 -> SqlCharT
{-# LINE 75 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      411 -> SqlCharT
{-# LINE 76 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      19 -> SqlVarCharT
{-# LINE 77 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1042 -> SqlCharT
{-# LINE 78 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1043 -> SqlVarCharT
{-# LINE 79 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      25 -> SqlVarCharT
{-# LINE 80 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      17 -> SqlVarBinaryT
{-# LINE 81 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      21 -> SqlSmallIntT
{-# LINE 82 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      26 -> SqlIntegerT
{-# LINE 83 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      28 -> SqlIntegerT
{-# LINE 84 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      23 -> SqlBigIntT
{-# LINE 85 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      20 -> SqlBigIntT
{-# LINE 86 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1700 -> SqlNumericT
{-# LINE 87 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      700 -> SqlRealT
{-# LINE 88 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      701 -> SqlFloatT
{-# LINE 89 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1082 -> SqlDateT
{-# LINE 90 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      702 -> SqlTimestampT
{-# LINE 91 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1184 -> SqlTimestampT
{-# LINE 92 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1114 -> SqlTimestampT
{-# LINE 93 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1296 -> SqlTimestampT
{-# LINE 94 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1083 -> SqlTimeT
{-# LINE 95 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      1266 -> SqlTimeT
{-# LINE 96 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      704 -> SqlIntervalT SqlIntervalMonthT -- SqlIntervalMonthT chosen arbitrarily in these two. PG allows any parts
{-# LINE 97 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      703   -> SqlIntervalT SqlIntervalMonthT -- of an interval (microsecond to millennium) to be specified together.
{-# LINE 98 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      16 -> SqlBitT
{-# LINE 99 "Database/HDBC/PostgreSQL/PTypeConv.hsc" #-}
      x -> SqlUnknownT (show x)