module Database.PostgreSQL.PQTypes.Model.ForeignKey (
    ForeignKey(..)
  , ForeignKeyAction(..)
  , fkOnColumn
  , fkOnColumns
  , fkName
  , sqlAddValidFKMaybeDowntime
  , sqlAddNotValidFK
  , sqlValidateFK
  , sqlDropFK
  ) where

import Data.Monoid.Utils
import Database.PostgreSQL.PQTypes
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 -- ^ Set to 'False' if foreign key is created as NOT
                       -- VALID and left in such state (for whatever reason).
} 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
    -- PostgreSQL's limit for identifier is 63 characters
    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

-- | Add valid foreign key. Warning: PostgreSQL acquires SHARE ROW EXCLUSIVE
-- lock (that prevents data updates) on both modified and referenced table for
-- the duration of the creation. If this is not acceptable, use
-- 'sqlAddNotValidFK' and 'sqlValidateFK'.
sqlAddValidFKMaybeDowntime :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddValidFKMaybeDowntime :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddValidFKMaybeDowntime = Bool -> RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK_ Bool
True

-- | Add foreign key marked as NOT VALID. This avoids potentially long
-- validation blocking updates to both modified and referenced table for its
-- duration. However, keys created as such need to be validated later using
-- 'sqlValidateFK'.
sqlAddNotValidFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddNotValidFK :: RawSQL () -> ForeignKey -> RawSQL ()
sqlAddNotValidFK = Bool -> RawSQL () -> ForeignKey -> RawSQL ()
sqlAddFK_ Bool
False

-- | Validate foreign key previously created as NOT VALID.
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