{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-type-defaults #-}

-- | Migrations support for beam-postgres. See "Database.Beam.Migrate" for more
-- information on beam migrations.
module Database.Beam.Postgres.Migrate
  ( PgCommandSyntax, migrationBackend
  , postgresDataTypeDeserializers
  , pgPredConverter
  , getDbConstraints
  , getDbConstraintsForSchemas
  , pgTypeToHs
  , migrateScript
  , writeMigrationScript
  , pgDataTypeFromAtt

    -- * Postgres data types
  , tsquery, tsvector, text, bytea
  , unboundedArray, uuid, money
  , json, jsonb
  , smallserial, serial, bigserial
  , point, line, lineSegment, box
  ) where

import           Database.Beam.Backend.SQL
import           Database.Beam.Migrate.Actions (defaultActionProvider)
import qualified Database.Beam.Migrate.Backend as Tool
import qualified Database.Beam.Migrate.Checks as Db
import qualified Database.Beam.Migrate.SQL as Db
import           Database.Beam.Migrate.SQL.BeamExtensions
import qualified Database.Beam.Migrate.Serialization as Db
import qualified Database.Beam.Migrate.Types as Db
import qualified Database.Beam.Query.DataTypes as Db

import           Database.Beam.Postgres.Connection
import           Database.Beam.Postgres.CustomTypes
import           Database.Beam.Postgres.Extensions
import           Database.Beam.Postgres.PgSpecific
import           Database.Beam.Postgres.Syntax
import           Database.Beam.Postgres.Types

import           Database.Beam.Haskell.Syntax

import qualified Database.PostgreSQL.Simple as Pg
import qualified Database.PostgreSQL.Simple.Types as Pg
import qualified Database.PostgreSQL.Simple.TypeInfo.Static as Pg

import           Control.Applicative ((<|>))
import           Control.Arrow
import           Control.Exception (bracket)
import           Control.Monad

import           Data.Aeson hiding (json)
import           Data.Bits
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.HashMap.Strict as HM
import           Data.Int
import           Data.Maybe
import           Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Data.Typeable
import           Data.UUID.Types (UUID)
import qualified Data.Vector as V
#if !MIN_VERSION_base(4, 11, 0)
import           Data.Semigroup
#else
import           Data.Monoid (Endo(..))
#endif
import           Data.Word (Word64)

-- | Top-level migration backend for use by @beam-migrate@ tools
migrationBackend :: Tool.BeamMigrationBackend Postgres Pg
migrationBackend :: BeamMigrationBackend Postgres Pg
migrationBackend = String
-> String
-> Pg [SomeDatabasePredicate]
-> BeamDeserializers Postgres
-> (BeamSqlBackendSyntax Postgres -> String)
-> String
-> HaskellPredicateConverter
-> ActionProvider Postgres
-> (forall a. String -> Pg a -> IO (Either String a))
-> BeamMigrationBackend Postgres Pg
forall be (m :: * -> *).
(MonadBeam be m, MonadFail m, HasQBuilder be,
 BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 BeamSqlBackendCanSerialize be LocalTime,
 BeamSqlBackendCanSerialize be (Maybe LocalTime),
 BeamSqlBackendCanSerialize be Text,
 BeamSqlBackendCanSerialize be SqlNull,
 Sql92ReasonableMarshaller be) =>
String
-> String
-> m [SomeDatabasePredicate]
-> BeamDeserializers be
-> (BeamSqlBackendSyntax be -> String)
-> String
-> HaskellPredicateConverter
-> ActionProvider be
-> (forall a. String -> m a -> IO (Either String a))
-> BeamMigrationBackend be m
Tool.BeamMigrationBackend
                        String
"postgres"
                        ([String] -> String
unlines [ String
"For beam-postgres, this is a libpq connection string which can either be a list of key value pairs or a URI"
                                 , String
""
                                 , String
"For example, 'host=localhost port=5432 dbname=mydb connect_timeout=10' or 'dbname=mydb'"
                                 , String
""
                                 , String
"Or use URIs, for which the general form is:"
                                 , String
"  postgresql://[user[:password]@][netloc][:port][/dbname][?param1=value1&...]"
                                 , String
""
                                 , String
"See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING> for more information" ])
                        ((Connection -> IO [SomeDatabasePredicate])
-> Pg [SomeDatabasePredicate]
forall a. (Connection -> IO a) -> Pg a
liftIOWithHandle Connection -> IO [SomeDatabasePredicate]
getDbConstraints)
                        (BeamDeserializers Postgres
forall be. BeamMigrateSqlBackend be => BeamDeserializers be
Db.sql92Deserializers BeamDeserializers Postgres
-> BeamDeserializers Postgres -> BeamDeserializers Postgres
forall a. Semigroup a => a -> a -> a
<> BeamDeserializers Postgres
forall be. BeamMigrateSql99Backend be => BeamDeserializers be
Db.sql99DataTypeDeserializers BeamDeserializers Postgres
-> BeamDeserializers Postgres -> BeamDeserializers Postgres
forall a. Semigroup a => a -> a -> a
<>
                         BeamDeserializers Postgres
forall be.
(BeamMigrateSqlBackend be, BeamSqlT071Backend be) =>
BeamDeserializers be
Db.sql2008BigIntDataTypeDeserializers BeamDeserializers Postgres
-> BeamDeserializers Postgres -> BeamDeserializers Postgres
forall a. Semigroup a => a -> a -> a
<>
                         BeamDeserializers Postgres
postgresDataTypeDeserializers BeamDeserializers Postgres
-> BeamDeserializers Postgres -> BeamDeserializers Postgres
forall a. Semigroup a => a -> a -> a
<>
                         BeamDeserializers Postgres
forall be.
(Typeable be, BeamMigrateOnlySqlBackend be,
 HasDataTypeCreatedCheck
   (BeamMigrateSqlBackendDataTypeSyntax be)) =>
BeamDeserializers be
Db.beamCheckDeserializers)
                        (ByteString -> String
BCL.unpack (ByteString -> String)
-> (PgCommandSyntax -> ByteString) -> PgCommandSyntax -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";") (ByteString -> ByteString)
-> (PgCommandSyntax -> ByteString) -> PgCommandSyntax -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgSyntax -> ByteString
pgRenderSyntaxScript (PgSyntax -> ByteString)
-> (PgCommandSyntax -> PgSyntax) -> PgCommandSyntax -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgCommandSyntax -> PgSyntax
fromPgCommand) String
"postgres.sql"
                        HaskellPredicateConverter
pgPredConverter (ActionProvider Postgres
forall be.
(Typeable be, BeamMigrateOnlySqlBackend be) =>
ActionProvider be
defaultActionProvider ActionProvider Postgres
-> ActionProvider Postgres -> ActionProvider Postgres
forall a. Semigroup a => a -> a -> a
<> ActionProvider Postgres
pgExtensionActionProvider ActionProvider Postgres
-> ActionProvider Postgres -> ActionProvider Postgres
forall a. Semigroup a => a -> a -> a
<>
                                         ActionProvider Postgres
pgCustomEnumActionProvider)
                        (\String
options Pg a
action ->
                            IO Connection
-> (Connection -> IO ())
-> (Connection -> IO (Either String a))
-> IO (Either String a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> IO Connection
Pg.connectPostgreSQL (String -> ByteString
forall a. IsString a => String -> a
fromString String
options)) Connection -> IO ()
Pg.close ((Connection -> IO (Either String a)) -> IO (Either String a))
-> (Connection -> IO (Either String a)) -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
                              (BeamRowReadError -> String)
-> Either BeamRowReadError a -> Either String a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left BeamRowReadError -> String
forall a. Show a => a -> String
show (Either BeamRowReadError a -> Either String a)
-> IO (Either BeamRowReadError a) -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO ())
-> Connection -> Pg a -> IO (Either BeamRowReadError a)
forall a.
(String -> IO ())
-> Connection -> Pg a -> IO (Either BeamRowReadError a)
withPgDebug (\String
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Connection
conn Pg a
action)

-- | 'BeamDeserializers' for postgres-specific types:
--
--    * 'bytea'
--    * 'smallserial'
--    * 'serial'
--    * 'bigserial'
--    * 'tsvector'
--    * 'tsquery'
--    * 'text'
--    * 'json'
--    * 'jsonb'
--    * 'uuid'
--    * 'money'
--
postgresDataTypeDeserializers
  :: Db.BeamDeserializers Postgres
postgresDataTypeDeserializers :: BeamDeserializers Postgres
postgresDataTypeDeserializers =
  (forall be'.
 BeamDeserializers be' -> Value -> Parser PgDataTypeSyntax)
-> BeamDeserializers Postgres
forall ty be.
Typeable ty =>
(forall be'. BeamDeserializers be' -> Value -> Parser ty)
-> BeamDeserializers be
Db.beamDeserializer ((forall be'.
  BeamDeserializers be' -> Value -> Parser PgDataTypeSyntax)
 -> BeamDeserializers Postgres)
-> (forall be'.
    BeamDeserializers be' -> Value -> Parser PgDataTypeSyntax)
-> BeamDeserializers Postgres
forall a b. (a -> b) -> a -> b
$ \BeamDeserializers be'
_ Value
v ->
  case Value
v of
    Value
"bytea"       -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgByteaType
    Value
"smallserial" -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgSmallSerialType
    Value
"serial"      -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgSerialType
    Value
"bigserial"   -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgBigSerialType
    Value
"tsquery"     -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgTsQueryType
    Value
"tsvector"    -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgTsVectorType
    Value
"text"        -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgTextType
    Value
"json"        -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgJsonType
    Value
"jsonb"       -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgJsonbType
    Value
"uuid"        -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgUuidType
    Value
"money"       -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgMoneyType
    Value
"point"       -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgPointType
    Value
"line"        -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgLineType
    Value
"lseg"        -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgLineSegmentType
    Value
"box"         -> PgDataTypeSyntax -> Parser PgDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgBoxType
    Value
_             -> String -> Parser PgDataTypeSyntax
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Postgres data type"

-- | Converts postgres 'DatabasePredicate's to 'DatabasePredicate's in the
-- Haskell syntax. Allows automatic generation of Haskell schemas from postgres
-- constraints.
pgPredConverter :: Tool.HaskellPredicateConverter
pgPredConverter :: HaskellPredicateConverter
pgPredConverter = (BeamMigrateSqlBackendDataTypeSyntax Postgres -> Maybe HsDataType)
-> HaskellPredicateConverter
forall fromBe.
Typeable fromBe =>
(BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
-> HaskellPredicateConverter
Tool.sql92HsPredicateConverters @Postgres BeamMigrateSqlBackendDataTypeSyntax Postgres -> Maybe HsDataType
PgDataTypeSyntax -> Maybe HsDataType
pgTypeToHs HaskellPredicateConverter
-> HaskellPredicateConverter -> HaskellPredicateConverter
forall a. Semigroup a => a -> a -> a
<>
                  (TableColumnHasConstraint Postgres -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall pred.
Typeable pred =>
(pred -> Maybe SomeDatabasePredicate) -> HaskellPredicateConverter
Tool.hsPredicateConverter TableColumnHasConstraint Postgres -> Maybe SomeDatabasePredicate
pgHasColumnConstraint
  where
    pgHasColumnConstraint :: TableColumnHasConstraint Postgres -> Maybe SomeDatabasePredicate
pgHasColumnConstraint (Db.TableColumnHasConstraint QualifiedName
tblNm Text
colNm BeamSqlBackendColumnConstraintDefinitionSyntax Postgres
c :: Db.TableColumnHasConstraint Postgres)
      | BeamSqlBackendColumnConstraintDefinitionSyntax Postgres
PgColumnConstraintDefinitionSyntax
c PgColumnConstraintDefinitionSyntax
-> PgColumnConstraintDefinitionSyntax -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax
     PgColumnConstraintDefinitionSyntax
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax
        PgColumnConstraintDefinitionSyntax)
-> PgColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax Maybe Text
forall a. Maybe a
Nothing Sql92ColumnConstraintDefinitionConstraintSyntax
  PgColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax Maybe
  (Sql92ColumnConstraintDefinitionAttributesSyntax
     PgColumnConstraintDefinitionSyntax)
forall a. Maybe a
Nothing =
          SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall a. a -> Maybe a
Just (TableColumnHasConstraint HsMigrateBackend -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax HsMigrateBackend
-> TableColumnHasConstraint HsMigrateBackend
forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
Db.TableColumnHasConstraint QualifiedName
tblNm Text
colNm (Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax
     HsConstraintDefinition
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax
        HsConstraintDefinition)
-> HsConstraintDefinition
forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax Maybe Text
forall a. Maybe a
Nothing Sql92ColumnConstraintDefinitionConstraintSyntax
  HsConstraintDefinition
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax Maybe
  (Sql92ColumnConstraintDefinitionAttributesSyntax
     HsConstraintDefinition)
forall a. Maybe a
Nothing) :: Db.TableColumnHasConstraint HsMigrateBackend))
      | Bool
otherwise = Maybe SomeDatabasePredicate
forall a. Maybe a
Nothing

-- | Turn a 'PgDataTypeSyntax' into the corresponding 'HsDataType'. This is a
-- best effort guess, and may fail on more exotic types. Feel free to send PRs
-- to make this function more robust!
pgTypeToHs :: PgDataTypeSyntax -> Maybe HsDataType
pgTypeToHs :: PgDataTypeSyntax -> Maybe HsDataType
pgTypeToHs (PgDataTypeSyntax PgDataTypeDescr
tyDescr PgSyntax
_ BeamSerializedDataType
_) =
  case PgDataTypeDescr
tyDescr of
    PgDataTypeDescrOid Oid
oid Maybe Int32
width
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int2    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
smallIntType
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int4    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int8    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql2008BigIntDataTypeSyntax dataType => dataType
bigIntType

      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.bpchar  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> Maybe Text -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Maybe Text -> dataType
charType (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word) -> Maybe Int32 -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
width) Maybe Text
forall a. Maybe a
Nothing)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.varchar Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> Maybe Text -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Maybe Text -> dataType
varCharType (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word) -> Maybe Int32 -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
width) Maybe Text
forall a. Maybe a
Nothing)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.bit     Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
bitType (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word) -> Maybe Int32 -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
width))
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.varbit  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
varBitType (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word) -> Maybe Int32 -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
width))

      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.numeric Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          let decimals :: Int32
decimals = Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 Maybe Int32
width Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. Int32
0xFFFF
              prec :: Int32
prec     = (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 Maybe Int32
width Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. Int32
0xFFFF
          in HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe (Word, Maybe Word) -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType ((Word, Maybe Word) -> Maybe (Word, Maybe Word)
forall a. a -> Maybe a
Just (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
prec, Word -> Maybe Word
forall a. a -> Maybe a
Just (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
decimals))))

      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.float4  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
floatType (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word) -> Maybe Int32 -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
width))
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.float8  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
doubleType

      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.date    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql92DataTypeSyntax dataType => dataType
dateType

      -- We prefer using the standard beam names
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.text    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql99DataTypeSyntax dataType => dataType
characterLargeObjectType
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.bytea   Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql99DataTypeSyntax dataType => dataType
binaryLargeObjectType
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.bool    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just HsDataType
forall dataType. IsSql99DataTypeSyntax dataType => dataType
booleanType

      -- TODO timestamp prec
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.time        Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> Bool -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timeType Maybe Word
forall a. Maybe a
Nothing Bool
False)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.timestamp   Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> Bool -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timestampType Maybe Word
forall a. Maybe a
Nothing Bool
False)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.timestamptz Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (Maybe Word -> Bool -> HsDataType
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timestampType Maybe Word
forall a. Maybe a
Nothing Bool
True)

      -- Postgres specific datatypes, haskell versions
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.uuid        Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"uuid" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"UUID")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Data.UUID.Types" [Text -> ImportSpec ()
importTyNamed Text
"UUID"]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgUuidType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.money       Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"money" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"PgMoney")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [Text -> ImportSpec ()
importTyNamed Text
"PgMoney"]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgMoneyType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.json        Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"json" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (Type () -> [Type ()] -> Type ()
tyApp (String -> Type ()
tyConNamed String
"PgJSON") [ String -> Type ()
tyConNamed String
"Value" ])
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Data.Aeson" [Text -> ImportSpec ()
importTyNamed Text
"Value"] HsImports -> HsImports -> HsImports
forall a. Semigroup a => a -> a -> a
<>
                                     Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [Text -> ImportSpec ()
importTyNamed Text
"PgJSON"]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgJsonType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.jsonb       Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"jsonb" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (Type () -> [Type ()] -> Type ()
tyApp (String -> Type ()
tyConNamed String
"PgJSONB") [ String -> Type ()
tyConNamed String
"Value" ])
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Data.Aeson" [Text -> ImportSpec ()
importTyNamed Text
"Value"] HsImports -> HsImports -> HsImports
forall a. Semigroup a => a -> a -> a
<>
                                     Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [Text -> ImportSpec ()
importTyNamed Text
"PgJSONB"]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgJsonType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
pgTsVectorTypeInfo Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"tsvector" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"TsVector")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [Text -> ImportSpec ()
importTyNamed Text
"TsVector"]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgTsVectorType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
pgTsQueryTypeInfo Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"tsquery" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"TsQuery")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [Text -> ImportSpec ()
importTyNamed Text
"TsQuery"]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgTsQueryType)

      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.point   Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"point" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"PgPoint")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [ Text -> ImportSpec ()
importTyNamed Text
"PgPoint" ]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgPointType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.line    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"line" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"PgLine")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [ Text -> ImportSpec ()
importTyNamed Text
"PgLine" ]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgLineType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.lseg    Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"lineSegment" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"PgLineSegment")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [ Text -> ImportSpec ()
importTyNamed Text
"PgLineSegment" ]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgLineSegmentType)
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.box     Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType) -> HsDataType -> Maybe HsDataType
forall a b. (a -> b) -> a -> b
$ HsExpr -> HsType -> BeamSerializedDataType -> HsDataType
HsDataType (Text -> Text -> HsExpr
hsVarFrom Text
"box" Text
"Database.Beam.Postgres")
                            (Type () -> HsImports -> HsType
HsType (String -> Type ()
tyConNamed String
"PgBox")
                                    (Text -> [ImportSpec ()] -> HsImports
importSome Text
"Database.Beam.Postgres" [ Text -> ImportSpec ()
importTyNamed Text
"PgBox" ]))
                            (PgDataTypeSyntax -> BeamSerializedDataType
pgDataTypeSerialized PgDataTypeSyntax
pgBoxType)

    PgDataTypeDescr
_ -> HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (String -> HsDataType
hsErrorType (String
"PG type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PgDataTypeDescr -> String
forall a. Show a => a -> String
show PgDataTypeDescr
tyDescr))

-- | Turn a series of 'Db.MigrationSteps' into a line-by-line array of
-- 'BL.ByteString's suitable for writing to a script.
migrateScript :: Db.MigrationSteps Postgres () a' -> [BL.ByteString]
migrateScript :: MigrationSteps Postgres () a' -> [ByteString]
migrateScript MigrationSteps Postgres () a'
steps =
  ByteString
"-- CAUTION: beam-postgres currently escapes postgres string literals somewhat\n"                 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"--          haphazardly when generating scripts (but not when generating commands)\n"            ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"--          This is due to technical limitations in libPq that require a Postgres\n"             ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"--          Connection in order to correctly escape strings. Please verify that the\n"           ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"--          generated migration script is correct before running it on your database.\n"         ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"--          If you feel so called, please contribute better escaping support to beam-postgres\n" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"\n"                                                                                              ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"-- Set connection encoding to UTF-8\n"                                                           ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"SET client_encoding = 'UTF8';\n"                                                                 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"SET standard_conforming_strings = off;\n\n"                                                      ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  Endo [ByteString] -> [ByteString] -> [ByteString]
forall a. Endo a -> a -> a
appEndo ((Text -> Endo [ByteString])
-> (BeamSqlBackendSyntax Postgres -> Endo [ByteString])
-> MigrationSteps Postgres () a'
-> Endo [ByteString]
forall be m a.
(Monoid m, Semigroup m, BeamSqlBackend be) =>
(Text -> m)
-> (BeamSqlBackendSyntax be -> m) -> MigrationSteps be () a -> m
Db.migrateScript Text -> Endo [ByteString]
renderHeader BeamSqlBackendSyntax Postgres -> Endo [ByteString]
PgCommandSyntax -> Endo [ByteString]
renderCommand MigrationSteps Postgres () a'
steps) []
  where
    renderHeader :: Text -> Endo [ByteString]
renderHeader Text
nm =
      ([ByteString] -> [ByteString]) -> Endo [ByteString]
forall a. (a -> a) -> Endo a
Endo ((ByteString
"-- " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
TE.encodeUtf8 Text
nm) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
    renderCommand :: PgCommandSyntax -> Endo [ByteString]
renderCommand PgCommandSyntax
command =
      ([ByteString] -> [ByteString]) -> Endo [ByteString]
forall a. (a -> a) -> Endo a
Endo ((PgSyntax -> ByteString
pgRenderSyntaxScript (PgCommandSyntax -> PgSyntax
fromPgCommand PgCommandSyntax
command) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";\n")ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)

-- | Write the migration given by the 'Db.MigrationSteps' to a file.
writeMigrationScript :: FilePath -> Db.MigrationSteps Postgres () a -> IO ()
writeMigrationScript :: String -> MigrationSteps Postgres () a -> IO ()
writeMigrationScript String
fp MigrationSteps Postgres () a
steps =
  let stepBs :: [ByteString]
stepBs = MigrationSteps Postgres () a -> [ByteString]
forall a'. MigrationSteps Postgres () a' -> [ByteString]
migrateScript MigrationSteps Postgres () a
steps
  in String -> ByteString -> IO ()
BL.writeFile String
fp ([ByteString] -> ByteString
BL.concat [ByteString]
stepBs)

pgExpandDataType :: Db.DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType :: DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (Db.DataType BeamSqlBackendCastTargetSyntax Postgres
pg) = BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pg

pgCharLength :: Maybe Int32 -> Maybe Word
pgCharLength :: Maybe Int32 -> Maybe Word
pgCharLength Maybe Int32
Nothing = Maybe Word
forall a. Maybe a
Nothing
pgCharLength (Just (-1)) = Maybe Word
forall a. Maybe a
Nothing
pgCharLength (Just Int32
x) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)

pgDataTypeFromAtt :: ByteString -> Pg.Oid -> Maybe Int32 -> Maybe PgDataTypeSyntax
pgDataTypeFromAtt :: ByteString -> Oid -> Maybe Int32 -> Maybe PgDataTypeSyntax
pgDataTypeFromAtt ByteString
_ Oid
oid Maybe Int32
pgMod
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.bool Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid        = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Bool -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType DataType Postgres Bool
forall be. BeamSql99DataTypeBackend be => DataType be Bool
Db.boolean
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.bytea Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Text -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType DataType Postgres Text
forall be. BeamSql99DataTypeBackend be => DataType be Text
Db.binaryLargeObject
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.char Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid        = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Text -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (Maybe Word -> DataType Postgres Text
forall be. BeamSqlBackend be => Maybe Word -> DataType be Text
Db.char (Maybe Int32 -> Maybe Word
pgCharLength Maybe Int32
pgMod))
  -- TODO Pg.name
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int8 Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid        = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Int64 -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (DataType Postgres Int64
forall be a.
(BeamSqlBackend be, BeamSqlT071Backend be, Integral a) =>
DataType be a
Db.bigint :: Db.DataType Postgres Int64)
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int4 Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid        = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Int32 -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (DataType Postgres Int32
forall be a. (BeamSqlBackend be, Integral a) => DataType be a
Db.int :: Db.DataType Postgres Int32)
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int2 Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid        = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Int16 -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (DataType Postgres Int16
forall be a. (BeamSqlBackend be, Integral a) => DataType be a
Db.smallint :: Db.DataType Postgres Int16)
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.varchar Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid     = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Text -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (Maybe Word -> DataType Postgres Text
forall be. BeamSqlBackend be => Maybe Word -> DataType be Text
Db.varchar (Maybe Int32 -> Maybe Word
pgCharLength Maybe Int32
pgMod))
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.timestamp Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid   = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres LocalTime -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType DataType Postgres LocalTime
forall be. BeamSqlBackend be => DataType be LocalTime
Db.timestamp
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.timestamptz Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres LocalTime -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType DataType Postgres LocalTime
forall be. BeamSqlBackend be => DataType be LocalTime
Db.timestamptz
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.float8 Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid      = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Double -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType DataType Postgres Double
forall be. BeamSqlBackend be => DataType be Double
Db.double
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.text  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgTextType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.json  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgJsonType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.jsonb Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgJsonbType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.uuid  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgUuidType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.point Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgPointType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.line  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgLineType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.lseg  Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgLineSegmentType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.box   Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid       = PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgBoxType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.numeric Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid =
      let precAndDecimal :: Maybe (Word, Maybe Word)
precAndDecimal =
            case Maybe Int32
pgMod of
              Maybe Int32
Nothing -> Maybe (Word, Maybe Word)
forall a. Maybe a
Nothing
              Just Int32
pgMod' ->
                let prec :: Word
prec = Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
pgMod' Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
                    dec :: Word
dec = Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
pgMod' Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. Int32
0xFFFF)
                in (Word, Maybe Word) -> Maybe (Word, Maybe Word)
forall a. a -> Maybe a
Just (Word
prec, if Word
dec Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Maybe Word
forall a. Maybe a
Nothing else Word -> Maybe Word
forall a. a -> Maybe a
Just Word
dec)
      in PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a. a -> Maybe a
Just (PgDataTypeSyntax -> Maybe PgDataTypeSyntax)
-> PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$ DataType Postgres Scientific -> PgDataTypeSyntax
forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (Maybe (Word, Maybe Word) -> DataType Postgres Scientific
forall be.
BeamSqlBackend be =>
Maybe (Word, Maybe Word) -> DataType be Scientific
Db.numeric Maybe (Word, Maybe Word)
precAndDecimal)
  | Bool
otherwise = Maybe PgDataTypeSyntax
forall a. Maybe a
Nothing

pgEnumerationTypeFromAtt :: [ (T.Text, Pg.Oid, V.Vector T.Text) ] -> ByteString -> Pg.Oid -> Maybe Int32 -> Maybe PgDataTypeSyntax
pgEnumerationTypeFromAtt :: [(Text, Oid, Vector Text)]
-> ByteString -> Oid -> Maybe Int32 -> Maybe PgDataTypeSyntax
pgEnumerationTypeFromAtt [(Text, Oid, Vector Text)]
enumData =
  let enumDataMap :: HashMap Word64 PgDataTypeSyntax
enumDataMap = [(Word64, PgDataTypeSyntax)] -> HashMap Word64 PgDataTypeSyntax
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (CUInt -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
oid' :: Word64, -- Get around lack of Hashable for CUInt
                                   PgDataTypeDescr
-> PgSyntax -> BeamSerializedDataType -> PgDataTypeSyntax
PgDataTypeSyntax (Text -> PgDataTypeDescr
PgDataTypeDescrDomain Text
nm) (ByteString -> PgSyntax
emit (Text -> ByteString
TE.encodeUtf8 Text
nm))
                                          (Value -> BeamSerializedDataType
pgDataTypeJSON ([Pair] -> Value
object [ Text
"customType" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
nm ]))) | (Text
nm, (Pg.Oid CUInt
oid'), Vector Text
_) <- [(Text, Oid, Vector Text)]
enumData ]
  in \ByteString
_ (Pg.Oid CUInt
oid) Maybe Int32
_ -> Word64 -> HashMap Word64 PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (CUInt -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
oid) HashMap Word64 PgDataTypeSyntax
enumDataMap

pgUnknownDataType :: Pg.Oid -> Maybe Int32 -> PgDataTypeSyntax
pgUnknownDataType :: Oid -> Maybe Int32 -> PgDataTypeSyntax
pgUnknownDataType oid :: Oid
oid@(Pg.Oid CUInt
oid') Maybe Int32
pgMod =
  PgDataTypeDescr
-> PgSyntax -> BeamSerializedDataType -> PgDataTypeSyntax
PgDataTypeSyntax (Oid -> Maybe Int32 -> PgDataTypeDescr
PgDataTypeDescrOid Oid
oid Maybe Int32
pgMod) (ByteString -> PgSyntax
emit ByteString
"{- UNKNOWN -}")
                   (Value -> BeamSerializedDataType
pgDataTypeJSON ([Pair] -> Value
object [ Text
"oid" Text -> Word -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
oid' :: Word), Text
"mod" Text -> Maybe Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Int32
pgMod ]))

-- * Create constraints from a connection

getDbConstraints :: Pg.Connection -> IO [ Db.SomeDatabasePredicate ]
getDbConstraints :: Connection -> IO [SomeDatabasePredicate]
getDbConstraints = Maybe [String] -> Connection -> IO [SomeDatabasePredicate]
getDbConstraintsForSchemas Maybe [String]
forall a. Maybe a
Nothing

getDbConstraintsForSchemas :: Maybe [String] -> Pg.Connection -> IO [ Db.SomeDatabasePredicate ]
getDbConstraintsForSchemas :: Maybe [String] -> Connection -> IO [SomeDatabasePredicate]
getDbConstraintsForSchemas Maybe [String]
subschemas Connection
conn =
  do [(Oid, Text)]
tbls <- case Maybe [String]
subschemas of
        Maybe [String]
Nothing -> Connection -> Query -> IO [(Oid, Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
Pg.query_ Connection
conn Query
"SELECT cl.oid, relname FROM pg_catalog.pg_class \"cl\" join pg_catalog.pg_namespace \"ns\" on (ns.oid = relnamespace) where nspname = any (current_schemas(false)) and relkind='r'"
        Just [String]
ss -> Connection -> Query -> Only (In [String]) -> IO [(Oid, Text)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
Pg.query  Connection
conn Query
"SELECT cl.oid, relname FROM pg_catalog.pg_class \"cl\" join pg_catalog.pg_namespace \"ns\" on (ns.oid = relnamespace) where nspname IN ? and relkind='r'" (In [String] -> Only (In [String])
forall a. a -> Only a
Pg.Only ([String] -> In [String]
forall a. a -> In a
Pg.In [String]
ss))
     let tblsExist :: [SomeDatabasePredicate]
tblsExist = ((Oid, Text) -> SomeDatabasePredicate)
-> [(Oid, Text)] -> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(Oid
_, Text
tbl) -> TableExistsPredicate -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName -> TableExistsPredicate
Db.TableExistsPredicate (Maybe Text -> Text -> QualifiedName
Db.QualifiedName Maybe Text
forall a. Maybe a
Nothing Text
tbl))) [(Oid, Text)]
tbls

     [(Text, Oid, Vector Text)]
enumerationData <-
       Connection -> Query -> IO [(Text, Oid, Vector Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
Pg.query_ Connection
conn
         (String -> Query
forall a. IsString a => String -> a
fromString ([String] -> String
unlines
                      [ String
"SELECT t.typname, t.oid, array_agg(e.enumlabel ORDER BY e.enumsortorder)"
                      , String
"FROM pg_enum e JOIN pg_type t ON t.oid = e.enumtypid"
                      , String
"GROUP BY t.typname, t.oid" ]))

     [SomeDatabasePredicate]
columnChecks <-
       ([[SomeDatabasePredicate]] -> [SomeDatabasePredicate])
-> IO [[SomeDatabasePredicate]] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SomeDatabasePredicate]] -> [SomeDatabasePredicate]
forall a. Monoid a => [a] -> a
mconcat (IO [[SomeDatabasePredicate]] -> IO [SomeDatabasePredicate])
-> (((Oid, Text) -> IO [SomeDatabasePredicate])
    -> IO [[SomeDatabasePredicate]])
-> ((Oid, Text) -> IO [SomeDatabasePredicate])
-> IO [SomeDatabasePredicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Oid, Text)]
-> ((Oid, Text) -> IO [SomeDatabasePredicate])
-> IO [[SomeDatabasePredicate]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Oid, Text)]
tbls (((Oid, Text) -> IO [SomeDatabasePredicate])
 -> IO [SomeDatabasePredicate])
-> ((Oid, Text) -> IO [SomeDatabasePredicate])
-> IO [SomeDatabasePredicate]
forall a b. (a -> b) -> a -> b
$ \(Oid
oid, Text
tbl) ->
       do [(Text, Oid, Int32, Bool, ByteString)]
columns <- Connection
-> Query -> Only Oid -> IO [(Text, Oid, Int32, Bool, ByteString)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
Pg.query Connection
conn Query
"SELECT attname, atttypid, atttypmod, attnotnull, pg_catalog.format_type(atttypid, atttypmod) FROM pg_catalog.pg_attribute att WHERE att.attrelid=? AND att.attnum>0 AND att.attisdropped='f'"
                       (Oid -> Only Oid
forall a. a -> Only a
Pg.Only (Oid
oid :: Pg.Oid))
          let columnChecks :: [SomeDatabasePredicate]
columnChecks = ((Text, Oid, Int32, Bool, ByteString) -> SomeDatabasePredicate)
-> [(Text, Oid, Int32, Bool, ByteString)]
-> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
nm, Oid
typId :: Pg.Oid, Int32
typmod, Bool
_, ByteString
typ :: ByteString) ->
                                    let typmod' :: Maybe Int32
typmod' = if Int32
typmod Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int32
1 then Maybe Int32
forall a. Maybe a
Nothing else Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Int32
typmod Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
4)

                                        pgDataType :: PgDataTypeSyntax
pgDataType = PgDataTypeSyntax -> Maybe PgDataTypeSyntax -> PgDataTypeSyntax
forall a. a -> Maybe a -> a
fromMaybe (Oid -> Maybe Int32 -> PgDataTypeSyntax
pgUnknownDataType Oid
typId Maybe Int32
typmod') (Maybe PgDataTypeSyntax -> PgDataTypeSyntax)
-> Maybe PgDataTypeSyntax -> PgDataTypeSyntax
forall a b. (a -> b) -> a -> b
$
                                                     ByteString -> Oid -> Maybe Int32 -> Maybe PgDataTypeSyntax
pgDataTypeFromAtt ByteString
typ Oid
typId Maybe Int32
typmod' Maybe PgDataTypeSyntax
-> Maybe PgDataTypeSyntax -> Maybe PgDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                                     [(Text, Oid, Vector Text)]
-> ByteString -> Oid -> Maybe Int32 -> Maybe PgDataTypeSyntax
pgEnumerationTypeFromAtt [(Text, Oid, Vector Text)]
enumerationData ByteString
typ Oid
typId Maybe Int32
typmod'

                                    in TableHasColumn Postgres -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax Postgres
-> TableHasColumn Postgres
forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
Db.TableHasColumn (Maybe Text -> Text -> QualifiedName
Db.QualifiedName Maybe Text
forall a. Maybe a
Nothing Text
tbl) Text
nm BeamMigrateSqlBackendDataTypeSyntax Postgres
PgDataTypeSyntax
pgDataType :: Db.TableHasColumn Postgres)) [(Text, Oid, Int32, Bool, ByteString)]
columns
              notNullChecks :: [SomeDatabasePredicate]
notNullChecks = ((Text, Oid, Int32, Bool, ByteString) -> [SomeDatabasePredicate])
-> [(Text, Oid, Int32, Bool, ByteString)]
-> [SomeDatabasePredicate]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
nm, Oid
_, Int32
_, Bool
isNotNull, ByteString
_) ->
                                           if Bool
isNotNull then
                                            [TableColumnHasConstraint Postgres -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax Postgres
-> TableColumnHasConstraint Postgres
forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
Db.TableColumnHasConstraint (Maybe Text -> Text -> QualifiedName
Db.QualifiedName Maybe Text
forall a. Maybe a
Nothing Text
tbl) Text
nm (Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax
     PgColumnConstraintDefinitionSyntax
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax
        PgColumnConstraintDefinitionSyntax)
-> PgColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax Maybe Text
forall a. Maybe a
Nothing Sql92ColumnConstraintDefinitionConstraintSyntax
  PgColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax Maybe
  (Sql92ColumnConstraintDefinitionAttributesSyntax
     PgColumnConstraintDefinitionSyntax)
forall a. Maybe a
Nothing)
                                              :: Db.TableColumnHasConstraint Postgres)]
                                           else [] ) [(Text, Oid, Int32, Bool, ByteString)]
columns

          [SomeDatabasePredicate] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SomeDatabasePredicate]
columnChecks [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
notNullChecks)

     [SomeDatabasePredicate]
primaryKeys <-
       ((Text, Vector Text) -> SomeDatabasePredicate)
-> [(Text, Vector Text)] -> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
relnm, Vector Text
cols) -> TableHasPrimaryKey -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName -> [Text] -> TableHasPrimaryKey
Db.TableHasPrimaryKey (Maybe Text -> Text -> QualifiedName
Db.QualifiedName Maybe Text
forall a. Maybe a
Nothing Text
relnm) (Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList Vector Text
cols))) ([(Text, Vector Text)] -> [SomeDatabasePredicate])
-> IO [(Text, Vector Text)] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       Connection -> Query -> IO [(Text, Vector Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
Pg.query_ Connection
conn (String -> Query
forall a. IsString a => String -> a
fromString ([String] -> String
unlines [ String
"SELECT c.relname, array_agg(a.attname ORDER BY k.n ASC)"
                                           , String
"FROM pg_index i"
                                           , String
"CROSS JOIN unnest(i.indkey) WITH ORDINALITY k(attid, n)"
                                           , String
"JOIN pg_attribute a ON a.attnum=k.attid AND a.attrelid=i.indrelid"
                                           , String
"JOIN pg_class c ON c.oid=i.indrelid"
                                           , String
"JOIN pg_namespace ns ON ns.oid=c.relnamespace"
                                           , String
"WHERE ns.nspname = any (current_schemas(false)) AND c.relkind='r' AND i.indisprimary GROUP BY relname, i.indrelid" ]))

     let enumerations :: [SomeDatabasePredicate]
enumerations =
           ((Text, Oid, Vector Text) -> SomeDatabasePredicate)
-> [(Text, Oid, Vector Text)] -> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
enumNm, Oid
_, Vector Text
options) -> PgHasEnum -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (Text -> [Text] -> PgHasEnum
PgHasEnum Text
enumNm (Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList Vector Text
options))) [(Text, Oid, Vector Text)]
enumerationData

     [SomeDatabasePredicate]
extensions <-
       (Only Text -> SomeDatabasePredicate)
-> [Only Text] -> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(Pg.Only Text
extname) -> PgHasExtension -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (Text -> PgHasExtension
PgHasExtension Text
extname)) ([Only Text] -> [SomeDatabasePredicate])
-> IO [Only Text] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       Connection -> Query -> IO [Only Text]
forall r. FromRow r => Connection -> Query -> IO [r]
Pg.query_ Connection
conn Query
"SELECT extname from pg_extension"

     [SomeDatabasePredicate] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SomeDatabasePredicate]
tblsExist [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
columnChecks [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
primaryKeys [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
enumerations [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
extensions)

-- * Postgres-specific data types

-- | 'Db.DataType' for @tsquery@. See 'TsQuery' for more information
tsquery :: Db.DataType Postgres TsQuery
tsquery :: DataType Postgres TsQuery
tsquery = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres TsQuery
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgTsQueryType

-- | 'Db.DataType' for @tsvector@. See 'TsVector' for more information
tsvector :: Db.DataType Postgres TsVector
tsvector :: DataType Postgres TsVector
tsvector = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres TsVector
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgTsVectorType

-- | 'Db.DataType' for Postgres @TEXT@. 'characterLargeObject' is also mapped to
-- this data type
text :: Db.DataType Postgres T.Text
text :: DataType Postgres Text
text = BeamSqlBackendCastTargetSyntax Postgres -> DataType Postgres Text
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgTextType

-- | 'Db.DataType' for Postgres @BYTEA@. 'binaryLargeObject' is also mapped to
-- this data type
bytea :: Db.DataType Postgres ByteString
bytea :: DataType Postgres ByteString
bytea = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres ByteString
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgByteaType

-- | 'Db.DataType' for a Postgres array without any bounds.
--
-- Note that array support in @beam-migrate@ is still incomplete.
unboundedArray :: forall a. Typeable a
               => Db.DataType Postgres a
               -> Db.DataType Postgres (V.Vector a)
unboundedArray :: DataType Postgres a -> DataType Postgres (Vector a)
unboundedArray (Db.DataType BeamSqlBackendCastTargetSyntax Postgres
elTy) =
  BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres (Vector a)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType (PgDataTypeSyntax -> PgDataTypeSyntax
pgUnboundedArrayType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
elTy)

-- | 'Db.DataType' for @JSON@. See 'PgJSON' for more information
json :: (ToJSON a, FromJSON a) => Db.DataType Postgres (PgJSON a)
json :: DataType Postgres (PgJSON a)
json = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres (PgJSON a)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgJsonType

-- | 'Db.DataType' for @JSONB@. See 'PgJSON' for more information
jsonb :: (ToJSON a, FromJSON a) => Db.DataType Postgres (PgJSONB a)
jsonb :: DataType Postgres (PgJSONB a)
jsonb = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres (PgJSONB a)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgJsonbType

-- | 'Db.DataType' for @UUID@ columns. The 'pgCryptoGenRandomUUID' function in
-- the 'PgCrypto' extension can be used to generate UUIDs at random.
uuid :: Db.DataType Postgres UUID
uuid :: DataType Postgres UUID
uuid = BeamSqlBackendCastTargetSyntax Postgres -> DataType Postgres UUID
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgUuidType

-- | 'Db.DataType' for @MONEY@ columns.
money :: Db.DataType Postgres PgMoney
money :: DataType Postgres PgMoney
money = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres PgMoney
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgMoneyType

point :: Db.DataType Postgres PgPoint
point :: DataType Postgres PgPoint
point = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres PgPoint
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgPointType

line :: Db.DataType Postgres PgLine
line :: DataType Postgres PgLine
line = BeamSqlBackendCastTargetSyntax Postgres -> DataType Postgres PgLine
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgLineType

lineSegment :: Db.DataType Postgres PgLineSegment
lineSegment :: DataType Postgres PgLineSegment
lineSegment = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres PgLineSegment
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgLineSegmentType

box :: Db.DataType Postgres PgBox
box :: DataType Postgres PgBox
box = BeamSqlBackendCastTargetSyntax Postgres -> DataType Postgres PgBox
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgBoxType

-- * Pseudo-data types

-- | Postgres @SERIAL@ data types. Automatically generates an appropriate
-- @DEFAULT@ clause and sequence
smallserial, serial, bigserial :: Integral a => Db.DataType Postgres (SqlSerial a)
smallserial :: DataType Postgres (SqlSerial a)
smallserial = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres (SqlSerial a)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgSmallSerialType
serial :: DataType Postgres (SqlSerial a)
serial = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres (SqlSerial a)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgSerialType
bigserial :: DataType Postgres (SqlSerial a)
bigserial = BeamSqlBackendCastTargetSyntax Postgres
-> DataType Postgres (SqlSerial a)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
pgBigSerialType

data PgHasDefault = PgHasDefault
instance Db.FieldReturnType 'True 'False Postgres resTy a =>
         Db.FieldReturnType 'False 'False Postgres resTy (PgHasDefault -> a) where
  field' :: Proxy 'False
-> Proxy 'False
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax Postgres
-> Maybe (BeamSqlBackendExpressionSyntax Postgres)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax Postgres]
-> PgHasDefault
-> a
field' Proxy 'False
_ Proxy 'False
_ Text
nm BeamMigrateSqlBackendDataTypeSyntax Postgres
ty Maybe (BeamSqlBackendExpressionSyntax Postgres)
_ Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax Postgres]
constraints PgHasDefault
PgHasDefault =
    Proxy 'True
-> Proxy 'False
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax Postgres
-> Maybe (BeamSqlBackendExpressionSyntax Postgres)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax Postgres]
-> a
forall (defaultGiven :: Bool) (collationGiven :: Bool) be resTy a.
(FieldReturnType defaultGiven collationGiven be resTy a,
 BeamMigrateSqlBackend be) =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
Db.field' (Proxy 'True
forall k (t :: k). Proxy t
Proxy @'True) (Proxy 'False
forall k (t :: k). Proxy t
Proxy @'False) Text
nm BeamMigrateSqlBackendDataTypeSyntax Postgres
ty Maybe (BeamSqlBackendExpressionSyntax Postgres)
forall a. Maybe a
Nothing Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax Postgres]
constraints

instance BeamSqlBackendHasSerial Postgres where
  genericSerial :: Text -> a
genericSerial Text
nm = Text -> DataType Postgres (SqlSerial Int) -> PgHasDefault -> a
forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
Db.field Text
nm DataType Postgres (SqlSerial Int)
forall a. Integral a => DataType Postgres (SqlSerial a)
serial PgHasDefault
PgHasDefault