{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.PgCatalog.PgNamespace
  ( PgNamespace (..)
  , NamespaceName
  , namespaceNameToString
  , pgNamespaceTable
  , namespaceNameField
  )
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)

{- |
  The Haskell representation of data read from the @pg_catalog.pg_namespace@
  table. Namespaces in @pg_catalog@ correspond to "schema" concept in database
  organization.

@since 1.0.0.0
-}
data PgNamespace = PgNamespace
  { PgNamespace -> Oid
pgNamespaceOid :: LibPQ.Oid
  -- ^ The PostgreSQL @oid@ for the namespace. This is referenced from
  -- other tables, such as @pg_class@.
  , PgNamespace -> NamespaceName
pgNamespaceName :: NamespaceName
  -- ^ The name of the namespace.
  }

{- |
  A Haskell type for the name of a namespace.

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

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

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

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

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

pgNamespaceMarshaller :: Orville.SqlMarshaller PgNamespace PgNamespace
pgNamespaceMarshaller :: SqlMarshaller PgNamespace PgNamespace
pgNamespaceMarshaller =
  Oid -> NamespaceName -> PgNamespace
PgNamespace
    (Oid -> NamespaceName -> PgNamespace)
-> SqlMarshaller PgNamespace Oid
-> SqlMarshaller PgNamespace (NamespaceName -> PgNamespace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PgNamespace -> Oid)
-> FieldDefinition NotNull Oid -> SqlMarshaller PgNamespace Oid
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgNamespace -> Oid
pgNamespaceOid FieldDefinition NotNull Oid
oidField
    SqlMarshaller PgNamespace (NamespaceName -> PgNamespace)
-> SqlMarshaller PgNamespace NamespaceName
-> SqlMarshaller PgNamespace PgNamespace
forall a b.
SqlMarshaller PgNamespace (a -> b)
-> SqlMarshaller PgNamespace a -> SqlMarshaller PgNamespace b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgNamespace -> NamespaceName)
-> FieldDefinition NotNull NamespaceName
-> SqlMarshaller PgNamespace NamespaceName
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Orville.marshallField PgNamespace -> NamespaceName
pgNamespaceName FieldDefinition NotNull NamespaceName
namespaceNameField

{- |
  The @nspname@ column of the @pg_catalog.pg_namespace@ table.

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