{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This is a module which adapts and simplifies certain things normally provided by "beam-migrate", but
--     without the extra complication of importing and using the library itself.
module Database.Beam.AutoMigrate.Compat where

import Data.Aeson (FromJSON, ToJSON)
import Data.ByteString (ByteString)
import Data.Int
import qualified Data.Map.Strict as M
import Data.Scientific (Scientific)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (LocalTime, TimeOfDay, UTCTime)
import Data.Time.Calendar (Day)
import Data.Typeable
import Data.UUID
import Data.Vector (Vector)
import Data.Word
import qualified Database.Beam as Beam
import Database.Beam.AutoMigrate.Types
import qualified Database.Beam.AutoMigrate.Util as Util
import Database.Beam.Backend.SQL hiding (tableName)
import qualified Database.Beam.Backend.SQL.AST as AST
import qualified Database.Beam.Postgres as Pg
import qualified Database.PostgreSQL.Simple.Types as Psql

--
-- Specifying SQL data types and constraints
--

class HasColumnType ty where
  -- | Provide a 'ColumnType' for the given type
  defaultColumnType :: Proxy ty -> ColumnType

  defaultTypeCast :: Proxy ty -> Maybe Text
  defaultTypeCast Proxy ty
_ = Maybe Text
forall a. Maybe a
Nothing

  -- | If @ty@ maps to a DB @ENUM@, use this method to specify which one.
  defaultEnums :: Proxy ty -> Enumerations
  defaultEnums Proxy ty
_ = Enumerations
forall a. Monoid a => a
mempty

class Ord (SchemaConstraint ty) => HasSchemaConstraints ty where
  -- | Provide arbitrary constraints on a field of the requested type.
  schemaConstraints :: Proxy ty -> Set (SchemaConstraint ty)
  schemaConstraints Proxy ty
_ = Set (SchemaConstraint ty)
forall a. Monoid a => a
mempty

class Ord (SchemaConstraint ty) => HasSchemaConstraints' (nullary :: Bool) ty where
  schemaConstraints' :: Proxy nullary -> Proxy ty -> Set (SchemaConstraint ty)

type family SchemaConstraint (k :: *) where
  SchemaConstraint (Beam.TableEntity e) = TableConstraint
  SchemaConstraint (Beam.TableField e t) = ColumnConstraint

type family IsMaybe (k :: *) :: Bool where
  IsMaybe (Maybe x) = 'True
  IsMaybe (Beam.TableField t (Maybe x)) = 'True
  IsMaybe (Beam.TableField t _) = 'False
  IsMaybe _ = 'False

-- Default /table-level/ constraints.
instance HasSchemaConstraints' 'True (Beam.TableEntity tbl) where
  schemaConstraints' :: Proxy 'True
-> Proxy (TableEntity tbl)
-> Set (SchemaConstraint (TableEntity tbl))
schemaConstraints' Proxy 'True
Proxy Proxy (TableEntity tbl)
Proxy = Set (SchemaConstraint (TableEntity tbl))
forall a. Monoid a => a
mempty

instance HasSchemaConstraints' 'False (Beam.TableEntity tbl) where
  schemaConstraints' :: Proxy 'False
-> Proxy (TableEntity tbl)
-> Set (SchemaConstraint (TableEntity tbl))
schemaConstraints' Proxy 'False
Proxy Proxy (TableEntity tbl)
Proxy = Set (SchemaConstraint (TableEntity tbl))
forall a. Monoid a => a
mempty

-- Default /field-level/ constraints.

instance HasSchemaConstraints' 'True (Beam.TableField e (Beam.TableField e t)) where
  schemaConstraints' :: Proxy 'True
-> Proxy (TableField e (TableField e t))
-> Set (SchemaConstraint (TableField e (TableField e t)))
schemaConstraints' Proxy 'True
Proxy Proxy (TableField e (TableField e t))
Proxy = Set (SchemaConstraint (TableField e (TableField e t)))
forall a. Monoid a => a
mempty

instance HasSchemaConstraints' 'False (Beam.TableField e (Beam.TableField e t)) where
  schemaConstraints' :: Proxy 'False
-> Proxy (TableField e (TableField e t))
-> Set (SchemaConstraint (TableField e (TableField e t)))
schemaConstraints' Proxy 'False
Proxy Proxy (TableField e (TableField e t))
Proxy = ColumnConstraint -> Set ColumnConstraint
forall a. a -> Set a
S.singleton ColumnConstraint
NotNull

instance HasSchemaConstraints' 'True (Beam.TableField e (Maybe t)) where
  schemaConstraints' :: Proxy 'True
-> Proxy (TableField e (Maybe t))
-> Set (SchemaConstraint (TableField e (Maybe t)))
schemaConstraints' Proxy 'True
Proxy Proxy (TableField e (Maybe t))
Proxy = Set (SchemaConstraint (TableField e (Maybe t)))
forall a. Monoid a => a
mempty

instance HasSchemaConstraints' 'False (Beam.TableField e t) where
  schemaConstraints' :: Proxy 'False
-> Proxy (TableField e t)
-> Set (SchemaConstraint (TableField e t))
schemaConstraints' Proxy 'False
Proxy Proxy (TableField e t)
Proxy = ColumnConstraint -> Set ColumnConstraint
forall a. a -> Set a
S.singleton ColumnConstraint
NotNull

instance
  ( IsMaybe a ~ nullary,
    HasSchemaConstraints' nullary a,
    Ord (SchemaConstraint a)
  ) =>
  HasSchemaConstraints a
  where
  schemaConstraints :: Proxy a -> Set (SchemaConstraint a)
schemaConstraints = Proxy nullary -> Proxy a -> Set (SchemaConstraint a)
forall (nullary :: Bool) ty.
HasSchemaConstraints' nullary ty =>
Proxy nullary -> Proxy ty -> Set (SchemaConstraint ty)
schemaConstraints' (Proxy nullary
forall k (t :: k). Proxy t
Proxy :: Proxy nullary)

--
-- Generating \"companion\" sequences when particular types are used.
--

type family GeneratesSqlSequence ty where
  GeneratesSqlSequence (SqlSerial a) = 'True
  GeneratesSqlSequence _ = 'False

class HasCompanionSequence' (generatesSeq :: Bool) ty where
  hasCompanionSequence' ::
    Proxy generatesSeq ->
    Proxy ty ->
    TableName ->
    ColumnName ->
    Maybe ((SequenceName, Sequence), ColumnConstraint)

class HasCompanionSequence ty where
  hasCompanionSequence ::
    Proxy ty ->
    TableName ->
    ColumnName ->
    Maybe ((SequenceName, Sequence), ColumnConstraint)

instance
  ( GeneratesSqlSequence ty ~ genSeq,
    HasCompanionSequence' genSeq ty
  ) =>
  HasCompanionSequence ty
  where
  hasCompanionSequence :: Proxy ty
-> TableName
-> ColumnName
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
hasCompanionSequence = Proxy genSeq
-> Proxy ty
-> TableName
-> ColumnName
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
forall (generatesSeq :: Bool) ty.
HasCompanionSequence' generatesSeq ty =>
Proxy generatesSeq
-> Proxy ty
-> TableName
-> ColumnName
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
hasCompanionSequence' (Proxy genSeq
forall k (t :: k). Proxy t
Proxy :: Proxy genSeq)

instance HasCompanionSequence' 'False ty where
  hasCompanionSequence' :: Proxy 'False
-> Proxy ty
-> TableName
-> ColumnName
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
hasCompanionSequence' Proxy 'False
_ Proxy ty
_ TableName
_ ColumnName
_ = Maybe ((SequenceName, Sequence), ColumnConstraint)
forall a. Maybe a
Nothing

--
-- Sql datatype instances for the most common types.
--

instance HasColumnType ty => HasColumnType (Beam.TableField e ty) where
  defaultColumnType :: Proxy (TableField e ty) -> ColumnType
defaultColumnType Proxy (TableField e ty)
_ = Proxy ty -> ColumnType
forall ty. HasColumnType ty => Proxy ty -> ColumnType
defaultColumnType (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty)
  defaultTypeCast :: Proxy (TableField e ty) -> Maybe Text
defaultTypeCast Proxy (TableField e ty)
_ = Proxy ty -> Maybe Text
forall ty. HasColumnType ty => Proxy ty -> Maybe Text
defaultTypeCast (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty)

instance HasColumnType ty => HasColumnType (Maybe ty) where
  defaultColumnType :: Proxy (Maybe ty) -> ColumnType
defaultColumnType Proxy (Maybe ty)
_ = Proxy ty -> ColumnType
forall ty. HasColumnType ty => Proxy ty -> ColumnType
defaultColumnType (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty)
  defaultTypeCast :: Proxy (Maybe ty) -> Maybe Text
defaultTypeCast Proxy (Maybe ty)
_ = Proxy ty -> Maybe Text
forall ty. HasColumnType ty => Proxy ty -> Maybe Text
defaultTypeCast (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty)
  defaultEnums :: Proxy (Maybe ty) -> Enumerations
defaultEnums Proxy (Maybe ty)
_ = Proxy ty -> Enumerations
forall ty. HasColumnType ty => Proxy ty -> Enumerations
defaultEnums (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty)

instance HasColumnType Int where
  defaultColumnType :: Proxy Int -> ColumnType
defaultColumnType Proxy Int
_ = DataType -> ColumnType
SqlStdType DataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType
  defaultTypeCast :: Proxy Int -> Maybe Text
defaultTypeCast Proxy Int
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"integer"

instance HasColumnType Int32 where
  defaultColumnType :: Proxy Int32 -> ColumnType
defaultColumnType Proxy Int32
_ = DataType -> ColumnType
SqlStdType DataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType
  defaultTypeCast :: Proxy Int32 -> Maybe Text
defaultTypeCast Proxy Int32
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"integer"

instance HasColumnType Int16 where
  defaultColumnType :: Proxy Int16 -> ColumnType
defaultColumnType Proxy Int16
_ = DataType -> ColumnType
SqlStdType DataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType
  defaultTypeCast :: Proxy Int16 -> Maybe Text
defaultTypeCast Proxy Int16
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"integer"

instance HasColumnType Int64 where
  defaultColumnType :: Proxy Int64 -> ColumnType
defaultColumnType Proxy Int64
_ = DataType -> ColumnType
SqlStdType DataType
forall dataType. IsSql2008BigIntDataTypeSyntax dataType => dataType
bigIntType
  defaultTypeCast :: Proxy Int64 -> Maybe Text
defaultTypeCast Proxy Int64
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bigint"

instance HasColumnType Word where
  defaultColumnType :: Proxy Word -> ColumnType
defaultColumnType Proxy Word
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe (Word, Maybe Word) -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType ((Word, Maybe Word) -> Maybe (Word, Maybe Word)
forall a. a -> Maybe a
Just (Word
10, Maybe Word
forall a. Maybe a
Nothing))
  defaultTypeCast :: Proxy Word -> Maybe Text
defaultTypeCast Proxy Word
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"numeric"

instance HasColumnType Word16 where
  defaultColumnType :: Proxy Word16 -> ColumnType
defaultColumnType Proxy Word16
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe (Word, Maybe Word) -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType ((Word, Maybe Word) -> Maybe (Word, Maybe Word)
forall a. a -> Maybe a
Just (Word
5, Maybe Word
forall a. Maybe a
Nothing))
  defaultTypeCast :: Proxy Word16 -> Maybe Text
defaultTypeCast Proxy Word16
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"numeric"

instance HasColumnType Word32 where
  defaultColumnType :: Proxy Word32 -> ColumnType
defaultColumnType Proxy Word32
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe (Word, Maybe Word) -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType ((Word, Maybe Word) -> Maybe (Word, Maybe Word)
forall a. a -> Maybe a
Just (Word
10, Maybe Word
forall a. Maybe a
Nothing))
  defaultTypeCast :: Proxy Word32 -> Maybe Text
defaultTypeCast Proxy Word32
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"numeric"

instance HasColumnType Word64 where
  defaultColumnType :: Proxy Word64 -> ColumnType
defaultColumnType Proxy Word64
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe (Word, Maybe Word) -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType ((Word, Maybe Word) -> Maybe (Word, Maybe Word)
forall a. a -> Maybe a
Just (Word
20, Maybe Word
forall a. Maybe a
Nothing))
  defaultTypeCast :: Proxy Word64 -> Maybe Text
defaultTypeCast Proxy Word64
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"numeric"

instance HasColumnType Text where
  defaultColumnType :: Proxy Text -> ColumnType
defaultColumnType Proxy Text
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe Word -> Maybe Text -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Maybe Text -> dataType
varCharType Maybe Word
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
  defaultTypeCast :: Proxy Text -> Maybe Text
defaultTypeCast Proxy Text
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"character varying"

instance HasColumnType SqlBitString where
  defaultColumnType :: Proxy SqlBitString -> ColumnType
defaultColumnType Proxy SqlBitString
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe Word -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
varBitType Maybe Word
forall a. Maybe a
Nothing
  defaultTypeCast :: Proxy SqlBitString -> Maybe Text
defaultTypeCast Proxy SqlBitString
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bit"

instance HasColumnType ByteString where
  defaultColumnType :: Proxy ByteString -> ColumnType
defaultColumnType Proxy ByteString
_ = DataType -> ColumnType
SqlStdType DataType
AST.DataTypeBinaryLargeObject

instance HasColumnType Double where
  defaultColumnType :: Proxy Double -> ColumnType
defaultColumnType Proxy Double
_ = DataType -> ColumnType
SqlStdType DataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
doubleType
  defaultTypeCast :: Proxy Double -> Maybe Text
defaultTypeCast Proxy Double
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"double precision"

instance HasColumnType Scientific where
  defaultColumnType :: Proxy Scientific -> ColumnType
defaultColumnType Proxy Scientific
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe (Word, Maybe Word) -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType ((Word, Maybe Word) -> Maybe (Word, Maybe Word)
forall a. a -> Maybe a
Just (Word
20, Word -> Maybe Word
forall a. a -> Maybe a
Just Word
10))
  defaultTypeCast :: Proxy Scientific -> Maybe Text
defaultTypeCast Proxy Scientific
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"numeric"

instance HasColumnType Day where
  defaultColumnType :: Proxy Day -> ColumnType
defaultColumnType Proxy Day
_ = DataType -> ColumnType
SqlStdType DataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
dateType
  defaultTypeCast :: Proxy Day -> Maybe Text
defaultTypeCast Proxy Day
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"date"

instance HasColumnType TimeOfDay where
  defaultColumnType :: Proxy TimeOfDay -> ColumnType
defaultColumnType Proxy TimeOfDay
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe Word -> Bool -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timeType Maybe Word
forall a. Maybe a
Nothing Bool
False
  defaultTypeCast :: Proxy TimeOfDay -> Maybe Text
defaultTypeCast Proxy TimeOfDay
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"time without time zone"

instance HasColumnType Bool where
  defaultColumnType :: Proxy Bool -> ColumnType
defaultColumnType Proxy Bool
_ = DataType -> ColumnType
SqlStdType DataType
forall dataType. IsSql99DataTypeSyntax dataType => dataType
booleanType
  defaultTypeCast :: Proxy Bool -> Maybe Text
defaultTypeCast Proxy Bool
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"boolean"

instance HasColumnType LocalTime where
  defaultColumnType :: Proxy LocalTime -> ColumnType
defaultColumnType Proxy LocalTime
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe Word -> Bool -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timestampType Maybe Word
forall a. Maybe a
Nothing Bool
False
  defaultTypeCast :: Proxy LocalTime -> Maybe Text
defaultTypeCast Proxy LocalTime
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"timestamp without time zone"

instance HasColumnType UTCTime where
  defaultColumnType :: Proxy UTCTime -> ColumnType
defaultColumnType Proxy UTCTime
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe Word -> Bool -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timestampType Maybe Word
forall a. Maybe a
Nothing Bool
True
  defaultTypeCast :: Proxy UTCTime -> Maybe Text
defaultTypeCast Proxy UTCTime
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"timestamp with time zone"

instance HasColumnType UUID where
  defaultColumnType :: Proxy UUID -> ColumnType
defaultColumnType Proxy UUID
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgUuid
  defaultTypeCast :: Proxy UUID -> Maybe Text
defaultTypeCast Proxy UUID
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"uuid"

--
-- support for json types
--

instance (FromJSON a, ToJSON a) => HasColumnType (Pg.PgJSON a) where
  defaultColumnType :: Proxy (PgJSON a) -> ColumnType
defaultColumnType Proxy (PgJSON a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgJson

instance (FromJSON a, ToJSON a) => HasColumnType (Pg.PgJSONB a) where
  defaultColumnType :: Proxy (PgJSONB a) -> ColumnType
defaultColumnType Proxy (PgJSONB a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgJsonB

--
-- support for pg range types
--

instance HasColumnType (Pg.PgRange Pg.PgInt4Range a) where
  defaultColumnType :: Proxy (PgRange PgInt4Range a) -> ColumnType
defaultColumnType Proxy (PgRange PgInt4Range a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgRangeInt4

instance HasColumnType (Pg.PgRange Pg.PgInt8Range a) where
  defaultColumnType :: Proxy (PgRange PgInt8Range a) -> ColumnType
defaultColumnType Proxy (PgRange PgInt8Range a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgRangeInt8

instance HasColumnType (Pg.PgRange Pg.PgNumRange a) where
  defaultColumnType :: Proxy (PgRange PgNumRange a) -> ColumnType
defaultColumnType Proxy (PgRange PgNumRange a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgRangeNum

instance HasColumnType (Pg.PgRange Pg.PgTsRange a) where
  defaultColumnType :: Proxy (PgRange PgTsRange a) -> ColumnType
defaultColumnType Proxy (PgRange PgTsRange a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgRangeTs

instance HasColumnType (Pg.PgRange Pg.PgTsTzRange a) where
  defaultColumnType :: Proxy (PgRange PgTsTzRange a) -> ColumnType
defaultColumnType Proxy (PgRange PgTsTzRange a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgRangeTsTz

instance HasColumnType (Pg.PgRange Pg.PgDateRange a) where
  defaultColumnType :: Proxy (PgRange PgDateRange a) -> ColumnType
defaultColumnType Proxy (PgRange PgDateRange a)
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgRangeDate

--
-- support for arrays
--

instance HasColumnType a => HasColumnType (Vector a) where
  defaultColumnType :: Proxy (Vector a) -> ColumnType
defaultColumnType Proxy (Vector a)
_ = case Proxy a -> ColumnType
forall ty. HasColumnType ty => Proxy ty -> ColumnType
defaultColumnType (Proxy a
forall k (t :: k). Proxy t
Proxy @a) of
    SqlArrayType ColumnType
t Word
d -> ColumnType -> Word -> ColumnType
SqlArrayType ColumnType
t (Word
d Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
    ColumnType
t -> ColumnType -> Word -> ColumnType
SqlArrayType ColumnType
t Word
1

--
-- Support for 'SqlSerial'. \"SERIAL\" is treated by Postgres as syntactic sugar for:
---
-- CREATE SEQUENCE tablename_colname_seq;
-- CREATE TABLE tablename (
--     colname integer DEFAULT nextval('tablename_colname_seq') NOT NULL
-- );
--
-- Historically this was treated as a richer type (i.e. a 'PgSpecificType PgSerial') which had the advantage
-- of being able, for example, to track down when a column type changed so that we were able to drop the
-- relevant sequence if needed. However, this created problems when reconciling the 'Schema' type with the
-- one from the DB in case this type appeared \"behind\" a 'PrimaryKey' constraint. In that case it appeared
-- in the 'Schema' as a 'PgSerial' but in reality that should have been simply an integer. This led to the
-- creation of an auxiliary \"companion type\" concept which was making the overall complication ever so
-- slightly more complicated. Using just 'intType' here simplifies everything, at the cost of not-so-precise
-- \"resource tracking\" (i.e. created-but-now-unused requences remains in the DB).
instance (Integral ty, HasColumnType ty) => HasColumnType (SqlSerial ty) where
  defaultColumnType :: Proxy (SqlSerial ty) -> ColumnType
defaultColumnType Proxy (SqlSerial ty)
_ = Proxy ty -> ColumnType
forall ty. HasColumnType ty => Proxy ty -> ColumnType
defaultColumnType (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty)

instance HasCompanionSequence' 'True (SqlSerial a) where
  hasCompanionSequence' :: Proxy 'True
-> Proxy (SqlSerial a)
-> TableName
-> ColumnName
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
hasCompanionSequence' Proxy 'True
Proxy Proxy (SqlSerial a)
Proxy TableName
tName ColumnName
cname =
    let s :: SequenceName
s@(SequenceName Text
sname) = SequenceName
mkSeqName
     in ((SequenceName, Sequence), ColumnConstraint)
-> Maybe ((SequenceName, Sequence), ColumnConstraint)
forall a. a -> Maybe a
Just ((SequenceName
s, TableName -> ColumnName -> Sequence
Sequence TableName
tName ColumnName
cname), Text -> ColumnConstraint
Default (Text
"nextval('" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Util.sqlEscaped Text
sname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'::regclass)"))
    where
      mkSeqName :: SequenceName
      mkSeqName :: SequenceName
mkSeqName = Text -> SequenceName
SequenceName (TableName -> Text
tableName TableName
tName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"___" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnName -> Text
columnName ColumnName
cname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"___seq")

--
-- support for enum types
--

instance (Show a, Typeable a, Enum a, Bounded a) => HasColumnType (PgEnum a) where
  defaultColumnType :: Proxy (PgEnum a) -> ColumnType
defaultColumnType (Proxy (PgEnum a)
Proxy :: (Proxy (PgEnum a))) =
    -- Postgres converts enumeration types to lowercase, so we need to call 'toLower' here.
    PgDataType -> ColumnType
PgSpecificType (EnumerationName -> PgDataType
PgEnumeration (EnumerationName -> PgDataType) -> EnumerationName -> PgDataType
forall a b. (a -> b) -> a -> b
$ Text -> EnumerationName
EnumerationName (Text -> Text
T.toLower (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep -> ShowS
showsTypeRep (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy @a)) String
forall a. Monoid a => a
mempty))

  defaultEnums :: Proxy (PgEnum a) -> Enumerations
defaultEnums p :: Proxy (PgEnum a)
p@(Proxy (PgEnum a)
Proxy :: (Proxy (PgEnum a))) =
    let (PgSpecificType (PgEnumeration EnumerationName
ty)) = Proxy (PgEnum a) -> ColumnType
forall ty. HasColumnType ty => Proxy ty -> ColumnType
defaultColumnType Proxy (PgEnum a)
p
        vals :: Enumeration
vals = [Text] -> Enumeration
Enumeration ([Text] -> Enumeration) -> [Text] -> Enumeration
forall a b. (a -> b) -> a -> b
$ (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) ([a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound] :: [a])
     in EnumerationName -> Enumeration -> Enumerations
forall k a. k -> a -> Map k a
M.singleton EnumerationName
ty Enumeration
vals

-- For now a `DbEnum` is isomorphic to a `varCharType`, as we don't have enough information on the Postgres
-- side to reconstruct the enumerated values.
instance (Show a, Typeable a, Enum a, Bounded a) => HasColumnType (DbEnum a) where
  defaultColumnType :: Proxy (DbEnum a) -> ColumnType
defaultColumnType Proxy (DbEnum a)
_ = DataType -> ColumnType
SqlStdType (DataType -> ColumnType) -> DataType -> ColumnType
forall a b. (a -> b) -> a -> b
$ Maybe Word -> Maybe Text -> DataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Maybe Text -> dataType
varCharType Maybe Word
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
  defaultTypeCast :: Proxy (DbEnum a) -> Maybe Text
defaultTypeCast Proxy (DbEnum a)
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"character varying"

--
-- support for oid
--

instance HasColumnType Psql.Oid where
  defaultColumnType :: Proxy Oid -> ColumnType
defaultColumnType Proxy Oid
_ = PgDataType -> ColumnType
PgSpecificType PgDataType
PgOid