{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.PgCatalog.PgIndex
  ( PgIndex (..)
  , pgIndexTable
  , indexRelationOidField
  , indexIsLiveField
  )
where

import qualified Data.Attoparsec.Text as AttoText
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LTB
import qualified Database.PostgreSQL.LibPQ as LibPQ

import qualified Orville.PostgreSQL as Orville
import Orville.PostgreSQL.PgCatalog.OidField (oidTypeField)
import Orville.PostgreSQL.PgCatalog.PgAttribute (AttributeNumber, attributeNumberParser, attributeNumberTextBuilder)

{- |
  The Haskell representation of data read from the @pg_catalog.pg_index@ table.
  Rows in this table contain extended information about indices. Information
  about indices is also contained in the @pg_catalog.pg_class@ table as well.

@since 1.0.0.0
-}
data PgIndex = PgIndex
  { PgIndex -> Oid
pgIndexPgClassOid :: LibPQ.Oid
  -- ^ The PostgreSQL @oid@ of the @pg_class@ entry for this index.
  , PgIndex -> Oid
pgIndexRelationOid :: LibPQ.Oid
  -- ^ The PostgreSQL @oid@ of the @pg_class@ entry for the table that this
  -- index is for.
  , PgIndex -> [AttributeNumber]
pgIndexAttributeNumbers :: [AttributeNumber]
  -- ^ An array of attribute number references for the columns of the table
  -- that are included in the index. An attribute number of @0@ indicates an
  -- expression over the table's columns rather than just a reference to a
  -- column.
  --
  -- In PostgreSQL 11+ this includes both key columns and non-key-included
  -- columns. Orville is currently not aware of this distinction, however.
  , PgIndex -> Bool
pgIndexIsUnique :: Bool
  -- ^ Indicates whether this is a unique index.
  , PgIndex -> Bool
pgIndexIsPrimary :: Bool
  -- ^ Indicates whether this is the primary key index for the table.
  , PgIndex -> Bool
pgIndexIsLive :: Bool
  -- ^ When @False@, indicates that this index is in the process of being
  -- dropped and should be ignored.
  }

{- |
  An Orville 'Orville.TableDefinition' for querying the
  @pg_catalog.pg_index@ table.

@since 1.0.0.0
-}
pgIndexTable :: Orville.TableDefinition Orville.NoKey PgIndex PgIndex
pgIndexTable :: TableDefinition NoKey PgIndex PgIndex
pgIndexTable =
  String
-> TableDefinition NoKey PgIndex PgIndex
-> TableDefinition NoKey PgIndex PgIndex
forall key writeEntity readEntity.
String
-> TableDefinition key writeEntity readEntity
-> TableDefinition key writeEntity readEntity
Orville.setTableSchema String
"pg_catalog" (TableDefinition NoKey PgIndex PgIndex
 -> TableDefinition NoKey PgIndex PgIndex)
-> TableDefinition NoKey PgIndex PgIndex
-> TableDefinition NoKey PgIndex PgIndex
forall a b. (a -> b) -> a -> b
$
    String
-> SqlMarshaller PgIndex PgIndex
-> TableDefinition NoKey PgIndex PgIndex
forall writeEntity readEntity.
String
-> SqlMarshaller writeEntity readEntity
-> TableDefinition NoKey writeEntity readEntity
Orville.mkTableDefinitionWithoutKey
      String
"pg_index"
      SqlMarshaller PgIndex PgIndex
pgIndexMarshaller

pgIndexMarshaller :: Orville.SqlMarshaller PgIndex PgIndex
pgIndexMarshaller :: SqlMarshaller PgIndex PgIndex
pgIndexMarshaller =
  Oid -> Oid -> [AttributeNumber] -> Bool -> Bool -> Bool -> PgIndex
PgIndex
    (Oid
 -> Oid -> [AttributeNumber] -> Bool -> Bool -> Bool -> PgIndex)
-> SqlMarshaller PgIndex Oid
-> SqlMarshaller
     PgIndex
     (Oid -> [AttributeNumber] -> Bool -> Bool -> Bool -> PgIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PgIndex -> Oid)
-> FieldDefinition NotNull Oid -> SqlMarshaller PgIndex Oid
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgIndex -> Oid
pgIndexPgClassOid FieldDefinition NotNull Oid
indexPgClassOidField
    SqlMarshaller
  PgIndex
  (Oid -> [AttributeNumber] -> Bool -> Bool -> Bool -> PgIndex)
-> SqlMarshaller PgIndex Oid
-> SqlMarshaller
     PgIndex ([AttributeNumber] -> Bool -> Bool -> Bool -> PgIndex)
forall a b.
SqlMarshaller PgIndex (a -> b)
-> SqlMarshaller PgIndex a -> SqlMarshaller PgIndex b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgIndex -> Oid)
-> FieldDefinition NotNull Oid -> SqlMarshaller PgIndex Oid
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgIndex -> Oid
pgIndexRelationOid FieldDefinition NotNull Oid
indexRelationOidField
    SqlMarshaller
  PgIndex ([AttributeNumber] -> Bool -> Bool -> Bool -> PgIndex)
-> SqlMarshaller PgIndex [AttributeNumber]
-> SqlMarshaller PgIndex (Bool -> Bool -> Bool -> PgIndex)
forall a b.
SqlMarshaller PgIndex (a -> b)
-> SqlMarshaller PgIndex a -> SqlMarshaller PgIndex b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgIndex -> [AttributeNumber])
-> FieldDefinition NotNull [AttributeNumber]
-> SqlMarshaller PgIndex [AttributeNumber]
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgIndex -> [AttributeNumber]
pgIndexAttributeNumbers FieldDefinition NotNull [AttributeNumber]
indexAttributeNumbersField
    SqlMarshaller PgIndex (Bool -> Bool -> Bool -> PgIndex)
-> SqlMarshaller PgIndex Bool
-> SqlMarshaller PgIndex (Bool -> Bool -> PgIndex)
forall a b.
SqlMarshaller PgIndex (a -> b)
-> SqlMarshaller PgIndex a -> SqlMarshaller PgIndex b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgIndex -> Bool)
-> FieldDefinition NotNull Bool -> SqlMarshaller PgIndex Bool
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgIndex -> Bool
pgIndexIsUnique FieldDefinition NotNull Bool
indexIsUniqueField
    SqlMarshaller PgIndex (Bool -> Bool -> PgIndex)
-> SqlMarshaller PgIndex Bool
-> SqlMarshaller PgIndex (Bool -> PgIndex)
forall a b.
SqlMarshaller PgIndex (a -> b)
-> SqlMarshaller PgIndex a -> SqlMarshaller PgIndex b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgIndex -> Bool)
-> FieldDefinition NotNull Bool -> SqlMarshaller PgIndex Bool
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgIndex -> Bool
pgIndexIsPrimary FieldDefinition NotNull Bool
indexIsPrimaryField
    SqlMarshaller PgIndex (Bool -> PgIndex)
-> SqlMarshaller PgIndex Bool -> SqlMarshaller PgIndex PgIndex
forall a b.
SqlMarshaller PgIndex (a -> b)
-> SqlMarshaller PgIndex a -> SqlMarshaller PgIndex b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgIndex -> Bool)
-> FieldDefinition NotNull Bool -> SqlMarshaller PgIndex Bool
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgIndex -> Bool
pgIndexIsLive FieldDefinition NotNull Bool
indexIsLiveField

{- |
  The @indexrelid@ column of the @pg_index@ table.

@since 1.0.0.0
-}
indexPgClassOidField :: Orville.FieldDefinition Orville.NotNull LibPQ.Oid
indexPgClassOidField :: FieldDefinition NotNull Oid
indexPgClassOidField =
  String -> FieldDefinition NotNull Oid
oidTypeField String
"indexrelid"

{- |
  The @indrelid@ column of the @pg_index@ table.

@since 1.0.0.0
-}
indexRelationOidField :: Orville.FieldDefinition Orville.NotNull LibPQ.Oid
indexRelationOidField :: FieldDefinition NotNull Oid
indexRelationOidField =
  String -> FieldDefinition NotNull Oid
oidTypeField String
"indrelid"

{- |
  The @indkey@ column of the @pg_index@ table.

@since 1.0.0.0
-}
indexAttributeNumbersField :: Orville.FieldDefinition Orville.NotNull [AttributeNumber]
indexAttributeNumbersField :: FieldDefinition NotNull [AttributeNumber]
indexAttributeNumbersField =
  (SqlType Text -> SqlType [AttributeNumber])
-> FieldDefinition NotNull Text
-> FieldDefinition NotNull [AttributeNumber]
forall a b nullability.
(SqlType a -> SqlType b)
-> FieldDefinition nullability a -> FieldDefinition nullability b
Orville.convertField
    (([AttributeNumber] -> Text)
-> (Text -> Either String [AttributeNumber])
-> SqlType Text
-> SqlType [AttributeNumber]
forall b a.
(b -> a) -> (a -> Either String b) -> SqlType a -> SqlType b
Orville.tryConvertSqlType [AttributeNumber] -> Text
attributeNumberListToPgVectorText Text -> Either String [AttributeNumber]
pgVectorTextToAttributeNumberList)
    (String -> FieldDefinition NotNull Text
Orville.unboundedTextField String
"indkey")

{- |
  The @indisunique@ column of the @pg_index@ table.

@since 1.0.0.0
-}
indexIsUniqueField :: Orville.FieldDefinition Orville.NotNull Bool
indexIsUniqueField :: FieldDefinition NotNull Bool
indexIsUniqueField =
  String -> FieldDefinition NotNull Bool
Orville.booleanField String
"indisunique"

{- |
  The @indisprimary@ column of the @pg_index@ table.

@since 1.0.0.0
-}
indexIsPrimaryField :: Orville.FieldDefinition Orville.NotNull Bool
indexIsPrimaryField :: FieldDefinition NotNull Bool
indexIsPrimaryField =
  String -> FieldDefinition NotNull Bool
Orville.booleanField String
"indisprimary"

{- |
  The @indislive@ column of the @pg_index@ table.

@since 1.0.0.0
-}
indexIsLiveField :: Orville.FieldDefinition Orville.NotNull Bool
indexIsLiveField :: FieldDefinition NotNull Bool
indexIsLiveField =
  String -> FieldDefinition NotNull Bool
Orville.booleanField String
"indislive"

pgVectorTextToAttributeNumberList :: T.Text -> Either String [AttributeNumber]
pgVectorTextToAttributeNumberList :: Text -> Either String [AttributeNumber]
pgVectorTextToAttributeNumberList Text
text =
  let
    parser :: Parser Text [AttributeNumber]
parser = do
      [AttributeNumber]
attNums <- Parser Text AttributeNumber
-> Parser Text Char -> Parser Text [AttributeNumber]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
AttoText.sepBy Parser Text AttributeNumber
attributeNumberParser (Char -> Parser Text Char
AttoText.char Char
' ')
      Parser Text ()
forall t. Chunk t => Parser t ()
AttoText.endOfInput
      [AttributeNumber] -> Parser Text [AttributeNumber]
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AttributeNumber]
attNums
  in
    case Parser Text [AttributeNumber]
-> Text -> Either String [AttributeNumber]
forall a. Parser a -> Text -> Either String a
AttoText.parseOnly Parser Text [AttributeNumber]
parser Text
text of
      Left String
err -> String -> Either String [AttributeNumber]
forall a b. a -> Either a b
Left (String
"Unable to decode PostgreSQL Vector as AttributeNumber list: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err)
      Right [AttributeNumber]
nums -> [AttributeNumber] -> Either String [AttributeNumber]
forall a b. b -> Either a b
Right [AttributeNumber]
nums

attributeNumberListToPgVectorText :: [AttributeNumber] -> T.Text
attributeNumberListToPgVectorText :: [AttributeNumber] -> Text
attributeNumberListToPgVectorText [AttributeNumber]
attNums =
  let
    spaceDelimitedAttributeNumbers :: Builder
spaceDelimitedAttributeNumbers =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
        Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse (Char -> Builder
LTB.singleton Char
' ') ((AttributeNumber -> Builder) -> [AttributeNumber] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map AttributeNumber -> Builder
attributeNumberTextBuilder [AttributeNumber]
attNums)
  in
    Text -> Text
LT.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
      Builder
spaceDelimitedAttributeNumbers