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

import Data.Monoid.Utils
import Data.Text qualified as T
import Database.PostgreSQL.PQTypes

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
$c== :: ForeignKey -> ForeignKey -> Bool
== :: ForeignKey -> ForeignKey -> Bool
$c/= :: ForeignKey -> ForeignKey -> Bool
/= :: 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
$ccompare :: ForeignKey -> ForeignKey -> Ordering
compare :: ForeignKey -> ForeignKey -> Ordering
$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
>= :: ForeignKey -> ForeignKey -> Bool
$cmax :: ForeignKey -> ForeignKey -> ForeignKey
max :: ForeignKey -> ForeignKey -> ForeignKey
$cmin :: ForeignKey -> ForeignKey -> ForeignKey
min :: ForeignKey -> ForeignKey -> 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
$cshowsPrec :: Int -> ForeignKey -> ShowS
showsPrec :: Int -> ForeignKey -> ShowS
$cshow :: ForeignKey -> String
show :: ForeignKey -> String
$cshowList :: [ForeignKey] -> ShowS
showList :: [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
$c== :: ForeignKeyAction -> ForeignKeyAction -> Bool
== :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c/= :: ForeignKeyAction -> ForeignKeyAction -> Bool
/= :: 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
$ccompare :: ForeignKeyAction -> ForeignKeyAction -> Ordering
compare :: ForeignKeyAction -> ForeignKeyAction -> Ordering
$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
>= :: ForeignKeyAction -> ForeignKeyAction -> Bool
$cmax :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
max :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
$cmin :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
min :: ForeignKeyAction -> ForeignKeyAction -> 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
$cshowsPrec :: Int -> ForeignKeyAction -> ShowS
showsPrec :: Int -> ForeignKeyAction -> ShowS
$cshow :: ForeignKeyAction -> String
show :: ForeignKeyAction -> String
$cshowList :: [ForeignKeyAction] -> ShowS
showList :: [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
    { 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
fkColumns :: ForeignKey -> [RawSQL ()]
fkRefTable :: ForeignKey -> RawSQL ()
fkRefColumns :: ForeignKey -> [RawSQL ()]
fkOnUpdate :: ForeignKey -> ForeignKeyAction
fkOnDelete :: ForeignKey -> ForeignKeyAction
fkDeferrable :: ForeignKey -> Bool
fkDeferred :: ForeignKey -> Bool
fkValidated :: ForeignKey -> Bool
fkColumns :: [RawSQL ()]
fkRefTable :: RawSQL ()
fkRefColumns :: [RawSQL ()]
fkOnUpdate :: ForeignKeyAction
fkOnDelete :: ForeignKeyAction
fkDeferrable :: Bool
fkDeferred :: Bool
fkValidated :: Bool
..} =
  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
fkColumns :: ForeignKey -> [RawSQL ()]
fkRefTable :: ForeignKey -> RawSQL ()
fkRefColumns :: ForeignKey -> [RawSQL ()]
fkOnUpdate :: ForeignKey -> ForeignKeyAction
fkOnDelete :: ForeignKey -> ForeignKeyAction
fkDeferrable :: ForeignKey -> Bool
fkDeferred :: ForeignKey -> Bool
fkValidated :: ForeignKey -> Bool
fkColumns :: [RawSQL ()]
fkRefTable :: RawSQL ()
fkRefColumns :: [RawSQL ()]
fkOnUpdate :: ForeignKeyAction
fkOnDelete :: ForeignKeyAction
fkDeferrable :: Bool
fkDeferred :: Bool
fkValidated :: Bool
..} =
  [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 {a}. IsString a => ForeignKeyAction -> a
foreignKeyActionToSQL ForeignKeyAction
fkOnUpdate
    , RawSQL ()
"  ON DELETE" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> ForeignKeyAction -> RawSQL ()
forall {a}. IsString a => ForeignKeyAction -> a
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 -> a
foreignKeyActionToSQL ForeignKeyAction
ForeignKeyNoAction = a
"NO ACTION"
    foreignKeyActionToSQL ForeignKeyAction
ForeignKeyRestrict = a
"RESTRICT"
    foreignKeyActionToSQL ForeignKeyAction
ForeignKeyCascade = a
"CASCADE"
    foreignKeyActionToSQL ForeignKeyAction
ForeignKeySetNull = a
"SET NULL"
    foreignKeyActionToSQL ForeignKeyAction
ForeignKeySetDefault = a
"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