{-# LANGUAGE
AllowAmbiguousTypes
, ConstraintKinds
, DeriveAnyClass
, DeriveGeneric
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, GADTs
, LambdaCase
, MultiParamTypeClasses
, OverloadedLabels
, OverloadedStrings
, RankNTypes
, ScopedTypeVariables
, TypeApplications
, TypeInType
, TypeOperators
, UndecidableSuperClasses
#-}
module Squeal.PostgreSQL.Definition.Procedure
(
createProcedure
, createOrReplaceProcedure
, dropProcedure
, dropProcedureIfExists
, 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
createProcedure
:: ( Has sch db schema
, KnownSymbol pro
, SOP.SListI args )
=> QualifiedAlias sch pro
-> NP (TypeExpression db) args
-> ProcedureDefinition db args
-> Definition db (Alter sch (Create pro ('Procedure args) schema) db)
createProcedure pro args prodef = UnsafeDefinition $
"CREATE" <+> "PROCEDURE" <+> renderSQL pro
<+> parenthesized (renderCommaSeparated renderSQL args)
<+> renderSQL prodef <> ";"
createOrReplaceProcedure
:: ( Has sch db schema
, KnownSymbol pro
, SOP.SListI args )
=> QualifiedAlias sch pro
-> NP (TypeExpression db) args
-> ProcedureDefinition db args
-> Definition db (Alter sch (CreateOrReplace pro ('Procedure args) schema) db)
createOrReplaceProcedure pro args prodef = UnsafeDefinition $
"CREATE" <+> "OR" <+> "REPLACE" <+> "PROCEDURE" <+> renderSQL pro
<+> parenthesized (renderCommaSeparated renderSQL args)
<+> renderSQL prodef <> ";"
languageSqlManipulation
:: [Manipulation '[] db args '[]]
-> ProcedureDefinition db args
languageSqlManipulation mnps = UnsafeProcedureDefinition $
"language sql as" <+> "$$" <+> Prelude.foldr (<+>) "" (Prelude.map ((<> ";") . renderSQL) mnps) <> "$$"
dropProcedure
:: (Has sch db schema, KnownSymbol pro)
=> QualifiedAlias sch pro
-> Definition db (Alter sch (DropSchemum pro 'Procedure schema) db)
dropProcedure pro = UnsafeDefinition $
"DROP PROCEDURE" <+> renderSQL pro <> ";"
dropProcedureIfExists
:: (Has sch db schema, KnownSymbol pro)
=> QualifiedAlias sch pro
-> Definition db (Alter sch (DropSchemumIfExists pro 'Procedure schema) db)
dropProcedureIfExists pro = UnsafeDefinition $
"DROP PROCEDURE IF EXISTS" <+> renderSQL pro <> ";"
newtype ProcedureDefinition db args = UnsafeProcedureDefinition
{ renderProcedureDefinition :: ByteString }
deriving (Eq,Show,GHC.Generic,NFData)
instance RenderSQL (ProcedureDefinition db args) where
renderSQL = renderProcedureDefinition