module Hasql.TH.Extraction.PrimitiveType where

import Hasql.TH.Prelude hiding (bit, fromList, sortBy)
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
CharPrimitiveType

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)