indexes and functions

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs

@@ -50,6 +50,7 @@ module Squeal.PostgreSQL.Definition
   , createDomain
   , createTypeRange
   , createIndex
+  , createIndexIfNotExists
   , IndexMethod (..)
   , btree, hash, gist, spgist, gin, brin
   , createFunction
@@ -1161,6 +1162,31 @@ createIndex ix tab method cols = UnsafeDefinition $
       DescNullsLast expression -> parenthesized (renderSQL expression)
         <+> "DESC NULLS LAST"
 
+createIndexIfNotExists
+  :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
+  => Alias ix
+  -> QualifiedAlias sch tab
+  -> IndexMethod method
+  -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
+  -> Definition schemas (Alter sch (CreateIfNotExists ix ('Index method) schema) schemas)
+createIndexIfNotExists ix tab method cols = UnsafeDefinition $
+  "CREATE INDEX IF NOT EXISTS" <+> renderSQL ix <+> "ON" <+> renderSQL tab
+    <+> "USING" <+> renderSQL method
+    <+> parenthesized (commaSeparated (renderIndex <$> cols))
+    <> ";"
+  where
+    renderIndex = \case
+      Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
+      Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
+      AscNullsFirst expression -> parenthesized (renderSQL expression)
+        <+> "ASC NULLS FIRST"
+      DescNullsFirst expression -> parenthesized (renderSQL expression)
+        <+> "DESC NULLS FIRST"
+      AscNullsLast expression -> parenthesized (renderSQL expression)
+        <+> "ASC NULLS LAST"
+      DescNullsLast expression -> parenthesized (renderSQL expression)
+        <+> "DESC NULLS LAST"
+
 newtype IndexMethod ty = UnsafeIndexMethod {renderIndexMethod :: ByteString}
   deriving stock (Eq, Ord, Show, GHC.Generic)
 instance RenderSQL (IndexMethod ty) where renderSQL = renderIndexMethod
@@ -1185,7 +1211,7 @@ createFunction
   -> NP (TypeExpression schemas) args
   -> TypeExpression schemas ret
   -> FunctionDefinition schemas args ('Returns ret)
-  -> Definition schemas (Alter sch (Create fun ('Function args ('Returns ret)) schema) schemas)
+  -> Definition schemas (Alter sch (Create fun ('Function (args '::--> 'Returns ret)) schema) schemas)
 createFunction fun args ret fundef = UnsafeDefinition $
   "CREATE" <+> "FUNCTION" <+> renderSQL fun
     <+> parenthesized (renderCommaSeparated renderSQL args)
@@ -1193,13 +1219,13 @@ createFunction fun args ret fundef = UnsafeDefinition $
 
 createOrReplaceFunction
   :: ( Has sch schemas schema
-     , Has fun schema ('Function args0 ret0)
+     , KnownSymbol fun
      , SOP.SListI args )
   => QualifiedAlias sch fun
   -> NP (TypeExpression schemas) args
   -> TypeExpression schemas ret
   -> FunctionDefinition schemas args ('Returns ret)
-  -> Definition schemas (Alter sch (CreateOrReplace fun ('Function args ('Returns ret)) schema) schemas)
+  -> Definition schemas (Alter sch (CreateOrReplace fun ('Function (args '::--> 'Returns ret)) schema) schemas)
 createOrReplaceFunction fun args ret fundef = UnsafeDefinition $
   "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
     <+> parenthesized (renderCommaSeparated renderSQL args)
@@ -1227,7 +1253,7 @@ createSetFunction
   -> NP (TypeExpression schemas) args
   -> NP (Aliased (TypeExpression schemas)) rets
   -> FunctionDefinition schemas args ('ReturnsTable rets)
-  -> Definition schemas (Alter sch (Create fun ('Function args ('ReturnsTable rets)) schema) schemas)
+  -> Definition schemas (Alter sch (Create fun ('Function (args '::--> 'ReturnsTable rets)) schema) schemas)
 createSetFunction fun args rets fundef = UnsafeDefinition $
   "CREATE" <+> "FUNCTION" <+> renderSQL fun
     <+> parenthesized (renderCommaSeparated renderSQL args)
@@ -1240,14 +1266,14 @@ createSetFunction fun args rets fundef = UnsafeDefinition $
 
 createOrReplaceSetFunction
   :: ( Has sch schemas schema
-     , Has fun schema ('Function args0 ret0)
+     , Has fun schema ('Function (args0 '::--> ret0))
      , SOP.SListI args
      , SOP.SListI rets )
   => QualifiedAlias sch fun
   -> NP (TypeExpression schemas) args
   -> NP (Aliased (TypeExpression schemas)) rets
   -> FunctionDefinition schemas args ('ReturnsTable rets)
-  -> Definition schemas (Alter sch (CreateOrReplace fun ('Function args ('ReturnsTable rets)) schema) schemas)
+  -> Definition schemas (Alter sch (CreateOrReplace fun ('Function (args '::--> 'ReturnsTable rets)) schema) schemas)
 createOrReplaceSetFunction fun args rets fundef = UnsafeDefinition $
   "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
     <+> parenthesized (renderCommaSeparated renderSQL args)
@@ -1261,7 +1287,7 @@ createOrReplaceSetFunction fun args rets fundef = UnsafeDefinition $
 createBinaryOp
   :: forall op fun sch schemas schema x y z.
      ( Has sch schemas schema
-     , Has fun schema ('Function '[x,y] ('Returns z))
+     , Has fun schema ('Function ('[x,y] '::--> 'Returns z))
      , KnownSymbol op )
   => Alias fun
   -> TypeExpression schemas x
@@ -1280,7 +1306,7 @@ createBinaryOp fun x y = UnsafeDefinition $
 createLeftOp
   :: forall op fun sch schemas schema x y.
      ( Has sch schemas schema
-     , Has fun schema ('Function '[x] ('Returns y))
+     , Has fun schema ('Function ('[x] '::--> 'Returns y))
      , KnownSymbol op )
   => Alias fun
   -> TypeExpression schemas x
@@ -1297,7 +1323,7 @@ createLeftOp fun x = UnsafeDefinition $
 createRightOp
   :: forall op fun sch schemas schema x y.
      ( Has sch schemas schema
-     , Has fun schema ('Function '[x] ('Returns y))
+     , Has fun schema ('Function ('[x] '::--> 'Returns y))
      , KnownSymbol op )
   => Alias fun
   -> TypeExpression schemas x
@@ -1312,7 +1338,7 @@ createRightOp fun x = UnsafeDefinition $
         , "LEFTARG" <+> "=" <+> renderSQL x ]
 
 dropFunction
-  :: (Has sch schemas schema, Has fun schema ('Function args ret))
+  :: (Has sch schemas schema, Has fun schema ('Function (args '::--> ret)))
   => QualifiedAlias sch fun
   -- ^ name of the user defined function
   -> Definition schemas (Alter sch (Drop fun schema) schemas)

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs

@@ -356,7 +356,7 @@ unsafeFunction fun x = UnsafeExpression $
   fun <> parenthesized (renderSQL x)
 
 function
-  :: (Has sch schemas schema, Has fun schema ('Function '[x] ('Returns y)))
+  :: (Has sch schemas schema, Has fun schema ('Function ('[x] '::--> 'Returns y)))
   => QualifiedAlias sch fun
   -> FunctionDB schemas x y
 function = unsafeFunction . renderSQL
@@ -369,7 +369,7 @@ unsafeFunctionN fun xs = UnsafeExpression $
 
 functionN
   :: ( Has sch schemas schema
-     , Has fun schema ('Function xs ('Returns y))
+     , Has fun schema ('Function (xs '::--> 'Returns y))
      , SListI xs )
   => QualifiedAlias sch fun
   -> FunctionNDB schemas xs y

squeal-postgresql/src/Squeal/PostgreSQL/Expression/SetOf.hs

@@ -62,7 +62,7 @@ unsafeSetOfFunction x = UnsafeFromClause $
 
 setOfFunction
   :: ( Has sch schemas schema
-     , Has fun schema ('Function '[ty] ('ReturnsTable setof)) )
+     , Has fun schema ('Function ('[ty] '::--> 'ReturnsTable setof)) )
   => Alias fun
   -> ( forall outer commons params
         .  Expression outer commons 'Ungrouped schemas params '[] ty
@@ -88,7 +88,7 @@ unsafeSetOfFunctionN xs = UnsafeFromClause $
 
 setOfFunctionN
   :: ( Has sch schemas schema
-     , Has fun schema ('Function tys ('ReturnsTable setof))
+     , Has fun schema ('Function (tys '::--> 'ReturnsTable setof))
      , SOP.SListI tys )
   => Alias fun
   -> ( forall outer commons params

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs

@@ -45,6 +45,7 @@ module Squeal.PostgreSQL.Schema
   , TableType
   , SchemumType (..)
   , IndexType (..)
+  , FunctionType (..)
   , OperatorType (..)
   , ReturnsType (..)
   , SchemaType
@@ -428,10 +429,12 @@ data SchemumType
   | View RowType
   | Typedef PGType
   | Index IndexType
-  | Function [NullityType] ReturnsType
+  | Function FunctionType
   | Operator OperatorType
   | UnsafeSchemum Symbol
 
+data FunctionType = (::-->) [NullityType] ReturnsType
+
 data IndexType
   = Btree
   | Hash