{- |
   Module     : Database.HDBC.ColTypes
   Copyright  : Copyright (C) 2006-2011 John Goerzen
   License    : BSD3

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

Definitions of, and utilities for, specifying what type of data is represented
by a column.

Written by John Goerzen, jgoerzen\@complete.org
-}
{-# LANGUAGE DeriveDataTypeable #-}

module Database.HDBC.ColTypes (SqlColDesc(..),
                               SqlTypeId(..),
                               SqlInterval(..)
                              )

where
import Data.Dynamic

{- | The description of a column.

Fields are Nothing if the database backend cannot supply the
requested information.

The colSize field works like this:

For character types, the maximum width of the column.  For numeric
types, the total number of digits allowed.  See the ODBC manual for more.

The colOctetLength field is defined for character and binary types, and
gives the number of bytes the column requires, regardless of encoding.
-}
data SqlColDesc = 
   SqlColDesc {
               SqlColDesc -> SqlTypeId
colType :: SqlTypeId   -- ^ Type of data stored here
              ,SqlColDesc -> Maybe Int
colSize :: Maybe Int   -- ^ The size of a column
              ,SqlColDesc -> Maybe Int
colOctetLength :: Maybe Int -- ^ The maximum size in octets
              ,SqlColDesc -> Maybe Int
colDecDigits :: Maybe Int -- ^ Digits to the right of the period
              ,SqlColDesc -> Maybe Bool
colNullable :: Maybe Bool -- ^ Whether NULL is acceptable
              }
   deriving (SqlColDesc -> SqlColDesc -> Bool
(SqlColDesc -> SqlColDesc -> Bool)
-> (SqlColDesc -> SqlColDesc -> Bool) -> Eq SqlColDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlColDesc -> SqlColDesc -> Bool
$c/= :: SqlColDesc -> SqlColDesc -> Bool
== :: SqlColDesc -> SqlColDesc -> Bool
$c== :: SqlColDesc -> SqlColDesc -> Bool
Eq, ReadPrec [SqlColDesc]
ReadPrec SqlColDesc
Int -> ReadS SqlColDesc
ReadS [SqlColDesc]
(Int -> ReadS SqlColDesc)
-> ReadS [SqlColDesc]
-> ReadPrec SqlColDesc
-> ReadPrec [SqlColDesc]
-> Read SqlColDesc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SqlColDesc]
$creadListPrec :: ReadPrec [SqlColDesc]
readPrec :: ReadPrec SqlColDesc
$creadPrec :: ReadPrec SqlColDesc
readList :: ReadS [SqlColDesc]
$creadList :: ReadS [SqlColDesc]
readsPrec :: Int -> ReadS SqlColDesc
$creadsPrec :: Int -> ReadS SqlColDesc
Read, Int -> SqlColDesc -> ShowS
[SqlColDesc] -> ShowS
SqlColDesc -> String
(Int -> SqlColDesc -> ShowS)
-> (SqlColDesc -> String)
-> ([SqlColDesc] -> ShowS)
-> Show SqlColDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlColDesc] -> ShowS
$cshowList :: [SqlColDesc] -> ShowS
show :: SqlColDesc -> String
$cshow :: SqlColDesc -> String
showsPrec :: Int -> SqlColDesc -> ShowS
$cshowsPrec :: Int -> SqlColDesc -> ShowS
Show, Typeable)

{- | The type identifier for a given column. 

This represents the type of data stored in the column in the underlying
SQL engine.  It does not form the entire column type; see 'SqlColDesc' for
that.

These types correspond mainly to those defined by ODBC. -}
data SqlTypeId =
    SqlCharT                    -- ^ Fixed-width character strings
    | SqlVarCharT               -- ^ Variable-width character strings
    | SqlLongVarCharT           -- ^ Variable-width character strings, max length implementation dependant
    | SqlWCharT                 -- ^ Fixed-width Unicode strings
    | SqlWVarCharT              -- ^ Variable-width Unicode strings
    | SqlWLongVarCharT          -- ^ Variable-width Unicode strings, max length implementation dependant
    | SqlDecimalT               -- ^ Signed exact values
    | SqlNumericT               -- ^ Signed exact integer values
    | SqlSmallIntT              -- ^ 16-bit integer values
    | SqlIntegerT               -- ^ 32-bit integer values
    | SqlRealT
    | SqlFloatT                 -- ^ Signed inexact floating-point values
    | SqlDoubleT                -- ^ Signed inexact double-precision values
    | SqlBitT                   -- ^ A single bit
    | SqlTinyIntT               -- ^ 8-bit integer values
    | SqlBigIntT                -- ^ 64-bit integer values
    | SqlBinaryT                -- ^ Fixed-length binary data
    | SqlVarBinaryT             -- ^ Variable-length binary data
    | SqlLongVarBinaryT         -- ^ Variable-length binary data, max length implementation dependant
    | SqlDateT                  -- ^ A date
    | SqlTimeT                  -- ^ A time, no timezone
    | SqlTimeWithZoneT          -- ^ A time, with timezone
    | SqlTimestampT             -- ^ Combined date and time, no timezone
    | SqlTimestampWithZoneT     -- ^ Combined date and time, with timezone
    | SqlUTCDateTimeT           -- ^ UTC date\/time
    | SqlUTCTimeT               -- ^ UTC time
    | SqlIntervalT SqlInterval  -- ^ A time or date difference
    | SqlGUIDT                  -- ^ Global unique identifier
    | SqlUnknownT String        -- ^ A type not represented here; implementation-specific information in the String

  deriving (SqlTypeId -> SqlTypeId -> Bool
(SqlTypeId -> SqlTypeId -> Bool)
-> (SqlTypeId -> SqlTypeId -> Bool) -> Eq SqlTypeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlTypeId -> SqlTypeId -> Bool
$c/= :: SqlTypeId -> SqlTypeId -> Bool
== :: SqlTypeId -> SqlTypeId -> Bool
$c== :: SqlTypeId -> SqlTypeId -> Bool
Eq, Int -> SqlTypeId -> ShowS
[SqlTypeId] -> ShowS
SqlTypeId -> String
(Int -> SqlTypeId -> ShowS)
-> (SqlTypeId -> String)
-> ([SqlTypeId] -> ShowS)
-> Show SqlTypeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlTypeId] -> ShowS
$cshowList :: [SqlTypeId] -> ShowS
show :: SqlTypeId -> String
$cshow :: SqlTypeId -> String
showsPrec :: Int -> SqlTypeId -> ShowS
$cshowsPrec :: Int -> SqlTypeId -> ShowS
Show, ReadPrec [SqlTypeId]
ReadPrec SqlTypeId
Int -> ReadS SqlTypeId
ReadS [SqlTypeId]
(Int -> ReadS SqlTypeId)
-> ReadS [SqlTypeId]
-> ReadPrec SqlTypeId
-> ReadPrec [SqlTypeId]
-> Read SqlTypeId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SqlTypeId]
$creadListPrec :: ReadPrec [SqlTypeId]
readPrec :: ReadPrec SqlTypeId
$creadPrec :: ReadPrec SqlTypeId
readList :: ReadS [SqlTypeId]
$creadList :: ReadS [SqlTypeId]
readsPrec :: Int -> ReadS SqlTypeId
$creadsPrec :: Int -> ReadS SqlTypeId
Read, Typeable)

{- | The different types of intervals in SQL. -}
data SqlInterval =
      SqlIntervalMonthT         -- ^ Difference in months
    | SqlIntervalYearT          -- ^ Difference in years
    | SqlIntervalYearToMonthT   -- ^ Difference in years+months
    | SqlIntervalDayT           -- ^ Difference in days
    | SqlIntervalHourT          -- ^ Difference in hours
    | SqlIntervalMinuteT        -- ^ Difference in minutes
    | SqlIntervalSecondT        -- ^ Difference in seconds
    | SqlIntervalDayToHourT     -- ^ Difference in days+hours
    | SqlIntervalDayToMinuteT   -- ^ Difference in days+minutes
    | SqlIntervalDayToSecondT   -- ^ Difference in days+seconds
    | SqlIntervalHourToMinuteT  -- ^ Difference in hours+minutes
    | SqlIntervalHourToSecondT  -- ^ Difference in hours+seconds
    | SqlIntervalMinuteToSecondT -- ^ Difference in minutes+seconds
      deriving (SqlInterval -> SqlInterval -> Bool
(SqlInterval -> SqlInterval -> Bool)
-> (SqlInterval -> SqlInterval -> Bool) -> Eq SqlInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlInterval -> SqlInterval -> Bool
$c/= :: SqlInterval -> SqlInterval -> Bool
== :: SqlInterval -> SqlInterval -> Bool
$c== :: SqlInterval -> SqlInterval -> Bool
Eq, Int -> SqlInterval -> ShowS
[SqlInterval] -> ShowS
SqlInterval -> String
(Int -> SqlInterval -> ShowS)
-> (SqlInterval -> String)
-> ([SqlInterval] -> ShowS)
-> Show SqlInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlInterval] -> ShowS
$cshowList :: [SqlInterval] -> ShowS
show :: SqlInterval -> String
$cshow :: SqlInterval -> String
showsPrec :: Int -> SqlInterval -> ShowS
$cshowsPrec :: Int -> SqlInterval -> ShowS
Show, ReadPrec [SqlInterval]
ReadPrec SqlInterval
Int -> ReadS SqlInterval
ReadS [SqlInterval]
(Int -> ReadS SqlInterval)
-> ReadS [SqlInterval]
-> ReadPrec SqlInterval
-> ReadPrec [SqlInterval]
-> Read SqlInterval
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SqlInterval]
$creadListPrec :: ReadPrec [SqlInterval]
readPrec :: ReadPrec SqlInterval
$creadPrec :: ReadPrec SqlInterval
readList :: ReadS [SqlInterval]
$creadList :: ReadS [SqlInterval]
readsPrec :: Int -> ReadS SqlInterval
$creadsPrec :: Int -> ReadS SqlInterval
Read, Typeable)