{-# LANGUAGE
AllowAmbiguousTypes
, ConstraintKinds
, DeriveAnyClass
, DeriveGeneric
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, GADTs
, LambdaCase
, MultiParamTypeClasses
, OverloadedLabels
, OverloadedStrings
, RankNTypes
, ScopedTypeVariables
, TypeApplications
, DataKinds
, PolyKinds
, TypeOperators
, UndecidableSuperClasses
#-}
module Squeal.PostgreSQL.Definition.Function
(
createFunction
, createOrReplaceFunction
, createSetFunction
, createOrReplaceSetFunction
, dropFunction
, dropFunctionIfExists
, FunctionDefinition(..)
, languageSqlExpr
, languageSqlQuery
) 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
import Squeal.PostgreSQL.Expression.Type
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Query
import Squeal.PostgreSQL.Query.Values
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema
createFunction
:: ( Has sch db schema
, KnownSymbol fun
, SOP.SListI args )
=> QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> TypeExpression db ret
-> FunctionDefinition db args ('Returns ret)
-> Definition db (Alter sch (Create fun ('Function (args :=> 'Returns ret)) schema) db)
createFunction :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
(schema :: SchemaType) (fun :: Symbol) (args :: [NullType])
(ret :: NullType).
(Has sch db schema, KnownSymbol fun, SListI args) =>
QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> TypeExpression db ret
-> FunctionDefinition db args ('Returns ret)
-> Definition
db
(Alter
sch (Create fun ('Function (args :=> 'Returns ret)) schema) db)
createFunction QualifiedAlias sch fun
fun NP (TypeExpression db) args
args TypeExpression db ret
ret FunctionDefinition db args ('Returns ret)
fundef = 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
"FUNCTION" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch fun
fun
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
<+> ByteString
"RETURNS" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db ret
ret ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL FunctionDefinition db args ('Returns ret)
fundef forall a. Semigroup a => a -> a -> a
<> ByteString
";"
createOrReplaceFunction
:: ( Has sch db schema
, KnownSymbol fun
, SOP.SListI args )
=> QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> TypeExpression db ret
-> FunctionDefinition db args ('Returns ret)
-> Definition db (Alter sch (CreateOrReplace fun ('Function (args :=> 'Returns ret)) schema) db)
createOrReplaceFunction :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
(schema :: SchemaType) (fun :: Symbol) (args :: [NullType])
(ret :: NullType).
(Has sch db schema, KnownSymbol fun, SListI args) =>
QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> TypeExpression db ret
-> FunctionDefinition db args ('Returns ret)
-> Definition
db
(Alter
sch
(CreateOrReplace fun ('Function (args :=> 'Returns ret)) schema)
db)
createOrReplaceFunction QualifiedAlias sch fun
fun NP (TypeExpression db) args
args TypeExpression db ret
ret FunctionDefinition db args ('Returns ret)
fundef = 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
"FUNCTION" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch fun
fun
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
<+> ByteString
"RETURNS" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db ret
ret ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL FunctionDefinition db args ('Returns ret)
fundef forall a. Semigroup a => a -> a -> a
<> ByteString
";"
languageSqlExpr
:: Expression 'Ungrouped '[] '[] db args '[] ret
-> FunctionDefinition db args ('Returns ret)
languageSqlExpr :: forall (db :: [(Symbol, SchemaType)]) (args :: [NullType])
(ret :: NullType).
Expression 'Ungrouped '[] '[] db args '[] ret
-> FunctionDefinition db args ('Returns ret)
languageSqlExpr Expression 'Ungrouped '[] '[] db args '[] ret
expr = forall {k} {k} {k} (db :: k) (args :: k) (ret :: k).
ByteString -> FunctionDefinition db args ret
UnsafeFunctionDefinition forall a b. (a -> b) -> a -> b
$
ByteString
"language sql as"
ByteString -> ByteString -> ByteString
<+> ByteString
"$$" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL (forall (cols :: RowType) (lat :: FromType) (with :: FromType)
(db :: [(Symbol, SchemaType)]) (params :: [NullType]).
SListI cols =>
NP (Aliased (Expression 'Ungrouped lat with db params '[])) cols
-> Query lat with db params cols
values_ (Expression 'Ungrouped '[] '[] db args '[] ret
expr `as` forall a. IsLabel "ret" a => a
#ret)) ByteString -> ByteString -> ByteString
<+> ByteString
"$$"
languageSqlQuery
:: Query '[] '[] db args rets
-> FunctionDefinition db args ('ReturnsTable rets)
languageSqlQuery :: forall (db :: [(Symbol, SchemaType)]) (args :: [NullType])
(rets :: RowType).
Query '[] '[] db args rets
-> FunctionDefinition db args ('ReturnsTable rets)
languageSqlQuery Query '[] '[] db args rets
qry = forall {k} {k} {k} (db :: k) (args :: k) (ret :: k).
ByteString -> FunctionDefinition db args ret
UnsafeFunctionDefinition forall a b. (a -> b) -> a -> b
$
ByteString
"language sql as" ByteString -> ByteString -> ByteString
<+> ByteString
"$$" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL Query '[] '[] db args rets
qry ByteString -> ByteString -> ByteString
<+> ByteString
"$$"
createSetFunction
:: ( Has sch db schema
, KnownSymbol fun
, SOP.SListI args
, SOP.SListI rets )
=> QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> NP (Aliased (TypeExpression db)) rets
-> FunctionDefinition db args ('ReturnsTable rets)
-> Definition db (Alter sch (Create fun ('Function (args :=> 'ReturnsTable rets)) schema) db)
createSetFunction :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
(schema :: SchemaType) (fun :: Symbol) (args :: [NullType])
(rets :: RowType).
(Has sch db schema, KnownSymbol fun, SListI args, SListI rets) =>
QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> NP (Aliased (TypeExpression db)) rets
-> FunctionDefinition db args ('ReturnsTable rets)
-> Definition
db
(Alter
sch
(Create fun ('Function (args :=> 'ReturnsTable rets)) schema)
db)
createSetFunction QualifiedAlias sch fun
fun NP (TypeExpression db) args
args NP (Aliased (TypeExpression db)) rets
rets FunctionDefinition db args ('ReturnsTable rets)
fundef = 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
"FUNCTION" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch fun
fun
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
<+> ByteString
"RETURNS" ByteString -> ByteString -> ByteString
<+> ByteString
"TABLE"
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 (s :: [(Symbol, SchemaType)]) (r :: (Symbol, NullType)).
Aliased (TypeExpression s) r -> ByteString
renderRet NP (Aliased (TypeExpression db)) rets
rets)
ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL FunctionDefinition db args ('ReturnsTable rets)
fundef forall a. Semigroup a => a -> a -> a
<> ByteString
";"
where
renderRet :: Aliased (TypeExpression s) r -> ByteString
renderRet :: forall (s :: [(Symbol, SchemaType)]) (r :: (Symbol, NullType)).
Aliased (TypeExpression s) r -> ByteString
renderRet (TypeExpression s ty
ty `As` Alias alias
col) = forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias alias
col ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression s ty
ty
createOrReplaceSetFunction
:: ( Has sch db schema
, KnownSymbol fun
, SOP.SListI args
, SOP.SListI rets )
=> QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> NP (Aliased (TypeExpression db)) rets
-> FunctionDefinition db args ('ReturnsTable rets)
-> Definition db (Alter sch (CreateOrReplace fun ('Function (args :=> 'ReturnsTable rets)) schema) db)
createOrReplaceSetFunction :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
(schema :: SchemaType) (fun :: Symbol) (args :: [NullType])
(rets :: RowType).
(Has sch db schema, KnownSymbol fun, SListI args, SListI rets) =>
QualifiedAlias sch fun
-> NP (TypeExpression db) args
-> NP (Aliased (TypeExpression db)) rets
-> FunctionDefinition db args ('ReturnsTable rets)
-> Definition
db
(Alter
sch
(CreateOrReplace
fun ('Function (args :=> 'ReturnsTable rets)) schema)
db)
createOrReplaceSetFunction QualifiedAlias sch fun
fun NP (TypeExpression db) args
args NP (Aliased (TypeExpression db)) rets
rets FunctionDefinition db args ('ReturnsTable rets)
fundef = 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
"FUNCTION" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch fun
fun
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
<+> ByteString
"RETURNS" ByteString -> ByteString -> ByteString
<+> ByteString
"TABLE"
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 (s :: [(Symbol, SchemaType)]) (r :: (Symbol, NullType)).
Aliased (TypeExpression s) r -> ByteString
renderRet NP (Aliased (TypeExpression db)) rets
rets)
ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL FunctionDefinition db args ('ReturnsTable rets)
fundef forall a. Semigroup a => a -> a -> a
<> ByteString
";"
where
renderRet :: Aliased (TypeExpression s) r -> ByteString
renderRet :: forall (s :: [(Symbol, SchemaType)]) (r :: (Symbol, NullType)).
Aliased (TypeExpression s) r -> ByteString
renderRet (TypeExpression s ty
ty `As` Alias alias
col) = forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias alias
col ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression s ty
ty
dropFunction
:: (Has sch db schema, KnownSymbol fun)
=> QualifiedAlias sch fun
-> Definition db (Alter sch (DropSchemum fun 'Function schema) db)
dropFunction :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
(schema :: SchemaType) (fun :: Symbol).
(Has sch db schema, KnownSymbol fun) =>
QualifiedAlias sch fun
-> Definition db (Alter sch (DropSchemum fun 'Function schema) db)
dropFunction QualifiedAlias sch fun
fun = forall (db0 :: [(Symbol, SchemaType)])
(db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
ByteString
"DROP FUNCTION" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch fun
fun forall a. Semigroup a => a -> a -> a
<> ByteString
";"
dropFunctionIfExists
:: (Has sch db schema, KnownSymbol fun)
=> QualifiedAlias sch fun
-> Definition db (Alter sch (DropSchemumIfExists fun 'Function schema) db)
dropFunctionIfExists :: forall (sch :: Symbol) (db :: [(Symbol, SchemaType)])
(schema :: SchemaType) (fun :: Symbol).
(Has sch db schema, KnownSymbol fun) =>
QualifiedAlias sch fun
-> Definition
db (Alter sch (DropSchemumIfExists fun 'Function schema) db)
dropFunctionIfExists QualifiedAlias sch fun
fun = forall (db0 :: [(Symbol, SchemaType)])
(db1 :: [(Symbol, SchemaType)]).
ByteString -> Definition db0 db1
UnsafeDefinition forall a b. (a -> b) -> a -> b
$
ByteString
"DROP FUNCTION IF EXISTS" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch fun
fun forall a. Semigroup a => a -> a -> a
<> ByteString
";"
newtype FunctionDefinition db args ret = UnsafeFunctionDefinition
{ forall {k} {k} {k} (db :: k) (args :: k) (ret :: k).
FunctionDefinition db args ret -> ByteString
renderFunctionDefinition :: ByteString }
deriving (FunctionDefinition db args ret
-> FunctionDefinition db args ret -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (db :: k) k (args :: k) k (ret :: k).
FunctionDefinition db args ret
-> FunctionDefinition db args ret -> Bool
/= :: FunctionDefinition db args ret
-> FunctionDefinition db args ret -> Bool
$c/= :: forall k (db :: k) k (args :: k) k (ret :: k).
FunctionDefinition db args ret
-> FunctionDefinition db args ret -> Bool
== :: FunctionDefinition db args ret
-> FunctionDefinition db args ret -> Bool
$c== :: forall k (db :: k) k (args :: k) k (ret :: k).
FunctionDefinition db args ret
-> FunctionDefinition db args ret -> Bool
Eq,Int -> FunctionDefinition db args ret -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (db :: k) k (args :: k) k (ret :: k).
Int -> FunctionDefinition db args ret -> ShowS
forall k (db :: k) k (args :: k) k (ret :: k).
[FunctionDefinition db args ret] -> ShowS
forall k (db :: k) k (args :: k) k (ret :: k).
FunctionDefinition db args ret -> String
showList :: [FunctionDefinition db args ret] -> ShowS
$cshowList :: forall k (db :: k) k (args :: k) k (ret :: k).
[FunctionDefinition db args ret] -> ShowS
show :: FunctionDefinition db args ret -> String
$cshow :: forall k (db :: k) k (args :: k) k (ret :: k).
FunctionDefinition db args ret -> String
showsPrec :: Int -> FunctionDefinition db args ret -> ShowS
$cshowsPrec :: forall k (db :: k) k (args :: k) k (ret :: k).
Int -> FunctionDefinition db args ret -> 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) k (ret :: k) x.
Rep (FunctionDefinition db args ret) x
-> FunctionDefinition db args ret
forall k (db :: k) k (args :: k) k (ret :: k) x.
FunctionDefinition db args ret
-> Rep (FunctionDefinition db args ret) x
$cto :: forall k (db :: k) k (args :: k) k (ret :: k) x.
Rep (FunctionDefinition db args ret) x
-> FunctionDefinition db args ret
$cfrom :: forall k (db :: k) k (args :: k) k (ret :: k) x.
FunctionDefinition db args ret
-> Rep (FunctionDefinition db args ret) x
GHC.Generic,forall a. (a -> ()) -> NFData a
forall k (db :: k) k (args :: k) k (ret :: k).
FunctionDefinition db args ret -> ()
rnf :: FunctionDefinition db args ret -> ()
$crnf :: forall k (db :: k) k (args :: k) k (ret :: k).
FunctionDefinition db args ret -> ()
NFData)
instance RenderSQL (FunctionDefinition db args ret) where
renderSQL :: FunctionDefinition db args ret -> ByteString
renderSQL = forall {k} {k} {k} (db :: k) (args :: k) (ret :: k).
FunctionDefinition db args ret -> ByteString
renderFunctionDefinition