{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE EmptyCase #-}
module Database.Beam.Postgres.CustomTypes
    ( PgType, PgTypeCheck(..)
    , PgDataTypeSchema

    , IsPgCustomDataType(..)

    , PgHasEnum(..)

    , HasSqlValueSyntax, FromBackendRow

    , pgCustomEnumSchema, pgBoundedEnumSchema

    , pgCustomEnumActionProvider
    , pgCreateEnumActionProvider
    , pgDropEnumActionProvider

    , pgChecksForTypeSchema

    , pgEnumValueSyntax, pgParseEnum

    , createEnum
    , beamTypeForCustomPg
    ) where

import           Database.Beam
import           Database.Beam.Schema.Tables
import           Database.Beam.Backend.SQL
import           Database.Beam.Migrate
import           Database.Beam.Postgres.Types
import           Database.Beam.Postgres.Syntax

import           Control.Monad
import           Control.Monad.Free.Church
import           Data.Aeson (object, (.=))
import qualified Data.ByteString.Char8 as BC
import           Data.Functor.Const
import qualified Data.HashSet as HS
import           Data.Proxy (Proxy(..))
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif
import           Data.Text (Text)
import qualified Data.Text.Encoding as TE

import qualified Database.PostgreSQL.Simple.FromField as Pg

data PgType a
newtype PgTypeCheck = PgTypeCheck (Text -> SomeDatabasePredicate)

data PgDataTypeSchema a where
    PgDataTypeEnum :: HasSqlValueSyntax PgValueSyntax a => [a] -> PgDataTypeSchema a

class IsPgCustomDataType a where
    pgDataTypeName :: Proxy a -> Text
    pgDataTypeDescription :: PgDataTypeSchema a

pgCustomEnumSchema :: HasSqlValueSyntax PgValueSyntax a => [a] -> PgDataTypeSchema a
pgCustomEnumSchema :: forall a.
HasSqlValueSyntax PgValueSyntax a =>
[a] -> PgDataTypeSchema a
pgCustomEnumSchema = [a] -> PgDataTypeSchema a
forall a.
HasSqlValueSyntax PgValueSyntax a =>
[a] -> PgDataTypeSchema a
PgDataTypeEnum

pgBoundedEnumSchema :: ( Enum a, Bounded a, HasSqlValueSyntax PgValueSyntax a )
                    => PgDataTypeSchema a
pgBoundedEnumSchema :: forall a.
(Enum a, Bounded a, HasSqlValueSyntax PgValueSyntax a) =>
PgDataTypeSchema a
pgBoundedEnumSchema = [a] -> PgDataTypeSchema a
forall a.
HasSqlValueSyntax PgValueSyntax a =>
[a] -> PgDataTypeSchema a
pgCustomEnumSchema [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound]

pgCustomEnumActionProvider :: ActionProvider Postgres
pgCustomEnumActionProvider :: ActionProvider Postgres
pgCustomEnumActionProvider = ActionProvider Postgres
pgCreateEnumActionProvider ActionProvider Postgres
-> ActionProvider Postgres -> ActionProvider Postgres
forall a. Semigroup a => a -> a -> a
<> ActionProvider Postgres
pgDropEnumActionProvider

pgCreateEnumActionProvider :: ActionProvider Postgres
pgCreateEnumActionProvider :: ActionProvider Postgres
pgCreateEnumActionProvider =
  ActionProviderFn Postgres -> ActionProvider Postgres
forall be. ActionProviderFn be -> ActionProvider be
ActionProvider (ActionProviderFn Postgres -> ActionProvider Postgres)
-> ActionProviderFn Postgres -> ActionProvider Postgres
forall a b. (a -> b) -> a -> b
$ \forall preCondition. Typeable preCondition => [preCondition]
findPre forall preCondition. Typeable preCondition => [preCondition]
findPost ->
  do enumP@(PgHasEnum nm vals) <- [PgHasEnum]
forall preCondition. Typeable preCondition => [preCondition]
findPost
     ensuringNot_ $
      do (PgHasEnum beforeNm _) <- findPre
         guard (beforeNm == nm)

     let cmd = Text -> [PgValueSyntax] -> PgCommandSyntax
pgCreateEnumSyntax Text
nm ((Text -> PgValueSyntax) -> [Text] -> [PgValueSyntax]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> PgValueSyntax
forall expr ty. HasSqlValueSyntax expr ty => ty -> expr
sqlValueSyntax [Text]
vals)
     pure (PotentialAction mempty (HS.fromList [p enumP])
                           (pure (MigrationCommand cmd MigrationKeepsData))
                           ("Create the enumeration " <> nm) 1)

pgDropEnumActionProvider :: ActionProvider Postgres
pgDropEnumActionProvider :: ActionProvider Postgres
pgDropEnumActionProvider =
  ActionProviderFn Postgres -> ActionProvider Postgres
forall be. ActionProviderFn be -> ActionProvider be
ActionProvider (ActionProviderFn Postgres -> ActionProvider Postgres)
-> ActionProviderFn Postgres -> ActionProvider Postgres
forall a b. (a -> b) -> a -> b
$ \forall preCondition. Typeable preCondition => [preCondition]
findPre forall preCondition. Typeable preCondition => [preCondition]
findPost ->
  do enumP@(PgHasEnum nm _) <- [PgHasEnum]
forall preCondition. Typeable preCondition => [preCondition]
findPre
     ensuringNot_ $
      do (PgHasEnum afterNm _) <- findPost
         guard (afterNm == nm)

     let cmd = Text -> PgCommandSyntax
pgDropTypeSyntax Text
nm
     pure (PotentialAction (HS.fromList [p enumP]) mempty
                           (pure (MigrationCommand cmd MigrationKeepsData))
                           ("Drop the enumeration type " <> nm) 1)

pgChecksForTypeSchema :: PgDataTypeSchema a -> [ PgTypeCheck ]
pgChecksForTypeSchema :: forall a. PgDataTypeSchema a -> [PgTypeCheck]
pgChecksForTypeSchema (PgDataTypeEnum [a]
vals) =
  let valTxts :: [Text]
valTxts = (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall {ty}. HasSqlValueSyntax PgValueSyntax ty => ty -> Text
encodeToString [a]
vals

      -- TODO better reporting
      encodeToString :: ty -> Text
encodeToString ty
val =
        let PgValueSyntax (PgSyntax PgSyntaxM ()
syntax) = ty -> PgValueSyntax
forall expr ty. HasSqlValueSyntax expr ty => ty -> expr
sqlValueSyntax ty
val
        in PgSyntaxM () -> forall r. (() -> r) -> (PgSyntaxF r -> r) -> r
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF PgSyntaxM ()
syntax (\()
_ -> String -> Text
forall a. HasCallStack => String -> a
error String
"Expecting a simple text encoding for enumeration type")
                       (\case
                           EmitByteString ByteString
"'" Text
next -> Text
next
                           EscapeString ByteString
s Text
_ -> ByteString -> Text
TE.decodeUtf8 ByteString
s -- TODO Make this more robust
                           PgSyntaxF Text
_ -> String -> Text
forall a. HasCallStack => String -> a
error String
"Expecting a simple text encoding for enumeration type")
  in [ (Text -> SomeDatabasePredicate) -> PgTypeCheck
PgTypeCheck (\Text
nm -> PgHasEnum -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p (Text -> [Text] -> PgHasEnum
PgHasEnum Text
nm [Text]
valTxts)) ]

instance IsDatabaseEntity Postgres (PgType a) where

  data DatabaseEntityDescriptor Postgres (PgType a) where
      PgTypeDescriptor :: Maybe Text -> Text -> PgDataTypeSyntax
                       -> DatabaseEntityDescriptor Postgres (PgType a)

  type DatabaseEntityDefaultRequirements Postgres (PgType a) =
      ( HasSqlValueSyntax PgValueSyntax a
      , FromBackendRow Postgres a
      , IsPgCustomDataType a)

  type DatabaseEntityRegularRequirements Postgres (PgType a) =
      ( HasSqlValueSyntax PgValueSyntax a
      , FromBackendRow Postgres a )

  dbEntityName :: Lens' (DatabaseEntityDescriptor Postgres (PgType a)) Text
dbEntityName Text -> f Text
f (PgTypeDescriptor Maybe Text
sch Text
nm PgDataTypeSyntax
ty) = (\Text
nm' -> Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
forall a.
Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
PgTypeDescriptor Maybe Text
sch Text
nm' PgDataTypeSyntax
ty) (Text -> DatabaseEntityDescriptor Postgres (PgType a))
-> f Text -> f (DatabaseEntityDescriptor Postgres (PgType a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
nm
  dbEntitySchema :: Traversal'
  (DatabaseEntityDescriptor Postgres (PgType a)) (Maybe Text)
dbEntitySchema Maybe Text -> f (Maybe Text)
f (PgTypeDescriptor Maybe Text
sch Text
nm PgDataTypeSyntax
ty) = Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
forall a.
Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
PgTypeDescriptor (Maybe Text
 -> Text
 -> PgDataTypeSyntax
 -> DatabaseEntityDescriptor Postgres (PgType a))
-> f (Maybe Text)
-> f (Text
      -> PgDataTypeSyntax
      -> DatabaseEntityDescriptor Postgres (PgType a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> f (Maybe Text)
f Maybe Text
sch f (Text
   -> PgDataTypeSyntax
   -> DatabaseEntityDescriptor Postgres (PgType a))
-> f Text
-> f (PgDataTypeSyntax
      -> DatabaseEntityDescriptor Postgres (PgType a))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
nm f (PgDataTypeSyntax
   -> DatabaseEntityDescriptor Postgres (PgType a))
-> f PgDataTypeSyntax
-> f (DatabaseEntityDescriptor Postgres (PgType a))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PgDataTypeSyntax -> f PgDataTypeSyntax
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDataTypeSyntax
ty
  dbEntityAuto :: DatabaseEntityDefaultRequirements Postgres (PgType a) =>
Text -> DatabaseEntityDescriptor Postgres (PgType a)
dbEntityAuto Text
_ = Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
forall a.
Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
PgTypeDescriptor Maybe Text
forall a. Maybe a
Nothing Text
typeName
                                    (PgDataTypeDescr
-> PgSyntax -> BeamSerializedDataType -> PgDataTypeSyntax
PgDataTypeSyntax (Text -> PgDataTypeDescr
PgDataTypeDescrDomain Text
typeName)
                                                      (Text -> PgSyntax
pgQuotedIdentifier Text
typeName)
                                                      (Value -> BeamSerializedDataType
pgDataTypeJSON ([Pair] -> Value
object [ Key
"customType" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
typeName])))
      where
        typeName :: Text
typeName = Proxy a -> Text
forall a. IsPgCustomDataType a => Proxy a -> Text
pgDataTypeName (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

instance IsCheckedDatabaseEntity Postgres (PgType a) where
    data CheckedDatabaseEntityDescriptor Postgres (PgType a) where
        CheckedPgTypeDescriptor :: DatabaseEntityDescriptor Postgres (PgType a)
                                -> [ PgTypeCheck ]
                                -> CheckedDatabaseEntityDescriptor Postgres (PgType a)
    type CheckedDatabaseEntityDefaultRequirements Postgres (PgType a) =
        DatabaseEntityDefaultRequirements Postgres (PgType a)

    unChecked :: Lens'
  (CheckedDatabaseEntityDescriptor Postgres (PgType a))
  (DatabaseEntityDescriptor Postgres (PgType a))
unChecked DatabaseEntityDescriptor Postgres (PgType a)
-> f (DatabaseEntityDescriptor Postgres (PgType a))
f (CheckedPgTypeDescriptor DatabaseEntityDescriptor Postgres (PgType a)
ty [PgTypeCheck]
d) = (DatabaseEntityDescriptor Postgres (PgType a)
 -> CheckedDatabaseEntityDescriptor Postgres (PgType a))
-> f (DatabaseEntityDescriptor Postgres (PgType a))
-> f (CheckedDatabaseEntityDescriptor Postgres (PgType a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DatabaseEntityDescriptor Postgres (PgType a)
ty' -> DatabaseEntityDescriptor Postgres (PgType a)
-> [PgTypeCheck]
-> CheckedDatabaseEntityDescriptor Postgres (PgType a)
forall a.
DatabaseEntityDescriptor Postgres (PgType a)
-> [PgTypeCheck]
-> CheckedDatabaseEntityDescriptor Postgres (PgType a)
CheckedPgTypeDescriptor DatabaseEntityDescriptor Postgres (PgType a)
ty' [PgTypeCheck]
d) (DatabaseEntityDescriptor Postgres (PgType a)
-> f (DatabaseEntityDescriptor Postgres (PgType a))
f DatabaseEntityDescriptor Postgres (PgType a)
ty)
    collectEntityChecks :: CheckedDatabaseEntityDescriptor Postgres (PgType a)
-> [SomeDatabasePredicate]
collectEntityChecks (CheckedPgTypeDescriptor DatabaseEntityDescriptor Postgres (PgType a)
e [PgTypeCheck]
chks) =
        (PgTypeCheck -> SomeDatabasePredicate)
-> [PgTypeCheck] -> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PgTypeCheck Text -> SomeDatabasePredicate
mkCheck) -> Text -> SomeDatabasePredicate
mkCheck (Const Text (DatabaseEntityDescriptor Postgres (PgType a)) -> Text
forall {k} a (b :: k). Const a b -> a
getConst ((Text -> Const Text Text)
-> DatabaseEntityDescriptor Postgres (PgType a)
-> Const Text (DatabaseEntityDescriptor Postgres (PgType a))
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
Lens' (DatabaseEntityDescriptor Postgres (PgType a)) Text
dbEntityName Text -> Const Text Text
forall {k} a (b :: k). a -> Const a b
Const DatabaseEntityDescriptor Postgres (PgType a)
e))) [PgTypeCheck]
chks
    checkedDbEntityAuto :: CheckedDatabaseEntityDefaultRequirements Postgres (PgType a) =>
Text -> CheckedDatabaseEntityDescriptor Postgres (PgType a)
checkedDbEntityAuto Text
nm = DatabaseEntityDescriptor Postgres (PgType a)
-> [PgTypeCheck]
-> CheckedDatabaseEntityDescriptor Postgres (PgType a)
forall a.
DatabaseEntityDescriptor Postgres (PgType a)
-> [PgTypeCheck]
-> CheckedDatabaseEntityDescriptor Postgres (PgType a)
CheckedPgTypeDescriptor (Text -> DatabaseEntityDescriptor Postgres (PgType a)
forall be entityType.
(IsDatabaseEntity be entityType,
 DatabaseEntityDefaultRequirements be entityType) =>
Text -> DatabaseEntityDescriptor be entityType
dbEntityAuto Text
nm)
                                                     (PgDataTypeSchema a -> [PgTypeCheck]
forall a. PgDataTypeSchema a -> [PgTypeCheck]
pgChecksForTypeSchema (forall a. IsPgCustomDataType a => PgDataTypeSchema a
pgDataTypeDescription @a))

instance RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor Postgres (PgType a))) where
    renamingFields :: (NonEmpty Text -> Text)
-> FieldRenamer (DatabaseEntityDescriptor Postgres (PgType a))
renamingFields NonEmpty Text -> Text
_ = (DatabaseEntityDescriptor Postgres (PgType a)
 -> DatabaseEntityDescriptor Postgres (PgType a))
-> FieldRenamer (DatabaseEntityDescriptor Postgres (PgType a))
forall entity. (entity -> entity) -> FieldRenamer entity
FieldRenamer DatabaseEntityDescriptor Postgres (PgType a)
-> DatabaseEntityDescriptor Postgres (PgType a)
forall a. a -> a
id

createEnum :: forall a db
            . ( HasSqlValueSyntax PgValueSyntax a
              , Enum a, Bounded a )
           => Text -> Migration Postgres (CheckedDatabaseEntity Postgres db (PgType a))
createEnum :: forall a (db :: (* -> *) -> *).
(HasSqlValueSyntax PgValueSyntax a, Enum a, Bounded a) =>
Text
-> Migration
     Postgres (CheckedDatabaseEntity Postgres db (PgType a))
createEnum Text
nm = do
  BeamSqlBackendSyntax Postgres
-> Maybe (BeamSqlBackendSyntax Postgres) -> Migration Postgres ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (Text -> [PgValueSyntax] -> PgCommandSyntax
pgCreateEnumSyntax Text
nm ((a -> PgValueSyntax) -> [a] -> [PgValueSyntax]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> PgValueSyntax
forall expr ty. HasSqlValueSyntax expr ty => ty -> expr
sqlValueSyntax [a
forall a. Bounded a => a
minBound..(a
forall a. Bounded a => a
maxBound::a)]))
         (PgCommandSyntax -> Maybe PgCommandSyntax
forall a. a -> Maybe a
Just (Text -> PgCommandSyntax
pgDropTypeSyntax Text
nm))

  let tyDesc :: DatabaseEntityDescriptor Postgres (PgType a)
tyDesc = Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
forall a.
Maybe Text
-> Text
-> PgDataTypeSyntax
-> DatabaseEntityDescriptor Postgres (PgType a)
PgTypeDescriptor Maybe Text
forall a. Maybe a
Nothing Text
nm (PgDataTypeSyntax -> DatabaseEntityDescriptor Postgres (PgType a))
-> PgDataTypeSyntax -> DatabaseEntityDescriptor Postgres (PgType a)
forall a b. (a -> b) -> a -> b
$
               PgDataTypeDescr
-> PgSyntax -> BeamSerializedDataType -> PgDataTypeSyntax
PgDataTypeSyntax (Text -> PgDataTypeDescr
PgDataTypeDescrDomain Text
nm)
                                (Text -> PgSyntax
pgQuotedIdentifier Text
nm)
                                (Value -> BeamSerializedDataType
pgDataTypeJSON ([Pair] -> Value
object [ Key
"customType" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
nm ]))

  CheckedDatabaseEntity Postgres db (PgType a)
-> F (MigrationF Postgres)
     (CheckedDatabaseEntity Postgres db (PgType a))
forall a. a -> F (MigrationF Postgres) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckedDatabaseEntityDescriptor Postgres (PgType a)
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity Postgres db (PgType a)
forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity
          (DatabaseEntityDescriptor Postgres (PgType a)
-> [PgTypeCheck]
-> CheckedDatabaseEntityDescriptor Postgres (PgType a)
forall a.
DatabaseEntityDescriptor Postgres (PgType a)
-> [PgTypeCheck]
-> CheckedDatabaseEntityDescriptor Postgres (PgType a)
CheckedPgTypeDescriptor DatabaseEntityDescriptor Postgres (PgType a)
tyDesc
             (PgDataTypeSchema a -> [PgTypeCheck]
forall a. PgDataTypeSchema a -> [PgTypeCheck]
pgChecksForTypeSchema ([a] -> PgDataTypeSchema a
forall a.
HasSqlValueSyntax PgValueSyntax a =>
[a] -> PgDataTypeSchema a
PgDataTypeEnum [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound::a])))
          [])


pgEnumValueSyntax :: (a -> String) -> a -> PgValueSyntax
pgEnumValueSyntax :: forall a. (a -> String) -> a -> PgValueSyntax
pgEnumValueSyntax a -> String
namer = String -> PgValueSyntax
forall expr ty. HasSqlValueSyntax expr ty => ty -> expr
sqlValueSyntax (String -> PgValueSyntax) -> (a -> String) -> a -> PgValueSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
namer

newtype PgRawString = PgRawString String
instance FromBackendRow Postgres PgRawString
instance Pg.FromField PgRawString where
    fromField :: FieldParser PgRawString
fromField Field
f Maybe ByteString
Nothing = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion PgRawString
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
Pg.returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Pg.UnexpectedNull Field
f String
"When parsing enumeration string"
    fromField Field
_ (Just ByteString
d) = PgRawString -> Conversion PgRawString
forall a. a -> Conversion a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> PgRawString
PgRawString (ByteString -> String
BC.unpack ByteString
d))

pgParseEnum :: (Enum a, Bounded a) => (a -> String)
            -> FromBackendRowM Postgres a
pgParseEnum :: forall a.
(Enum a, Bounded a) =>
(a -> String) -> FromBackendRowM Postgres a
pgParseEnum a -> String
namer =
  let allNames :: [(String, a)]
allNames = (a -> (String, a)) -> [a] -> [(String, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a -> String
namer a
x, a
x)) [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound]
  in do
    PgRawString name <- FromBackendRowM Postgres PgRawString
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
    case lookup name allNames of
      Maybe a
Nothing -> String -> FromBackendRowM Postgres a
forall a. String -> FromBackendRowM Postgres a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid postgres enumeration value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
      Just  a
v -> a -> FromBackendRowM Postgres a
forall a. a -> FromBackendRowM Postgres a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v

beamTypeForCustomPg :: CheckedDatabaseEntity Postgres db (PgType a) -> DataType Postgres a
beamTypeForCustomPg :: forall (db :: (* -> *) -> *) a.
CheckedDatabaseEntity Postgres db (PgType a) -> DataType Postgres a
beamTypeForCustomPg (CheckedDatabaseEntity (CheckedPgTypeDescriptor (PgTypeDescriptor Maybe Text
_ Text
_ PgDataTypeSyntax
dt) [PgTypeCheck]
_) [SomeDatabasePredicate]
_)
    = BeamSqlBackendCastTargetSyntax Postgres -> DataType Postgres a
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
DataType BeamSqlBackendCastTargetSyntax Postgres
PgDataTypeSyntax
dt