{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
module Database.Beam.Postgres.Extensions where
import Database.Beam
import Database.Beam.Schema.Tables
import Database.Beam.Postgres.Types
import Database.Beam.Postgres.Syntax
import Database.Beam.Migrate
import Control.Monad
import Data.Aeson
import qualified Data.HashSet as HS
import Data.Hashable (Hashable)
import Data.Proxy
import Data.Text (Text)
#if !MIN_VERSION_base(4, 11, 0)
import Data.Semigroup
#endif
data PgExtensionEntity extension
class IsPgExtension extension where
pgExtensionName :: Proxy extension -> Text
pgExtensionBuild :: extension
instance RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor Postgres (PgExtensionEntity e))) where
renamingFields :: (NonEmpty Text -> Text)
-> FieldRenamer
(DatabaseEntityDescriptor Postgres (PgExtensionEntity e))
renamingFields NonEmpty Text -> Text
_ = (DatabaseEntityDescriptor Postgres (PgExtensionEntity e)
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity e))
-> FieldRenamer
(DatabaseEntityDescriptor Postgres (PgExtensionEntity e))
forall entity. (entity -> entity) -> FieldRenamer entity
FieldRenamer DatabaseEntityDescriptor Postgres (PgExtensionEntity e)
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity e)
forall a. a -> a
id
instance IsDatabaseEntity Postgres (PgExtensionEntity extension) where
data DatabaseEntityDescriptor Postgres (PgExtensionEntity extension) where
PgDatabaseExtension :: IsPgExtension extension
=> Text
-> extension
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
type DatabaseEntityDefaultRequirements Postgres (PgExtensionEntity extension) =
( IsPgExtension extension )
type DatabaseEntityRegularRequirements Postgres (PgExtensionEntity extension) =
( IsPgExtension extension )
dbEntityName :: (Text -> f Text)
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
dbEntityName Text -> f Text
f (PgDatabaseExtension nm ext) = (Text
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension))
-> f Text
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
nm' -> Text
-> extension
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
forall extension.
IsPgExtension extension =>
Text
-> extension
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
PgDatabaseExtension Text
nm' extension
ext) (Text -> f Text
f Text
nm)
dbEntitySchema :: (Maybe Text -> f (Maybe Text))
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
dbEntitySchema Maybe Text -> f (Maybe Text)
_ DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
n = DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
n
dbEntityAuto :: Text
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
dbEntityAuto Text
_ = Text
-> extension
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
forall extension.
IsPgExtension extension =>
Text
-> extension
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
PgDatabaseExtension (Proxy extension -> Text
forall extension.
IsPgExtension extension =>
Proxy extension -> Text
pgExtensionName (Proxy extension
forall k (t :: k). Proxy t
Proxy @extension)) extension
forall extension. IsPgExtension extension => extension
pgExtensionBuild
instance IsCheckedDatabaseEntity Postgres (PgExtensionEntity extension) where
newtype CheckedDatabaseEntityDescriptor Postgres (PgExtensionEntity extension) =
CheckedPgExtension (DatabaseEntityDescriptor Postgres (PgExtensionEntity extension))
type CheckedDatabaseEntityDefaultRequirements Postgres (PgExtensionEntity extension) =
DatabaseEntityRegularRequirements Postgres (PgExtensionEntity extension)
unChecked :: (DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)))
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
-> f (CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
unChecked DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
f (CheckedPgExtension ext) = DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
forall extension.
DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
CheckedPgExtension (DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
-> f (CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> f (DatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
f DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
ext
collectEntityChecks :: CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
-> [SomeDatabasePredicate]
collectEntityChecks (CheckedPgExtension (PgDatabaseExtension {})) =
[ PgHasExtension -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (Text -> PgHasExtension
PgHasExtension (Proxy extension -> Text
forall extension.
IsPgExtension extension =>
Proxy extension -> Text
pgExtensionName (Proxy extension
forall k (t :: k). Proxy t
Proxy @extension))) ]
checkedDbEntityAuto :: Text
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
checkedDbEntityAuto = DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
forall extension.
DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
CheckedPgExtension (DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension))
-> (Text
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension))
-> Text
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> DatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
forall be entityType.
(IsDatabaseEntity be entityType,
DatabaseEntityDefaultRequirements be entityType) =>
Text -> DatabaseEntityDescriptor be entityType
dbEntityAuto
getPgExtension :: DatabaseEntity Postgres db (PgExtensionEntity extension)
-> extension
getPgExtension :: DatabaseEntity Postgres db (PgExtensionEntity extension)
-> extension
getPgExtension (DatabaseEntity (PgDatabaseExtension _ ext)) = extension
ext
pgCreateExtension :: forall extension db
. IsPgExtension extension
=> Migration Postgres (CheckedDatabaseEntity Postgres db (PgExtensionEntity extension))
pgCreateExtension :: Migration
Postgres
(CheckedDatabaseEntity Postgres db (PgExtensionEntity extension))
pgCreateExtension =
let entity :: CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
entity = Text
-> CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
forall be entity.
(IsCheckedDatabaseEntity be entity,
CheckedDatabaseEntityDefaultRequirements be entity) =>
Text -> CheckedDatabaseEntityDescriptor be entity
checkedDbEntityAuto Text
""
extName :: Text
extName = Proxy extension -> Text
forall extension.
IsPgExtension extension =>
Proxy extension -> Text
pgExtensionName (Proxy extension
forall k (t :: k). Proxy t
Proxy @extension)
in BeamSqlBackendSyntax Postgres
-> Maybe (BeamSqlBackendSyntax Postgres) -> Migration Postgres ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (Text -> PgCommandSyntax
pgCreateExtensionSyntax Text
extName) Maybe (BeamSqlBackendSyntax Postgres)
forall a. Maybe a
Nothing Migration Postgres ()
-> Migration
Postgres
(CheckedDatabaseEntity Postgres db (PgExtensionEntity extension))
-> Migration
Postgres
(CheckedDatabaseEntity Postgres db (PgExtensionEntity extension))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
CheckedDatabaseEntity Postgres db (PgExtensionEntity extension)
-> Migration
Postgres
(CheckedDatabaseEntity Postgres db (PgExtensionEntity extension))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity Postgres db (PgExtensionEntity extension)
forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
entity (CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
-> [SomeDatabasePredicate]
forall be entity.
IsCheckedDatabaseEntity be entity =>
CheckedDatabaseEntityDescriptor be entity
-> [SomeDatabasePredicate]
collectEntityChecks CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
entity))
pgDropExtension :: forall extension
. CheckedDatabaseEntityDescriptor Postgres (PgExtensionEntity extension)
-> Migration Postgres ()
pgDropExtension :: CheckedDatabaseEntityDescriptor
Postgres (PgExtensionEntity extension)
-> Migration Postgres ()
pgDropExtension (CheckedPgExtension (PgDatabaseExtension {})) =
BeamSqlBackendSyntax Postgres
-> Maybe (BeamSqlBackendSyntax Postgres) -> Migration Postgres ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (Text -> PgCommandSyntax
pgDropExtensionSyntax (Proxy extension -> Text
forall extension.
IsPgExtension extension =>
Proxy extension -> Text
pgExtensionName (Proxy extension
forall k (t :: k). Proxy t
Proxy @extension))) Maybe (BeamSqlBackendSyntax Postgres)
forall a. Maybe a
Nothing
newtype PgHasExtension = PgHasExtension Text
deriving (Int -> PgHasExtension -> ShowS
[PgHasExtension] -> ShowS
PgHasExtension -> String
(Int -> PgHasExtension -> ShowS)
-> (PgHasExtension -> String)
-> ([PgHasExtension] -> ShowS)
-> Show PgHasExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgHasExtension] -> ShowS
$cshowList :: [PgHasExtension] -> ShowS
show :: PgHasExtension -> String
$cshow :: PgHasExtension -> String
showsPrec :: Int -> PgHasExtension -> ShowS
$cshowsPrec :: Int -> PgHasExtension -> ShowS
Show, PgHasExtension -> PgHasExtension -> Bool
(PgHasExtension -> PgHasExtension -> Bool)
-> (PgHasExtension -> PgHasExtension -> Bool) -> Eq PgHasExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgHasExtension -> PgHasExtension -> Bool
$c/= :: PgHasExtension -> PgHasExtension -> Bool
== :: PgHasExtension -> PgHasExtension -> Bool
$c== :: PgHasExtension -> PgHasExtension -> Bool
Eq, (forall x. PgHasExtension -> Rep PgHasExtension x)
-> (forall x. Rep PgHasExtension x -> PgHasExtension)
-> Generic PgHasExtension
forall x. Rep PgHasExtension x -> PgHasExtension
forall x. PgHasExtension -> Rep PgHasExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PgHasExtension x -> PgHasExtension
$cfrom :: forall x. PgHasExtension -> Rep PgHasExtension x
Generic, Int -> PgHasExtension -> Int
PgHasExtension -> Int
(Int -> PgHasExtension -> Int)
-> (PgHasExtension -> Int) -> Hashable PgHasExtension
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PgHasExtension -> Int
$chash :: PgHasExtension -> Int
hashWithSalt :: Int -> PgHasExtension -> Int
$chashWithSalt :: Int -> PgHasExtension -> Int
Hashable)
instance DatabasePredicate PgHasExtension where
englishDescription :: PgHasExtension -> String
englishDescription (PgHasExtension Text
extName) =
String
"Postgres extension " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
extName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is loaded"
predicateSpecificity :: proxy PgHasExtension -> PredicateSpecificity
predicateSpecificity proxy PgHasExtension
_ = String -> PredicateSpecificity
PredicateSpecificityOnlyBackend String
"postgres"
serializePredicate :: PgHasExtension -> Value
serializePredicate (PgHasExtension Text
nm) =
[Pair] -> Value
object [ Key
"has-postgres-extension" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
nm ]
pgExtensionActionProvider :: ActionProvider Postgres
pgExtensionActionProvider :: ActionProvider Postgres
pgExtensionActionProvider = ActionProvider Postgres
pgCreateExtensionProvider ActionProvider Postgres
-> ActionProvider Postgres -> ActionProvider Postgres
forall a. Semigroup a => a -> a -> a
<> ActionProvider Postgres
pgDropExtensionProvider
pgCreateExtensionProvider, pgDropExtensionProvider :: ActionProvider Postgres
pgCreateExtensionProvider :: ActionProvider Postgres
pgCreateExtensionProvider =
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 extP :: PgHasExtension
extP@(PgHasExtension Text
ext) <- [PgHasExtension]
forall preCondition. Typeable preCondition => [preCondition]
findPost
[()] -> [()]
forall (m :: * -> *) a. Alternative m => [a] -> m ()
ensuringNot_ ([()] -> [()]) -> [()] -> [()]
forall a b. (a -> b) -> a -> b
$
do PgHasExtension Text
ext' <- [PgHasExtension]
forall preCondition. Typeable preCondition => [preCondition]
findPre
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
ext Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ext')
let cmd :: PgCommandSyntax
cmd = Text -> PgCommandSyntax
pgCreateExtensionSyntax Text
ext
PotentialAction Postgres -> [PotentialAction Postgres]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashSet SomeDatabasePredicate
-> HashSet SomeDatabasePredicate
-> Seq (MigrationCommand Postgres)
-> Text
-> Int
-> PotentialAction Postgres
forall be.
HashSet SomeDatabasePredicate
-> HashSet SomeDatabasePredicate
-> Seq (MigrationCommand be)
-> Text
-> Int
-> PotentialAction be
PotentialAction HashSet SomeDatabasePredicate
forall a. Monoid a => a
mempty ([SomeDatabasePredicate] -> HashSet SomeDatabasePredicate
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [PgHasExtension -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p PgHasExtension
extP])
(MigrationCommand Postgres -> Seq (MigrationCommand Postgres)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamSqlBackendSyntax Postgres
-> MigrationDataLoss -> MigrationCommand Postgres
forall be.
BeamSqlBackendSyntax be -> MigrationDataLoss -> MigrationCommand be
MigrationCommand BeamSqlBackendSyntax Postgres
PgCommandSyntax
cmd MigrationDataLoss
MigrationKeepsData))
(Text
"Load the postgres extension " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ext) Int
1)
pgDropExtensionProvider :: ActionProvider Postgres
pgDropExtensionProvider =
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 extP :: PgHasExtension
extP@(PgHasExtension Text
ext) <- [PgHasExtension]
forall preCondition. Typeable preCondition => [preCondition]
findPre
[()] -> [()]
forall (m :: * -> *) a. Alternative m => [a] -> m ()
ensuringNot_ ([()] -> [()]) -> [()] -> [()]
forall a b. (a -> b) -> a -> b
$
do PgHasExtension Text
ext' <- [PgHasExtension]
forall preCondition. Typeable preCondition => [preCondition]
findPost
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
ext Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ext')
let cmd :: PgCommandSyntax
cmd = Text -> PgCommandSyntax
pgDropExtensionSyntax Text
ext
PotentialAction Postgres -> [PotentialAction Postgres]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashSet SomeDatabasePredicate
-> HashSet SomeDatabasePredicate
-> Seq (MigrationCommand Postgres)
-> Text
-> Int
-> PotentialAction Postgres
forall be.
HashSet SomeDatabasePredicate
-> HashSet SomeDatabasePredicate
-> Seq (MigrationCommand be)
-> Text
-> Int
-> PotentialAction be
PotentialAction ([SomeDatabasePredicate] -> HashSet SomeDatabasePredicate
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [PgHasExtension -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p PgHasExtension
extP]) HashSet SomeDatabasePredicate
forall a. Monoid a => a
mempty
(MigrationCommand Postgres -> Seq (MigrationCommand Postgres)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamSqlBackendSyntax Postgres
-> MigrationDataLoss -> MigrationCommand Postgres
forall be.
BeamSqlBackendSyntax be -> MigrationDataLoss -> MigrationCommand be
MigrationCommand BeamSqlBackendSyntax Postgres
PgCommandSyntax
cmd MigrationDataLoss
MigrationKeepsData))
(Text
"Unload the postgres extension " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ext) Int
1)