{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.PgCatalog.PgClass
  ( PgClass (..)
  , RelationName
  , relationNameToString
  , RelationKind (..)
  , pgClassTable
  , relationNameField
  , namespaceOidField
  , relationKindField
  )
where

import qualified Data.String as String
import qualified Data.Text as T
import qualified Database.PostgreSQL.LibPQ as LibPQ

import qualified Orville.PostgreSQL as Orville
import Orville.PostgreSQL.PgCatalog.OidField (oidField, oidTypeField)

{- |
  The Haskell representation of data read from the @pg_catalog.pg_class@
  table. Rows in this table correspond to tables, indexes, sequences, views,
  materialized views, composite types and TOAST tables.

@since 1.0.0.0
-}
data PgClass = PgClass
  { PgClass -> Oid
pgClassOid :: LibPQ.Oid
  -- ^ The PostgreSQL @oid@ for the relation.
  , PgClass -> Oid
pgClassNamespaceOid :: LibPQ.Oid
  -- ^ The PostgreSQL @oid@ of the namespace that the relation belongs to.
  -- References @pg_namespace.oid@.
  , PgClass -> RelationName
pgClassRelationName :: RelationName
  -- ^ The name of the relation.
  , PgClass -> RelationKind
pgClassRelationKind :: RelationKind
  -- ^ The kind of relation (table, view, etc).
  }

{- |
  A Haskell type for the name of the relation represented by a 'PgClass'.

@since 1.0.0.0
-}
newtype RelationName
  = RelationName T.Text
  deriving (Int -> RelationName -> ShowS
[RelationName] -> ShowS
RelationName -> String
(Int -> RelationName -> ShowS)
-> (RelationName -> String)
-> ([RelationName] -> ShowS)
-> Show RelationName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationName -> ShowS
showsPrec :: Int -> RelationName -> ShowS
$cshow :: RelationName -> String
show :: RelationName -> String
$cshowList :: [RelationName] -> ShowS
showList :: [RelationName] -> ShowS
Show, RelationName -> RelationName -> Bool
(RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool) -> Eq RelationName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationName -> RelationName -> Bool
== :: RelationName -> RelationName -> Bool
$c/= :: RelationName -> RelationName -> Bool
/= :: RelationName -> RelationName -> Bool
Eq, Eq RelationName
Eq RelationName
-> (RelationName -> RelationName -> Ordering)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> Bool)
-> (RelationName -> RelationName -> RelationName)
-> (RelationName -> RelationName -> RelationName)
-> Ord RelationName
RelationName -> RelationName -> Bool
RelationName -> RelationName -> Ordering
RelationName -> RelationName -> RelationName
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 :: RelationName -> RelationName -> Ordering
compare :: RelationName -> RelationName -> Ordering
$c< :: RelationName -> RelationName -> Bool
< :: RelationName -> RelationName -> Bool
$c<= :: RelationName -> RelationName -> Bool
<= :: RelationName -> RelationName -> Bool
$c> :: RelationName -> RelationName -> Bool
> :: RelationName -> RelationName -> Bool
$c>= :: RelationName -> RelationName -> Bool
>= :: RelationName -> RelationName -> Bool
$cmax :: RelationName -> RelationName -> RelationName
max :: RelationName -> RelationName -> RelationName
$cmin :: RelationName -> RelationName -> RelationName
min :: RelationName -> RelationName -> RelationName
Ord, String -> RelationName
(String -> RelationName) -> IsString RelationName
forall a. (String -> a) -> IsString a
$cfromString :: String -> RelationName
fromString :: String -> RelationName
String.IsString)

{- |
  Convert a 'RelationName' to a plain 'String'.

@since 1.0.0.0
-}
relationNameToString :: RelationName -> String
relationNameToString :: RelationName -> String
relationNameToString (RelationName Text
text) =
  Text -> String
T.unpack Text
text

{- |
  The kind of relation represented by a 'PgClass', as described at
  https://www.postgresql.org/docs/13/catalog-pg-class.html.

@since 1.0.0.0
-}
data RelationKind
  = OrdinaryTable
  | Index
  | Sequence
  | ToastTable
  | View
  | MaterializedView
  | CompositeType
  | ForeignTable
  | PartitionedTable
  | PartitionedIndex
  deriving (Int -> RelationKind -> ShowS
[RelationKind] -> ShowS
RelationKind -> String
(Int -> RelationKind -> ShowS)
-> (RelationKind -> String)
-> ([RelationKind] -> ShowS)
-> Show RelationKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationKind -> ShowS
showsPrec :: Int -> RelationKind -> ShowS
$cshow :: RelationKind -> String
show :: RelationKind -> String
$cshowList :: [RelationKind] -> ShowS
showList :: [RelationKind] -> ShowS
Show, RelationKind -> RelationKind -> Bool
(RelationKind -> RelationKind -> Bool)
-> (RelationKind -> RelationKind -> Bool) -> Eq RelationKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationKind -> RelationKind -> Bool
== :: RelationKind -> RelationKind -> Bool
$c/= :: RelationKind -> RelationKind -> Bool
/= :: RelationKind -> RelationKind -> Bool
Eq)

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

@since 1.0.0.0
-}
pgClassTable :: Orville.TableDefinition (Orville.HasKey LibPQ.Oid) PgClass PgClass
pgClassTable :: TableDefinition (HasKey Oid) PgClass PgClass
pgClassTable =
  String
-> TableDefinition (HasKey Oid) PgClass PgClass
-> TableDefinition (HasKey Oid) PgClass PgClass
forall key writeEntity readEntity.
String
-> TableDefinition key writeEntity readEntity
-> TableDefinition key writeEntity readEntity
Orville.setTableSchema String
"pg_catalog" (TableDefinition (HasKey Oid) PgClass PgClass
 -> TableDefinition (HasKey Oid) PgClass PgClass)
-> TableDefinition (HasKey Oid) PgClass PgClass
-> TableDefinition (HasKey Oid) PgClass PgClass
forall a b. (a -> b) -> a -> b
$
    String
-> PrimaryKey Oid
-> SqlMarshaller PgClass PgClass
-> TableDefinition (HasKey Oid) PgClass PgClass
forall key writeEntity readEntity.
String
-> PrimaryKey key
-> SqlMarshaller writeEntity readEntity
-> TableDefinition (HasKey key) writeEntity readEntity
Orville.mkTableDefinition
      String
"pg_class"
      (FieldDefinition NotNull Oid -> PrimaryKey Oid
forall key. FieldDefinition NotNull key -> PrimaryKey key
Orville.primaryKey FieldDefinition NotNull Oid
oidField)
      SqlMarshaller PgClass PgClass
pgClassMarshaller

pgClassMarshaller :: Orville.SqlMarshaller PgClass PgClass
pgClassMarshaller :: SqlMarshaller PgClass PgClass
pgClassMarshaller =
  Oid -> Oid -> RelationName -> RelationKind -> PgClass
PgClass
    (Oid -> Oid -> RelationName -> RelationKind -> PgClass)
-> SqlMarshaller PgClass Oid
-> SqlMarshaller
     PgClass (Oid -> RelationName -> RelationKind -> PgClass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PgClass -> Oid)
-> FieldDefinition NotNull Oid -> SqlMarshaller PgClass Oid
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgClass -> Oid
pgClassOid FieldDefinition NotNull Oid
oidField
    SqlMarshaller
  PgClass (Oid -> RelationName -> RelationKind -> PgClass)
-> SqlMarshaller PgClass Oid
-> SqlMarshaller PgClass (RelationName -> RelationKind -> PgClass)
forall a b.
SqlMarshaller PgClass (a -> b)
-> SqlMarshaller PgClass a -> SqlMarshaller PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgClass -> Oid)
-> FieldDefinition NotNull Oid -> SqlMarshaller PgClass Oid
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgClass -> Oid
pgClassNamespaceOid FieldDefinition NotNull Oid
namespaceOidField
    SqlMarshaller PgClass (RelationName -> RelationKind -> PgClass)
-> SqlMarshaller PgClass RelationName
-> SqlMarshaller PgClass (RelationKind -> PgClass)
forall a b.
SqlMarshaller PgClass (a -> b)
-> SqlMarshaller PgClass a -> SqlMarshaller PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgClass -> RelationName)
-> FieldDefinition NotNull RelationName
-> SqlMarshaller PgClass RelationName
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgClass -> RelationName
pgClassRelationName FieldDefinition NotNull RelationName
relationNameField
    SqlMarshaller PgClass (RelationKind -> PgClass)
-> SqlMarshaller PgClass RelationKind
-> SqlMarshaller PgClass PgClass
forall a b.
SqlMarshaller PgClass (a -> b)
-> SqlMarshaller PgClass a -> SqlMarshaller PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgClass -> RelationKind)
-> FieldDefinition NotNull RelationKind
-> SqlMarshaller PgClass RelationKind
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgClass -> RelationKind
pgClassRelationKind FieldDefinition NotNull RelationKind
relationKindField

{- |
  The @relnamespace@ column of the @pg_catalog.pg_class@ table.

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

{- |
  The @relname@ column of the @pg_catalog.pg_class@ table.

@since 1.0.0.0
-}
relationNameField :: Orville.FieldDefinition Orville.NotNull RelationName
relationNameField :: FieldDefinition NotNull RelationName
relationNameField =
  FieldDefinition NotNull Text
-> FieldDefinition NotNull RelationName
forall a b nullability.
(Coercible a b, Coercible b a) =>
FieldDefinition nullability a -> FieldDefinition nullability b
Orville.coerceField (FieldDefinition NotNull Text
 -> FieldDefinition NotNull RelationName)
-> FieldDefinition NotNull Text
-> FieldDefinition NotNull RelationName
forall a b. (a -> b) -> a -> b
$
    String -> FieldDefinition NotNull Text
Orville.unboundedTextField String
"relname"

{- |
  The @relkind@ column of the @pg_catalog.pg_class@ table.

@since 1.0.0.0
-}
relationKindField :: Orville.FieldDefinition Orville.NotNull RelationKind
relationKindField :: FieldDefinition NotNull RelationKind
relationKindField =
  (SqlType Text -> SqlType RelationKind)
-> FieldDefinition NotNull Text
-> FieldDefinition NotNull RelationKind
forall a b nullability.
(SqlType a -> SqlType b)
-> FieldDefinition nullability a -> FieldDefinition nullability b
Orville.convertField
    ((RelationKind -> Text)
-> (Text -> Either String RelationKind)
-> SqlType Text
-> SqlType RelationKind
forall b a.
(b -> a) -> (a -> Either String b) -> SqlType a -> SqlType b
Orville.tryConvertSqlType RelationKind -> Text
relationKindToPgText Text -> Either String RelationKind
pgTextToRelationKind)
    (String -> FieldDefinition NotNull Text
Orville.unboundedTextField String
"relkind")

{- |
  Converts a 'RelationKind' to the corresponding single character text
  representation used by PostgreSQL.

  See also 'pgTextToRelationKind'

@since 1.0.0.0
-}
relationKindToPgText :: RelationKind -> T.Text
relationKindToPgText :: RelationKind -> Text
relationKindToPgText RelationKind
kind =
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    case RelationKind
kind of
      RelationKind
OrdinaryTable -> String
"r"
      RelationKind
Index -> String
"i"
      RelationKind
Sequence -> String
"S"
      RelationKind
ToastTable -> String
"t"
      RelationKind
View -> String
"v"
      RelationKind
MaterializedView -> String
"m"
      RelationKind
CompositeType -> String
"c"
      RelationKind
ForeignTable -> String
"f"
      RelationKind
PartitionedTable -> String
"p"
      RelationKind
PartitionedIndex -> String
"I"

{- |
  Attempts to parse a PostgreSQL single character textual value as a
  'RelationKind'.

  See also 'relationKindToPgText'

@since 1.0.0.0
-}
pgTextToRelationKind :: T.Text -> Either String RelationKind
pgTextToRelationKind :: Text -> Either String RelationKind
pgTextToRelationKind Text
text =
  case Text -> String
T.unpack Text
text of
    String
"r" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
OrdinaryTable
    String
"i" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
Index
    String
"S" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
Sequence
    String
"t" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
ToastTable
    String
"v" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
View
    String
"m" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
MaterializedView
    String
"c" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
CompositeType
    String
"f" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
ForeignTable
    String
"p" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
PartitionedTable
    String
"I" -> RelationKind -> Either String RelationKind
forall a b. b -> Either a b
Right RelationKind
PartitionedIndex
    String
kind -> String -> Either String RelationKind
forall a b. a -> Either a b
Left (String
"Unrecognized PostgreSQL relation kind: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
kind)