{-|
Module: Squeal.PostgreSQL.Definition.Index
Description: create and drop indexes
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

create and drop indexes
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , ConstraintKinds
  , DeriveAnyClass
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , LambdaCase
  , MultiParamTypeClasses
  , OverloadedLabels
  , OverloadedStrings
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeInType
  , TypeOperators
  , UndecidableSuperClasses
#-}

module Squeal.PostgreSQL.Definition.Index
  ( -- * Create
    createIndex
  , createIndexIfNotExists
    -- * Drop
  , dropIndex
  , dropIndexIfExists
    -- * Index Method
  , IndexMethod (..)
  , btree
  , hash
  , gist
  , spgist
  , gin
  , brin
  ) where

import Data.ByteString
import GHC.TypeLits

import qualified GHC.Generics as GHC

import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Definition
import Squeal.PostgreSQL.Expression.Sort
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL
-- >>> :set -XPolyKinds

{- | Create an index.

>>> :{
type Table = '[] :=>
  '[ "a" ::: 'NoDef :=> 'Null 'PGint4
   , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
:}

>>> :{
let
  setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table, "ix" ::: 'Index 'Btree])
  setup =
    createTable #tab (nullable int `as` #a :* nullable real `as` #b) Nil >>>
    createIndex #ix #tab btree [#a & AscNullsFirst, #b & AscNullsLast]
in printSQL setup
:}
CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
CREATE INDEX "ix" ON "tab" USING btree (("a") ASC NULLS FIRST, ("b") ASC NULLS LAST);
-}
createIndex
  :: (Has sch db schema, Has tab schema ('Table table), KnownSymbol ix)
  => Alias ix -- ^ index alias
  -> QualifiedAlias sch tab -- ^ table alias
  -> IndexMethod method -- ^ index method
  -> [SortExpression 'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
  -- ^ sorted columns
  -> Definition db (Alter sch (Create ix ('Index method) schema) db)
createIndex :: Alias ix
-> QualifiedAlias sch tab
-> IndexMethod method
-> [SortExpression
      'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
-> Definition db (Alter sch (Create ix ('Index method) schema) db)
createIndex Alias ix
ix QualifiedAlias sch tab
tab IndexMethod method
method [SortExpression
   'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
cols = ByteString
-> Definition db (Alter sch (Create ix ('Index method) schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition db (Alter sch (Create ix ('Index method) schema) db))
-> ByteString
-> Definition db (Alter sch (Create ix ('Index method) schema) db)
forall a b. (a -> b) -> a -> b
$
  ByteString
"CREATE" ByteString -> ByteString -> ByteString
<+> ByteString
"INDEX" ByteString -> ByteString -> ByteString
<+> Alias ix -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias ix
ix ByteString -> ByteString -> ByteString
<+> ByteString
"ON" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch tab -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch tab
tab
    ByteString -> ByteString -> ByteString
<+> ByteString
"USING" ByteString -> ByteString -> ByteString
<+> IndexMethod method -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL IndexMethod method
method
    ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized ([ByteString] -> ByteString
commaSeparated (SortExpression
  'Ungrouped
  '[]
  '[]
  db
  '[]
  '[tab ::: ColumnsToRow (TableToColumns table)]
-> ByteString
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
SortExpression grp lat with db params from -> ByteString
renderIndex (SortExpression
   'Ungrouped
   '[]
   '[]
   db
   '[]
   '[tab ::: ColumnsToRow (TableToColumns table)]
 -> ByteString)
-> [SortExpression
      'Ungrouped
      '[]
      '[]
      db
      '[]
      '[tab ::: ColumnsToRow (TableToColumns table)]]
-> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SortExpression
   'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
[SortExpression
   'Ungrouped
   '[]
   '[]
   db
   '[]
   '[tab ::: ColumnsToRow (TableToColumns table)]]
cols))
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
  where
    renderIndex :: SortExpression grp lat with db params from -> ByteString
renderIndex = \case
      Asc Expression grp lat with db params from ('NotNull ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('NotNull ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('NotNull ty)
expression) ByteString -> ByteString -> ByteString
<+> ByteString
"ASC"
      Desc Expression grp lat with db params from ('NotNull ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('NotNull ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('NotNull ty)
expression) ByteString -> ByteString -> ByteString
<+> ByteString
"DESC"
      AscNullsFirst Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"ASC NULLS FIRST"
      DescNullsFirst Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"DESC NULLS FIRST"
      AscNullsLast Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"ASC NULLS LAST"
      DescNullsLast Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"DESC NULLS LAST"

-- | Create an index if it doesn't exist.
createIndexIfNotExists
  :: (Has sch db schema, Has tab schema ('Table table), KnownSymbol ix)
  => Alias ix -- ^ index alias
  -> QualifiedAlias sch tab -- ^ table alias
  -> IndexMethod method -- ^ index method
  -> [SortExpression 'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
  -- ^ sorted columns
  -> Definition db (Alter sch (CreateIfNotExists ix ('Index method) schema) db)
createIndexIfNotExists :: Alias ix
-> QualifiedAlias sch tab
-> IndexMethod method
-> [SortExpression
      'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
-> Definition
     db (Alter sch (CreateIfNotExists ix ('Index method) schema) db)
createIndexIfNotExists Alias ix
ix QualifiedAlias sch tab
tab IndexMethod method
method [SortExpression
   'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
cols = ByteString
-> Definition
     db (Alter sch (CreateIfNotExists ix ('Index method) schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition
      db (Alter sch (CreateIfNotExists ix ('Index method) schema) db))
-> ByteString
-> Definition
     db (Alter sch (CreateIfNotExists ix ('Index method) schema) db)
forall a b. (a -> b) -> a -> b
$
  ByteString
"CREATE INDEX IF NOT EXISTS" ByteString -> ByteString -> ByteString
<+> Alias ix -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias ix
ix ByteString -> ByteString -> ByteString
<+> ByteString
"ON" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch tab -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch tab
tab
    ByteString -> ByteString -> ByteString
<+> ByteString
"USING" ByteString -> ByteString -> ByteString
<+> IndexMethod method -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL IndexMethod method
method
    ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized ([ByteString] -> ByteString
commaSeparated (SortExpression
  'Ungrouped
  '[]
  '[]
  db
  '[]
  '[tab ::: ColumnsToRow (TableToColumns table)]
-> ByteString
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
SortExpression grp lat with db params from -> ByteString
renderIndex (SortExpression
   'Ungrouped
   '[]
   '[]
   db
   '[]
   '[tab ::: ColumnsToRow (TableToColumns table)]
 -> ByteString)
-> [SortExpression
      'Ungrouped
      '[]
      '[]
      db
      '[]
      '[tab ::: ColumnsToRow (TableToColumns table)]]
-> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SortExpression
   'Ungrouped '[] '[] db '[] '[tab ::: TableToRow table]]
[SortExpression
   'Ungrouped
   '[]
   '[]
   db
   '[]
   '[tab ::: ColumnsToRow (TableToColumns table)]]
cols))
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
  where
    renderIndex :: SortExpression grp lat with db params from -> ByteString
renderIndex = \case
      Asc Expression grp lat with db params from ('NotNull ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('NotNull ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('NotNull ty)
expression) ByteString -> ByteString -> ByteString
<+> ByteString
"ASC"
      Desc Expression grp lat with db params from ('NotNull ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('NotNull ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('NotNull ty)
expression) ByteString -> ByteString -> ByteString
<+> ByteString
"DESC"
      AscNullsFirst Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"ASC NULLS FIRST"
      DescNullsFirst Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"DESC NULLS FIRST"
      AscNullsLast Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"ASC NULLS LAST"
      DescNullsLast Expression grp lat with db params from ('Null ty)
expression -> ByteString -> ByteString
parenthesized (Expression grp lat with db params from ('Null ty) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('Null ty)
expression)
        ByteString -> ByteString -> ByteString
<+> ByteString
"DESC NULLS LAST"

{- |
PostgreSQL provides several index types:
B-tree, Hash, GiST, SP-GiST, GIN and BRIN.
Each index type uses a different algorithm
that is best suited to different types of queries.
-}
newtype IndexMethod ty = UnsafeIndexMethod {IndexMethod ty -> ByteString
renderIndexMethod :: ByteString}
  deriving stock (IndexMethod ty -> IndexMethod ty -> Bool
(IndexMethod ty -> IndexMethod ty -> Bool)
-> (IndexMethod ty -> IndexMethod ty -> Bool)
-> Eq (IndexMethod ty)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
/= :: IndexMethod ty -> IndexMethod ty -> Bool
$c/= :: forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
== :: IndexMethod ty -> IndexMethod ty -> Bool
$c== :: forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
Eq, Eq (IndexMethod ty)
Eq (IndexMethod ty)
-> (IndexMethod ty -> IndexMethod ty -> Ordering)
-> (IndexMethod ty -> IndexMethod ty -> Bool)
-> (IndexMethod ty -> IndexMethod ty -> Bool)
-> (IndexMethod ty -> IndexMethod ty -> Bool)
-> (IndexMethod ty -> IndexMethod ty -> Bool)
-> (IndexMethod ty -> IndexMethod ty -> IndexMethod ty)
-> (IndexMethod ty -> IndexMethod ty -> IndexMethod ty)
-> Ord (IndexMethod ty)
IndexMethod ty -> IndexMethod ty -> Bool
IndexMethod ty -> IndexMethod ty -> Ordering
IndexMethod ty -> IndexMethod ty -> IndexMethod ty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (ty :: k). Eq (IndexMethod ty)
forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Ordering
forall k (ty :: k).
IndexMethod ty -> IndexMethod ty -> IndexMethod ty
min :: IndexMethod ty -> IndexMethod ty -> IndexMethod ty
$cmin :: forall k (ty :: k).
IndexMethod ty -> IndexMethod ty -> IndexMethod ty
max :: IndexMethod ty -> IndexMethod ty -> IndexMethod ty
$cmax :: forall k (ty :: k).
IndexMethod ty -> IndexMethod ty -> IndexMethod ty
>= :: IndexMethod ty -> IndexMethod ty -> Bool
$c>= :: forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
> :: IndexMethod ty -> IndexMethod ty -> Bool
$c> :: forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
<= :: IndexMethod ty -> IndexMethod ty -> Bool
$c<= :: forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
< :: IndexMethod ty -> IndexMethod ty -> Bool
$c< :: forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Bool
compare :: IndexMethod ty -> IndexMethod ty -> Ordering
$ccompare :: forall k (ty :: k). IndexMethod ty -> IndexMethod ty -> Ordering
$cp1Ord :: forall k (ty :: k). Eq (IndexMethod ty)
Ord, Int -> IndexMethod ty -> ShowS
[IndexMethod ty] -> ShowS
IndexMethod ty -> String
(Int -> IndexMethod ty -> ShowS)
-> (IndexMethod ty -> String)
-> ([IndexMethod ty] -> ShowS)
-> Show (IndexMethod ty)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (ty :: k). Int -> IndexMethod ty -> ShowS
forall k (ty :: k). [IndexMethod ty] -> ShowS
forall k (ty :: k). IndexMethod ty -> String
showList :: [IndexMethod ty] -> ShowS
$cshowList :: forall k (ty :: k). [IndexMethod ty] -> ShowS
show :: IndexMethod ty -> String
$cshow :: forall k (ty :: k). IndexMethod ty -> String
showsPrec :: Int -> IndexMethod ty -> ShowS
$cshowsPrec :: forall k (ty :: k). Int -> IndexMethod ty -> ShowS
Show, (forall x. IndexMethod ty -> Rep (IndexMethod ty) x)
-> (forall x. Rep (IndexMethod ty) x -> IndexMethod ty)
-> Generic (IndexMethod ty)
forall x. Rep (IndexMethod ty) x -> IndexMethod ty
forall x. IndexMethod ty -> Rep (IndexMethod ty) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (ty :: k) x. Rep (IndexMethod ty) x -> IndexMethod ty
forall k (ty :: k) x. IndexMethod ty -> Rep (IndexMethod ty) x
$cto :: forall k (ty :: k) x. Rep (IndexMethod ty) x -> IndexMethod ty
$cfrom :: forall k (ty :: k) x. IndexMethod ty -> Rep (IndexMethod ty) x
GHC.Generic)
instance RenderSQL (IndexMethod ty) where renderSQL :: IndexMethod ty -> ByteString
renderSQL = IndexMethod ty -> ByteString
forall k (ty :: k). IndexMethod ty -> ByteString
renderIndexMethod
-- | B-trees can handle equality and range queries on data
-- that can be sorted into some ordering.
btree :: IndexMethod 'Btree
btree :: IndexMethod 'Btree
btree = ByteString -> IndexMethod 'Btree
forall k (ty :: k). ByteString -> IndexMethod ty
UnsafeIndexMethod ByteString
"btree"
-- | Hash indexes can only handle simple equality comparisons.
hash :: IndexMethod 'Hash
hash :: IndexMethod 'Hash
hash = ByteString -> IndexMethod 'Hash
forall k (ty :: k). ByteString -> IndexMethod ty
UnsafeIndexMethod ByteString
"hash"
-- | GiST indexes are not a single kind of index,
-- but rather an infrastructure within which many different
-- indexing strategies can be implemented.
gist :: IndexMethod 'Gist
gist :: IndexMethod 'Gist
gist = ByteString -> IndexMethod 'Gist
forall k (ty :: k). ByteString -> IndexMethod ty
UnsafeIndexMethod ByteString
"gist"
-- | SP-GiST indexes, like GiST indexes,
-- offer an infrastructure that supports various kinds of searches.
spgist :: IndexMethod 'Spgist
spgist :: IndexMethod 'Spgist
spgist = ByteString -> IndexMethod 'Spgist
forall k (ty :: k). ByteString -> IndexMethod ty
UnsafeIndexMethod ByteString
"spgist"
-- | GIN indexes are “inverted indexes” which are appropriate for
-- data values that contain multiple component values, such as arrays.
gin :: IndexMethod 'Gin
gin :: IndexMethod 'Gin
gin = ByteString -> IndexMethod 'Gin
forall k (ty :: k). ByteString -> IndexMethod ty
UnsafeIndexMethod ByteString
"gin"
-- | BRIN indexes (a shorthand for Block Range INdexes) store summaries
-- about the values stored in consecutive physical block ranges of a table.
brin :: IndexMethod 'Brin
brin :: IndexMethod 'Brin
brin = ByteString -> IndexMethod 'Brin
forall k (ty :: k). ByteString -> IndexMethod ty
UnsafeIndexMethod ByteString
"brin"

-- | Drop an index.
--
-- >>> printSQL (dropIndex #ix :: Definition (Public '["ix" ::: 'Index 'Btree]) (Public '[]))
-- DROP INDEX "ix";
dropIndex
  :: (Has sch db schema, KnownSymbol ix)
  => QualifiedAlias sch ix -- ^ index alias
  -> Definition db (Alter sch (DropSchemum ix 'Index schema) db)
dropIndex :: QualifiedAlias sch ix
-> Definition db (Alter sch (DropSchemum ix 'Index schema) db)
dropIndex QualifiedAlias sch ix
ix = ByteString
-> Definition db (Alter sch (DropSchemum ix 'Index schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition db (Alter sch (DropSchemum ix 'Index schema) db))
-> ByteString
-> Definition db (Alter sch (DropSchemum ix 'Index schema) db)
forall a b. (a -> b) -> a -> b
$ ByteString
"DROP INDEX" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch ix -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch ix
ix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"

-- | Drop an index if it exists.
dropIndexIfExists
  :: (Has sch db schema, KnownSymbol ix)
  => QualifiedAlias sch ix -- ^ index alias
  -> Definition db (Alter sch (DropSchemumIfExists ix 'Index schema) db)
dropIndexIfExists :: QualifiedAlias sch ix
-> Definition
     db (Alter sch (DropSchemumIfExists ix 'Index schema) db)
dropIndexIfExists QualifiedAlias sch ix
ix = ByteString
-> Definition
     db (Alter sch (DropSchemumIfExists ix 'Index schema) db)
forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition (ByteString
 -> Definition
      db (Alter sch (DropSchemumIfExists ix 'Index schema) db))
-> ByteString
-> Definition
     db (Alter sch (DropSchemumIfExists ix 'Index schema) db)
forall a b. (a -> b) -> a -> b
$
  ByteString
"DROP INDEX IF EXISTS" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch ix -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch ix
ix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"