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

create and drop procedures
-}

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

module Squeal.PostgreSQL.Definition.Procedure
  ( -- * Create
    createProcedure
  , createOrReplaceProcedure
    -- * Drop
  , dropProcedure
  , dropProcedureIfExists
    -- * Procedure Definition
  , ProcedureDefinition(..)
  , languageSqlManipulation
  ) where

import Control.DeepSeq
import Data.ByteString
import GHC.TypeLits

import qualified Generics.SOP as SOP
import qualified GHC.Generics as GHC

import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Definition
import Squeal.PostgreSQL.Expression.Type
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema

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

{- | Create a procedure.

>>> type Proc = 'Procedure '[ 'NotNull 'PGint4 ]
>>> type Thing = 'Table ('[] :=> '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4 ])
>>> :{
let
  definition :: Definition (Public '["things" ::: Thing ]) (Public '["things" ::: Thing, "proc" ::: Proc])
  definition = createProcedure #proc (one int4) 
             . languageSqlManipulation
             $ [deleteFrom_ #things (#id .== param @1)]
in printSQL definition
:}
CREATE PROCEDURE "proc" (int4) language sql as $$ DELETE FROM "things" AS "things" WHERE ("id" = ($1 :: int4)); $$;
-}
createProcedure
  :: ( Has sch db schema
     , KnownSymbol pro
     , SOP.SListI args )
  => QualifiedAlias sch pro -- ^ procedure alias
  -> NP (TypeExpression db) args -- ^ arguments
  -> ProcedureDefinition db args -- ^ procedure definition
  -> Definition db (Alter sch (Create pro ('Procedure args) schema) db)
createProcedure :: QualifiedAlias sch pro
-> NP (TypeExpression db) args
-> ProcedureDefinition db args
-> Definition
     db (Alter sch (Create pro ('Procedure args) schema) db)
createProcedure QualifiedAlias sch pro
pro NP (TypeExpression db) args
args ProcedureDefinition db args
prodef = ByteString
-> Definition
     db (Alter sch (Create pro ('Procedure args) schema) db)
forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition
      db (Alter sch (Create pro ('Procedure args) schema) db))
-> ByteString
-> Definition
     db (Alter sch (Create pro ('Procedure args) schema) db)
forall a b. (a -> b) -> a -> b
$
  ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"PROCEDURE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch pro -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro
    ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized ((forall (x :: NullType). TypeExpression db x -> ByteString)
-> NP (TypeExpression db) args -> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall sql. RenderSQL sql => sql -> ByteString
forall (x :: NullType). TypeExpression db x -> ByteString
renderSQL NP (TypeExpression db) args
args)
    ByteString -> ByteString -> ByteString
<+> ProcedureDefinition db args -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ProcedureDefinition db args
prodef ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"

{- | Create or replace a procedure.
It is not possible to change the name or argument types
of a procedure this way.

>>> type Proc = 'Procedure '[ 'NotNull 'PGint4 ]
>>> type Thing = 'Table ('[] :=> '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4 ])
>>> :{
let
  definition :: Definition (Public '["things" ::: Thing ]) (Public '["things" ::: Thing, "proc" ::: Proc])
  definition = createOrReplaceProcedure #proc (one int4) 
             . languageSqlManipulation
             $ [deleteFrom_ #things (#id .== param @1)]
in printSQL definition
:}
CREATE OR REPLACE PROCEDURE "proc" (int4) language sql as $$ DELETE FROM "things" AS "things" WHERE ("id" = ($1 :: int4)); $$;
-}
createOrReplaceProcedure
  :: ( Has sch db schema
     , KnownSymbol pro
     , SOP.SListI args )
  => QualifiedAlias sch pro -- ^ procedure alias
  -> NP (TypeExpression db) args -- ^ arguments
  -> ProcedureDefinition db args -- ^ procedure definition
  -> Definition db (Alter sch (CreateOrReplace pro ('Procedure args) schema) db)
createOrReplaceProcedure :: QualifiedAlias sch pro
-> NP (TypeExpression db) args
-> ProcedureDefinition db args
-> Definition
     db (Alter sch (CreateOrReplace pro ('Procedure args) schema) db)
createOrReplaceProcedure QualifiedAlias sch pro
pro NP (TypeExpression db) args
args ProcedureDefinition db args
prodef = ByteString
-> Definition
     db (Alter sch (CreateOrReplace pro ('Procedure args) schema) db)
forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition
      db (Alter sch (CreateOrReplace pro ('Procedure args) schema) db))
-> ByteString
-> Definition
     db (Alter sch (CreateOrReplace pro ('Procedure args) schema) db)
forall a b. (a -> b) -> a -> b
$
  ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"OR" ByteString -> ByteString -> ByteString
<+> ByteString
"REPLACE" ByteString -> ByteString -> ByteString
<+> ByteString
"PROCEDURE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch pro -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro
    ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized ((forall (x :: NullType). TypeExpression db x -> ByteString)
-> NP (TypeExpression db) args -> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall sql. RenderSQL sql => sql -> ByteString
forall (x :: NullType). TypeExpression db x -> ByteString
renderSQL NP (TypeExpression db) args
args)
    ByteString -> ByteString -> ByteString
<+> ProcedureDefinition db args -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ProcedureDefinition db args
prodef ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"

-- | Use a parameterized `Manipulation` as a procedure body
languageSqlManipulation
  :: [Manipulation '[] db args '[]]
  -- ^ procedure body
  -> ProcedureDefinition db args
languageSqlManipulation :: [Manipulation '[] db args '[]] -> ProcedureDefinition db args
languageSqlManipulation [Manipulation '[] db args '[]]
mnps = ByteString -> ProcedureDefinition db args
forall k k (db :: k) (args :: k).
ByteString -> ProcedureDefinition db args
UnsafeProcedureDefinition (ByteString -> ProcedureDefinition db args)
-> ByteString -> ProcedureDefinition db args
forall a b. (a -> b) -> a -> b
$
  ByteString
"language sql as" ByteString -> ByteString -> ByteString
<+> ByteString
"$$" ByteString -> ByteString -> ByteString
<+> (ByteString -> ByteString -> ByteString)
-> ByteString -> [ByteString] -> ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr ByteString -> ByteString -> ByteString
(<+>) ByteString
"" ((Manipulation '[] db args '[] -> ByteString)
-> [Manipulation '[] db args '[]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ((ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";") (ByteString -> ByteString)
-> (Manipulation '[] db args '[] -> ByteString)
-> Manipulation '[] db args '[]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manipulation '[] db args '[] -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL) [Manipulation '[] db args '[]]
mnps) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"$$"

-- | 

{- | Drop a procedure.

>>> type Proc = 'Procedure '[ 'Null 'PGint4, 'Null 'PGint4]
>>> :{
let
  definition :: Definition (Public '["proc" ::: Proc]) (Public '[])
  definition = dropProcedure #proc
in printSQL definition
:}
DROP PROCEDURE "proc";
-}
dropProcedure
  :: (Has sch db schema, KnownSymbol pro)
  => QualifiedAlias sch pro
  -- ^ procedure alias
  -> Definition db (Alter sch (DropSchemum pro 'Procedure schema) db)
dropProcedure :: QualifiedAlias sch pro
-> Definition db (Alter sch (DropSchemum pro 'Procedure schema) db)
dropProcedure QualifiedAlias sch pro
pro = ByteString
-> Definition db (Alter sch (DropSchemum pro 'Procedure schema) db)
forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition
      db (Alter sch (DropSchemum pro 'Procedure schema) db))
-> ByteString
-> Definition db (Alter sch (DropSchemum pro 'Procedure schema) db)
forall a b. (a -> b) -> a -> b
$
  ByteString
"DROP PROCEDURE" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch pro -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"

{- | Drop a procedure.

>>> type Proc = 'Procedure '[ 'Null 'PGint4, 'Null 'PGint4 ]
>>> :{
let
  definition :: Definition (Public '[]) (Public '[])
  definition = dropProcedureIfExists #proc
in printSQL definition
:}
DROP PROCEDURE IF EXISTS "proc";
-}
dropProcedureIfExists
  :: (Has sch db schema, KnownSymbol pro)
  => QualifiedAlias sch pro
  -- ^ procedure alias
  -> Definition db (Alter sch (DropSchemumIfExists pro 'Procedure schema) db)
dropProcedureIfExists :: QualifiedAlias sch pro
-> Definition
     db (Alter sch (DropSchemumIfExists pro 'Procedure schema) db)
dropProcedureIfExists QualifiedAlias sch pro
pro = ByteString
-> Definition
     db (Alter sch (DropSchemumIfExists pro 'Procedure schema) db)
forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition
      db (Alter sch (DropSchemumIfExists pro 'Procedure schema) db))
-> ByteString
-> Definition
     db (Alter sch (DropSchemumIfExists pro 'Procedure schema) db)
forall a b. (a -> b) -> a -> b
$
  ByteString
"DROP PROCEDURE IF EXISTS" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch pro -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"

{- | Body of a user defined procedure-}
newtype ProcedureDefinition db args = UnsafeProcedureDefinition
  { ProcedureDefinition db args -> ByteString
renderProcedureDefinition :: ByteString }
  deriving (ProcedureDefinition db args -> ProcedureDefinition db args -> Bool
(ProcedureDefinition db args
 -> ProcedureDefinition db args -> Bool)
-> (ProcedureDefinition db args
    -> ProcedureDefinition db args -> Bool)
-> Eq (ProcedureDefinition db args)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (db :: k) k (args :: k).
ProcedureDefinition db args -> ProcedureDefinition db args -> Bool
/= :: ProcedureDefinition db args -> ProcedureDefinition db args -> Bool
$c/= :: forall k (db :: k) k (args :: k).
ProcedureDefinition db args -> ProcedureDefinition db args -> Bool
== :: ProcedureDefinition db args -> ProcedureDefinition db args -> Bool
$c== :: forall k (db :: k) k (args :: k).
ProcedureDefinition db args -> ProcedureDefinition db args -> Bool
Eq,Int -> ProcedureDefinition db args -> ShowS
[ProcedureDefinition db args] -> ShowS
ProcedureDefinition db args -> String
(Int -> ProcedureDefinition db args -> ShowS)
-> (ProcedureDefinition db args -> String)
-> ([ProcedureDefinition db args] -> ShowS)
-> Show (ProcedureDefinition db args)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (db :: k) k (args :: k).
Int -> ProcedureDefinition db args -> ShowS
forall k (db :: k) k (args :: k).
[ProcedureDefinition db args] -> ShowS
forall k (db :: k) k (args :: k).
ProcedureDefinition db args -> String
showList :: [ProcedureDefinition db args] -> ShowS
$cshowList :: forall k (db :: k) k (args :: k).
[ProcedureDefinition db args] -> ShowS
show :: ProcedureDefinition db args -> String
$cshow :: forall k (db :: k) k (args :: k).
ProcedureDefinition db args -> String
showsPrec :: Int -> ProcedureDefinition db args -> ShowS
$cshowsPrec :: forall k (db :: k) k (args :: k).
Int -> ProcedureDefinition db args -> ShowS
Show,(forall x.
 ProcedureDefinition db args -> Rep (ProcedureDefinition db args) x)
-> (forall x.
    Rep (ProcedureDefinition db args) x -> ProcedureDefinition db args)
-> Generic (ProcedureDefinition db args)
forall x.
Rep (ProcedureDefinition db args) x -> ProcedureDefinition db args
forall x.
ProcedureDefinition db args -> Rep (ProcedureDefinition db args) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (db :: k) k (args :: k) x.
Rep (ProcedureDefinition db args) x -> ProcedureDefinition db args
forall k (db :: k) k (args :: k) x.
ProcedureDefinition db args -> Rep (ProcedureDefinition db args) x
$cto :: forall k (db :: k) k (args :: k) x.
Rep (ProcedureDefinition db args) x -> ProcedureDefinition db args
$cfrom :: forall k (db :: k) k (args :: k) x.
ProcedureDefinition db args -> Rep (ProcedureDefinition db args) x
GHC.Generic,ProcedureDefinition db args -> ()
(ProcedureDefinition db args -> ())
-> NFData (ProcedureDefinition db args)
forall a. (a -> ()) -> NFData a
forall k (db :: k) k (args :: k). ProcedureDefinition db args -> ()
rnf :: ProcedureDefinition db args -> ()
$crnf :: forall k (db :: k) k (args :: k). ProcedureDefinition db args -> ()
NFData)
instance RenderSQL (ProcedureDefinition db args) where
  renderSQL :: ProcedureDefinition db args -> ByteString
renderSQL = ProcedureDefinition db args -> ByteString
forall k (db :: k) k (args :: k).
ProcedureDefinition db args -> ByteString
renderProcedureDefinition