module Database.PostgreSQL.PQTypes.Model.Domain (
    Domain(..)
  , mkChecks
  , sqlCreateDomain
  , sqlAlterDomain
  , sqlDropDomain
  ) where

import Data.Monoid.Utils
import Data.Set (Set, fromList)
import Database.PostgreSQL.PQTypes

import Database.PostgreSQL.PQTypes.Model.Check
import Database.PostgreSQL.PQTypes.Model.ColumnType

-- Domains are global, i.e. not bound to any particular table.
-- The first table that uses a new domain needs to create it
-- by a migration.
--
-- If a migration that alters the domain needs to be performed,
-- there are three possible situations:
--
-- 1) The modification doesn't require data change in any of the tables.
-- 2) The modification requires data change, but only in one table.
-- 3) The modification requires data change in more than one table.
--
-- These situations should be handled as follows:
--
-- 1) One of the tables that use the domain should migrate it.
-- 2) The table that requires data modification should migrate it.
-- 3) One of the tables that require data modification should migrate
-- it.  Note that modification of constraints may conflict with the
-- data in the other tables. In this case, these constraints should be
-- created as NOT VALID (see
-- http://www.postgresql.org/docs/current/static/sql-alterdomain.html
-- for more info) and VALIDATEd in the migration of the last table
-- with the conflicting data.
--
-- TODO: the proper solution to this is to version the domains to be
-- able to handle (1) and the first and last part of (3) by migrating
-- the domain itself, however that requires substantial change to the
-- migration system.
--
-- As opposed to the current solution, the other temporary one is to
-- create domains statically and not worry about migrations. The problem
-- with this approach is the separation of domain creation from the rest
-- of the universe, which results in problems later, when the proper
-- solution will have to be implemented (i.e. one would need to go back
-- and edit old migrations), whereas the current solution makes the
-- transition trivial.

data Domain = Domain {
  -- | Name of the domain.
  Domain -> RawSQL ()
domName     :: RawSQL ()
  -- | Type of the domain.
, Domain -> ColumnType
domType     :: ColumnType
  -- | Defines whether the domain value can be NULL.
  -- *Cannot* be superseded by a table column definition.
, Domain -> Bool
domNullable :: Bool
  -- Default value for the domain. *Can* be
  -- superseded by a table column definition.
, Domain -> Maybe (RawSQL ())
domDefault  :: Maybe (RawSQL ())
  -- Set of constraint checks on the domain.
, Domain -> Set Check
domChecks   :: Set Check
} deriving (Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: Domain -> Domain -> Bool
Eq, Eq Domain
Eq Domain
-> (Domain -> Domain -> Ordering)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Domain)
-> (Domain -> Domain -> Domain)
-> Ord Domain
Domain -> Domain -> Bool
Domain -> Domain -> Ordering
Domain -> Domain -> Domain
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 :: Domain -> Domain -> Domain
$cmin :: Domain -> Domain -> Domain
max :: Domain -> Domain -> Domain
$cmax :: Domain -> Domain -> Domain
>= :: Domain -> Domain -> Bool
$c>= :: Domain -> Domain -> Bool
> :: Domain -> Domain -> Bool
$c> :: Domain -> Domain -> Bool
<= :: Domain -> Domain -> Bool
$c<= :: Domain -> Domain -> Bool
< :: Domain -> Domain -> Bool
$c< :: Domain -> Domain -> Bool
compare :: Domain -> Domain -> Ordering
$ccompare :: Domain -> Domain -> Ordering
$cp1Ord :: Eq Domain
Ord, Int -> Domain -> ShowS
[Domain] -> ShowS
Domain -> String
(Int -> Domain -> ShowS)
-> (Domain -> String) -> ([Domain] -> ShowS) -> Show Domain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Domain] -> ShowS
$cshowList :: [Domain] -> ShowS
show :: Domain -> String
$cshow :: Domain -> String
showsPrec :: Int -> Domain -> ShowS
$cshowsPrec :: Int -> Domain -> ShowS
Show)

mkChecks :: [Check] -> Set Check
mkChecks :: [Check] -> Set Check
mkChecks = [Check] -> Set Check
forall a. Ord a => [a] -> Set a
fromList

sqlCreateDomain :: Domain -> RawSQL ()
sqlCreateDomain :: Domain -> RawSQL ()
sqlCreateDomain Domain{Bool
Maybe (RawSQL ())
Set Check
RawSQL ()
ColumnType
domChecks :: Set Check
domDefault :: Maybe (RawSQL ())
domNullable :: Bool
domType :: ColumnType
domName :: RawSQL ()
domChecks :: Domain -> Set Check
domDefault :: Domain -> Maybe (RawSQL ())
domNullable :: Domain -> Bool
domType :: Domain -> ColumnType
domName :: Domain -> RawSQL ()
..} = [RawSQL ()] -> RawSQL ()
forall m. (IsString m, Monoid m) => [m] -> m
smconcat [
    RawSQL ()
"CREATE DOMAIN" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
domName RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"AS"
  , ColumnType -> RawSQL ()
columnTypeToSQL ColumnType
domType
  , if Bool
domNullable then RawSQL ()
"NULL" else RawSQL ()
"NOT NULL"
  , RawSQL ()
-> (RawSQL () -> RawSQL ()) -> Maybe (RawSQL ()) -> RawSQL ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSQL ()
"" (RawSQL ()
"DEFAULT" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+>) Maybe (RawSQL ())
domDefault
  ]

sqlAlterDomain :: RawSQL () -> RawSQL () -> RawSQL ()
sqlAlterDomain :: RawSQL () -> RawSQL () -> RawSQL ()
sqlAlterDomain RawSQL ()
dname RawSQL ()
alter = RawSQL ()
"ALTER DOMAIN" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
dname RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
alter

sqlDropDomain :: RawSQL () -> RawSQL ()
sqlDropDomain :: RawSQL () -> RawSQL ()
sqlDropDomain RawSQL ()
dname = RawSQL ()
"DROP DOMAIN" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
dname