module Database.PostgreSQL.PQTypes.Model.ForeignKey (
ForeignKey(..)
, ForeignKeyAction(..)
, fkOnColumn
, fkOnColumns
, fkName
, sqlAddFK
, sqlAddValidFK
, sqlAddNotValidFK
, sqlValidateFK
, sqlDropFK
) where
import Data.Monoid
import Data.Monoid.Utils
import Database.PostgreSQL.PQTypes
import Prelude
import qualified Data.Text as T
data ForeignKey = ForeignKey {
ForeignKey -> [RawSQL ()]
fkColumns :: [RawSQL ()]
, ForeignKey -> RawSQL ()
fkRefTable :: RawSQL ()
, ForeignKey -> [RawSQL ()]
fkRefColumns :: [RawSQL ()]
, ForeignKey -> ForeignKeyAction
fkOnUpdate :: ForeignKeyAction
, ForeignKey -> ForeignKeyAction
fkOnDelete :: ForeignKeyAction
, ForeignKey -> Bool
fkDeferrable :: Bool
, ForeignKey -> Bool
fkDeferred :: Bool
, ForeignKey -> Bool
fkValidated :: Bool
} deriving (ForeignKey -> ForeignKey -> Bool
(ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool) -> Eq ForeignKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignKey -> ForeignKey -> Bool
$c/= :: ForeignKey -> ForeignKey -> Bool
== :: ForeignKey -> ForeignKey -> Bool
$c== :: ForeignKey -> ForeignKey -> Bool
Eq, Eq ForeignKey
Eq ForeignKey
-> (ForeignKey -> ForeignKey -> Ordering)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> Bool)
-> (ForeignKey -> ForeignKey -> ForeignKey)
-> (ForeignKey -> ForeignKey -> ForeignKey)
-> Ord ForeignKey
ForeignKey -> ForeignKey -> Bool
ForeignKey -> ForeignKey -> Ordering
ForeignKey -> ForeignKey -> ForeignKey
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 :: ForeignKey -> ForeignKey -> ForeignKey
$cmin :: ForeignKey -> ForeignKey -> ForeignKey
max :: ForeignKey -> ForeignKey -> ForeignKey
$cmax :: ForeignKey -> ForeignKey -> ForeignKey
>= :: ForeignKey -> ForeignKey -> Bool
$c>= :: ForeignKey -> ForeignKey -> Bool
> :: ForeignKey -> ForeignKey -> Bool
$c> :: ForeignKey -> ForeignKey -> Bool
<= :: ForeignKey -> ForeignKey -> Bool
$c<= :: ForeignKey -> ForeignKey -> Bool
< :: ForeignKey -> ForeignKey -> Bool
$c< :: ForeignKey -> ForeignKey -> Bool
compare :: ForeignKey -> ForeignKey -> Ordering
$ccompare :: ForeignKey -> ForeignKey -> Ordering
$cp1Ord :: Eq ForeignKey
Ord, Int -> ForeignKey -> ShowS
[ForeignKey] -> ShowS
ForeignKey -> String
(Int -> ForeignKey -> ShowS)
-> (ForeignKey -> String)
-> ([ForeignKey] -> ShowS)
-> Show ForeignKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignKey] -> ShowS
$cshowList :: [ForeignKey] -> ShowS
show :: ForeignKey -> String
$cshow :: ForeignKey -> String
showsPrec :: Int -> ForeignKey -> ShowS
$cshowsPrec :: Int -> ForeignKey -> ShowS
Show)
data ForeignKeyAction
= ForeignKeyNoAction
| ForeignKeyRestrict
| ForeignKeyCascade
| ForeignKeySetNull
| ForeignKeySetDefault
deriving (ForeignKeyAction -> ForeignKeyAction -> Bool
(ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> Eq ForeignKeyAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c/= :: ForeignKeyAction -> ForeignKeyAction -> Bool
== :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c== :: ForeignKeyAction -> ForeignKeyAction -> Bool
Eq, Eq ForeignKeyAction
Eq ForeignKeyAction
-> (ForeignKeyAction -> ForeignKeyAction -> Ordering)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction)
-> (ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction)
-> Ord ForeignKeyAction
ForeignKeyAction -> ForeignKeyAction -> Bool
ForeignKeyAction -> ForeignKeyAction -> Ordering
ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
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 :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
$cmin :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
max :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
$cmax :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
>= :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c>= :: ForeignKeyAction -> ForeignKeyAction -> Bool
> :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c> :: ForeignKeyAction -> ForeignKeyAction -> Bool
<= :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c<= :: ForeignKeyAction -> ForeignKeyAction -> Bool
< :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c< :: ForeignKeyAction -> ForeignKeyAction -> Bool
compare :: ForeignKeyAction -> ForeignKeyAction -> Ordering
$ccompare :: ForeignKeyAction -> ForeignKeyAction -> Ordering
$cp1Ord :: Eq ForeignKeyAction
Ord, Int -> ForeignKeyAction -> ShowS
[ForeignKeyAction] -> ShowS
ForeignKeyAction -> String
(Int -> ForeignKeyAction -> ShowS)
-> (ForeignKeyAction -> String)
-> ([ForeignKeyAction] -> ShowS)
-> Show ForeignKeyAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignKeyAction] -> ShowS
$cshowList :: [ForeignKeyAction] -> ShowS
show :: ForeignKeyAction -> String
$cshow :: ForeignKeyAction -> String
showsPrec :: Int -> ForeignKeyAction -> ShowS
$cshowsPrec :: Int -> ForeignKeyAction -> ShowS
Show)
fkOnColumn :: RawSQL () -> RawSQL () -> RawSQL () -> ForeignKey
fkOnColumn :: RawSQL () -> RawSQL () -> RawSQL () -> ForeignKey
fkOnColumn RawSQL ()
column RawSQL ()
reftable RawSQL ()
refcolumn =
[RawSQL ()] -> RawSQL () -> [RawSQL ()] -> ForeignKey
fkOnColumns [RawSQL ()
column] RawSQL ()
reftable [RawSQL ()
refcolumn]
fkOnColumns :: [RawSQL ()] -> RawSQL () -> [RawSQL ()] -> ForeignKey
fkOnColumns :: [RawSQL ()] -> RawSQL () -> [RawSQL ()] -> ForeignKey
fkOnColumns [RawSQL ()]
columns RawSQL ()
reftable [RawSQL ()]
refcolumns = ForeignKey :: [RawSQL ()]
-> RawSQL ()
-> [RawSQL ()]
-> ForeignKeyAction
-> ForeignKeyAction
-> Bool
-> Bool
-> Bool
-> ForeignKey
ForeignKey {
fkColumns :: [RawSQL ()]
fkColumns = [RawSQL ()]
columns
, fkRefTable :: RawSQL ()
fkRefTable = RawSQL ()
reftable
, fkRefColumns :: [RawSQL ()]
fkRefColumns = [RawSQL ()]
refcolumns
, fkOnUpdate :: ForeignKeyAction
fkOnUpdate = ForeignKeyAction
ForeignKeyCascade
, fkOnDelete :: ForeignKeyAction
fkOnDelete = ForeignKeyAction
ForeignKeyNoAction
, fkDeferrable :: Bool
fkDeferrable = Bool
True
, fkDeferred :: Bool
fkDeferred = Bool
False
, fkValidated :: Bool
fkValidated = Bool
True
}
fkName :: RawSQL () -> ForeignKey -> RawSQL ()
fkName :: RawSQL () -> ForeignKey -> RawSQL ()
fkName RawSQL ()
tname ForeignKey{Bool
[RawSQL ()]
RawSQL ()
ForeignKeyAction
fkValidated :: Bool
fkDeferred :: Bool
fkDeferrable :: Bool
fkOnDelete :: ForeignKeyAction
fkOnUpdate :: ForeignKeyAction
fkRefColumns :: [RawSQL ()]
fkRefTable :: RawSQL ()
fkColumns :: [RawSQL ()]
fkValidated :: ForeignKey -> Bool
fkDeferred :: ForeignKey -> Bool
fkDeferrable :: ForeignKey -> Bool
fkOnDelete :: ForeignKey -> ForeignKeyAction
fkOnUpdate :: ForeignKey -> ForeignKeyAction
fkRefColumns :: ForeignKey -> [RawSQL ()]
fkRefTable :: ForeignKey -> RawSQL ()
fkColumns :: ForeignKey -> [RawSQL ()]
..} = RawSQL () -> RawSQL ()
shorten (RawSQL () -> RawSQL ()) -> RawSQL () -> RawSQL ()
forall a b. (a -> b) -> a -> b
$ [RawSQL ()] -> RawSQL ()
forall a. Monoid a => [a] -> a
mconcat [
RawSQL ()
"fk__"
, RawSQL ()
tname
, RawSQL ()
"__"
, RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
"__" [RawSQL ()]
fkColumns
, RawSQL ()
"__"
, RawSQL ()
fkRefTable
]
where
shorten :: RawSQL () -> RawSQL ()
shorten = (Text -> () -> RawSQL ()) -> () -> Text -> RawSQL ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL () (Text -> RawSQL ())
-> (RawSQL () -> Text) -> RawSQL () -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
63 (Text -> Text) -> (RawSQL () -> Text) -> RawSQL () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSQL () -> Text
unRawSQL
{-# DEPRECATED sqlAddFK "Use sqlAddValidFK instead" #-}
sqlAddFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK = Bool -> RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK_ Bool
True
sqlAddValidFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddValidFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddValidFK = Bool -> RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK_ Bool
True
sqlAddNotValidFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddNotValidFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddNotValidFK = Bool -> RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK_ Bool
False
sqlValidateFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlValidateFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlValidateFK RawSQL ()
tname ForeignKey
fk = RawSQL ()
"VALIDATE CONSTRAINT" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> ForeignKey -> RawSQL ()
fkName RawSQL ()
tname ForeignKey
fk
sqlAddFK_ :: Bool -> RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK_ :: Bool -> RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK_ Bool
valid RawSQL ()
tname fk :: ForeignKey
fk@ForeignKey{Bool
[RawSQL ()]
RawSQL ()
ForeignKeyAction
fkValidated :: Bool
fkDeferred :: Bool
fkDeferrable :: Bool
fkOnDelete :: ForeignKeyAction
fkOnUpdate :: ForeignKeyAction
fkRefColumns :: [RawSQL ()]
fkRefTable :: RawSQL ()
fkColumns :: [RawSQL ()]
fkValidated :: ForeignKey -> Bool
fkDeferred :: ForeignKey -> Bool
fkDeferrable :: ForeignKey -> Bool
fkOnDelete :: ForeignKey -> ForeignKeyAction
fkOnUpdate :: ForeignKey -> ForeignKeyAction
fkRefColumns :: ForeignKey -> [RawSQL ()]
fkRefTable :: ForeignKey -> RawSQL ()
fkColumns :: ForeignKey -> [RawSQL ()]
..} = [RawSQL ()] -> RawSQL ()
forall a. Monoid a => [a] -> a
mconcat [
RawSQL ()
"ADD CONSTRAINT" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> ForeignKey -> RawSQL ()
fkName RawSQL ()
tname ForeignKey
fk RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"FOREIGN KEY ("
, RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
", " [RawSQL ()]
fkColumns
, RawSQL ()
") REFERENCES" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
fkRefTable RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"("
, RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
", " [RawSQL ()]
fkRefColumns
, RawSQL ()
") ON UPDATE" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> ForeignKeyAction -> RawSQL ()
forall p. IsString p => ForeignKeyAction -> p
foreignKeyActionToSQL ForeignKeyAction
fkOnUpdate
, RawSQL ()
" ON DELETE" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> ForeignKeyAction -> RawSQL ()
forall p. IsString p => ForeignKeyAction -> p
foreignKeyActionToSQL ForeignKeyAction
fkOnDelete
, RawSQL ()
" " RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> if Bool
fkDeferrable then RawSQL ()
"DEFERRABLE" else RawSQL ()
"NOT DEFERRABLE"
, RawSQL ()
" INITIALLY" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> if Bool
fkDeferred then RawSQL ()
"DEFERRED" else RawSQL ()
"IMMEDIATE"
, if Bool
valid then RawSQL ()
"" else RawSQL ()
" NOT VALID"
]
where
foreignKeyActionToSQL :: ForeignKeyAction -> p
foreignKeyActionToSQL ForeignKeyAction
ForeignKeyNoAction = p
"NO ACTION"
foreignKeyActionToSQL ForeignKeyAction
ForeignKeyRestrict = p
"RESTRICT"
foreignKeyActionToSQL ForeignKeyAction
ForeignKeyCascade = p
"CASCADE"
foreignKeyActionToSQL ForeignKeyAction
ForeignKeySetNull = p
"SET NULL"
foreignKeyActionToSQL ForeignKeyAction
ForeignKeySetDefault = p
"SET DEFAULT"
sqlDropFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlDropFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlDropFK RawSQL ()
tname ForeignKey
fk = RawSQL ()
"DROP CONSTRAINT" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> ForeignKey -> RawSQL ()
fkName RawSQL ()
tname ForeignKey
fk