module Database.PostgreSQL.PQTypes.Model.Index (
TableIndex(..)
, IndexMethod(..)
, tblIndex
, indexOnColumn
, indexOnColumns
, indexOnColumnWithMethod
, indexOnColumnsWithMethod
, uniqueIndexOnColumn
, uniqueIndexOnColumnWithCondition
, uniqueIndexOnColumns
, indexName
, sqlCreateIndex
, sqlCreateIndexSequentially
, sqlCreateIndexConcurrently
, sqlDropIndex
, sqlDropIndexConcurrently
) where
import Crypto.Hash.RIPEMD160
import Data.ByteString.Base16
import Data.Char
import Data.Monoid
import Data.Monoid.Utils
import Database.PostgreSQL.PQTypes
import Prelude
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
data TableIndex = TableIndex {
TableIndex -> [RawSQL ()]
idxColumns :: [RawSQL ()]
, TableIndex -> IndexMethod
idxMethod :: IndexMethod
, TableIndex -> Bool
idxUnique :: Bool
, TableIndex -> Bool
idxValid :: Bool
, TableIndex -> Maybe (RawSQL ())
idxWhere :: Maybe (RawSQL ())
} deriving (TableIndex -> TableIndex -> Bool
(TableIndex -> TableIndex -> Bool)
-> (TableIndex -> TableIndex -> Bool) -> Eq TableIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableIndex -> TableIndex -> Bool
$c/= :: TableIndex -> TableIndex -> Bool
== :: TableIndex -> TableIndex -> Bool
$c== :: 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
min :: TableIndex -> TableIndex -> TableIndex
$cmin :: TableIndex -> TableIndex -> TableIndex
max :: TableIndex -> TableIndex -> TableIndex
$cmax :: TableIndex -> TableIndex -> TableIndex
>= :: TableIndex -> TableIndex -> Bool
$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
compare :: TableIndex -> TableIndex -> Ordering
$ccompare :: TableIndex -> TableIndex -> Ordering
$cp1Ord :: Eq 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
showList :: [TableIndex] -> ShowS
$cshowList :: [TableIndex] -> ShowS
show :: TableIndex -> String
$cshow :: TableIndex -> String
showsPrec :: Int -> TableIndex -> ShowS
$cshowsPrec :: Int -> TableIndex -> ShowS
Show)
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
/= :: IndexMethod -> IndexMethod -> Bool
$c/= :: IndexMethod -> IndexMethod -> Bool
== :: IndexMethod -> IndexMethod -> Bool
$c== :: 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
min :: IndexMethod -> IndexMethod -> IndexMethod
$cmin :: IndexMethod -> IndexMethod -> IndexMethod
max :: IndexMethod -> IndexMethod -> IndexMethod
$cmax :: IndexMethod -> IndexMethod -> IndexMethod
>= :: IndexMethod -> IndexMethod -> Bool
$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
compare :: IndexMethod -> IndexMethod -> Ordering
$ccompare :: IndexMethod -> IndexMethod -> Ordering
$cp1Ord :: Eq 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 :: [RawSQL ()]
-> IndexMethod -> Bool -> Bool -> Maybe (RawSQL ()) -> TableIndex
TableIndex {
idxColumns :: [RawSQL ()]
idxColumns = []
, 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
}
indexOnColumn :: RawSQL () -> TableIndex
indexOnColumn :: RawSQL () -> TableIndex
indexOnColumn RawSQL ()
column = TableIndex
tblIndex { idxColumns :: [RawSQL ()]
idxColumns = [RawSQL ()
column] }
indexOnColumnWithMethod :: RawSQL () -> IndexMethod -> TableIndex
indexOnColumnWithMethod :: RawSQL () -> IndexMethod -> TableIndex
indexOnColumnWithMethod RawSQL ()
column IndexMethod
method =
TableIndex
tblIndex { idxColumns :: [RawSQL ()]
idxColumns = [RawSQL ()
column]
, idxMethod :: IndexMethod
idxMethod = IndexMethod
method }
indexOnColumns :: [RawSQL ()] -> TableIndex
indexOnColumns :: [RawSQL ()] -> TableIndex
indexOnColumns [RawSQL ()]
columns = TableIndex
tblIndex { idxColumns :: [RawSQL ()]
idxColumns = [RawSQL ()]
columns }
indexOnColumnsWithMethod :: [RawSQL ()] -> IndexMethod -> TableIndex
indexOnColumnsWithMethod :: [RawSQL ()] -> IndexMethod -> TableIndex
indexOnColumnsWithMethod [RawSQL ()]
columns IndexMethod
method =
TableIndex
tblIndex { idxColumns :: [RawSQL ()]
idxColumns = [RawSQL ()]
columns
, idxMethod :: IndexMethod
idxMethod = IndexMethod
method }
uniqueIndexOnColumn :: RawSQL () -> TableIndex
uniqueIndexOnColumn :: RawSQL () -> TableIndex
uniqueIndexOnColumn RawSQL ()
column = TableIndex :: [RawSQL ()]
-> IndexMethod -> Bool -> Bool -> Maybe (RawSQL ()) -> TableIndex
TableIndex {
idxColumns :: [RawSQL ()]
idxColumns = [RawSQL ()
column]
, 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
}
uniqueIndexOnColumns :: [RawSQL ()] -> TableIndex
uniqueIndexOnColumns :: [RawSQL ()] -> TableIndex
uniqueIndexOnColumns [RawSQL ()]
columns = TableIndex :: [RawSQL ()]
-> IndexMethod -> Bool -> Bool -> Maybe (RawSQL ()) -> TableIndex
TableIndex {
idxColumns :: [RawSQL ()]
idxColumns = [RawSQL ()]
columns
, 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
}
uniqueIndexOnColumnWithCondition :: RawSQL () -> RawSQL () -> TableIndex
uniqueIndexOnColumnWithCondition :: RawSQL () -> RawSQL () -> TableIndex
uniqueIndexOnColumnWithCondition RawSQL ()
column RawSQL ()
whereC = TableIndex :: [RawSQL ()]
-> IndexMethod -> Bool -> Bool -> Maybe (RawSQL ()) -> TableIndex
TableIndex {
idxColumns :: [RawSQL ()]
idxColumns = [RawSQL ()
column]
, 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
}
indexName :: RawSQL () -> TableIndex -> RawSQL ()
indexName :: RawSQL () -> TableIndex -> RawSQL ()
indexName RawSQL ()
tname TableIndex{Bool
[RawSQL ()]
Maybe (RawSQL ())
IndexMethod
idxWhere :: Maybe (RawSQL ())
idxValid :: Bool
idxUnique :: Bool
idxMethod :: IndexMethod
idxColumns :: [RawSQL ()]
idxWhere :: TableIndex -> Maybe (RawSQL ())
idxValid :: TableIndex -> Bool
idxUnique :: TableIndex -> Bool
idxMethod :: TableIndex -> IndexMethod
idxColumns :: TableIndex -> [RawSQL ()]
..} = (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
$ (RawSQL () -> RawSQL ()) -> [RawSQL ()] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> RawSQL () -> RawSQL ()
asText Text -> Text
sanitize) [RawSQL ()]
idxColumns
, 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
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 (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
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
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
. ByteString -> ByteString
hash (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
{-# DEPRECATED sqlCreateIndex "Use sqlCreateIndexSequentially instead" #-}
sqlCreateIndex :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex = Bool -> RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex_ Bool
False
sqlCreateIndexSequentially :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndexSequentially :: RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndexSequentially = Bool -> RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndex_ Bool
False
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 ()]
Maybe (RawSQL ())
IndexMethod
idxWhere :: Maybe (RawSQL ())
idxValid :: Bool
idxUnique :: Bool
idxMethod :: IndexMethod
idxColumns :: [RawSQL ()]
idxWhere :: TableIndex -> Maybe (RawSQL ())
idxValid :: TableIndex -> Bool
idxUnique :: TableIndex -> Bool
idxMethod :: TableIndex -> IndexMethod
idxColumns :: TableIndex -> [RawSQL ()]
..} = [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 ()
", " [RawSQL ()]
idxColumns
, 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
]
sqlDropIndex :: RawSQL () -> TableIndex -> RawSQL ()
sqlDropIndex :: RawSQL () -> TableIndex -> RawSQL ()
sqlDropIndex 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