module Database.PostgreSQL.PQTypes.Model.Check (
    Check(..)
  , tblCheck
  , sqlAddValidCheckMaybeDowntime
  , sqlAddNotValidCheck
  , sqlValidateCheck
  , sqlDropCheck
  ) where

import Data.Monoid.Utils
import Database.PostgreSQL.PQTypes
import Prelude

data Check = Check {
  Check -> RawSQL ()
chkName      :: RawSQL ()
, Check -> RawSQL ()
chkCondition :: RawSQL ()
, Check -> Bool
chkValidated :: Bool -- ^ Set to 'False' if check is created as NOT VALID and
                       -- left in such state (for whatever reason).
} deriving (Check -> Check -> Bool
(Check -> Check -> Bool) -> (Check -> Check -> Bool) -> Eq Check
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Check -> Check -> Bool
$c/= :: Check -> Check -> Bool
== :: Check -> Check -> Bool
$c== :: Check -> Check -> Bool
Eq, Eq Check
Eq Check
-> (Check -> Check -> Ordering)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Check)
-> (Check -> Check -> Check)
-> Ord Check
Check -> Check -> Bool
Check -> Check -> Ordering
Check -> Check -> Check
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 :: Check -> Check -> Check
$cmin :: Check -> Check -> Check
max :: Check -> Check -> Check
$cmax :: Check -> Check -> Check
>= :: Check -> Check -> Bool
$c>= :: Check -> Check -> Bool
> :: Check -> Check -> Bool
$c> :: Check -> Check -> Bool
<= :: Check -> Check -> Bool
$c<= :: Check -> Check -> Bool
< :: Check -> Check -> Bool
$c< :: Check -> Check -> Bool
compare :: Check -> Check -> Ordering
$ccompare :: Check -> Check -> Ordering
$cp1Ord :: Eq Check
Ord, Int -> Check -> ShowS
[Check] -> ShowS
Check -> String
(Int -> Check -> ShowS)
-> (Check -> String) -> ([Check] -> ShowS) -> Show Check
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Check] -> ShowS
$cshowList :: [Check] -> ShowS
show :: Check -> String
$cshow :: Check -> String
showsPrec :: Int -> Check -> ShowS
$cshowsPrec :: Int -> Check -> ShowS
Show)

tblCheck :: Check
tblCheck :: Check
tblCheck = Check :: RawSQL () -> RawSQL () -> Bool -> Check
Check
  { chkName :: RawSQL ()
chkName      = RawSQL ()
""
  , chkCondition :: RawSQL ()
chkCondition = RawSQL ()
""
  , chkValidated :: Bool
chkValidated = Bool
True
  }

-- | Add valid check constraint. Warning: PostgreSQL acquires SHARE ROW
-- EXCLUSIVE lock (that prevents updates) on modified table for the duration of
-- the creation. If this is not acceptable, use 'sqlAddNotValidCheck' and
-- 'sqlValidateCheck'.
sqlAddValidCheckMaybeDowntime :: Check -> RawSQL ()
sqlAddValidCheckMaybeDowntime :: Check -> RawSQL ()
sqlAddValidCheckMaybeDowntime = Bool -> Check -> RawSQL ()
sqlAddCheck_ Bool
True

-- | Add check marked as NOT VALID. This avoids potentially long validation
-- blocking updates to modified table for its duration. However, checks created
-- as such need to be validated later using 'sqlValidateCheck'.
sqlAddNotValidCheck :: Check -> RawSQL ()
sqlAddNotValidCheck :: Check -> RawSQL ()
sqlAddNotValidCheck = Bool -> Check -> RawSQL ()
sqlAddCheck_ Bool
False

-- | Validate check previously created as NOT VALID.
sqlValidateCheck :: RawSQL () -> RawSQL ()
sqlValidateCheck :: RawSQL () -> RawSQL ()
sqlValidateCheck RawSQL ()
checkName = RawSQL ()
"VALIDATE CONSTRAINT" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
checkName

sqlAddCheck_ :: Bool -> Check -> RawSQL ()
sqlAddCheck_ :: Bool -> Check -> RawSQL ()
sqlAddCheck_ Bool
valid Check{Bool
RawSQL ()
chkValidated :: Bool
chkCondition :: RawSQL ()
chkName :: RawSQL ()
chkValidated :: Check -> Bool
chkCondition :: Check -> RawSQL ()
chkName :: Check -> RawSQL ()
..} = [RawSQL ()] -> RawSQL ()
forall m. (IsString m, Monoid m) => [m] -> m
smconcat [
    RawSQL ()
"ADD CONSTRAINT"
  , RawSQL ()
chkName
  , RawSQL ()
"CHECK ("
  , RawSQL ()
chkCondition
  , RawSQL ()
")"
  , if Bool
valid then RawSQL ()
"" else RawSQL ()
" NOT VALID"
  ]

sqlDropCheck :: RawSQL () -> RawSQL ()
sqlDropCheck :: RawSQL () -> RawSQL ()
sqlDropCheck RawSQL ()
name = RawSQL ()
"DROP CONSTRAINT" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
name