{-# 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 = 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" ])
                        (forall a. (Connection -> IO a) -> Pg a
liftIOWithHandle Connection -> IO [SomeDatabasePredicate]
getDbConstraints)
                        (forall be. BeamMigrateSqlBackend be => BeamDeserializers be
Db.sql92Deserializers forall a. Semigroup a => a -> a -> a
<> forall be. BeamMigrateSql99Backend be => BeamDeserializers be
Db.sql99DataTypeDeserializers forall a. Semigroup a => a -> a -> a
<>
                         forall be.
(BeamMigrateSqlBackend be, BeamSqlT071Backend be) =>
BeamDeserializers be
Db.sql2008BigIntDataTypeDeserializers forall a. Semigroup a => a -> a -> a
<>
                         BeamDeserializers Postgres
postgresDataTypeDeserializers forall a. Semigroup a => a -> a -> a
<>
                         forall be.
(Typeable be, BeamMigrateOnlySqlBackend be,
 HasDataTypeCreatedCheck
   (BeamMigrateSqlBackendDataTypeSyntax be)) =>
BeamDeserializers be
Db.beamCheckDeserializers)
                        (ByteString -> String
BCL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
";") forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgSyntax -> ByteString
pgRenderSyntaxScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgCommandSyntax -> PgSyntax
fromPgCommand) String
"postgres.sql"
                        HaskellPredicateConverter
pgPredConverter (forall be.
(Typeable be, BeamMigrateOnlySqlBackend be) =>
ActionProvider be
defaultActionProvider forall a. Semigroup a => a -> a -> a
<> ActionProvider Postgres
pgExtensionActionProvider forall a. Semigroup a => a -> a -> a
<>
                                         ActionProvider Postgres
pgCustomEnumActionProvider)
                        (\String
options Pg a
action ->
                            forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> IO Connection
Pg.connectPostgreSQL (forall a. IsString a => String -> a
fromString String
options)) Connection -> IO ()
Pg.close forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
                              forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(String -> IO ())
-> Connection -> Pg a -> IO (Either BeamRowReadError a)
withPgDebug (\String
_ -> 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 ty be.
Typeable ty =>
(forall be'. BeamDeserializers be' -> Value -> Parser ty)
-> BeamDeserializers be
Db.beamDeserializer forall a b. (a -> b) -> a -> b
$ \BeamDeserializers be'
_ Value
v ->
  case Value
v of
    Value
"bytea"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgByteaType
    Value
"smallserial" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgSmallSerialType
    Value
"serial"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgSerialType
    Value
"bigserial"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgBigSerialType
    Value
"tsquery"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgTsQueryType
    Value
"tsvector"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgTsVectorType
    Value
"text"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgTextType
    Value
"json"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgJsonType
    Value
"jsonb"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgJsonbType
    Value
"uuid"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgUuidType
    Value
"money"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgMoneyType
    Value
"point"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgPointType
    Value
"line"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgLineType
    Value
"lseg"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgLineSegmentType
    Value
"box"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
pgBoxType
    Value
_             -> 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 = forall fromBe.
Typeable fromBe =>
(BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
-> HaskellPredicateConverter
Tool.sql92HsPredicateConverters @Postgres PgDataTypeSyntax -> Maybe HsDataType
pgTypeToHs forall a. Semigroup a => a -> a -> a
<>
                  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
c forall a. Eq a => a -> a -> Bool
== forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax forall a. Maybe a
Nothing forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax forall a. Maybe a
Nothing =
          forall a. a -> Maybe a
Just (forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
Db.TableColumnHasConstraint QualifiedName
tblNm Text
colNm (forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax forall a. Maybe a
Nothing forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax forall a. Maybe a
Nothing) :: Db.TableColumnHasConstraint HsMigrateBackend))
      | Bool
otherwise = 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    forall a. Eq a => a -> a -> Bool
== Oid
oid -> forall a. a -> Maybe a
Just forall dataType. IsSql92DataTypeSyntax dataType => dataType
smallIntType
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int4    forall a. Eq a => a -> a -> Bool
== Oid
oid -> forall a. a -> Maybe a
Just forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int8    forall a. Eq a => a -> a -> Bool
== Oid
oid -> forall a. a -> Maybe a
Just forall dataType. IsSql2008BigIntDataTypeSyntax dataType => dataType
bigIntType

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

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

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

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

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

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

      -- Postgres specific datatypes, haskell versions
      | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.uuid        forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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       forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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        forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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"] 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       forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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"] 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 forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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 forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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   forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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    forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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    forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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     forall a. Eq a => a -> a -> Bool
== Oid
oid ->
          forall a. a -> Maybe a
Just 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
_ -> forall a. a -> Maybe a
Just (String -> HsDataType
hsErrorType (String
"PG type " forall a. [a] -> [a] -> [a]
++ 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 :: forall a'. MigrationSteps Postgres () a' -> [ByteString]
migrateScript MigrationSteps Postgres () a'
steps =
  ByteString
"-- CAUTION: beam-postgres currently escapes postgres string literals somewhat\n"                 forall a. a -> [a] -> [a]
:
  ByteString
"--          haphazardly when generating scripts (but not when generating commands)\n"            forall a. a -> [a] -> [a]
:
  ByteString
"--          This is due to technical limitations in libPq that require a Postgres\n"             forall a. a -> [a] -> [a]
:
  ByteString
"--          Connection in order to correctly escape strings. Please verify that the\n"           forall a. a -> [a] -> [a]
:
  ByteString
"--          generated migration script is correct before running it on your database.\n"         forall a. a -> [a] -> [a]
:
  ByteString
"--          If you feel so called, please contribute better escaping support to beam-postgres\n" forall a. a -> [a] -> [a]
:
  ByteString
"\n"                                                                                              forall a. a -> [a] -> [a]
:
  ByteString
"-- Set connection encoding to UTF-8\n"                                                           forall a. a -> [a] -> [a]
:
  ByteString
"SET client_encoding = 'UTF8';\n"                                                                 forall a. a -> [a] -> [a]
:
  ByteString
"SET standard_conforming_strings = off;\n\n"                                                      forall a. a -> [a] -> [a]
:
  forall a. Endo a -> a -> a
appEndo (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 PgCommandSyntax -> Endo [ByteString]
renderCommand MigrationSteps Postgres () a'
steps) []
  where
    renderHeader :: Text -> Endo [ByteString]
renderHeader Text
nm =
      forall a. (a -> a) -> Endo a
Endo ((ByteString
"-- " forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
TE.encodeUtf8 Text
nm) forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")forall a. a -> [a] -> [a]
:)
    renderCommand :: PgCommandSyntax -> Endo [ByteString]
renderCommand PgCommandSyntax
command =
      forall a. (a -> a) -> Endo a
Endo ((PgSyntax -> ByteString
pgRenderSyntaxScript (PgCommandSyntax -> PgSyntax
fromPgCommand PgCommandSyntax
command) forall a. Semigroup a => a -> a -> a
<> ByteString
";\n")forall a. a -> [a] -> [a]
:)

-- | Write the migration given by the 'Db.MigrationSteps' to a file.
writeMigrationScript :: FilePath -> Db.MigrationSteps Postgres () a -> IO ()
writeMigrationScript :: forall a. String -> MigrationSteps Postgres () a -> IO ()
writeMigrationScript String
fp MigrationSteps Postgres () a
steps =
  let stepBs :: [ByteString]
stepBs = 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 :: forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (Db.DataType BeamSqlBackendCastTargetSyntax Postgres
pg) = BeamSqlBackendCastTargetSyntax Postgres
pg

pgCharLength :: Maybe Int32 -> Maybe Word
pgCharLength :: Maybe Int32 -> Maybe Word
pgCharLength Maybe Int32
Nothing = forall a. Maybe a
Nothing
pgCharLength (Just (-1)) = forall a. Maybe a
Nothing
pgCharLength (Just Int32
x) = forall a. a -> Maybe a
Just (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 forall a. Eq a => a -> a -> Bool
== Oid
oid        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType forall be. BeamSql99DataTypeBackend be => DataType be Bool
Db.boolean
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.bytea forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType forall be. BeamSql99DataTypeBackend be => DataType be Text
Db.binaryLargeObject
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.char forall a. Eq a => a -> a -> Bool
== Oid
oid        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (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 forall a. Eq a => a -> a -> Bool
== Oid
oid        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (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 forall a. Eq a => a -> a -> Bool
== Oid
oid        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (forall be a. (BeamSqlBackend be, Integral a) => DataType be a
Db.int :: Db.DataType Postgres Int32)
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.int2 forall a. Eq a => a -> a -> Bool
== Oid
oid        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (forall be a. (BeamSqlBackend be, Integral a) => DataType be a
Db.smallint :: Db.DataType Postgres Int16)
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.varchar forall a. Eq a => a -> a -> Bool
== Oid
oid     = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (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 forall a. Eq a => a -> a -> Bool
== Oid
oid   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType forall be. BeamSqlBackend be => DataType be LocalTime
Db.timestamp
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.timestamptz forall a. Eq a => a -> a -> Bool
== Oid
oid = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType forall be. BeamSqlBackend be => DataType be LocalTime
Db.timestamptz
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.float8 forall a. Eq a => a -> a -> Bool
== Oid
oid      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType forall be. BeamSqlBackend be => DataType be Double
Db.double
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.text  forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgTextType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.json  forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgJsonType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.jsonb forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgJsonbType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.uuid  forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgUuidType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.point forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgPointType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.line  forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgLineType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.lseg  forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgLineSegmentType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.box   forall a. Eq a => a -> a -> Bool
== Oid
oid       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PgDataTypeSyntax
pgBoxType
  | TypeInfo -> Oid
Pg.typoid TypeInfo
Pg.numeric forall a. Eq a => a -> a -> Bool
== Oid
oid =
      let precAndDecimal :: Maybe (Word, Maybe Word)
precAndDecimal =
            case Maybe Int32
pgMod of
              Maybe Int32
Nothing -> forall a. Maybe a
Nothing
              Just Int32
pgMod' ->
                let prec :: Word
prec = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
pgMod' forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
                    dec :: Word
dec = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
pgMod' forall a. Bits a => a -> a -> a
.&. Int32
0xFFFF)
                in forall a. a -> Maybe a
Just (Word
prec, if Word
dec forall a. Eq a => a -> a -> Bool
== Word
0 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Word
dec)
      in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DataType Postgres a -> PgDataTypeSyntax
pgExpandDataType (forall be.
BeamSqlBackend be =>
Maybe (Word, Maybe Word) -> DataType be Scientific
Db.numeric Maybe (Word, Maybe Word)
precAndDecimal)
  | Bool
otherwise = 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 = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (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 [ Key
"customType" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
_ -> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (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 [ Key
"oid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
oid' :: Word), Key
"mod" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 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 -> 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 -> 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'" (forall a. a -> Only a
Pg.Only (forall a. a -> In a
Pg.In [String]
ss))
     let tblsExist :: [SomeDatabasePredicate]
tblsExist = forall a b. (a -> b) -> [a] -> [b]
map (\(Oid
_, Text
tbl) -> forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName -> TableExistsPredicate
Db.TableExistsPredicate (Maybe Text -> Text -> QualifiedName
Db.QualifiedName forall a. Maybe a
Nothing Text
tbl))) [(Oid, Text)]
tbls

     [(Text, Oid, Vector Text)]
enumerationData <-
       forall r. FromRow r => Connection -> Query -> IO [r]
Pg.query_ Connection
conn
         (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 <-
       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Oid, Text)]
tbls forall a b. (a -> b) -> a -> b
$ \(Oid
oid, Text
tbl) ->
       do [(Text, Oid, Int32, Bool, ByteString)]
columns <- 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'"
                       (forall a. a -> Only a
Pg.Only (Oid
oid :: Pg.Oid))
          let columnChecks :: [SomeDatabasePredicate]
columnChecks = 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 forall a. Eq a => a -> a -> Bool
== -Int32
1 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Int32
typmod forall a. Num a => a -> a -> a
- Int32
4)

                                        pgDataType :: PgDataTypeSyntax
pgDataType = forall a. a -> Maybe a -> a
fromMaybe (Oid -> Maybe Int32 -> PgDataTypeSyntax
pgUnknownDataType Oid
typId Maybe Int32
typmod') forall a b. (a -> b) -> a -> b
$
                                                     ByteString -> Oid -> Maybe Int32 -> Maybe PgDataTypeSyntax
pgDataTypeFromAtt ByteString
typ Oid
typId Maybe Int32
typmod' 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 forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
Db.TableHasColumn (Maybe Text -> Text -> QualifiedName
Db.QualifiedName forall a. Maybe a
Nothing Text
tbl) Text
nm PgDataTypeSyntax
pgDataType :: Db.TableHasColumn Postgres)) [(Text, Oid, Int32, Bool, ByteString)]
columns
              notNullChecks :: [SomeDatabasePredicate]
notNullChecks = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
nm, Oid
_, Int32
_, Bool
isNotNull, ByteString
_) ->
                                           if Bool
isNotNull then
                                            [forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
Db.TableColumnHasConstraint (Maybe Text -> Text -> QualifiedName
Db.QualifiedName forall a. Maybe a
Nothing Text
tbl) Text
nm (forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax forall a. Maybe a
Nothing forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax forall a. Maybe a
Nothing)
                                              :: Db.TableColumnHasConstraint Postgres)]
                                           else [] ) [(Text, Oid, Int32, Bool, ByteString)]
columns

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

     [SomeDatabasePredicate]
primaryKeys <-
       forall a b. (a -> b) -> [a] -> [b]
map (\(Text
relnm, Vector Text
cols) -> forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName -> [Text] -> TableHasPrimaryKey
Db.TableHasPrimaryKey (Maybe Text -> Text -> QualifiedName
Db.QualifiedName forall a. Maybe a
Nothing Text
relnm) (forall a. Vector a -> [a]
V.toList Vector Text
cols))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       forall r. FromRow r => Connection -> Query -> IO [r]
Pg.query_ Connection
conn (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 =
           forall a b. (a -> b) -> [a] -> [b]
map (\(Text
enumNm, Oid
_, Vector Text
options) -> forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (Text -> [Text] -> PgHasEnum
PgHasEnum Text
enumNm (forall a. Vector a -> [a]
V.toList Vector Text
options))) [(Text, Oid, Vector Text)]
enumerationData

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

     forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SomeDatabasePredicate]
tblsExist forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
columnChecks forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
primaryKeys forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
enumerations 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 = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType PgDataTypeSyntax
pgTsQueryType

-- | 'Db.DataType' for @tsvector@. See 'TsVector' for more information
tsvector :: Db.DataType Postgres TsVector
tsvector :: DataType Postgres TsVector
tsvector = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType 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 = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType 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 = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType 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 :: forall a.
Typeable a =>
DataType Postgres a -> DataType Postgres (Vector a)
unboundedArray (Db.DataType BeamSqlBackendCastTargetSyntax Postgres
elTy) =
  forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType (PgDataTypeSyntax -> PgDataTypeSyntax
pgUnboundedArrayType BeamSqlBackendCastTargetSyntax Postgres
elTy)

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

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

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

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

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

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

box :: Db.DataType Postgres PgBox
box :: DataType Postgres PgBox
box = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType 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 :: forall a. Integral a => DataType Postgres (SqlSerial a)
smallserial = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType PgDataTypeSyntax
pgSmallSerialType
serial :: forall a. Integral a => DataType Postgres (SqlSerial a)
serial = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType PgDataTypeSyntax
pgSerialType
bigserial :: forall a. Integral a => DataType Postgres (SqlSerial a)
bigserial = forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType PgDataTypeSyntax
pgBigSerialType

data PgHasDefault = PgHasDefault
instance Db.FieldReturnType 'True 'False Postgres resTy a =>
         Db.FieldReturnType 'False 'False Postgres resTy (PgHasDefault -> a) where
  field' :: BeamMigrateSqlBackend Postgres =>
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 =
    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' (forall {k} (t :: k). Proxy t
Proxy @'True) (forall {k} (t :: k). Proxy t
Proxy @'False) Text
nm BeamMigrateSqlBackendDataTypeSyntax Postgres
ty forall a. Maybe a
Nothing Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax Postgres]
constraints

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