module DB.HSQL.Type where
{-| Differentiation of data types used in DBs.
-}

data SqlType
    -- numeric:         
    = SqlInteger               -- ODBC, MySQL, PostgreSQL, MSI
    | SqlBigInt                -- ODBC, MySQL, PostgreSQL, MSI
    | SqlSmallInt              -- ODBC, MySQL, PostgreSQL
    | SqlTinyInt               -- ODBC, MySQL, PostgreSQL
    | SqlMedInt                --     , MySQL,  
    | SqlDecimal       Int Int -- ODBC, MySQL, PostgreSQL
    | SqlNumeric       Int Int -- ODBC, MySQL, PostgreSQL
    | SqlReal                  -- ODBC, MySQL, PostgreSQL
    | SqlDouble                -- ODBC, MySQL, PostgreSQL
    | SqlFloat                 -- ODBC

    -- monetary:
    | SqlMoney                 --     ,      , PostgreSQL

    -- character:
    | SqlChar          Int     -- ODBC, MySQL, PostgreSQL
    | SqlVarChar       Int     -- ODBC, MySQL, PostgreSQL, MSI
    | SqlLongVarChar   Int     -- ODBC
    | SqlText                  --     ,      , PostgreSQL, MSI
    | SqlWChar         Int     -- ODBC
    | SqlWVarChar      Int     -- ODBC
    | SqlWLongVarChar  Int     -- ODBC

    -- date / time:
    | SqlDate                  -- ODBC, MySQL, PostgreSQL
    | SqlTime                  -- ODBC, MySQL, PostgreSQL
    | SqlTimeTZ                --     ,      , PostgreSQL
    | SqlAbsTime               --     ,      , PostgreSQL
    | SqlRelTime               --     ,      , PostgreSQL
    | SqlTimeInterval          --     ,      , PostgreSQL
    | SqlAbsTimeInterval       --     ,      , PostgreSQL
    | SqlTimeStamp             -- ODBC, MySQL
    | SqlDateTime              --     , MySQL
    | SqlDateTimeTZ            --     , MySQL, PostgreSQL
    | SqlYear                  --     , MySQL

    -- booleans:
    | SqlBit                   -- ODBC,      , PostgreSQL

    -- enums:
    | SqlENUM                  --     , MySQL

    -- geometric types:
    | SqlPoint                 --     ,      , PostgreSQL
    | SqlLSeg                  --     ,      , PostgreSQL
    | SqlPath                  --     ,      , PostgreSQL
    | SqlBox                   --     ,      , PostgreSQL
    | SqlPolygon               --     ,      , PostgreSQL
    | SqlLine                  --     ,      , PostgreSQL  
    | SqlCircle                --     ,      , PostgreSQL

    -- network addresses:
    | SqlINetAddr              --     ,      , PostgreSQL
    | SqlCIDRAddr              --     ,      , PostgreSQL
    | SqlMacAddr               --     ,      , PostgreSQL

    -- bit strings:
    | SqlBinary        Int     -- ODBC,      , PostgreSQL
    | SqlVarBinary     Int     -- ODBC,      , PostgreSQL
    | SqlLongVarBinary Int     -- ODBC

    -- collections:
    | SqlSET                   --     , MySQL
    
    -- lobs:
    | SqlBLOB                  --     , MySQL,           , MSI

    -- unknown:
    | SqlUnknown Int -- ^ HSQL returns @SqlUnknown tp@ for all
	             -- columns for which it cannot determine
	             -- the right type. The @tp@ here is the
	             -- internal type code returned from the
	             -- backend library
    deriving (Eq, Show)