module Database.PostgreSQL.PQTypes.Model.ColumnType (
    ColumnType(..)
  , columnTypeToSQL
  ) where

import Control.Applicative ((<$>))
import Data.Monoid
import Database.PostgreSQL.PQTypes
import Prelude
import qualified Data.Text as T

data ColumnType
  = BigIntT
  | BigSerialT
  | BinaryT
  | BoolT
  | DateT
  | DoubleT
  | IntegerT
  | UuidT
  | IntervalT
  | JsonT
  | JsonbT
  | SmallIntT
  | TextT
  | TimestampWithZoneT
  | TSVectorT
  | XmlT
  | ArrayT !ColumnType
  | CustomT !(RawSQL ())
    deriving (ColumnType -> ColumnType -> Bool
(ColumnType -> ColumnType -> Bool)
-> (ColumnType -> ColumnType -> Bool) -> Eq ColumnType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnType -> ColumnType -> Bool
$c/= :: ColumnType -> ColumnType -> Bool
== :: ColumnType -> ColumnType -> Bool
$c== :: ColumnType -> ColumnType -> Bool
Eq, Eq ColumnType
Eq ColumnType
-> (ColumnType -> ColumnType -> Ordering)
-> (ColumnType -> ColumnType -> Bool)
-> (ColumnType -> ColumnType -> Bool)
-> (ColumnType -> ColumnType -> Bool)
-> (ColumnType -> ColumnType -> Bool)
-> (ColumnType -> ColumnType -> ColumnType)
-> (ColumnType -> ColumnType -> ColumnType)
-> Ord ColumnType
ColumnType -> ColumnType -> Bool
ColumnType -> ColumnType -> Ordering
ColumnType -> ColumnType -> ColumnType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColumnType -> ColumnType -> ColumnType
$cmin :: ColumnType -> ColumnType -> ColumnType
max :: ColumnType -> ColumnType -> ColumnType
$cmax :: ColumnType -> ColumnType -> ColumnType
>= :: ColumnType -> ColumnType -> Bool
$c>= :: ColumnType -> ColumnType -> Bool
> :: ColumnType -> ColumnType -> Bool
$c> :: ColumnType -> ColumnType -> Bool
<= :: ColumnType -> ColumnType -> Bool
$c<= :: ColumnType -> ColumnType -> Bool
< :: ColumnType -> ColumnType -> Bool
$c< :: ColumnType -> ColumnType -> Bool
compare :: ColumnType -> ColumnType -> Ordering
$ccompare :: ColumnType -> ColumnType -> Ordering
$cp1Ord :: Eq ColumnType
Ord, Int -> ColumnType -> ShowS
[ColumnType] -> ShowS
ColumnType -> String
(Int -> ColumnType -> ShowS)
-> (ColumnType -> String)
-> ([ColumnType] -> ShowS)
-> Show ColumnType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnType] -> ShowS
$cshowList :: [ColumnType] -> ShowS
show :: ColumnType -> String
$cshow :: ColumnType -> String
showsPrec :: Int -> ColumnType -> ShowS
$cshowsPrec :: Int -> ColumnType -> ShowS
Show)

instance PQFormat ColumnType where
  pqFormat :: ByteString
pqFormat = PQFormat Text => ByteString
forall t. PQFormat t => ByteString
pqFormat @T.Text
instance FromSQL ColumnType where
  type PQBase ColumnType = PQBase T.Text
  fromSQL :: Maybe (PQBase ColumnType) -> IO ColumnType
fromSQL Maybe (PQBase ColumnType)
mbase = Text -> ColumnType
parseType (Text -> ColumnType) -> (Text -> Text) -> Text -> ColumnType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> ColumnType) -> IO Text -> IO ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PQBase Text) -> IO Text
forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe (PQBase Text)
Maybe (PQBase ColumnType)
mbase
    where
      parseType :: T.Text -> ColumnType
      parseType :: Text -> ColumnType
parseType = \case
        Text
"bigint" -> ColumnType
BigIntT
        Text
"bytea" -> ColumnType
BinaryT
        Text
"boolean" -> ColumnType
BoolT
        Text
"date" -> ColumnType
DateT
        Text
"double precision" -> ColumnType
DoubleT
        Text
"integer" -> ColumnType
IntegerT
        Text
"uuid" -> ColumnType
UuidT
        Text
"interval" -> ColumnType
IntervalT
        Text
"json" -> ColumnType
JsonT
        Text
"jsonb" -> ColumnType
JsonbT
        Text
"smallint" -> ColumnType
SmallIntT
        Text
"text" -> ColumnType
TextT
        Text
"timestamp with time zone" -> ColumnType
TimestampWithZoneT
        Text
"tsvector" -> ColumnType
TSVectorT
        Text
"xml" -> ColumnType
XmlT
        Text
tname
          | Text
"[]" Text -> Text -> Bool
`T.isSuffixOf` Text
tname -> ColumnType -> ColumnType
ArrayT (ColumnType -> ColumnType)
-> (Text -> ColumnType) -> Text -> ColumnType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ColumnType
parseType (Text -> ColumnType) -> Text -> ColumnType
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Text -> Int
T.length Text
tname Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Text
tname
          | Bool
otherwise -> RawSQL () -> ColumnType
CustomT (RawSQL () -> ColumnType) -> RawSQL () -> ColumnType
forall a b. (a -> b) -> a -> b
$ Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL Text
tname ()

columnTypeToSQL :: ColumnType -> RawSQL ()
columnTypeToSQL :: ColumnType -> RawSQL ()
columnTypeToSQL ColumnType
BigIntT            = RawSQL ()
"BIGINT"
columnTypeToSQL ColumnType
BigSerialT         = RawSQL ()
"BIGSERIAL"
columnTypeToSQL ColumnType
BinaryT            = RawSQL ()
"BYTEA"
columnTypeToSQL ColumnType
BoolT              = RawSQL ()
"BOOLEAN"
columnTypeToSQL ColumnType
DateT              = RawSQL ()
"DATE"
columnTypeToSQL ColumnType
DoubleT            = RawSQL ()
"DOUBLE PRECISION"
columnTypeToSQL ColumnType
IntegerT           = RawSQL ()
"INTEGER"
columnTypeToSQL ColumnType
UuidT              = RawSQL ()
"UUID"
columnTypeToSQL ColumnType
IntervalT          = RawSQL ()
"INTERVAL"
columnTypeToSQL ColumnType
JsonT              = RawSQL ()
"JSON"
columnTypeToSQL ColumnType
JsonbT             = RawSQL ()
"JSONB"
columnTypeToSQL ColumnType
SmallIntT          = RawSQL ()
"SMALLINT"
columnTypeToSQL ColumnType
TextT              = RawSQL ()
"TEXT"
columnTypeToSQL ColumnType
TSVectorT          = RawSQL ()
"TSVECTOR"
columnTypeToSQL ColumnType
TimestampWithZoneT = RawSQL ()
"TIMESTAMPTZ"
columnTypeToSQL ColumnType
XmlT               = RawSQL ()
"XML"
columnTypeToSQL (ArrayT ColumnType
t)         = ColumnType -> RawSQL ()
columnTypeToSQL ColumnType
t RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL ()
"[]"
columnTypeToSQL (CustomT RawSQL ()
tname)    = RawSQL ()
tname