module Database.PostgreSQL.PQTypes.Model.Index
  ( TableIndex (..)
  , IndexColumn (..)
  , indexColumn
  , indexColumnWithOperatorClass
  , IndexMethod (..)
  , tblIndex
  , indexOnColumn
  , indexOnColumns
  , indexOnColumnWithMethod
  , indexOnColumnsWithMethod
  , indexColumnName
  , uniqueIndexOnColumn
  , uniqueIndexOnColumnWithCondition
  , uniqueIndexOnColumns
  , indexName
  , sqlCreateIndexMaybeDowntime
  , sqlCreateIndexConcurrently
  , sqlDropIndexMaybeDowntime
  , sqlDropIndexConcurrently
  ) where

import Crypto.Hash qualified as H
import Data.ByteArray qualified as BA
import Data.ByteString.Base16 qualified as B16
import Data.ByteString.Char8 qualified as BS
import Data.Char
import Data.Function
import Data.Monoid.Utils
import Data.String
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Database.PostgreSQL.PQTypes

data TableIndex = TableIndex
  { TableIndex -> [IndexColumn]
idxColumns :: [IndexColumn]
  , TableIndex -> [RawSQL ()]
idxInclude :: [RawSQL ()]
  , TableIndex -> IndexMethod
idxMethod :: IndexMethod
  , TableIndex -> Bool
idxUnique :: Bool
  , TableIndex -> Bool
idxValid :: Bool
  , -- \^ If creation of index with CONCURRENTLY fails, index
    -- will be marked as invalid. Set it to 'False' if such
    -- situation is expected.
    TableIndex -> Maybe (RawSQL ())
idxWhere :: Maybe (RawSQL ())
  , TableIndex -> Bool
idxNotDistinctNulls :: Bool
  }
  -- \^ Adds NULL NOT DISTINCT on the index, meaning that
  -- \^ only one NULL value will be accepted; other NULLs
  -- \^ will be perceived as a violation of the constraint.
  -- \^ NB: will only be used if idxUnique is set to True
  deriving (TableIndex -> TableIndex -> Bool
(TableIndex -> TableIndex -> Bool)
-> (TableIndex -> TableIndex -> Bool) -> Eq TableIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableIndex -> TableIndex -> Bool
== :: TableIndex -> TableIndex -> Bool
$c/= :: TableIndex -> TableIndex -> Bool
/= :: TableIndex -> TableIndex -> Bool
Eq, Eq TableIndex
Eq TableIndex =>
(TableIndex -> TableIndex -> Ordering)
-> (TableIndex -> TableIndex -> Bool)
-> (TableIndex -> TableIndex -> Bool)
-> (TableIndex -> TableIndex -> Bool)
-> (TableIndex -> TableIndex -> Bool)
-> (TableIndex -> TableIndex -> TableIndex)
-> (TableIndex -> TableIndex -> TableIndex)
-> Ord TableIndex
TableIndex -> TableIndex -> Bool
TableIndex -> TableIndex -> Ordering
TableIndex -> TableIndex -> TableIndex
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
$ccompare :: TableIndex -> TableIndex -> Ordering
compare :: TableIndex -> TableIndex -> Ordering
$c< :: TableIndex -> TableIndex -> Bool
< :: TableIndex -> TableIndex -> Bool
$c<= :: TableIndex -> TableIndex -> Bool
<= :: TableIndex -> TableIndex -> Bool
$c> :: TableIndex -> TableIndex -> Bool
> :: TableIndex -> TableIndex -> Bool
$c>= :: TableIndex -> TableIndex -> Bool
>= :: TableIndex -> TableIndex -> Bool
$cmax :: TableIndex -> TableIndex -> TableIndex
max :: TableIndex -> TableIndex -> TableIndex
$cmin :: TableIndex -> TableIndex -> TableIndex
min :: TableIndex -> TableIndex -> TableIndex
Ord, Int -> TableIndex -> ShowS
[TableIndex] -> ShowS
TableIndex -> String
(Int -> TableIndex -> ShowS)
-> (TableIndex -> String)
-> ([TableIndex] -> ShowS)
-> Show TableIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableIndex -> ShowS
showsPrec :: Int -> TableIndex -> ShowS
$cshow :: TableIndex -> String
show :: TableIndex -> String
$cshowList :: [TableIndex] -> ShowS
showList :: [TableIndex] -> ShowS
Show)

data IndexColumn
  = IndexColumn (RawSQL ()) (Maybe (RawSQL ()))
  deriving (Int -> IndexColumn -> ShowS
[IndexColumn] -> ShowS
IndexColumn -> String
(Int -> IndexColumn -> ShowS)
-> (IndexColumn -> String)
-> ([IndexColumn] -> ShowS)
-> Show IndexColumn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexColumn -> ShowS
showsPrec :: Int -> IndexColumn -> ShowS
$cshow :: IndexColumn -> String
show :: IndexColumn -> String
$cshowList :: [IndexColumn] -> ShowS
showList :: [IndexColumn] -> ShowS
Show)

-- If one of the two columns doesn't specify the operator class, we just ignore
-- it and still treat them as equivalent.
instance Eq IndexColumn where
  IndexColumn RawSQL ()
x Maybe (RawSQL ())
Nothing == :: IndexColumn -> IndexColumn -> Bool
== IndexColumn RawSQL ()
y Maybe (RawSQL ())
_ = RawSQL ()
x RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== RawSQL ()
y
  IndexColumn RawSQL ()
x Maybe (RawSQL ())
_ == IndexColumn RawSQL ()
y Maybe (RawSQL ())
Nothing = RawSQL ()
x RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== RawSQL ()
y
  IndexColumn RawSQL ()
x (Just RawSQL ()
x') == IndexColumn RawSQL ()
y (Just RawSQL ()
y') = RawSQL ()
x RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== RawSQL ()
y Bool -> Bool -> Bool
&& RawSQL ()
x' RawSQL () -> RawSQL () -> Bool
forall a. Eq a => a -> a -> Bool
== RawSQL ()
y'

instance Ord IndexColumn where
  compare :: IndexColumn -> IndexColumn -> Ordering
compare = RawSQL () -> RawSQL () -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RawSQL () -> RawSQL () -> Ordering)
-> (IndexColumn -> RawSQL ())
-> IndexColumn
-> IndexColumn
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IndexColumn -> RawSQL ()
indexColumnName

instance IsString IndexColumn where
  fromString :: String -> IndexColumn
fromString String
s = RawSQL () -> Maybe (RawSQL ()) -> IndexColumn
IndexColumn (String -> RawSQL ()
forall a. IsString a => String -> a
fromString String
s) Maybe (RawSQL ())
forall a. Maybe a
Nothing

indexColumn :: RawSQL () -> IndexColumn
indexColumn :: RawSQL () -> IndexColumn
indexColumn RawSQL ()
col = RawSQL () -> Maybe (RawSQL ()) -> IndexColumn
IndexColumn RawSQL ()
col Maybe (RawSQL ())
forall a. Maybe a
Nothing

indexColumnWithOperatorClass :: RawSQL () -> RawSQL () -> IndexColumn
indexColumnWithOperatorClass :: RawSQL () -> RawSQL () -> IndexColumn
indexColumnWithOperatorClass RawSQL ()
col RawSQL ()
opclass = RawSQL () -> Maybe (RawSQL ()) -> IndexColumn
IndexColumn RawSQL ()
col (RawSQL () -> Maybe (RawSQL ())
forall a. a -> Maybe a
Just RawSQL ()
opclass)

indexColumnName :: IndexColumn -> RawSQL ()
indexColumnName :: IndexColumn -> RawSQL ()
indexColumnName (IndexColumn RawSQL ()
col Maybe (RawSQL ())
_) = RawSQL ()
col

data IndexMethod
  = BTree
  | GIN
  deriving (IndexMethod -> IndexMethod -> Bool
(IndexMethod -> IndexMethod -> Bool)
-> (IndexMethod -> IndexMethod -> Bool) -> Eq IndexMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexMethod -> IndexMethod -> Bool
== :: IndexMethod -> IndexMethod -> Bool
$c/= :: IndexMethod -> IndexMethod -> Bool
/= :: IndexMethod -> IndexMethod -> Bool
Eq, Eq IndexMethod
Eq IndexMethod =>
(IndexMethod -> IndexMethod -> Ordering)
-> (IndexMethod -> IndexMethod -> Bool)
-> (IndexMethod -> IndexMethod -> Bool)
-> (IndexMethod -> IndexMethod -> Bool)
-> (IndexMethod -> IndexMethod -> Bool)
-> (IndexMethod -> IndexMethod -> IndexMethod)
-> (IndexMethod -> IndexMethod -> IndexMethod)
-> Ord IndexMethod
IndexMethod -> IndexMethod -> Bool
IndexMethod -> IndexMethod -> Ordering
IndexMethod -> IndexMethod -> IndexMethod
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
$ccompare :: IndexMethod -> IndexMethod -> Ordering
compare :: IndexMethod -> IndexMethod -> Ordering
$c< :: IndexMethod -> IndexMethod -> Bool
< :: IndexMethod -> IndexMethod -> Bool
$c<= :: IndexMethod -> IndexMethod -> Bool
<= :: IndexMethod -> IndexMethod -> Bool
$c> :: IndexMethod -> IndexMethod -> Bool
> :: IndexMethod -> IndexMethod -> Bool
$c>= :: IndexMethod -> IndexMethod -> Bool
>= :: IndexMethod -> IndexMethod -> Bool
$cmax :: IndexMethod -> IndexMethod -> IndexMethod
max :: IndexMethod -> IndexMethod -> IndexMethod
$cmin :: IndexMethod -> IndexMethod -> IndexMethod
min :: IndexMethod -> IndexMethod -> IndexMethod
Ord)

instance Show IndexMethod where
  show :: IndexMethod -> String
show IndexMethod
BTree = String
"btree"
  show IndexMethod
GIN = String
"gin"

instance Read IndexMethod where
  readsPrec :: Int -> ReadS IndexMethod
readsPrec Int
_ ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower -> String
"btree") = [(IndexMethod
BTree, String
"")]
  readsPrec Int
_ ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower -> String
"gin") = [(IndexMethod
GIN, String
"")]
  readsPrec Int
_ String
_ = []

tblIndex :: TableIndex
tblIndex :: TableIndex
tblIndex =
  TableIndex
    { idxColumns :: [IndexColumn]
idxColumns = []
    , idxInclude :: [RawSQL ()]
idxInclude = []
    , idxMethod :: IndexMethod
idxMethod = IndexMethod
BTree
    , idxUnique :: Bool
idxUnique = Bool
False
    , idxValid :: Bool
idxValid = Bool
True
    , idxWhere :: Maybe (RawSQL ())
idxWhere = Maybe (RawSQL ())
forall a. Maybe a
Nothing
    , idxNotDistinctNulls :: Bool
idxNotDistinctNulls = Bool
False
    }

indexOnColumn :: IndexColumn -> TableIndex
indexOnColumn :: IndexColumn -> TableIndex
indexOnColumn IndexColumn
column = TableIndex
tblIndex {idxColumns = [column]}

-- | Create an index on the given column with the specified method.  No checks
-- are made that the method is appropriate for the type of the column.
indexOnColumnWithMethod :: IndexColumn -> IndexMethod -> TableIndex
indexOnColumnWithMethod :: IndexColumn -> IndexMethod -> TableIndex
indexOnColumnWithMethod IndexColumn
column IndexMethod
method =
  TableIndex
tblIndex
    { idxColumns = [column]
    , idxMethod = method
    }

indexOnColumns :: [IndexColumn] -> TableIndex
indexOnColumns :: [IndexColumn] -> TableIndex
indexOnColumns [IndexColumn]
columns = TableIndex
tblIndex {idxColumns = columns}

-- | Create an index on the given columns with the specified method.  No checks
-- are made that the method is appropriate for the type of the column;
-- cf. [the PostgreSQL manual](https://www.postgresql.org/docs/current/static/indexes-multicolumn.html).
indexOnColumnsWithMethod :: [IndexColumn] -> IndexMethod -> TableIndex
indexOnColumnsWithMethod :: [IndexColumn] -> IndexMethod -> TableIndex
indexOnColumnsWithMethod [IndexColumn]
columns IndexMethod
method =
  TableIndex
tblIndex
    { idxColumns = columns
    , idxMethod = method
    }

uniqueIndexOnColumn :: IndexColumn -> TableIndex
uniqueIndexOnColumn :: IndexColumn -> TableIndex
uniqueIndexOnColumn IndexColumn
column =
  TableIndex
    { idxColumns :: [IndexColumn]
idxColumns = [IndexColumn
column]
    , idxInclude :: [RawSQL ()]
idxInclude = []
    , idxMethod :: IndexMethod
idxMethod = IndexMethod
BTree
    , idxUnique :: Bool
idxUnique = Bool
True
    , idxValid :: Bool
idxValid = Bool
True
    , idxWhere :: Maybe (RawSQL ())
idxWhere = Maybe (RawSQL ())
forall a. Maybe a
Nothing
    , idxNotDistinctNulls :: Bool
idxNotDistinctNulls = Bool
False
    }

uniqueIndexOnColumns :: [IndexColumn] -> TableIndex
uniqueIndexOnColumns :: [IndexColumn] -> TableIndex
uniqueIndexOnColumns [IndexColumn]
columns =
  TableIndex
    { idxColumns :: [IndexColumn]
idxColumns = [IndexColumn]
columns
    , idxInclude :: [RawSQL ()]
idxInclude = []
    , idxMethod :: IndexMethod
idxMethod = IndexMethod
BTree
    , idxUnique :: Bool
idxUnique = Bool
True
    , idxValid :: Bool
idxValid = Bool
True
    , idxWhere :: Maybe (RawSQL ())
idxWhere = Maybe (RawSQL ())
forall a. Maybe a
Nothing
    , idxNotDistinctNulls :: Bool
idxNotDistinctNulls = Bool
False
    }

uniqueIndexOnColumnWithCondition :: IndexColumn -> RawSQL () -> TableIndex
uniqueIndexOnColumnWithCondition :: IndexColumn -> RawSQL () -> TableIndex
uniqueIndexOnColumnWithCondition IndexColumn
column RawSQL ()
whereC =
  TableIndex
    { idxColumns :: [IndexColumn]
idxColumns = [IndexColumn
column]
    , idxInclude :: [RawSQL ()]
idxInclude = []
    , idxMethod :: IndexMethod
idxMethod = IndexMethod
BTree
    , idxUnique :: Bool
idxUnique = Bool
True
    , idxValid :: Bool
idxValid = Bool
True
    , idxWhere :: Maybe (RawSQL ())
idxWhere = RawSQL () -> Maybe (RawSQL ())
forall a. a -> Maybe a
Just RawSQL ()
whereC
    , idxNotDistinctNulls :: Bool
idxNotDistinctNulls = Bool
False
    }

indexName :: RawSQL () -> TableIndex -> RawSQL ()
indexName :: RawSQL () -> TableIndex -> RawSQL ()
indexName RawSQL ()
tname TableIndex {Bool
[RawSQL ()]
[IndexColumn]
Maybe (RawSQL ())
IndexMethod
idxColumns :: TableIndex -> [IndexColumn]
idxInclude :: TableIndex -> [RawSQL ()]
idxMethod :: TableIndex -> IndexMethod
idxUnique :: TableIndex -> Bool
idxValid :: TableIndex -> Bool
idxWhere :: TableIndex -> Maybe (RawSQL ())
idxNotDistinctNulls :: TableIndex -> Bool
idxColumns :: [IndexColumn]
idxInclude :: [RawSQL ()]
idxMethod :: IndexMethod
idxUnique :: Bool
idxValid :: Bool
idxWhere :: Maybe (RawSQL ())
idxNotDistinctNulls :: Bool
..} =
  (Text -> () -> RawSQL ()) -> () -> Text -> RawSQL ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL () (Text -> RawSQL ()) -> Text -> RawSQL ()
forall a b. (a -> b) -> a -> b
$
    Int -> Text -> Text
T.take Int
63 (Text -> Text) -> (RawSQL () -> Text) -> RawSQL () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSQL () -> Text
unRawSQL (RawSQL () -> Text) -> RawSQL () -> Text
forall a b. (a -> b) -> a -> b
$
      [RawSQL ()] -> RawSQL ()
forall a. Monoid a => [a] -> a
mconcat
        [ if Bool
idxUnique then RawSQL ()
"unique_idx__" else RawSQL ()
"idx__"
        , RawSQL ()
tname
        , RawSQL ()
"__"
        , RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
"__" ([RawSQL ()] -> RawSQL ()) -> [RawSQL ()] -> RawSQL ()
forall a b. (a -> b) -> a -> b
$ (IndexColumn -> RawSQL ()) -> [IndexColumn] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> RawSQL () -> RawSQL ()
asText Text -> Text
sanitize (RawSQL () -> RawSQL ())
-> (IndexColumn -> RawSQL ()) -> IndexColumn -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexColumn -> RawSQL ()
indexColumnName) [IndexColumn]
idxColumns
        , if [RawSQL ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RawSQL ()]
idxInclude
            then RawSQL ()
""
            else RawSQL ()
"$$" RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
"__" ((RawSQL () -> RawSQL ()) -> [RawSQL ()] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> RawSQL () -> RawSQL ()
asText Text -> Text
sanitize) [RawSQL ()]
idxInclude)
        , RawSQL ()
-> (RawSQL () -> RawSQL ()) -> Maybe (RawSQL ()) -> RawSQL ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSQL ()
"" ((RawSQL ()
"__" RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<>) (RawSQL () -> RawSQL ())
-> (RawSQL () -> RawSQL ()) -> RawSQL () -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSQL () -> RawSQL ()
hashWhere) Maybe (RawSQL ())
idxWhere
        ]
  where
    asText :: (Text -> Text) -> RawSQL () -> RawSQL ()
asText Text -> Text
f = (Text -> () -> RawSQL ()) -> () -> Text -> RawSQL ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL () (Text -> RawSQL ())
-> (RawSQL () -> Text) -> RawSQL () -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> Text) -> (RawSQL () -> Text) -> RawSQL () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSQL () -> Text
unRawSQL
    -- See http://www.postgresql.org/docs/9.4/static/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS.
    -- Remove all unallowed characters and replace them by at most one adjacent dollar sign.
    sanitize :: Text -> Text
sanitize = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS) -> String -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
go [] ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
      where
        go :: Char -> ShowS
go Char
c String
acc =
          if Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
            then Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc
            else case String
acc of
              (Char
'$' : String
_) -> String
acc
              String
_ -> Char
'$' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc
    -- hash WHERE clause and add it to index name so that indexes
    -- with the same columns, but different constraints can coexist
    hashWhere :: RawSQL () -> RawSQL ()
hashWhere =
      (Text -> Text) -> RawSQL () -> RawSQL ()
asText ((Text -> Text) -> RawSQL () -> RawSQL ())
-> (Text -> Text) -> RawSQL () -> RawSQL ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> Text
T.decodeUtf8
          (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode
          (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
10
          (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest RIPEMD160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
          (Digest RIPEMD160 -> ByteString)
-> (Text -> Digest RIPEMD160) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
H.hash @_ @H.RIPEMD160
          (ByteString -> Digest RIPEMD160)
-> (Text -> ByteString) -> Text -> Digest RIPEMD160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

-- | Create an index. Warning: if the affected table is large, this will prevent
-- the table from being modified during the creation. If this is not acceptable,
-- use 'CreateIndexConcurrentlyMigration'. See
-- https://www.postgresql.org/docs/current/sql-createindex.html for more
-- information.
sqlCreateIndexMaybeDowntime :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndexMaybeDowntime :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndexMaybeDowntime = Bool -> RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex_ Bool
False

-- | Create index concurrently.
sqlCreateIndexConcurrently :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndexConcurrently :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndexConcurrently = Bool -> RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex_ Bool
True

sqlCreateIndex_ :: Bool -> RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex_ :: Bool -> RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex_ Bool
concurrently RawSQL ()
tname idx :: TableIndex
idx@TableIndex {Bool
[RawSQL ()]
[IndexColumn]
Maybe (RawSQL ())
IndexMethod
idxColumns :: TableIndex -> [IndexColumn]
idxInclude :: TableIndex -> [RawSQL ()]
idxMethod :: TableIndex -> IndexMethod
idxUnique :: TableIndex -> Bool
idxValid :: TableIndex -> Bool
idxWhere :: TableIndex -> Maybe (RawSQL ())
idxNotDistinctNulls :: TableIndex -> Bool
idxColumns :: [IndexColumn]
idxInclude :: [RawSQL ()]
idxMethod :: IndexMethod
idxUnique :: Bool
idxValid :: Bool
idxWhere :: Maybe (RawSQL ())
idxNotDistinctNulls :: Bool
..} =
  [RawSQL ()] -> RawSQL ()
forall a. Monoid a => [a] -> a
mconcat
    [ RawSQL ()
"CREATE"
    , if Bool
idxUnique then RawSQL ()
" UNIQUE" else RawSQL ()
""
    , RawSQL ()
" INDEX "
    , if Bool
concurrently then RawSQL ()
"CONCURRENTLY " else RawSQL ()
""
    , RawSQL () -> TableIndex -> RawSQL ()
indexName RawSQL ()
tname TableIndex
idx
    , RawSQL ()
" ON" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
tname
    , RawSQL ()
" USING" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL (String -> Text
T.pack (String -> Text) -> (IndexMethod -> String) -> IndexMethod -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexMethod -> String
forall a. Show a => a -> String
show (IndexMethod -> Text) -> IndexMethod -> Text
forall a b. (a -> b) -> a -> b
$ IndexMethod
idxMethod) () RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"("
    , RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate
        RawSQL ()
", "
        ( (IndexColumn -> RawSQL ()) -> [IndexColumn] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \case
                IndexColumn RawSQL ()
col Maybe (RawSQL ())
Nothing -> RawSQL ()
col
                IndexColumn RawSQL ()
col (Just RawSQL ()
opclass) -> RawSQL ()
col RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
opclass
            )
            [IndexColumn]
idxColumns
        )
    , RawSQL ()
")"
    , if [RawSQL ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RawSQL ()]
idxInclude
        then RawSQL ()
""
        else RawSQL ()
" INCLUDE (" RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
", " [RawSQL ()]
idxInclude RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
<> RawSQL ()
")"
    , if Bool
idxUnique Bool -> Bool -> Bool
&& Bool
idxNotDistinctNulls
        then RawSQL ()
" NULLS NOT DISTINCT"
        else RawSQL ()
""
    , RawSQL ()
-> (RawSQL () -> RawSQL ()) -> Maybe (RawSQL ()) -> RawSQL ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSQL ()
"" (RawSQL ()
" WHERE" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+>) Maybe (RawSQL ())
idxWhere
    ]

-- | Drop an index. Warning: if you don't want to lock out concurrent operations
-- on the index's table, use 'DropIndexConcurrentlyMigration'. See
-- https://www.postgresql.org/docs/current/sql-dropindex.html for more
-- information.
sqlDropIndexMaybeDowntime :: RawSQL () -> TableIndex -> RawSQL ()
sqlDropIndexMaybeDowntime :: RawSQL () -> TableIndex -> RawSQL ()
sqlDropIndexMaybeDowntime RawSQL ()
tname TableIndex
idx = RawSQL ()
"DROP INDEX" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> TableIndex -> RawSQL ()
indexName RawSQL ()
tname TableIndex
idx

sqlDropIndexConcurrently :: RawSQL () -> TableIndex -> RawSQL ()
sqlDropIndexConcurrently :: RawSQL () -> TableIndex -> RawSQL ()
sqlDropIndexConcurrently RawSQL ()
tname TableIndex
idx = RawSQL ()
"DROP INDEX CONCURRENTLY" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL () -> TableIndex -> RawSQL ()
indexName RawSQL ()
tname TableIndex
idx