{-|
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
  , DataKinds
  , PolyKinds
  , 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 :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
       (schema :: SchemaType) (pro :: Symbol) (args :: [NullType]).
(Has sch db schema, KnownSymbol pro, SListI args) =>
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 = forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"PROCEDURE" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro
    ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (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
renderSQL NP (TypeExpression db) args
args)
    ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL ProcedureDefinition db args
prodef 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 :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
       (schema :: SchemaType) (pro :: Symbol) (args :: [NullType]).
(Has sch db schema, KnownSymbol pro, SListI args) =>
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 = forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition 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
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro
    ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (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
renderSQL NP (TypeExpression db) args
args)
    ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL ProcedureDefinition db args
prodef 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 :: forall (db :: [(Symbol, SchemaType)]) (args :: [NullType]).
[Manipulation '[] db args '[]] -> ProcedureDefinition db args
languageSqlManipulation [Manipulation '[] db args '[]]
mnps = forall {k} {k} (db :: k) (args :: k).
ByteString -> ProcedureDefinition db args
UnsafeProcedureDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"language sql as" 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
"" (forall a b. (a -> b) -> [a] -> [b]
Prelude.map ((forall a. Semigroup a => a -> a -> a
<> ByteString
";") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql. RenderSQL sql => sql -> ByteString
renderSQL) [Manipulation '[] db args '[]]
mnps) 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 :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
       (schema :: SchemaType) (pro :: Symbol).
(Has sch db schema, KnownSymbol pro) =>
QualifiedAlias sch pro
-> Definition db (Alter sch (DropSchemum pro 'Procedure schema) db)
dropProcedure QualifiedAlias sch pro
pro = forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"DROP PROCEDURE" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro 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 :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
       (schema :: SchemaType) (pro :: Symbol).
(Has sch db schema, KnownSymbol pro) =>
QualifiedAlias sch pro
-> Definition
     db (Alter sch (DropSchemumIfExists pro 'Procedure schema) db)
dropProcedureIfExists QualifiedAlias sch pro
pro = forall (db0 :: [(Symbol, SchemaType)])
       (db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
  ByteString
"DROP PROCEDURE IF EXISTS" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch pro
pro forall a. Semigroup a => a -> a -> a
<> ByteString
";"

{- | Body of a user defined procedure-}
newtype ProcedureDefinition db args = UnsafeProcedureDefinition
  { forall {k} {k} (db :: k) (args :: k).
ProcedureDefinition db args -> ByteString
renderProcedureDefinition :: ByteString }
  deriving (ProcedureDefinition db args -> ProcedureDefinition db args -> Bool
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
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 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,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 = forall {k} {k} (db :: k) (args :: k).
ProcedureDefinition db args -> ByteString
renderProcedureDefinition