@@ -11,11 +11,12 @@ Squeal data definition language.
1111{-# LANGUAGE
1212 AllowAmbiguousTypes
1313 , ConstraintKinds
14+ , DeriveAnyClass
1415 , DeriveGeneric
16+ , DerivingStrategies
1517 , FlexibleContexts
1618 , FlexibleInstances
1719 , GADTs
18− , GeneralizedNewtypeDeriving
1920 , LambdaCase
2021 , MultiParamTypeClasses
2122 , OverloadedStrings
@@ -46,6 +47,7 @@ module Squeal.PostgreSQL.Definition
4647 , FieldTyped (..)
4748 , createDomain
4849 , createTypeRange
50+ , createIndex
4951 , TableConstraintExpression (..)
5052 , check
5153 , unique
@@ -59,6 +61,7 @@ module Squeal.PostgreSQL.Definition
5961 , dropTable
6062 , dropView
6163 , dropType
64+ , dropIndex
6265 -- ** Alter
6366 , alterTable
6467 , alterTableRename
@@ -101,6 +104,7 @@ import qualified GHC.Generics as GHC
101104import Squeal.PostgreSQL.Alias
102105import Squeal.PostgreSQL.Expression
103106import Squeal.PostgreSQL.Expression.Logic
107+import Squeal.PostgreSQL.Expression.Sort
104108import Squeal.PostgreSQL.Expression.Type
105109import Squeal.PostgreSQL.List
106110import Squeal.PostgreSQL.PG
@@ -1041,6 +1045,15 @@ createDomain dom ty condition =
10411045 <+> "AS" <+> renderTypeExpression ty
10421046 <+> "CHECK" <+> parenthesized (renderSQL condition) <> ";"
10431047
1048+{- |
1049+>>> :{
1050+let
1051+ createSmallIntRange :: Definition (Public '[]) (Public '["int2range" ::: 'Typedef ('PGrange 'PGint2)])
1052+ createSmallIntRange = createTypeRange #int2range int2
1053+in printSQL createSmallIntRange
1054+:}
1055+CREATE TYPE "int2range" AS RANGE (subtype = int2);
1056+-}
10441057createTypeRange
10451058 :: (Has sch schemas schema, KnownSymbol range)
10461059 => QualifiedAlias sch range
@@ -1048,7 +1061,78 @@ createTypeRange
10481061 -> Definition schemas (Alter sch (Create range ('Typedef ('PGrange ty)) schema) schemas)
10491062createTypeRange range ty = UnsafeDefinition $
10501063 "CREATE" <+> "TYPE" <+> renderSQL range <+> "AS" <+> "RANGE" <+>
1051− parenthesized ("subtype" <+> "=" <+> renderTypeExpression ty)
1064+ parenthesized ("subtype" <+> "=" <+> renderTypeExpression ty) <> ";"
1065+
1066+{- |
1067+>>> :{
1068+type Table = '[] :=>
1069+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4
1070+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
1071+:}
1072+
1073+>>> :{
1074+let
1075+ setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table, "ix" ::: 'Index])
1076+ setup =
1077+ createTable #tab (nullable int `as` #a :* nullable real `as` #b) Nil >>>
1078+ createIndex #ix #tab Btree [#a & AscNullsFirst, #b & AscNullsLast]
1079+in printSQL setup
1080+:}
1081+CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
1082+CREATE INDEX "ix" ON "tab" USING btree (("a") ASC NULLS FIRST, ("b") ASC NULLS LAST);
1083+-}
1084+createIndex
1085+ :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
1086+ => Alias ix
1087+ -> QualifiedAlias sch tab
1088+ -> IndexMethod
1089+ -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
1090+ -> Definition schemas (Alter sch (Create ix 'Index schema) schemas)
1091+createIndex ix tab method cols = UnsafeDefinition $
1092+ "CREATE" <+> "INDEX" <+> renderSQL ix <+> "ON" <+> renderSQL tab
1093+ <+> "USING" <+> renderSQL method
1094+ <+> parenthesized (commaSeparated (renderIndex <$> cols))
1095+ <> ";"
1096+ where
1097+ renderIndex = \case
1098+ Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
1099+ Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
1100+ AscNullsFirst expression -> parenthesized (renderSQL expression)
1101+ <+> "ASC NULLS FIRST"
1102+ DescNullsFirst expression -> parenthesized (renderSQL expression)
1103+ <+> "DESC NULLS FIRST"
1104+ AscNullsLast expression -> parenthesized (renderSQL expression)
1105+ <+> "ASC NULLS LAST"
1106+ DescNullsLast expression -> parenthesized (renderSQL expression)
1107+ <+> "DESC NULLS LAST"
1108+
1109+data IndexMethod
1110+ = Btree
1111+ | Hash
1112+ | Gist
1113+ | Spgist
1114+ | Gin
1115+ | Brin
1116+ deriving stock (Eq, Ord, Show, GHC.Generic)
1117+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)
1118+instance RenderSQL IndexMethod where
1119+ renderSQL = \case
1120+ Btree -> "btree"
1121+ Hash -> "hash"
1122+ Gist -> "gist"
1123+ Spgist -> "spgist"
1124+ Gin -> "gin"
1125+ Brin -> "brin"
1126+
1127+-- |
1128+-- >>> printSQL (dropIndex #ix :: Definition (Public '["ix" ::: 'Index]) (Public '[]))
1129+-- DROP INDEX "ix";
1130+dropIndex
1131+ :: (Has sch schemas schema, Has ix schema 'Index)
1132+ => QualifiedAlias sch ix
1133+ -- ^ name of the user defined type
1134+ -> Definition schemas (Alter sch (Drop ix schema) schemas)
1135+dropIndex ix = UnsafeDefinition $ "DROP" <+> "INDEX" <+> renderSQL ix <> ";"
10521136
10531137-- | Lift `PGTyped` to a field
10541138class FieldTyped schemas ty where