module Hasql.TH.Extraction.PrimitiveType where

import Hasql.TH.Prelude hiding (sortBy, bit, fromList)
import PostgresqlSyntax.Ast


data PrimitiveType =
  BoolPrimitiveType |
  Int2PrimitiveType |
  Int4PrimitiveType |
  Int8PrimitiveType |
  Float4PrimitiveType |
  Float8PrimitiveType |
  NumericPrimitiveType |
  CharPrimitiveType |
  TextPrimitiveType |
  ByteaPrimitiveType |
  DatePrimitiveType |
  TimestampPrimitiveType |
  TimestamptzPrimitiveType |
  TimePrimitiveType |
  TimetzPrimitiveType |
  IntervalPrimitiveType |
  UuidPrimitiveType |
  InetPrimitiveType |
  JsonPrimitiveType |
  JsonbPrimitiveType

simpleTypename :: SimpleTypename -> Either Text PrimitiveType
simpleTypename = \ case
  GenericTypeSimpleTypename GenericType
a -> GenericType -> Either Text PrimitiveType
genericType GenericType
a
  NumericSimpleTypename Numeric
a -> Numeric -> Either Text PrimitiveType
forall a. IsString a => Numeric -> Either a PrimitiveType
numeric Numeric
a
  BitSimpleTypename Bit
a -> Bit -> Either Text PrimitiveType
forall a p b. IsString a => p -> Either a b
bit Bit
a
  CharacterSimpleTypename Character
a -> Character -> Either Text PrimitiveType
forall p a. p -> Either a PrimitiveType
character Character
a
  ConstDatetimeSimpleTypename ConstDatetime
a -> ConstDatetime -> Either Text PrimitiveType
forall a. ConstDatetime -> Either a PrimitiveType
constDatetime ConstDatetime
a
  ConstIntervalSimpleTypename Either (Maybe Interval) Iconst
a -> PrimitiveType -> Either Text PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
IntervalPrimitiveType

genericType :: GenericType -> Either Text PrimitiveType
genericType (GenericType TypeFunctionName
a Maybe Attrs
b Maybe TypeModifiers
c) = case Maybe Attrs
b of
  Just Attrs
_ -> Text -> Either Text PrimitiveType
forall a b. a -> Either a b
Left Text
"Type attributes are not supported"
  Maybe Attrs
Nothing -> case Maybe TypeModifiers
c of
    Just TypeModifiers
_ -> Text -> Either Text PrimitiveType
forall a b. a -> Either a b
Left Text
"Type modifiers are not supported"
    Maybe TypeModifiers
Nothing -> TypeFunctionName -> Either Text PrimitiveType
ident TypeFunctionName
a

numeric :: Numeric -> Either a PrimitiveType
numeric = \ case
  Numeric
IntNumeric -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Int4PrimitiveType
  Numeric
IntegerNumeric -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Int4PrimitiveType
  Numeric
SmallintNumeric -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Int2PrimitiveType
  Numeric
BigintNumeric -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Int8PrimitiveType
  Numeric
RealNumeric -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Float4PrimitiveType
  FloatNumeric Maybe Iconst
a -> case Maybe Iconst
a of
    Just Iconst
_ -> a -> Either a PrimitiveType
forall a b. a -> Either a b
Left a
"Modifier on FLOAT is not supported"
    Maybe Iconst
Nothing -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Float4PrimitiveType
  Numeric
DoublePrecisionNumeric -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Float8PrimitiveType
  DecimalNumeric Maybe TypeModifiers
a -> case Maybe TypeModifiers
a of
    Just TypeModifiers
_ -> a -> Either a PrimitiveType
forall a b. a -> Either a b
Left a
"Modifiers on DECIMAL are not supported"
    Maybe TypeModifiers
Nothing -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
NumericPrimitiveType
  DecNumeric Maybe TypeModifiers
a -> case Maybe TypeModifiers
a of
    Just TypeModifiers
_ -> a -> Either a PrimitiveType
forall a b. a -> Either a b
Left a
"Modifiers on DEC are not supported"
    Maybe TypeModifiers
Nothing -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
NumericPrimitiveType
  NumericNumeric Maybe TypeModifiers
a -> case Maybe TypeModifiers
a of
    Just TypeModifiers
_ -> a -> Either a PrimitiveType
forall a b. a -> Either a b
Left a
"Modifiers on NUMERIC are not supported"
    Maybe TypeModifiers
Nothing -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
NumericPrimitiveType
  Numeric
BooleanNumeric -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
BoolPrimitiveType

bit :: p -> Either a b
bit p
_ = a -> Either a b
forall a b. a -> Either a b
Left a
"Bit codec is not supported"

character :: p -> Either a PrimitiveType
character p
_ = PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TextPrimitiveType

constDatetime :: ConstDatetime -> Either a PrimitiveType
constDatetime = \ case
  TimestampConstDatetime Maybe Iconst
_ Maybe Timezone
a -> if Maybe Timezone -> Timezone
tz Maybe Timezone
a then PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimestamptzPrimitiveType else PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimestampPrimitiveType
  TimeConstDatetime Maybe Iconst
_ Maybe Timezone
a -> if Maybe Timezone -> Timezone
tz Maybe Timezone
a then PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimetzPrimitiveType else PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimePrimitiveType
  where
    tz :: Maybe Timezone -> Timezone
tz = \ case
      Just Timezone
a -> Timezone
a
      Maybe Timezone
Nothing -> Timezone
False

ident :: TypeFunctionName -> Either Text PrimitiveType
ident = \ case
  QuotedIdent Text
a -> Text -> Either Text PrimitiveType
forall a.
(Eq a, IsString a, Semigroup a) =>
a -> Either a PrimitiveType
name Text
a
  UnquotedIdent Text
a -> Text -> Either Text PrimitiveType
forall a.
(Eq a, IsString a, Semigroup a) =>
a -> Either a PrimitiveType
name Text
a

name :: a -> Either a PrimitiveType
name = \ case
  a
"bool" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
BoolPrimitiveType
  a
"int2" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Int2PrimitiveType
  a
"int4" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Int4PrimitiveType
  a
"int8" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Int8PrimitiveType
  a
"float4" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Float4PrimitiveType
  a
"float8" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
Float8PrimitiveType
  a
"numeric" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
NumericPrimitiveType
  a
"char" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
CharPrimitiveType
  a
"text" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TextPrimitiveType
  a
"bytea" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
ByteaPrimitiveType
  a
"date" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
DatePrimitiveType
  a
"timestamp" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimestampPrimitiveType
  a
"timestamptz" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimestamptzPrimitiveType
  a
"time" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimePrimitiveType
  a
"timetz" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
TimetzPrimitiveType
  a
"interval" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
IntervalPrimitiveType
  a
"uuid" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
UuidPrimitiveType
  a
"inet" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
InetPrimitiveType
  a
"json" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
JsonPrimitiveType
  a
"jsonb" -> PrimitiveType -> Either a PrimitiveType
forall a b. b -> Either a b
Right PrimitiveType
JsonbPrimitiveType
  a
name -> a -> Either a PrimitiveType
forall a b. a -> Either a b
Left (a
"No codec exists for type: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
name)