{-|
Module: Squeal.PostgreSQL.Definition.Schema
Description: create and drop schemas
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

create and drop schemas
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , ConstraintKinds
  , DeriveAnyClass
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , LambdaCase
  , MultiParamTypeClasses
  , OverloadedLabels
  , OverloadedStrings
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , DataKinds
  , PolyKinds
  , TypeOperators
  , UndecidableSuperClasses
#-}

module Squeal.PostgreSQL.Definition.Schema
  ( -- * Create
    createSchema
  , createSchemaIfNotExists
    -- * Drop
  , dropSchemaCascade
  , dropSchemaCascadeIfExists
  ) where

import GHC.TypeLits

import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Definition
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL

{- |
`createSchema` enters a new schema into the current database.
The schema name must be distinct from the name of any existing schema
in the current database.

A schema is essentially a namespace: it contains named objects
(tables, data types, functions, and operators) whose names
can duplicate those of other objects existing in other schemas.
Named objects are accessed by `QualifiedAlias`es with the schema
name as a prefix.

>>> :{
let
  definition :: Definition '["public" ::: '[]] '["public" ::: '[], "my_schema" ::: '[]]
  definition = createSchema #my_schema
in printSQL definition
:}
CREATE SCHEMA "my_schema";
-}
createSchema
  :: KnownSymbol sch
  => Alias sch -- ^ schema alias
  -> Definition db (Create sch '[] db)
createSchema :: forall (sch :: Symbol) (db :: SchemasType).
KnownSymbol sch =>
Alias sch -> Definition db (Create sch '[] db)
createSchema Alias sch
sch = forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"SCHEMA" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias sch
sch forall a. Semigroup a => a -> a -> a
<> ByteString
";"

{- | Create a schema if it does not yet exist.-}
createSchemaIfNotExists
  :: (KnownSymbol sch, Has sch db schema)
  => Alias sch -- ^ schema alias
  -> Definition db (CreateIfNotExists sch '[] db)
createSchemaIfNotExists :: forall (sch :: Symbol) (db :: SchemasType)
       (schema :: [(Symbol, SchemumType)]).
(KnownSymbol sch, Has sch db schema) =>
Alias sch -> Definition db (CreateIfNotExists sch '[] db)
createSchemaIfNotExists Alias sch
sch = forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"SCHEMA" ByteString -> ByteString -> ByteString
<+> ByteString
"IF" ByteString -> ByteString -> ByteString
<+> ByteString
"NOT" ByteString -> ByteString -> ByteString
<+> ByteString
"EXISTS"
  ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias sch
sch forall a. Semigroup a => a -> a -> a
<> ByteString
";"

-- | Drop a schema.
-- Automatically drop objects (tables, functions, etc.)
-- that are contained in the schema.
--
-- >>> :{
-- let
--   definition :: Definition '["muh_schema" ::: schema, "public" ::: public] '["public" ::: public]
--   definition = dropSchemaCascade #muh_schema
-- :}
--
-- >>> printSQL definition
-- DROP SCHEMA "muh_schema" CASCADE;
dropSchemaCascade
  :: KnownSymbol sch
  => Alias sch -- ^ schema alias
  -> Definition db (Drop sch db)
dropSchemaCascade :: forall (sch :: Symbol) (db :: SchemasType).
KnownSymbol sch =>
Alias sch -> Definition db (Drop sch db)
dropSchemaCascade Alias sch
sch = forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"DROP SCHEMA" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias sch
sch ByteString -> ByteString -> ByteString
<+> ByteString
"CASCADE;"

-- | Drop a schema if it exists.
-- Automatically drop objects (tables, functions, etc.)
-- that are contained in the schema.
dropSchemaCascadeIfExists
  :: KnownSymbol sch
  => Alias sch -- ^ schema alias
  -> Definition db (DropIfExists sch db)
dropSchemaCascadeIfExists :: forall (sch :: Symbol) (db :: SchemasType).
KnownSymbol sch =>
Alias sch -> Definition db (DropIfExists sch db)
dropSchemaCascadeIfExists Alias sch
sch = forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"DROP SCHEMA IF EXISTS" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias sch
sch ByteString -> ByteString -> ByteString
<+> ByteString
"CASCADE;"