module Database.PostgreSQL.PQTypes.Model.Trigger (
TriggerEvent(..)
, Trigger(..)
, triggerMakeName
, triggerBaseName
, sqlCreateTrigger
, sqlDropTrigger
, createTrigger
, dropTrigger
, getDBTriggers
, sqlCreateTriggerFunction
, sqlDropTriggerFunction
, triggerFunctionMakeName
) where
import Data.Bits (testBit)
import Data.Foldable (foldl')
import Data.Int
import Data.Monoid.Utils
import Data.Set (Set)
import Data.Text (Text)
import Database.PostgreSQL.PQTypes
import Database.PostgreSQL.PQTypes.SQL.Builder
import qualified Data.Set as Set
import qualified Data.Text as Text
data TriggerEvent
= TriggerInsert
| TriggerUpdate
| TriggerUpdateOf [RawSQL ()]
| TriggerDelete
deriving (TriggerEvent -> TriggerEvent -> Bool
(TriggerEvent -> TriggerEvent -> Bool)
-> (TriggerEvent -> TriggerEvent -> Bool) -> Eq TriggerEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TriggerEvent -> TriggerEvent -> Bool
$c/= :: TriggerEvent -> TriggerEvent -> Bool
== :: TriggerEvent -> TriggerEvent -> Bool
$c== :: TriggerEvent -> TriggerEvent -> Bool
Eq, Eq TriggerEvent
Eq TriggerEvent
-> (TriggerEvent -> TriggerEvent -> Ordering)
-> (TriggerEvent -> TriggerEvent -> Bool)
-> (TriggerEvent -> TriggerEvent -> Bool)
-> (TriggerEvent -> TriggerEvent -> Bool)
-> (TriggerEvent -> TriggerEvent -> Bool)
-> (TriggerEvent -> TriggerEvent -> TriggerEvent)
-> (TriggerEvent -> TriggerEvent -> TriggerEvent)
-> Ord TriggerEvent
TriggerEvent -> TriggerEvent -> Bool
TriggerEvent -> TriggerEvent -> Ordering
TriggerEvent -> TriggerEvent -> TriggerEvent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TriggerEvent -> TriggerEvent -> TriggerEvent
$cmin :: TriggerEvent -> TriggerEvent -> TriggerEvent
max :: TriggerEvent -> TriggerEvent -> TriggerEvent
$cmax :: TriggerEvent -> TriggerEvent -> TriggerEvent
>= :: TriggerEvent -> TriggerEvent -> Bool
$c>= :: TriggerEvent -> TriggerEvent -> Bool
> :: TriggerEvent -> TriggerEvent -> Bool
$c> :: TriggerEvent -> TriggerEvent -> Bool
<= :: TriggerEvent -> TriggerEvent -> Bool
$c<= :: TriggerEvent -> TriggerEvent -> Bool
< :: TriggerEvent -> TriggerEvent -> Bool
$c< :: TriggerEvent -> TriggerEvent -> Bool
compare :: TriggerEvent -> TriggerEvent -> Ordering
$ccompare :: TriggerEvent -> TriggerEvent -> Ordering
$cp1Ord :: Eq TriggerEvent
Ord, Int -> TriggerEvent -> ShowS
[TriggerEvent] -> ShowS
TriggerEvent -> String
(Int -> TriggerEvent -> ShowS)
-> (TriggerEvent -> String)
-> ([TriggerEvent] -> ShowS)
-> Show TriggerEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TriggerEvent] -> ShowS
$cshowList :: [TriggerEvent] -> ShowS
show :: TriggerEvent -> String
$cshow :: TriggerEvent -> String
showsPrec :: Int -> TriggerEvent -> ShowS
$cshowsPrec :: Int -> TriggerEvent -> ShowS
Show)
data Trigger = Trigger {
Trigger -> RawSQL ()
triggerTable :: RawSQL ()
, Trigger -> RawSQL ()
triggerName :: RawSQL ()
, Trigger -> Set TriggerEvent
triggerEvents :: Set TriggerEvent
, Trigger -> Bool
triggerDeferrable :: Bool
, Trigger -> Bool
triggerInitiallyDeferred :: Bool
, Trigger -> Maybe (RawSQL ())
triggerWhen :: Maybe (RawSQL ())
, Trigger -> RawSQL ()
triggerFunction :: RawSQL ()
} deriving (Int -> Trigger -> ShowS
[Trigger] -> ShowS
Trigger -> String
(Int -> Trigger -> ShowS)
-> (Trigger -> String) -> ([Trigger] -> ShowS) -> Show Trigger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trigger] -> ShowS
$cshowList :: [Trigger] -> ShowS
show :: Trigger -> String
$cshow :: Trigger -> String
showsPrec :: Int -> Trigger -> ShowS
$cshowsPrec :: Int -> Trigger -> ShowS
Show)
instance Eq Trigger where
Trigger
t1 == :: Trigger -> Trigger -> Bool
== Trigger
t2 =
Trigger -> RawSQL ()
triggerTable Trigger
t1 RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== Trigger -> RawSQL ()
triggerTable Trigger
t2
Bool -> Bool -> Bool
&& Trigger -> RawSQL ()
triggerName Trigger
t1 RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== Trigger -> RawSQL ()
triggerName Trigger
t2
Bool -> Bool -> Bool
&& Trigger -> Set TriggerEvent
triggerEvents Trigger
t1 Set TriggerEvent -> Set TriggerEvent -> Bool
forall a. Eq a => a -> a -> Bool
== Trigger -> Set TriggerEvent
triggerEvents Trigger
t2
Bool -> Bool -> Bool
&& Trigger -> Bool
triggerDeferrable Trigger
t1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Trigger -> Bool
triggerDeferrable Trigger
t2
Bool -> Bool -> Bool
&& Trigger -> Bool
triggerInitiallyDeferred Trigger
t1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Trigger -> Bool
triggerInitiallyDeferred Trigger
t2
Bool -> Bool -> Bool
&& Trigger -> Maybe (RawSQL ())
triggerWhen Trigger
t1 Maybe (RawSQL ()) -> Maybe (RawSQL ()) -> Bool
forall a. Eq a => a -> a -> Bool
== Trigger -> Maybe (RawSQL ())
triggerWhen Trigger
t2
triggerMakeName :: RawSQL () -> RawSQL () -> RawSQL ()
triggerMakeName :: RawSQL () -> RawSQL () -> RawSQL ()
triggerMakeName RawSQL ()
name RawSQL ()
tableName = RawSQL ()
"trg__" RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL ()
tableName RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL ()
"__" RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL ()
name
triggerBaseName :: RawSQL () -> RawSQL () -> RawSQL ()
triggerBaseName :: RawSQL () -> RawSQL () -> RawSQL ()
triggerBaseName RawSQL ()
name RawSQL ()
tableName =
Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL ((Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
Text.breakOnEnd (RawSQL () -> Text
unRawSQL RawSQL ()
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"__") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ RawSQL () -> Text
unRawSQL RawSQL ()
name) ()
triggerEventName :: TriggerEvent -> RawSQL ()
triggerEventName :: TriggerEvent -> RawSQL ()
triggerEventName = \case
TriggerEvent
TriggerInsert -> RawSQL ()
"INSERT"
TriggerEvent
TriggerUpdate -> RawSQL ()
"UPDATE"
TriggerUpdateOf [RawSQL ()]
columns -> if [RawSQL ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RawSQL ()]
columns
then String -> RawSQL ()
forall a. HasCallStack => String -> a
error String
"UPDATE OF must have columns."
else RawSQL ()
"UPDATE OF" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
", " [RawSQL ()]
columns
TriggerEvent
TriggerDelete -> RawSQL ()
"DELETE"
sqlCreateTrigger :: Trigger -> RawSQL ()
sqlCreateTrigger :: Trigger -> RawSQL ()
sqlCreateTrigger Trigger{Bool
Maybe (RawSQL ())
Set TriggerEvent
RawSQL ()
triggerFunction :: RawSQL ()
triggerWhen :: Maybe (RawSQL ())
triggerInitiallyDeferred :: Bool
triggerDeferrable :: Bool
triggerEvents :: Set TriggerEvent
triggerName :: RawSQL ()
triggerTable :: RawSQL ()
triggerFunction :: Trigger -> RawSQL ()
triggerWhen :: Trigger -> Maybe (RawSQL ())
triggerInitiallyDeferred :: Trigger -> Bool
triggerDeferrable :: Trigger -> Bool
triggerEvents :: Trigger -> Set TriggerEvent
triggerName :: Trigger -> RawSQL ()
triggerTable :: Trigger -> RawSQL ()
..} =
RawSQL ()
"CREATE CONSTRAINT TRIGGER" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
trgName
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"AFTER" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
trgEvents
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"ON" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
triggerTable
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
trgTiming
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"FOR EACH ROW"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
trgWhen
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"EXECUTE FUNCTION" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
trgFunction
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"()"
where
trgName :: RawSQL ()
trgName
| RawSQL ()
triggerName RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== RawSQL ()
"" = String -> RawSQL ()
forall a. HasCallStack => String -> a
error String
"Trigger must have a name."
| Bool
otherwise = RawSQL () -> RawSQL () -> RawSQL ()
triggerMakeName RawSQL ()
triggerName RawSQL ()
triggerTable
trgEvents :: RawSQL ()
trgEvents
| Set TriggerEvent
triggerEvents Set TriggerEvent -> Set TriggerEvent -> Bool
forall a. Eq a => a -> a -> Bool
== Set TriggerEvent
forall a. Set a
Set.empty = String -> RawSQL ()
forall a. HasCallStack => String -> a
error String
"Trigger must have at least one event."
| Bool
otherwise = RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
" OR " ([RawSQL ()] -> RawSQL ())
-> ([TriggerEvent] -> [RawSQL ()]) -> [TriggerEvent] -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TriggerEvent -> RawSQL ()) -> [TriggerEvent] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map TriggerEvent -> RawSQL ()
triggerEventName ([TriggerEvent] -> RawSQL ()) -> [TriggerEvent] -> RawSQL ()
forall a b. (a -> b) -> a -> b
$ Set TriggerEvent -> [TriggerEvent]
forall a. Set a -> [a]
Set.toList Set TriggerEvent
triggerEvents
trgTiming :: RawSQL ()
trgTiming = let deferrable :: RawSQL ()
deferrable = (if Bool
triggerDeferrable then RawSQL ()
"" else RawSQL ()
"NOT") RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"DEFERRABLE"
deferred :: RawSQL ()
deferred = if Bool
triggerInitiallyDeferred
then RawSQL ()
"INITIALLY DEFERRED"
else RawSQL ()
"INITIALLY IMMEDIATE"
in RawSQL ()
deferrable RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
deferred
trgWhen :: RawSQL ()
trgWhen = RawSQL ()
-> (RawSQL () -> RawSQL ()) -> Maybe (RawSQL ()) -> RawSQL ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSQL ()
"" (\RawSQL ()
w -> RawSQL ()
"WHEN (" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
w RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
")") Maybe (RawSQL ())
triggerWhen
trgFunction :: RawSQL ()
trgFunction = RawSQL () -> RawSQL ()
triggerFunctionMakeName RawSQL ()
triggerName
sqlDropTrigger :: Trigger -> RawSQL ()
sqlDropTrigger :: Trigger -> RawSQL ()
sqlDropTrigger Trigger{Bool
Maybe (RawSQL ())
Set TriggerEvent
RawSQL ()
triggerFunction :: RawSQL ()
triggerWhen :: Maybe (RawSQL ())
triggerInitiallyDeferred :: Bool
triggerDeferrable :: Bool
triggerEvents :: Set TriggerEvent
triggerName :: RawSQL ()
triggerTable :: RawSQL ()
triggerFunction :: Trigger -> RawSQL ()
triggerWhen :: Trigger -> Maybe (RawSQL ())
triggerInitiallyDeferred :: Trigger -> Bool
triggerDeferrable :: Trigger -> Bool
triggerEvents :: Trigger -> Set TriggerEvent
triggerName :: Trigger -> RawSQL ()
triggerTable :: Trigger -> RawSQL ()
..} =
RawSQL ()
"DROP TRIGGER" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
trgName RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"ON" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
triggerTable RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"RESTRICT"
where
trgName :: RawSQL ()
trgName
| RawSQL ()
triggerName RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== RawSQL ()
"" = String -> RawSQL ()
forall a. HasCallStack => String -> a
error String
"Trigger must have a name."
| Bool
otherwise = RawSQL () -> RawSQL () -> RawSQL ()
triggerMakeName RawSQL ()
triggerName RawSQL ()
triggerTable
createTrigger :: MonadDB m => Trigger -> m ()
createTrigger :: Trigger -> m ()
createTrigger Trigger
trigger = do
RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ Trigger -> RawSQL ()
sqlCreateTriggerFunction Trigger
trigger
RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ Trigger -> RawSQL ()
sqlCreateTrigger Trigger
trigger
dropTrigger :: MonadDB m => Trigger -> m ()
dropTrigger :: Trigger -> m ()
dropTrigger Trigger
trigger = do
RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ Trigger -> RawSQL ()
sqlDropTrigger Trigger
trigger
RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ Trigger -> RawSQL ()
sqlDropTriggerFunction Trigger
trigger
getDBTriggers :: forall m. MonadDB m => RawSQL () -> m [(Trigger, RawSQL ())]
getDBTriggers :: RawSQL () -> m [(Trigger, RawSQL ())]
getDBTriggers RawSQL ()
tableName = do
SqlSelect -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (SqlSelect -> m ())
-> (State SqlSelect () -> SqlSelect) -> State SqlSelect () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> State SqlSelect () -> SqlSelect
sqlSelect SQL
"pg_trigger t" (State SqlSelect () -> m ()) -> State SqlSelect () -> m ()
forall a b. (a -> b) -> a -> b
$ do
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"t.tgname::text"
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"t.tgtype"
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"t.tgdeferrable"
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"t.tginitdeferred"
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"pg_get_triggerdef(t.oid, true)::text"
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"p.proname::text"
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"p.prosrc"
SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"c.relname::text"
SQL -> SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlFrom v) =>
SQL -> SQL -> m ()
sqlJoinOn SQL
"pg_proc p" SQL
"t.tgfoid = p.oid"
SQL -> SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlFrom v) =>
SQL -> SQL -> m ()
sqlJoinOn SQL
"pg_class c" SQL
"c.oid = t.tgrelid"
SQL -> Bool -> State SqlSelect ()
forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlWhereEq SQL
"t.tgisinternal" Bool
False
SQL -> Text -> State SqlSelect ()
forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlWhereEq SQL
"c.relname" (Text -> State SqlSelect ()) -> Text -> State SqlSelect ()
forall a b. (a -> b) -> a -> b
$ RawSQL () -> Text
unRawSQL RawSQL ()
tableName
((String, Int16, Bool, Bool, String, String, String, String)
-> (Trigger, RawSQL ()))
-> m [(Trigger, RawSQL ())]
forall (m :: * -> *) row t.
(MonadDB m, FromRow row) =>
(row -> t) -> m [t]
fetchMany (String, Int16, Bool, Bool, String, String, String, String)
-> (Trigger, RawSQL ())
getTrigger
where
getTrigger :: (String, Int16, Bool, Bool, String, String, String, String) -> (Trigger, RawSQL ())
getTrigger :: (String, Int16, Bool, Bool, String, String, String, String)
-> (Trigger, RawSQL ())
getTrigger (String
tgname, Int16
tgtype, Bool
tgdeferrable, Bool
tginitdeferrable, String
triggerdef, String
proname, String
prosrc, String
tblName) =
( Trigger :: RawSQL ()
-> RawSQL ()
-> Set TriggerEvent
-> Bool
-> Bool
-> Maybe (RawSQL ())
-> RawSQL ()
-> Trigger
Trigger { triggerTable :: RawSQL ()
triggerTable = RawSQL ()
tableName'
, triggerName :: RawSQL ()
triggerName = RawSQL () -> RawSQL () -> RawSQL ()
triggerBaseName (String -> RawSQL ()
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL String
tgname) RawSQL ()
tableName'
, triggerEvents :: Set TriggerEvent
triggerEvents = Set TriggerEvent
trgEvents
, triggerDeferrable :: Bool
triggerDeferrable = Bool
tgdeferrable
, triggerInitiallyDeferred :: Bool
triggerInitiallyDeferred = Bool
tginitdeferrable
, triggerWhen :: Maybe (RawSQL ())
triggerWhen = Maybe (RawSQL ())
tgrWhen
, triggerFunction :: RawSQL ()
triggerFunction = String -> RawSQL ()
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL String
prosrc
}
, String -> RawSQL ()
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL String
proname
)
where
tableName' :: RawSQL ()
tableName' :: RawSQL ()
tableName' = String -> RawSQL ()
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL String
tblName
parseBetween :: Text -> Text -> Maybe (RawSQL ())
parseBetween :: Text -> Text -> Maybe (RawSQL ())
parseBetween Text
left Text
right =
let (Text
prefix, Text
match) = Text -> Text -> (Text, Text)
Text.breakOnEnd Text
left (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
triggerdef
in if Text -> Bool
Text.null Text
prefix
then Maybe (RawSQL ())
forall a. Maybe a
Nothing
else RawSQL () -> Maybe (RawSQL ())
forall a. a -> Maybe a
Just (RawSQL () -> Maybe (RawSQL ())) -> RawSQL () -> Maybe (RawSQL ())
forall a b. (a -> b) -> a -> b
$ (Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL (Text -> () -> RawSQL ())
-> ((Text, Text) -> Text) -> (Text, Text) -> () -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> () -> RawSQL ())
-> (Text, Text) -> () -> RawSQL ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
Text.breakOn Text
right Text
match) ()
tgrWhen :: Maybe (RawSQL ())
tgrWhen :: Maybe (RawSQL ())
tgrWhen = Text -> Text -> Maybe (RawSQL ())
parseBetween Text
"WHEN (" Text
") EXECUTE"
trgEvents :: Set TriggerEvent
trgEvents :: Set TriggerEvent
trgEvents =
(Set TriggerEvent -> (Int, TriggerEvent) -> Set TriggerEvent)
-> Set TriggerEvent -> [(Int, TriggerEvent)] -> Set TriggerEvent
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Set TriggerEvent
set (Int
mask, TriggerEvent
event) ->
if Int16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int16
tgtype Int
mask
then
TriggerEvent -> Set TriggerEvent -> Set TriggerEvent
forall a. Ord a => a -> Set a -> Set a
Set.insert
(if TriggerEvent
event TriggerEvent -> TriggerEvent -> Bool
forall a. Eq a => a -> a -> Bool
== TriggerEvent
TriggerUpdate
then TriggerEvent
-> (RawSQL () -> TriggerEvent) -> Maybe (RawSQL ()) -> TriggerEvent
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TriggerEvent
event RawSQL () -> TriggerEvent
trgUpdateOf (Maybe (RawSQL ()) -> TriggerEvent)
-> Maybe (RawSQL ()) -> TriggerEvent
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe (RawSQL ())
parseBetween Text
"UPDATE OF " Text
" ON"
else TriggerEvent
event
)
Set TriggerEvent
set
else Set TriggerEvent
set
)
Set TriggerEvent
forall a. Set a
Set.empty
[ (Int
2, TriggerEvent
TriggerInsert)
, (Int
3, TriggerEvent
TriggerDelete)
, (Int
4, TriggerEvent
TriggerUpdate)
]
trgUpdateOf :: RawSQL () -> TriggerEvent
trgUpdateOf :: RawSQL () -> TriggerEvent
trgUpdateOf RawSQL ()
columnsSQL =
let columns :: [RawSQL ()]
columns = (Text -> RawSQL ()) -> [Text] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map (String -> RawSQL ()
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL (String -> RawSQL ()) -> (Text -> String) -> Text -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) ([Text] -> [RawSQL ()]) -> (Text -> [Text]) -> Text -> [RawSQL ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
", " (Text -> [RawSQL ()]) -> Text -> [RawSQL ()]
forall a b. (a -> b) -> a -> b
$ RawSQL () -> Text
unRawSQL RawSQL ()
columnsSQL
in [RawSQL ()] -> TriggerEvent
TriggerUpdateOf [RawSQL ()]
columns
sqlCreateTriggerFunction :: Trigger -> RawSQL ()
sqlCreateTriggerFunction :: Trigger -> RawSQL ()
sqlCreateTriggerFunction Trigger{Bool
Maybe (RawSQL ())
Set TriggerEvent
RawSQL ()
triggerFunction :: RawSQL ()
triggerWhen :: Maybe (RawSQL ())
triggerInitiallyDeferred :: Bool
triggerDeferrable :: Bool
triggerEvents :: Set TriggerEvent
triggerName :: RawSQL ()
triggerTable :: RawSQL ()
triggerFunction :: Trigger -> RawSQL ()
triggerWhen :: Trigger -> Maybe (RawSQL ())
triggerInitiallyDeferred :: Trigger -> Bool
triggerDeferrable :: Trigger -> Bool
triggerEvents :: Trigger -> Set TriggerEvent
triggerName :: Trigger -> RawSQL ()
triggerTable :: Trigger -> RawSQL ()
..} =
RawSQL ()
"CREATE FUNCTION"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> RawSQL ()
triggerFunctionMakeName RawSQL ()
triggerName
RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL ()
"()"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"RETURNS TRIGGER"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"AS $$"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
triggerFunction
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"$$"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"LANGUAGE PLPGSQL"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"VOLATILE"
RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"RETURNS NULL ON NULL INPUT"
sqlDropTriggerFunction :: Trigger -> RawSQL ()
sqlDropTriggerFunction :: Trigger -> RawSQL ()
sqlDropTriggerFunction Trigger{Bool
Maybe (RawSQL ())
Set TriggerEvent
RawSQL ()
triggerFunction :: RawSQL ()
triggerWhen :: Maybe (RawSQL ())
triggerInitiallyDeferred :: Bool
triggerDeferrable :: Bool
triggerEvents :: Set TriggerEvent
triggerName :: RawSQL ()
triggerTable :: RawSQL ()
triggerFunction :: Trigger -> RawSQL ()
triggerWhen :: Trigger -> Maybe (RawSQL ())
triggerInitiallyDeferred :: Trigger -> Bool
triggerDeferrable :: Trigger -> Bool
triggerEvents :: Trigger -> Set TriggerEvent
triggerName :: Trigger -> RawSQL ()
triggerTable :: Trigger -> RawSQL ()
..} =
RawSQL ()
"DROP FUNCTION" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> RawSQL ()
triggerFunctionMakeName RawSQL ()
triggerName RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"RESTRICT"
triggerFunctionMakeName :: RawSQL () -> RawSQL ()
triggerFunctionMakeName :: RawSQL () -> RawSQL ()
triggerFunctionMakeName RawSQL ()
name = RawSQL ()
"trgfun__" RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL ()
name