{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Postgres SQL Types
--
-- Combinators and helpers for dealing with Postgres types such as strings, numerals,
-- geography and geometry, etc.
module Hasura.Backends.Postgres.SQL.Types
  ( pgFmtLit,
    pgFmtIdentifier,
    isView,
    QualifiedTable,
    QualifiedFunction,
    PGDescription (..),
    PGCol,
    unsafePGCol,
    getPGColTxt,
    showPGCols,
    isNumType,
    stringTypes,
    isStringType,
    isJSONType,
    isComparableType,
    isBigNum,
    geoTypes,
    isGeoType,
    IsIdentifier (..),
    Identifier (..),
    ColumnIdentifier (..),
    TableIdentifier (..),
    SchemaName (..),
    publicSchema,
    hdbCatalogSchema,
    TableName (..),
    FunctionName (..),
    ConstraintName (..),
    QualifiedObject (..),
    getIdentifierQualifiedObject,
    qualifiedObjectToText,
    snakeCaseQualifiedObject,
    namingConventionSupport,
    qualifiedObjectToName,
    PGScalarType (..),
    textToPGScalarType,
    pgScalarTranslations,
    pgScalarTypeToText,
    PGTypeKind (..),
    QualifiedPGType (..),
    isBaseType,
    typeToTable,
    mkFunctionArgScalarType,
    PGRawFunctionInfo (..),
    mkScalarTypeName,
    pgTypeOid,
    tableIdentifierToIdentifier,
    identifierToTableIdentifier,
    PGExtraTableMetadata (..),
  )
where

import Autodocodec (HasCodec (codec), dimapCodec, optionalFieldWithDefault', parseAlternative, requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (typeableName)
import Data.Aeson
import Data.Aeson.Encoding (text)
import Data.Aeson.Key qualified as K
import Data.Aeson.Types (toJSONKeyText)
import Data.Int
import Data.List (uncons)
import Data.String
import Data.Text qualified as T
import Data.Text.Casing qualified as C
import Data.Text.Extended
import Data.Text.NonEmpty (NonEmptyText (unNonEmptyText))
import Data.Typeable (Typeable)
import Database.PG.Query qualified as PG
import Database.PG.Query.PTI qualified as PTI
import Database.PostgreSQL.LibPQ qualified as PQ
import Hasura.Base.Error
import Hasura.Base.ErrorValue qualified as ErrorValue
import Hasura.Base.ToErrorValue
import Hasura.Function.Cache
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.Types.Backend (SupportedNamingCase (..))
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField.Name (ComputedFieldName (..))
import Hasura.RQL.Types.Source.TableType (SourceTableType (..))
import Hasura.SQL.Types
import Language.GraphQL.Draft.Syntax qualified as G
import PostgreSQL.Binary.Decoding qualified as PD
import Text.Builder qualified as TB
import Text.Regex.TDFA ((=~))

{- Note [About identifier types]

In order to better be able to reason about values representing SQL binders and
variables we are in the process of retiring the generic 'Identifier' type in
favor of the more specific types 'TableIdentifier' and 'ColumnIdentifier'.

Likewise, we distinguish binders of names from uses of names: The types
'TableAlias' and `ColumnAlias` are used to for binders, whereas
`TableIdentifier` and `ColumnIdentifier` represent usages or references of
previously bound names.

We want to ensure these are handled in an hygenic way:
\* 'TableAlias'es and 'ColumnAlias'es can be constructed freely, but
\* 'TableIdentifier' can only be constructed from a 'TableAlias' via
  'tableAliasToIdentifier', and
\* 'ColumnIdentifier's can only be constructed from a 'ColumnAlias', and
  potentially be qualified with a 'TableIdentifier'.

-}

newtype Identifier = Identifier {Identifier -> Text
getIdenTxt :: Text}
  deriving stock (Typeable Identifier
Typeable Identifier
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Identifier -> c Identifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Identifier)
-> (Identifier -> Constr)
-> (Identifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Identifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Identifier))
-> ((forall b. Data b => b -> b) -> Identifier -> Identifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Identifier -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Identifier -> r)
-> (forall u. (forall d. Data d => d -> u) -> Identifier -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Identifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Identifier -> m Identifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Identifier -> m Identifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Identifier -> m Identifier)
-> Data Identifier
Identifier -> Constr
Identifier -> DataType
(forall b. Data b => b -> b) -> Identifier -> Identifier
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Identifier -> u
forall u. (forall d. Data d => d -> u) -> Identifier -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Identifier -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Identifier -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Identifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Identifier -> c Identifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Identifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Identifier)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Identifier -> c Identifier
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Identifier -> c Identifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Identifier
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Identifier
$ctoConstr :: Identifier -> Constr
toConstr :: Identifier -> Constr
$cdataTypeOf :: Identifier -> DataType
dataTypeOf :: Identifier -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Identifier)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Identifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Identifier)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Identifier)
$cgmapT :: (forall b. Data b => b -> b) -> Identifier -> Identifier
gmapT :: (forall b. Data b => b -> b) -> Identifier -> Identifier
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Identifier -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Identifier -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Identifier -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Identifier -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Identifier -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Identifier -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Identifier -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Identifier -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identifier -> m Identifier
Data, Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
/= :: Identifier -> Identifier -> Bool
Eq, Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Identifier -> ShowS
showsPrec :: Int -> Identifier -> ShowS
$cshow :: Identifier -> String
show :: Identifier -> String
$cshowList :: [Identifier] -> ShowS
showList :: [Identifier] -> ShowS
Show)
  deriving newtype (Identifier -> ()
(Identifier -> ()) -> NFData Identifier
forall a. (a -> ()) -> NFData a
$crnf :: Identifier -> ()
rnf :: Identifier -> ()
NFData, Value -> Parser [Identifier]
Value -> Parser Identifier
(Value -> Parser Identifier)
-> (Value -> Parser [Identifier]) -> FromJSON Identifier
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Identifier
parseJSON :: Value -> Parser Identifier
$cparseJSONList :: Value -> Parser [Identifier]
parseJSONList :: Value -> Parser [Identifier]
FromJSON, [Identifier] -> Value
[Identifier] -> Encoding
Identifier -> Value
Identifier -> Encoding
(Identifier -> Value)
-> (Identifier -> Encoding)
-> ([Identifier] -> Value)
-> ([Identifier] -> Encoding)
-> ToJSON Identifier
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Identifier -> Value
toJSON :: Identifier -> Value
$ctoEncoding :: Identifier -> Encoding
toEncoding :: Identifier -> Encoding
$ctoJSONList :: [Identifier] -> Value
toJSONList :: [Identifier] -> Value
$ctoEncodingList :: [Identifier] -> Encoding
toEncodingList :: [Identifier] -> Encoding
ToJSON, Eq Identifier
Eq Identifier
-> (Int -> Identifier -> Int)
-> (Identifier -> Int)
-> Hashable Identifier
Int -> Identifier -> Int
Identifier -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Identifier -> Int
hashWithSalt :: Int -> Identifier -> Int
$chash :: Identifier -> Int
hash :: Identifier -> Int
Hashable, NonEmpty Identifier -> Identifier
Identifier -> Identifier -> Identifier
(Identifier -> Identifier -> Identifier)
-> (NonEmpty Identifier -> Identifier)
-> (forall b. Integral b => b -> Identifier -> Identifier)
-> Semigroup Identifier
forall b. Integral b => b -> Identifier -> Identifier
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Identifier -> Identifier -> Identifier
<> :: Identifier -> Identifier -> Identifier
$csconcat :: NonEmpty Identifier -> Identifier
sconcat :: NonEmpty Identifier -> Identifier
$cstimes :: forall b. Integral b => b -> Identifier -> Identifier
stimes :: forall b. Integral b => b -> Identifier -> Identifier
Semigroup)

instance ToSQL Identifier where
  toSQL :: Identifier -> Builder
toSQL (Identifier Text
t) =
    Text -> Builder
TB.text (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> Text
pgFmtIdentifier Text
t

class IsIdentifier a where
  toIdentifier :: a -> Identifier

instance IsIdentifier Identifier where
  toIdentifier :: Identifier -> Identifier
toIdentifier = Identifier -> Identifier
forall a. a -> a
id

instance IsIdentifier ComputedFieldName where
  toIdentifier :: ComputedFieldName -> Identifier
toIdentifier = Text -> Identifier
Identifier (Text -> Identifier)
-> (ComputedFieldName -> Text) -> ComputedFieldName -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
unNonEmptyText (NonEmptyText -> Text)
-> (ComputedFieldName -> NonEmptyText) -> ComputedFieldName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComputedFieldName -> NonEmptyText
unComputedFieldName

-- | The type of identifiers representing tabular values.
-- While we are transitioning away from 'Identifier' we provisionally export
-- the value constructor.
newtype TableIdentifier = TableIdentifier {TableIdentifier -> Text
unTableIdentifier :: Text}
  deriving stock (Typeable TableIdentifier
Typeable TableIdentifier
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TableIdentifier -> c TableIdentifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TableIdentifier)
-> (TableIdentifier -> Constr)
-> (TableIdentifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TableIdentifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TableIdentifier))
-> ((forall b. Data b => b -> b)
    -> TableIdentifier -> TableIdentifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TableIdentifier -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TableIdentifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TableIdentifier -> m TableIdentifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TableIdentifier -> m TableIdentifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TableIdentifier -> m TableIdentifier)
-> Data TableIdentifier
TableIdentifier -> Constr
TableIdentifier -> DataType
(forall b. Data b => b -> b) -> TableIdentifier -> TableIdentifier
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TableIdentifier -> u
forall u. (forall d. Data d => d -> u) -> TableIdentifier -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableIdentifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableIdentifier -> c TableIdentifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableIdentifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TableIdentifier)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableIdentifier -> c TableIdentifier
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableIdentifier -> c TableIdentifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableIdentifier
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableIdentifier
$ctoConstr :: TableIdentifier -> Constr
toConstr :: TableIdentifier -> Constr
$cdataTypeOf :: TableIdentifier -> DataType
dataTypeOf :: TableIdentifier -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableIdentifier)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableIdentifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TableIdentifier)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TableIdentifier)
$cgmapT :: (forall b. Data b => b -> b) -> TableIdentifier -> TableIdentifier
gmapT :: (forall b. Data b => b -> b) -> TableIdentifier -> TableIdentifier
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableIdentifier -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableIdentifier -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableIdentifier -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TableIdentifier -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TableIdentifier -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableIdentifier -> m TableIdentifier
Data, TableIdentifier -> TableIdentifier -> Bool
(TableIdentifier -> TableIdentifier -> Bool)
-> (TableIdentifier -> TableIdentifier -> Bool)
-> Eq TableIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableIdentifier -> TableIdentifier -> Bool
== :: TableIdentifier -> TableIdentifier -> Bool
$c/= :: TableIdentifier -> TableIdentifier -> Bool
/= :: TableIdentifier -> TableIdentifier -> Bool
Eq, Int -> TableIdentifier -> ShowS
[TableIdentifier] -> ShowS
TableIdentifier -> String
(Int -> TableIdentifier -> ShowS)
-> (TableIdentifier -> String)
-> ([TableIdentifier] -> ShowS)
-> Show TableIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableIdentifier -> ShowS
showsPrec :: Int -> TableIdentifier -> ShowS
$cshow :: TableIdentifier -> String
show :: TableIdentifier -> String
$cshowList :: [TableIdentifier] -> ShowS
showList :: [TableIdentifier] -> ShowS
Show)
  deriving newtype (TableIdentifier -> ()
(TableIdentifier -> ()) -> NFData TableIdentifier
forall a. (a -> ()) -> NFData a
$crnf :: TableIdentifier -> ()
rnf :: TableIdentifier -> ()
NFData, Value -> Parser [TableIdentifier]
Value -> Parser TableIdentifier
(Value -> Parser TableIdentifier)
-> (Value -> Parser [TableIdentifier]) -> FromJSON TableIdentifier
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TableIdentifier
parseJSON :: Value -> Parser TableIdentifier
$cparseJSONList :: Value -> Parser [TableIdentifier]
parseJSONList :: Value -> Parser [TableIdentifier]
FromJSON, [TableIdentifier] -> Value
[TableIdentifier] -> Encoding
TableIdentifier -> Value
TableIdentifier -> Encoding
(TableIdentifier -> Value)
-> (TableIdentifier -> Encoding)
-> ([TableIdentifier] -> Value)
-> ([TableIdentifier] -> Encoding)
-> ToJSON TableIdentifier
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TableIdentifier -> Value
toJSON :: TableIdentifier -> Value
$ctoEncoding :: TableIdentifier -> Encoding
toEncoding :: TableIdentifier -> Encoding
$ctoJSONList :: [TableIdentifier] -> Value
toJSONList :: [TableIdentifier] -> Value
$ctoEncodingList :: [TableIdentifier] -> Encoding
toEncodingList :: [TableIdentifier] -> Encoding
ToJSON, Eq TableIdentifier
Eq TableIdentifier
-> (Int -> TableIdentifier -> Int)
-> (TableIdentifier -> Int)
-> Hashable TableIdentifier
Int -> TableIdentifier -> Int
TableIdentifier -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TableIdentifier -> Int
hashWithSalt :: Int -> TableIdentifier -> Int
$chash :: TableIdentifier -> Int
hash :: TableIdentifier -> Int
Hashable, NonEmpty TableIdentifier -> TableIdentifier
TableIdentifier -> TableIdentifier -> TableIdentifier
(TableIdentifier -> TableIdentifier -> TableIdentifier)
-> (NonEmpty TableIdentifier -> TableIdentifier)
-> (forall b.
    Integral b =>
    b -> TableIdentifier -> TableIdentifier)
-> Semigroup TableIdentifier
forall b. Integral b => b -> TableIdentifier -> TableIdentifier
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TableIdentifier -> TableIdentifier -> TableIdentifier
<> :: TableIdentifier -> TableIdentifier -> TableIdentifier
$csconcat :: NonEmpty TableIdentifier -> TableIdentifier
sconcat :: NonEmpty TableIdentifier -> TableIdentifier
$cstimes :: forall b. Integral b => b -> TableIdentifier -> TableIdentifier
stimes :: forall b. Integral b => b -> TableIdentifier -> TableIdentifier
Semigroup)

-- | Temporary conversion function, to be removed once 'Identifier' has been
-- entirely split into 'TableIdentifier' and 'ColumnIdentifier'.
tableIdentifierToIdentifier :: TableIdentifier -> Identifier
tableIdentifierToIdentifier :: TableIdentifier -> Identifier
tableIdentifierToIdentifier = Text -> Identifier
Identifier (Text -> Identifier)
-> (TableIdentifier -> Text) -> TableIdentifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableIdentifier -> Text
unTableIdentifier

-- | Temporary conversion function, to be removed once 'Identifier' has been
-- entirely split into 'TableIdentifier' and 'ColumnIdentifier'.
identifierToTableIdentifier :: Identifier -> TableIdentifier
identifierToTableIdentifier :: Identifier -> TableIdentifier
identifierToTableIdentifier = Text -> TableIdentifier
TableIdentifier (Text -> TableIdentifier)
-> (Identifier -> Text) -> Identifier -> TableIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
getIdenTxt

instance ToSQL TableIdentifier where
  toSQL :: TableIdentifier -> Builder
toSQL (TableIdentifier Text
t) =
    Text -> Builder
TB.text (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> Text
pgFmtIdentifier Text
t

-- | The type of identifiers representing scalar values
newtype ColumnIdentifier = ColumnIdentifier {ColumnIdentifier -> Text
unColumnIdentifier :: Text}
  deriving stock (Typeable ColumnIdentifier
Typeable ColumnIdentifier
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ColumnIdentifier -> c ColumnIdentifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ColumnIdentifier)
-> (ColumnIdentifier -> Constr)
-> (ColumnIdentifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ColumnIdentifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ColumnIdentifier))
-> ((forall b. Data b => b -> b)
    -> ColumnIdentifier -> ColumnIdentifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ColumnIdentifier -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ColumnIdentifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ColumnIdentifier -> m ColumnIdentifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ColumnIdentifier -> m ColumnIdentifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ColumnIdentifier -> m ColumnIdentifier)
-> Data ColumnIdentifier
ColumnIdentifier -> Constr
ColumnIdentifier -> DataType
(forall b. Data b => b -> b)
-> ColumnIdentifier -> ColumnIdentifier
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ColumnIdentifier -> u
forall u. (forall d. Data d => d -> u) -> ColumnIdentifier -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnIdentifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnIdentifier -> c ColumnIdentifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnIdentifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnIdentifier)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnIdentifier -> c ColumnIdentifier
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnIdentifier -> c ColumnIdentifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnIdentifier
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnIdentifier
$ctoConstr :: ColumnIdentifier -> Constr
toConstr :: ColumnIdentifier -> Constr
$cdataTypeOf :: ColumnIdentifier -> DataType
dataTypeOf :: ColumnIdentifier -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnIdentifier)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnIdentifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnIdentifier)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnIdentifier)
$cgmapT :: (forall b. Data b => b -> b)
-> ColumnIdentifier -> ColumnIdentifier
gmapT :: (forall b. Data b => b -> b)
-> ColumnIdentifier -> ColumnIdentifier
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnIdentifier -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColumnIdentifier -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColumnIdentifier -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ColumnIdentifier -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ColumnIdentifier -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnIdentifier -> m ColumnIdentifier
Data, ColumnIdentifier -> ColumnIdentifier -> Bool
(ColumnIdentifier -> ColumnIdentifier -> Bool)
-> (ColumnIdentifier -> ColumnIdentifier -> Bool)
-> Eq ColumnIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnIdentifier -> ColumnIdentifier -> Bool
== :: ColumnIdentifier -> ColumnIdentifier -> Bool
$c/= :: ColumnIdentifier -> ColumnIdentifier -> Bool
/= :: ColumnIdentifier -> ColumnIdentifier -> Bool
Eq, Int -> ColumnIdentifier -> ShowS
[ColumnIdentifier] -> ShowS
ColumnIdentifier -> String
(Int -> ColumnIdentifier -> ShowS)
-> (ColumnIdentifier -> String)
-> ([ColumnIdentifier] -> ShowS)
-> Show ColumnIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnIdentifier -> ShowS
showsPrec :: Int -> ColumnIdentifier -> ShowS
$cshow :: ColumnIdentifier -> String
show :: ColumnIdentifier -> String
$cshowList :: [ColumnIdentifier] -> ShowS
showList :: [ColumnIdentifier] -> ShowS
Show)
  deriving newtype (ColumnIdentifier -> ()
(ColumnIdentifier -> ()) -> NFData ColumnIdentifier
forall a. (a -> ()) -> NFData a
$crnf :: ColumnIdentifier -> ()
rnf :: ColumnIdentifier -> ()
NFData, Value -> Parser [ColumnIdentifier]
Value -> Parser ColumnIdentifier
(Value -> Parser ColumnIdentifier)
-> (Value -> Parser [ColumnIdentifier])
-> FromJSON ColumnIdentifier
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ColumnIdentifier
parseJSON :: Value -> Parser ColumnIdentifier
$cparseJSONList :: Value -> Parser [ColumnIdentifier]
parseJSONList :: Value -> Parser [ColumnIdentifier]
FromJSON, [ColumnIdentifier] -> Value
[ColumnIdentifier] -> Encoding
ColumnIdentifier -> Value
ColumnIdentifier -> Encoding
(ColumnIdentifier -> Value)
-> (ColumnIdentifier -> Encoding)
-> ([ColumnIdentifier] -> Value)
-> ([ColumnIdentifier] -> Encoding)
-> ToJSON ColumnIdentifier
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ColumnIdentifier -> Value
toJSON :: ColumnIdentifier -> Value
$ctoEncoding :: ColumnIdentifier -> Encoding
toEncoding :: ColumnIdentifier -> Encoding
$ctoJSONList :: [ColumnIdentifier] -> Value
toJSONList :: [ColumnIdentifier] -> Value
$ctoEncodingList :: [ColumnIdentifier] -> Encoding
toEncodingList :: [ColumnIdentifier] -> Encoding
ToJSON, Eq ColumnIdentifier
Eq ColumnIdentifier
-> (Int -> ColumnIdentifier -> Int)
-> (ColumnIdentifier -> Int)
-> Hashable ColumnIdentifier
Int -> ColumnIdentifier -> Int
ColumnIdentifier -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ColumnIdentifier -> Int
hashWithSalt :: Int -> ColumnIdentifier -> Int
$chash :: ColumnIdentifier -> Int
hash :: ColumnIdentifier -> Int
Hashable, NonEmpty ColumnIdentifier -> ColumnIdentifier
ColumnIdentifier -> ColumnIdentifier -> ColumnIdentifier
(ColumnIdentifier -> ColumnIdentifier -> ColumnIdentifier)
-> (NonEmpty ColumnIdentifier -> ColumnIdentifier)
-> (forall b.
    Integral b =>
    b -> ColumnIdentifier -> ColumnIdentifier)
-> Semigroup ColumnIdentifier
forall b. Integral b => b -> ColumnIdentifier -> ColumnIdentifier
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ColumnIdentifier -> ColumnIdentifier -> ColumnIdentifier
<> :: ColumnIdentifier -> ColumnIdentifier -> ColumnIdentifier
$csconcat :: NonEmpty ColumnIdentifier -> ColumnIdentifier
sconcat :: NonEmpty ColumnIdentifier -> ColumnIdentifier
$cstimes :: forall b. Integral b => b -> ColumnIdentifier -> ColumnIdentifier
stimes :: forall b. Integral b => b -> ColumnIdentifier -> ColumnIdentifier
Semigroup)

instance ToSQL ColumnIdentifier where
  toSQL :: ColumnIdentifier -> Builder
toSQL (ColumnIdentifier Text
t) =
    Text -> Builder
TB.text (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> Text
pgFmtIdentifier Text
t

pgFmtIdentifier :: Text -> Text
pgFmtIdentifier :: Text -> Text
pgFmtIdentifier Text
x =
  Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\"\"" (Text -> Text
trimNullChars Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

pgFmtLit :: Text -> Text
pgFmtLit :: Text -> Text
pgFmtLit Text
x =
  let trimmed :: Text
trimmed = Text -> Text
trimNullChars Text
x
      escaped :: Text
escaped = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"''" Text
trimmed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
      slashed :: Text
slashed = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\" Text
escaped
   in if Text
"\\" Text -> Text -> Bool
`T.isInfixOf` Text
escaped
        then Text
"E" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
slashed
        else Text
slashed

trimNullChars :: Text -> Text
trimNullChars :: Text -> Text
trimNullChars = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x0')

newtype TableName = TableName {TableName -> Text
getTableTxt :: Text}
  deriving stock (Typeable TableName
Typeable TableName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TableName -> c TableName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TableName)
-> (TableName -> Constr)
-> (TableName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TableName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName))
-> ((forall b. Data b => b -> b) -> TableName -> TableName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TableName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TableName -> r)
-> (forall u. (forall d. Data d => d -> u) -> TableName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TableName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TableName -> m TableName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TableName -> m TableName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TableName -> m TableName)
-> Data TableName
TableName -> Constr
TableName -> DataType
(forall b. Data b => b -> b) -> TableName -> TableName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TableName -> u
forall u. (forall d. Data d => d -> u) -> TableName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableName -> c TableName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableName -> c TableName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableName -> c TableName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableName
$ctoConstr :: TableName -> Constr
toConstr :: TableName -> Constr
$cdataTypeOf :: TableName -> DataType
dataTypeOf :: TableName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName)
$cgmapT :: (forall b. Data b => b -> b) -> TableName -> TableName
gmapT :: (forall b. Data b => b -> b) -> TableName -> TableName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
Data, TableName -> TableName -> Bool
(TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool) -> Eq TableName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableName -> TableName -> Bool
== :: TableName -> TableName -> Bool
$c/= :: TableName -> TableName -> Bool
/= :: TableName -> TableName -> Bool
Eq, (forall x. TableName -> Rep TableName x)
-> (forall x. Rep TableName x -> TableName) -> Generic TableName
forall x. Rep TableName x -> TableName
forall x. TableName -> Rep TableName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableName -> Rep TableName x
from :: forall x. TableName -> Rep TableName x
$cto :: forall x. Rep TableName x -> TableName
to :: forall x. Rep TableName x -> TableName
Generic, Eq TableName
Eq TableName
-> (TableName -> TableName -> Ordering)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> TableName)
-> (TableName -> TableName -> TableName)
-> Ord TableName
TableName -> TableName -> Bool
TableName -> TableName -> Ordering
TableName -> TableName -> TableName
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 :: TableName -> TableName -> Ordering
compare :: TableName -> TableName -> Ordering
$c< :: TableName -> TableName -> Bool
< :: TableName -> TableName -> Bool
$c<= :: TableName -> TableName -> Bool
<= :: TableName -> TableName -> Bool
$c> :: TableName -> TableName -> Bool
> :: TableName -> TableName -> Bool
$c>= :: TableName -> TableName -> Bool
>= :: TableName -> TableName -> Bool
$cmax :: TableName -> TableName -> TableName
max :: TableName -> TableName -> TableName
$cmin :: TableName -> TableName -> TableName
min :: TableName -> TableName -> TableName
Ord, Int -> TableName -> ShowS
[TableName] -> ShowS
TableName -> String
(Int -> TableName -> ShowS)
-> (TableName -> String)
-> ([TableName] -> ShowS)
-> Show TableName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableName -> ShowS
showsPrec :: Int -> TableName -> ShowS
$cshow :: TableName -> String
show :: TableName -> String
$cshowList :: [TableName] -> ShowS
showList :: [TableName] -> ShowS
Show)
  deriving newtype (Value -> Parser [TableName]
Value -> Parser TableName
(Value -> Parser TableName)
-> (Value -> Parser [TableName]) -> FromJSON TableName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TableName
parseJSON :: Value -> Parser TableName
$cparseJSONList :: Value -> Parser [TableName]
parseJSONList :: Value -> Parser [TableName]
FromJSON, [TableName] -> Value
[TableName] -> Encoding
TableName -> Value
TableName -> Encoding
(TableName -> Value)
-> (TableName -> Encoding)
-> ([TableName] -> Value)
-> ([TableName] -> Encoding)
-> ToJSON TableName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TableName -> Value
toJSON :: TableName -> Value
$ctoEncoding :: TableName -> Encoding
toEncoding :: TableName -> Encoding
$ctoJSONList :: [TableName] -> Value
toJSONList :: [TableName] -> Value
$ctoEncodingList :: [TableName] -> Encoding
toEncodingList :: [TableName] -> Encoding
ToJSON, Eq TableName
Eq TableName
-> (Int -> TableName -> Int)
-> (TableName -> Int)
-> Hashable TableName
Int -> TableName -> Int
TableName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TableName -> Int
hashWithSalt :: Int -> TableName -> Int
$chash :: TableName -> Int
hash :: TableName -> Int
Hashable, TableName -> PrepArg
(TableName -> PrepArg) -> ToPrepArg TableName
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: TableName -> PrepArg
toPrepVal :: TableName -> PrepArg
PG.ToPrepArg, Maybe ByteString -> Either Text TableName
(Maybe ByteString -> Either Text TableName) -> FromCol TableName
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text TableName
fromCol :: Maybe ByteString -> Either Text TableName
PG.FromCol, TableName -> ()
(TableName -> ()) -> NFData TableName
forall a. (a -> ()) -> NFData a
$crnf :: TableName -> ()
rnf :: TableName -> ()
NFData, String -> TableName
(String -> TableName) -> IsString TableName
forall a. (String -> a) -> IsString a
$cfromString :: String -> TableName
fromString :: String -> TableName
IsString)

instance HasCodec TableName where
  codec :: JSONCodec TableName
codec = (Text -> TableName)
-> (TableName -> Text)
-> Codec Value Text Text
-> JSONCodec TableName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> TableName
TableName TableName -> Text
getTableTxt Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance IsIdentifier TableName where
  toIdentifier :: TableName -> Identifier
toIdentifier (TableName Text
t) = Text -> Identifier
Identifier Text
t

instance ToTxt TableName where
  toTxt :: TableName -> Text
toTxt (TableName Text
t) = Text
t

instance ToSQL TableName where
  toSQL :: TableName -> Builder
toSQL = Identifier -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Identifier -> Builder)
-> (TableName -> Identifier) -> TableName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier

data TableType
  = TTBaseTable
  | TTView
  | TTForeignTable
  | TTLocalTemporary
  deriving (TableType -> TableType -> Bool
(TableType -> TableType -> Bool)
-> (TableType -> TableType -> Bool) -> Eq TableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableType -> TableType -> Bool
== :: TableType -> TableType -> Bool
$c/= :: TableType -> TableType -> Bool
/= :: TableType -> TableType -> Bool
Eq)

instance PG.FromCol TableType where
  fromCol :: Maybe ByteString -> Either Text TableType
fromCol Maybe ByteString
bs = (Value TableType -> Maybe ByteString -> Either Text TableType)
-> Maybe ByteString -> Value TableType -> Either Text TableType
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value TableType -> Maybe ByteString -> Either Text TableType
forall a. Value a -> Maybe ByteString -> Either Text a
PG.fromColHelper Maybe ByteString
bs
    (Value TableType -> Either Text TableType)
-> Value TableType -> Either Text TableType
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe TableType) -> Value TableType
forall a. (Text -> Maybe a) -> Value a
PD.enum
    ((Text -> Maybe TableType) -> Value TableType)
-> (Text -> Maybe TableType) -> Value TableType
forall a b. (a -> b) -> a -> b
$ \case
      Text
"BASE TABLE" -> TableType -> Maybe TableType
forall a. a -> Maybe a
Just TableType
TTBaseTable
      Text
"VIEW" -> TableType -> Maybe TableType
forall a. a -> Maybe a
Just TableType
TTView
      Text
"FOREIGN TABLE" -> TableType -> Maybe TableType
forall a. a -> Maybe a
Just TableType
TTForeignTable
      Text
"LOCAL TEMPORARY" -> TableType -> Maybe TableType
forall a. a -> Maybe a
Just TableType
TTLocalTemporary
      Text
_ -> Maybe TableType
forall a. Maybe a
Nothing

isView :: TableType -> Bool
isView :: TableType -> Bool
isView TableType
TTView = Bool
True
isView TableType
_ = Bool
False

newtype ConstraintName = ConstraintName {ConstraintName -> Text
getConstraintTxt :: Text}
  deriving stock (ConstraintName -> ConstraintName -> Bool
(ConstraintName -> ConstraintName -> Bool)
-> (ConstraintName -> ConstraintName -> Bool) -> Eq ConstraintName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstraintName -> ConstraintName -> Bool
== :: ConstraintName -> ConstraintName -> Bool
$c/= :: ConstraintName -> ConstraintName -> Bool
/= :: ConstraintName -> ConstraintName -> Bool
Eq, Eq ConstraintName
Eq ConstraintName
-> (ConstraintName -> ConstraintName -> Ordering)
-> (ConstraintName -> ConstraintName -> Bool)
-> (ConstraintName -> ConstraintName -> Bool)
-> (ConstraintName -> ConstraintName -> Bool)
-> (ConstraintName -> ConstraintName -> Bool)
-> (ConstraintName -> ConstraintName -> ConstraintName)
-> (ConstraintName -> ConstraintName -> ConstraintName)
-> Ord ConstraintName
ConstraintName -> ConstraintName -> Bool
ConstraintName -> ConstraintName -> Ordering
ConstraintName -> ConstraintName -> ConstraintName
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 :: ConstraintName -> ConstraintName -> Ordering
compare :: ConstraintName -> ConstraintName -> Ordering
$c< :: ConstraintName -> ConstraintName -> Bool
< :: ConstraintName -> ConstraintName -> Bool
$c<= :: ConstraintName -> ConstraintName -> Bool
<= :: ConstraintName -> ConstraintName -> Bool
$c> :: ConstraintName -> ConstraintName -> Bool
> :: ConstraintName -> ConstraintName -> Bool
$c>= :: ConstraintName -> ConstraintName -> Bool
>= :: ConstraintName -> ConstraintName -> Bool
$cmax :: ConstraintName -> ConstraintName -> ConstraintName
max :: ConstraintName -> ConstraintName -> ConstraintName
$cmin :: ConstraintName -> ConstraintName -> ConstraintName
min :: ConstraintName -> ConstraintName -> ConstraintName
Ord, Int -> ConstraintName -> ShowS
[ConstraintName] -> ShowS
ConstraintName -> String
(Int -> ConstraintName -> ShowS)
-> (ConstraintName -> String)
-> ([ConstraintName] -> ShowS)
-> Show ConstraintName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstraintName -> ShowS
showsPrec :: Int -> ConstraintName -> ShowS
$cshow :: ConstraintName -> String
show :: ConstraintName -> String
$cshowList :: [ConstraintName] -> ShowS
showList :: [ConstraintName] -> ShowS
Show)
  deriving newtype (Eq ConstraintName
Eq ConstraintName
-> (Int -> ConstraintName -> Int)
-> (ConstraintName -> Int)
-> Hashable ConstraintName
Int -> ConstraintName -> Int
ConstraintName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ConstraintName -> Int
hashWithSalt :: Int -> ConstraintName -> Int
$chash :: ConstraintName -> Int
hash :: ConstraintName -> Int
Hashable, ConstraintName -> ()
(ConstraintName -> ()) -> NFData ConstraintName
forall a. (a -> ()) -> NFData a
$crnf :: ConstraintName -> ()
rnf :: ConstraintName -> ()
NFData, ConstraintName -> Text
(ConstraintName -> Text) -> ToTxt ConstraintName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ConstraintName -> Text
toTxt :: ConstraintName -> Text
ToTxt, ConstraintName -> PrepArg
(ConstraintName -> PrepArg) -> ToPrepArg ConstraintName
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: ConstraintName -> PrepArg
toPrepVal :: ConstraintName -> PrepArg
PG.ToPrepArg, Maybe ByteString -> Either Text ConstraintName
(Maybe ByteString -> Either Text ConstraintName)
-> FromCol ConstraintName
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text ConstraintName
fromCol :: Maybe ByteString -> Either Text ConstraintName
PG.FromCol)
  deriving newtype (Value -> Parser [ConstraintName]
Value -> Parser ConstraintName
(Value -> Parser ConstraintName)
-> (Value -> Parser [ConstraintName]) -> FromJSON ConstraintName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConstraintName
parseJSON :: Value -> Parser ConstraintName
$cparseJSONList :: Value -> Parser [ConstraintName]
parseJSONList :: Value -> Parser [ConstraintName]
FromJSON, FromJSONKeyFunction [ConstraintName]
FromJSONKeyFunction ConstraintName
FromJSONKeyFunction ConstraintName
-> FromJSONKeyFunction [ConstraintName]
-> FromJSONKey ConstraintName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction ConstraintName
fromJSONKey :: FromJSONKeyFunction ConstraintName
$cfromJSONKeyList :: FromJSONKeyFunction [ConstraintName]
fromJSONKeyList :: FromJSONKeyFunction [ConstraintName]
FromJSONKey, [ConstraintName] -> Value
[ConstraintName] -> Encoding
ConstraintName -> Value
ConstraintName -> Encoding
(ConstraintName -> Value)
-> (ConstraintName -> Encoding)
-> ([ConstraintName] -> Value)
-> ([ConstraintName] -> Encoding)
-> ToJSON ConstraintName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConstraintName -> Value
toJSON :: ConstraintName -> Value
$ctoEncoding :: ConstraintName -> Encoding
toEncoding :: ConstraintName -> Encoding
$ctoJSONList :: [ConstraintName] -> Value
toJSONList :: [ConstraintName] -> Value
$ctoEncodingList :: [ConstraintName] -> Encoding
toEncodingList :: [ConstraintName] -> Encoding
ToJSON, ToJSONKeyFunction [ConstraintName]
ToJSONKeyFunction ConstraintName
ToJSONKeyFunction ConstraintName
-> ToJSONKeyFunction [ConstraintName] -> ToJSONKey ConstraintName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ConstraintName
toJSONKey :: ToJSONKeyFunction ConstraintName
$ctoJSONKeyList :: ToJSONKeyFunction [ConstraintName]
toJSONKeyList :: ToJSONKeyFunction [ConstraintName]
ToJSONKey)

instance IsIdentifier ConstraintName where
  toIdentifier :: ConstraintName -> Identifier
toIdentifier (ConstraintName Text
t) = Text -> Identifier
Identifier Text
t

instance ToSQL ConstraintName where
  toSQL :: ConstraintName -> Builder
toSQL = Identifier -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Identifier -> Builder)
-> (ConstraintName -> Identifier) -> ConstraintName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintName -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier

instance ToErrorValue ConstraintName where
  toErrorValue :: ConstraintName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (ConstraintName -> Text) -> ConstraintName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintName -> Text
getConstraintTxt

newtype FunctionName = FunctionName {FunctionName -> Text
getFunctionTxt :: Text}
  deriving stock (Typeable FunctionName
Typeable FunctionName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FunctionName -> c FunctionName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionName)
-> (FunctionName -> Constr)
-> (FunctionName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionName))
-> ((forall b. Data b => b -> b) -> FunctionName -> FunctionName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionName -> r)
-> (forall u. (forall d. Data d => d -> u) -> FunctionName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> Data FunctionName
FunctionName -> Constr
FunctionName -> DataType
(forall b. Data b => b -> b) -> FunctionName -> FunctionName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
$ctoConstr :: FunctionName -> Constr
toConstr :: FunctionName -> Constr
$cdataTypeOf :: FunctionName -> DataType
dataTypeOf :: FunctionName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
$cgmapT :: (forall b. Data b => b -> b) -> FunctionName -> FunctionName
gmapT :: (forall b. Data b => b -> b) -> FunctionName -> FunctionName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
Data, FunctionName -> FunctionName -> Bool
(FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool) -> Eq FunctionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionName -> FunctionName -> Bool
== :: FunctionName -> FunctionName -> Bool
$c/= :: FunctionName -> FunctionName -> Bool
/= :: FunctionName -> FunctionName -> Bool
Eq, (forall x. FunctionName -> Rep FunctionName x)
-> (forall x. Rep FunctionName x -> FunctionName)
-> Generic FunctionName
forall x. Rep FunctionName x -> FunctionName
forall x. FunctionName -> Rep FunctionName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionName -> Rep FunctionName x
from :: forall x. FunctionName -> Rep FunctionName x
$cto :: forall x. Rep FunctionName x -> FunctionName
to :: forall x. Rep FunctionName x -> FunctionName
Generic, Eq FunctionName
Eq FunctionName
-> (FunctionName -> FunctionName -> Ordering)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> FunctionName)
-> (FunctionName -> FunctionName -> FunctionName)
-> Ord FunctionName
FunctionName -> FunctionName -> Bool
FunctionName -> FunctionName -> Ordering
FunctionName -> FunctionName -> FunctionName
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 :: FunctionName -> FunctionName -> Ordering
compare :: FunctionName -> FunctionName -> Ordering
$c< :: FunctionName -> FunctionName -> Bool
< :: FunctionName -> FunctionName -> Bool
$c<= :: FunctionName -> FunctionName -> Bool
<= :: FunctionName -> FunctionName -> Bool
$c> :: FunctionName -> FunctionName -> Bool
> :: FunctionName -> FunctionName -> Bool
$c>= :: FunctionName -> FunctionName -> Bool
>= :: FunctionName -> FunctionName -> Bool
$cmax :: FunctionName -> FunctionName -> FunctionName
max :: FunctionName -> FunctionName -> FunctionName
$cmin :: FunctionName -> FunctionName -> FunctionName
min :: FunctionName -> FunctionName -> FunctionName
Ord, Int -> FunctionName -> ShowS
[FunctionName] -> ShowS
FunctionName -> String
(Int -> FunctionName -> ShowS)
-> (FunctionName -> String)
-> ([FunctionName] -> ShowS)
-> Show FunctionName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionName -> ShowS
showsPrec :: Int -> FunctionName -> ShowS
$cshow :: FunctionName -> String
show :: FunctionName -> String
$cshowList :: [FunctionName] -> ShowS
showList :: [FunctionName] -> ShowS
Show)
  deriving newtype (Value -> Parser [FunctionName]
Value -> Parser FunctionName
(Value -> Parser FunctionName)
-> (Value -> Parser [FunctionName]) -> FromJSON FunctionName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FunctionName
parseJSON :: Value -> Parser FunctionName
$cparseJSONList :: Value -> Parser [FunctionName]
parseJSONList :: Value -> Parser [FunctionName]
FromJSON, [FunctionName] -> Value
[FunctionName] -> Encoding
FunctionName -> Value
FunctionName -> Encoding
(FunctionName -> Value)
-> (FunctionName -> Encoding)
-> ([FunctionName] -> Value)
-> ([FunctionName] -> Encoding)
-> ToJSON FunctionName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FunctionName -> Value
toJSON :: FunctionName -> Value
$ctoEncoding :: FunctionName -> Encoding
toEncoding :: FunctionName -> Encoding
$ctoJSONList :: [FunctionName] -> Value
toJSONList :: [FunctionName] -> Value
$ctoEncodingList :: [FunctionName] -> Encoding
toEncodingList :: [FunctionName] -> Encoding
ToJSON, FunctionName -> PrepArg
(FunctionName -> PrepArg) -> ToPrepArg FunctionName
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: FunctionName -> PrepArg
toPrepVal :: FunctionName -> PrepArg
PG.ToPrepArg, Maybe ByteString -> Either Text FunctionName
(Maybe ByteString -> Either Text FunctionName)
-> FromCol FunctionName
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text FunctionName
fromCol :: Maybe ByteString -> Either Text FunctionName
PG.FromCol, Eq FunctionName
Eq FunctionName
-> (Int -> FunctionName -> Int)
-> (FunctionName -> Int)
-> Hashable FunctionName
Int -> FunctionName -> Int
FunctionName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FunctionName -> Int
hashWithSalt :: Int -> FunctionName -> Int
$chash :: FunctionName -> Int
hash :: FunctionName -> Int
Hashable, FunctionName -> ()
(FunctionName -> ()) -> NFData FunctionName
forall a. (a -> ()) -> NFData a
$crnf :: FunctionName -> ()
rnf :: FunctionName -> ()
NFData)

instance HasCodec FunctionName where
  codec :: JSONCodec FunctionName
codec = (Text -> FunctionName)
-> (FunctionName -> Text)
-> Codec Value Text Text
-> JSONCodec FunctionName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> FunctionName
FunctionName FunctionName -> Text
getFunctionTxt Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance IsIdentifier FunctionName where
  toIdentifier :: FunctionName -> Identifier
toIdentifier (FunctionName Text
t) = Text -> Identifier
Identifier Text
t

instance ToSQL FunctionName where
  toSQL :: FunctionName -> Builder
toSQL = Identifier -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Identifier -> Builder)
-> (FunctionName -> Identifier) -> FunctionName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier

instance ToTxt FunctionName where
  toTxt :: FunctionName -> Text
toTxt = FunctionName -> Text
getFunctionTxt

instance ToErrorValue FunctionName where
  toErrorValue :: FunctionName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (FunctionName -> Text) -> FunctionName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Text
getFunctionTxt

newtype SchemaName = SchemaName {SchemaName -> Text
getSchemaTxt :: Text}
  deriving stock (Typeable SchemaName
Typeable SchemaName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SchemaName -> c SchemaName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SchemaName)
-> (SchemaName -> Constr)
-> (SchemaName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SchemaName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SchemaName))
-> ((forall b. Data b => b -> b) -> SchemaName -> SchemaName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemaName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemaName -> r)
-> (forall u. (forall d. Data d => d -> u) -> SchemaName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SchemaName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SchemaName -> m SchemaName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemaName -> m SchemaName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemaName -> m SchemaName)
-> Data SchemaName
SchemaName -> Constr
SchemaName -> DataType
(forall b. Data b => b -> b) -> SchemaName -> SchemaName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SchemaName -> u
forall u. (forall d. Data d => d -> u) -> SchemaName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemaName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemaName -> c SchemaName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemaName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SchemaName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemaName -> c SchemaName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemaName -> c SchemaName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemaName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemaName
$ctoConstr :: SchemaName -> Constr
toConstr :: SchemaName -> Constr
$cdataTypeOf :: SchemaName -> DataType
dataTypeOf :: SchemaName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemaName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemaName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SchemaName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SchemaName)
$cgmapT :: (forall b. Data b => b -> b) -> SchemaName -> SchemaName
gmapT :: (forall b. Data b => b -> b) -> SchemaName -> SchemaName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SchemaName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SchemaName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SchemaName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SchemaName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
Data, SchemaName -> SchemaName -> Bool
(SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool) -> Eq SchemaName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaName -> SchemaName -> Bool
== :: SchemaName -> SchemaName -> Bool
$c/= :: SchemaName -> SchemaName -> Bool
/= :: SchemaName -> SchemaName -> Bool
Eq, (forall x. SchemaName -> Rep SchemaName x)
-> (forall x. Rep SchemaName x -> SchemaName) -> Generic SchemaName
forall x. Rep SchemaName x -> SchemaName
forall x. SchemaName -> Rep SchemaName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaName -> Rep SchemaName x
from :: forall x. SchemaName -> Rep SchemaName x
$cto :: forall x. Rep SchemaName x -> SchemaName
to :: forall x. Rep SchemaName x -> SchemaName
Generic, Eq SchemaName
Eq SchemaName
-> (SchemaName -> SchemaName -> Ordering)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> SchemaName)
-> (SchemaName -> SchemaName -> SchemaName)
-> Ord SchemaName
SchemaName -> SchemaName -> Bool
SchemaName -> SchemaName -> Ordering
SchemaName -> SchemaName -> SchemaName
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 :: SchemaName -> SchemaName -> Ordering
compare :: SchemaName -> SchemaName -> Ordering
$c< :: SchemaName -> SchemaName -> Bool
< :: SchemaName -> SchemaName -> Bool
$c<= :: SchemaName -> SchemaName -> Bool
<= :: SchemaName -> SchemaName -> Bool
$c> :: SchemaName -> SchemaName -> Bool
> :: SchemaName -> SchemaName -> Bool
$c>= :: SchemaName -> SchemaName -> Bool
>= :: SchemaName -> SchemaName -> Bool
$cmax :: SchemaName -> SchemaName -> SchemaName
max :: SchemaName -> SchemaName -> SchemaName
$cmin :: SchemaName -> SchemaName -> SchemaName
min :: SchemaName -> SchemaName -> SchemaName
Ord, Int -> SchemaName -> ShowS
[SchemaName] -> ShowS
SchemaName -> String
(Int -> SchemaName -> ShowS)
-> (SchemaName -> String)
-> ([SchemaName] -> ShowS)
-> Show SchemaName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaName -> ShowS
showsPrec :: Int -> SchemaName -> ShowS
$cshow :: SchemaName -> String
show :: SchemaName -> String
$cshowList :: [SchemaName] -> ShowS
showList :: [SchemaName] -> ShowS
Show)
  deriving newtype (Value -> Parser [SchemaName]
Value -> Parser SchemaName
(Value -> Parser SchemaName)
-> (Value -> Parser [SchemaName]) -> FromJSON SchemaName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SchemaName
parseJSON :: Value -> Parser SchemaName
$cparseJSONList :: Value -> Parser [SchemaName]
parseJSONList :: Value -> Parser [SchemaName]
FromJSON, [SchemaName] -> Value
[SchemaName] -> Encoding
SchemaName -> Value
SchemaName -> Encoding
(SchemaName -> Value)
-> (SchemaName -> Encoding)
-> ([SchemaName] -> Value)
-> ([SchemaName] -> Encoding)
-> ToJSON SchemaName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SchemaName -> Value
toJSON :: SchemaName -> Value
$ctoEncoding :: SchemaName -> Encoding
toEncoding :: SchemaName -> Encoding
$ctoJSONList :: [SchemaName] -> Value
toJSONList :: [SchemaName] -> Value
$ctoEncodingList :: [SchemaName] -> Encoding
toEncodingList :: [SchemaName] -> Encoding
ToJSON, Eq SchemaName
Eq SchemaName
-> (Int -> SchemaName -> Int)
-> (SchemaName -> Int)
-> Hashable SchemaName
Int -> SchemaName -> Int
SchemaName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SchemaName -> Int
hashWithSalt :: Int -> SchemaName -> Int
$chash :: SchemaName -> Int
hash :: SchemaName -> Int
Hashable, SchemaName -> PrepArg
(SchemaName -> PrepArg) -> ToPrepArg SchemaName
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: SchemaName -> PrepArg
toPrepVal :: SchemaName -> PrepArg
PG.ToPrepArg, Maybe ByteString -> Either Text SchemaName
(Maybe ByteString -> Either Text SchemaName) -> FromCol SchemaName
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text SchemaName
fromCol :: Maybe ByteString -> Either Text SchemaName
PG.FromCol, SchemaName -> ()
(SchemaName -> ()) -> NFData SchemaName
forall a. (a -> ()) -> NFData a
$crnf :: SchemaName -> ()
rnf :: SchemaName -> ()
NFData, String -> SchemaName
(String -> SchemaName) -> IsString SchemaName
forall a. (String -> a) -> IsString a
$cfromString :: String -> SchemaName
fromString :: String -> SchemaName
IsString)

instance HasCodec SchemaName where
  codec :: JSONCodec SchemaName
codec = (Text -> SchemaName)
-> (SchemaName -> Text)
-> Codec Value Text Text
-> JSONCodec SchemaName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> SchemaName
SchemaName SchemaName -> Text
getSchemaTxt Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

publicSchema :: SchemaName
publicSchema :: SchemaName
publicSchema = Text -> SchemaName
SchemaName Text
"public"

hdbCatalogSchema :: SchemaName
hdbCatalogSchema :: SchemaName
hdbCatalogSchema = Text -> SchemaName
SchemaName Text
"hdb_catalog"

instance IsIdentifier SchemaName where
  toIdentifier :: SchemaName -> Identifier
toIdentifier (SchemaName Text
t) = Text -> Identifier
Identifier Text
t

instance ToSQL SchemaName where
  toSQL :: SchemaName -> Builder
toSQL = Identifier -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Identifier -> Builder)
-> (SchemaName -> Identifier) -> SchemaName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaName -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier

data QualifiedObject a = QualifiedObject
  { forall a. QualifiedObject a -> SchemaName
qSchema :: SchemaName,
    forall a. QualifiedObject a -> a
qName :: a
  }
  deriving (Int -> QualifiedObject a -> ShowS
[QualifiedObject a] -> ShowS
QualifiedObject a -> String
(Int -> QualifiedObject a -> ShowS)
-> (QualifiedObject a -> String)
-> ([QualifiedObject a] -> ShowS)
-> Show (QualifiedObject a)
forall a. Show a => Int -> QualifiedObject a -> ShowS
forall a. Show a => [QualifiedObject a] -> ShowS
forall a. Show a => QualifiedObject a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> QualifiedObject a -> ShowS
showsPrec :: Int -> QualifiedObject a -> ShowS
$cshow :: forall a. Show a => QualifiedObject a -> String
show :: QualifiedObject a -> String
$cshowList :: forall a. Show a => [QualifiedObject a] -> ShowS
showList :: [QualifiedObject a] -> ShowS
Show, QualifiedObject a -> QualifiedObject a -> Bool
(QualifiedObject a -> QualifiedObject a -> Bool)
-> (QualifiedObject a -> QualifiedObject a -> Bool)
-> Eq (QualifiedObject a)
forall a. Eq a => QualifiedObject a -> QualifiedObject a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => QualifiedObject a -> QualifiedObject a -> Bool
== :: QualifiedObject a -> QualifiedObject a -> Bool
$c/= :: forall a. Eq a => QualifiedObject a -> QualifiedObject a -> Bool
/= :: QualifiedObject a -> QualifiedObject a -> Bool
Eq, (forall a b. (a -> b) -> QualifiedObject a -> QualifiedObject b)
-> (forall a b. a -> QualifiedObject b -> QualifiedObject a)
-> Functor QualifiedObject
forall a b. a -> QualifiedObject b -> QualifiedObject a
forall a b. (a -> b) -> QualifiedObject a -> QualifiedObject b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> QualifiedObject a -> QualifiedObject b
fmap :: forall a b. (a -> b) -> QualifiedObject a -> QualifiedObject b
$c<$ :: forall a b. a -> QualifiedObject b -> QualifiedObject a
<$ :: forall a b. a -> QualifiedObject b -> QualifiedObject a
Functor, Eq (QualifiedObject a)
Eq (QualifiedObject a)
-> (QualifiedObject a -> QualifiedObject a -> Ordering)
-> (QualifiedObject a -> QualifiedObject a -> Bool)
-> (QualifiedObject a -> QualifiedObject a -> Bool)
-> (QualifiedObject a -> QualifiedObject a -> Bool)
-> (QualifiedObject a -> QualifiedObject a -> Bool)
-> (QualifiedObject a -> QualifiedObject a -> QualifiedObject a)
-> (QualifiedObject a -> QualifiedObject a -> QualifiedObject a)
-> Ord (QualifiedObject a)
QualifiedObject a -> QualifiedObject a -> Bool
QualifiedObject a -> QualifiedObject a -> Ordering
QualifiedObject a -> QualifiedObject a -> QualifiedObject a
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
forall {a}. Ord a => Eq (QualifiedObject a)
forall a. Ord a => QualifiedObject a -> QualifiedObject a -> Bool
forall a.
Ord a =>
QualifiedObject a -> QualifiedObject a -> Ordering
forall a.
Ord a =>
QualifiedObject a -> QualifiedObject a -> QualifiedObject a
$ccompare :: forall a.
Ord a =>
QualifiedObject a -> QualifiedObject a -> Ordering
compare :: QualifiedObject a -> QualifiedObject a -> Ordering
$c< :: forall a. Ord a => QualifiedObject a -> QualifiedObject a -> Bool
< :: QualifiedObject a -> QualifiedObject a -> Bool
$c<= :: forall a. Ord a => QualifiedObject a -> QualifiedObject a -> Bool
<= :: QualifiedObject a -> QualifiedObject a -> Bool
$c> :: forall a. Ord a => QualifiedObject a -> QualifiedObject a -> Bool
> :: QualifiedObject a -> QualifiedObject a -> Bool
$c>= :: forall a. Ord a => QualifiedObject a -> QualifiedObject a -> Bool
>= :: QualifiedObject a -> QualifiedObject a -> Bool
$cmax :: forall a.
Ord a =>
QualifiedObject a -> QualifiedObject a -> QualifiedObject a
max :: QualifiedObject a -> QualifiedObject a -> QualifiedObject a
$cmin :: forall a.
Ord a =>
QualifiedObject a -> QualifiedObject a -> QualifiedObject a
min :: QualifiedObject a -> QualifiedObject a -> QualifiedObject a
Ord, (forall x. QualifiedObject a -> Rep (QualifiedObject a) x)
-> (forall x. Rep (QualifiedObject a) x -> QualifiedObject a)
-> Generic (QualifiedObject a)
forall x. Rep (QualifiedObject a) x -> QualifiedObject a
forall x. QualifiedObject a -> Rep (QualifiedObject a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (QualifiedObject a) x -> QualifiedObject a
forall a x. QualifiedObject a -> Rep (QualifiedObject a) x
$cfrom :: forall a x. QualifiedObject a -> Rep (QualifiedObject a) x
from :: forall x. QualifiedObject a -> Rep (QualifiedObject a) x
$cto :: forall a x. Rep (QualifiedObject a) x -> QualifiedObject a
to :: forall x. Rep (QualifiedObject a) x -> QualifiedObject a
Generic, Typeable (QualifiedObject a)
Typeable (QualifiedObject a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> QualifiedObject a
    -> c (QualifiedObject a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (QualifiedObject a))
-> (QualifiedObject a -> Constr)
-> (QualifiedObject a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (QualifiedObject a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (QualifiedObject a)))
-> ((forall b. Data b => b -> b)
    -> QualifiedObject a -> QualifiedObject a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> QualifiedObject a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> QualifiedObject a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> QualifiedObject a -> m (QualifiedObject a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> QualifiedObject a -> m (QualifiedObject a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> QualifiedObject a -> m (QualifiedObject a))
-> Data (QualifiedObject a)
QualifiedObject a -> Constr
QualifiedObject a -> DataType
(forall b. Data b => b -> b)
-> QualifiedObject a -> QualifiedObject a
forall {a}. Data a => Typeable (QualifiedObject a)
forall a. Data a => QualifiedObject a -> Constr
forall a. Data a => QualifiedObject a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b)
-> QualifiedObject a -> QualifiedObject a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> QualifiedObject a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> QualifiedObject a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QualifiedObject a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> QualifiedObject a
-> c (QualifiedObject a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (QualifiedObject a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QualifiedObject a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> QualifiedObject a -> u
forall u. (forall d. Data d => d -> u) -> QualifiedObject a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QualifiedObject a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> QualifiedObject a
-> c (QualifiedObject a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (QualifiedObject a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QualifiedObject a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> QualifiedObject a
-> c (QualifiedObject a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> QualifiedObject a
-> c (QualifiedObject a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QualifiedObject a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QualifiedObject a)
$ctoConstr :: forall a. Data a => QualifiedObject a -> Constr
toConstr :: QualifiedObject a -> Constr
$cdataTypeOf :: forall a. Data a => QualifiedObject a -> DataType
dataTypeOf :: QualifiedObject a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (QualifiedObject a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (QualifiedObject a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QualifiedObject a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QualifiedObject a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b)
-> QualifiedObject a -> QualifiedObject a
gmapT :: (forall b. Data b => b -> b)
-> QualifiedObject a -> QualifiedObject a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QualifiedObject a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> QualifiedObject a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> QualifiedObject a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> QualifiedObject a -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> QualifiedObject a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QualifiedObject a -> m (QualifiedObject a)
Data)

instance (NFData a) => NFData (QualifiedObject a)

instance (HasCodec a, Typeable a) => HasCodec (QualifiedObject a) where
  codec :: JSONCodec (QualifiedObject a)
codec = JSONCodec (QualifiedObject a)
-> Codec Value a (QualifiedObject a)
-> JSONCodec (QualifiedObject a)
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative JSONCodec (QualifiedObject a)
objCodec Codec Value a (QualifiedObject a)
strCodec
    where
      objCodec :: JSONCodec (QualifiedObject a)
objCodec =
        Text
-> ObjectCodec (QualifiedObject a) (QualifiedObject a)
-> JSONCodec (QualifiedObject a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"PostgresQualified_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @a)
          (ObjectCodec (QualifiedObject a) (QualifiedObject a)
 -> JSONCodec (QualifiedObject a))
-> ObjectCodec (QualifiedObject a) (QualifiedObject a)
-> JSONCodec (QualifiedObject a)
forall a b. (a -> b) -> a -> b
$ SchemaName -> a -> QualifiedObject a
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject
          (SchemaName -> a -> QualifiedObject a)
-> Codec Object (QualifiedObject a) SchemaName
-> Codec Object (QualifiedObject a) (a -> QualifiedObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SchemaName -> ObjectCodec SchemaName SchemaName
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"schema" SchemaName
publicSchema
          ObjectCodec SchemaName SchemaName
-> (QualifiedObject a -> SchemaName)
-> Codec Object (QualifiedObject a) SchemaName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= QualifiedObject a -> SchemaName
forall a. QualifiedObject a -> SchemaName
qSchema
            Codec Object (QualifiedObject a) (a -> QualifiedObject a)
-> Codec Object (QualifiedObject a) a
-> ObjectCodec (QualifiedObject a) (QualifiedObject a)
forall a b.
Codec Object (QualifiedObject a) (a -> b)
-> Codec Object (QualifiedObject a) a
-> Codec Object (QualifiedObject a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec a a
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
          ObjectCodec a a
-> (QualifiedObject a -> a) -> Codec Object (QualifiedObject a) a
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= QualifiedObject a -> a
forall a. QualifiedObject a -> a
qName
      strCodec :: Codec Value a (QualifiedObject a)
strCodec = SchemaName -> a -> QualifiedObject a
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject SchemaName
publicSchema (a -> QualifiedObject a)
-> Codec Value a a -> Codec Value a (QualifiedObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall value. HasCodec value => JSONCodec value
codec @a

instance (FromJSON a) => FromJSON (QualifiedObject a) where
  parseJSON :: Value -> Parser (QualifiedObject a)
parseJSON v :: Value
v@(String Text
_) =
    SchemaName -> a -> QualifiedObject a
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject SchemaName
publicSchema (a -> QualifiedObject a) -> Parser a -> Parser (QualifiedObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON (Object Object
o) =
    SchemaName -> a -> QualifiedObject a
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject
      (SchemaName -> a -> QualifiedObject a)
-> Parser SchemaName -> Parser (a -> QualifiedObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe SchemaName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schema"
      Parser (Maybe SchemaName) -> SchemaName -> Parser SchemaName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SchemaName
publicSchema
      Parser (a -> QualifiedObject a)
-> Parser a -> Parser (QualifiedObject a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
  parseJSON Value
_ =
    String -> Parser (QualifiedObject a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting a string/object for QualifiedObject"

instance (ToJSON a) => ToJSON (QualifiedObject a) where
  toJSON :: QualifiedObject a -> Value
toJSON (QualifiedObject SchemaName
sn a
o) =
    [Pair] -> Value
object
      [ Key
"schema" Key -> SchemaName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SchemaName
sn,
        Key
"name" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= a
o
      ]

instance (ToJSON a, ToTxt a) => ToJSONKey (QualifiedObject a) where
  toJSONKey :: ToJSONKeyFunction (QualifiedObject a)
toJSONKey = (QualifiedObject a -> Key)
-> (QualifiedObject a -> Encoding' Key)
-> ToJSONKeyFunction (QualifiedObject a)
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText (Text -> Key
K.fromText (Text -> Key)
-> (QualifiedObject a -> Text) -> QualifiedObject a -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedObject a -> Text
forall a. ToTxt a => QualifiedObject a -> Text
qualifiedObjectToText) (Text -> Encoding' Key
forall a. Text -> Encoding' a
text (Text -> Encoding' Key)
-> (QualifiedObject a -> Text)
-> QualifiedObject a
-> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedObject a -> Text
forall a. ToTxt a => QualifiedObject a -> Text
qualifiedObjectToText)

instance (ToTxt a) => ToTxt (QualifiedObject a) where
  toTxt :: QualifiedObject a -> Text
toTxt = QualifiedObject a -> Text
forall a. ToTxt a => QualifiedObject a -> Text
qualifiedObjectToText

instance (ToTxt a) => ToErrorValue (QualifiedObject a) where
  toErrorValue :: QualifiedObject a -> ErrorMessage
toErrorValue (QualifiedObject SchemaName
sn a
o) = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage) -> Text -> ErrorMessage
forall a b. (a -> b) -> a -> b
$ SchemaName -> Text
getSchemaTxt SchemaName
sn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ToTxt a => a -> Text
toTxt a
o

instance (Hashable a) => Hashable (QualifiedObject a)

instance (ToSQL a) => ToSQL (QualifiedObject a) where
  toSQL :: QualifiedObject a -> Builder
toSQL (QualifiedObject SchemaName
sn a
o) =
    SchemaName -> Builder
forall a. ToSQL a => a -> Builder
toSQL SchemaName
sn Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. ToSQL a => a -> Builder
toSQL a
o

qualifiedObjectToText :: (ToTxt a) => QualifiedObject a -> Text
qualifiedObjectToText :: forall a. ToTxt a => QualifiedObject a -> Text
qualifiedObjectToText (QualifiedObject SchemaName
sn a
o)
  | SchemaName
sn SchemaName -> SchemaName -> Bool
forall a. Eq a => a -> a -> Bool
== SchemaName
publicSchema = a -> Text
forall a. ToTxt a => a -> Text
toTxt a
o
  | Bool
otherwise = SchemaName -> Text
getSchemaTxt SchemaName
sn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ToTxt a => a -> Text
toTxt a
o

snakeCaseQualifiedObject :: (ToTxt a) => QualifiedObject a -> Text
snakeCaseQualifiedObject :: forall a. ToTxt a => QualifiedObject a -> Text
snakeCaseQualifiedObject (QualifiedObject SchemaName
sn a
o)
  | SchemaName
sn SchemaName -> SchemaName -> Bool
forall a. Eq a => a -> a -> Bool
== SchemaName
publicSchema = a -> Text
forall a. ToTxt a => a -> Text
toTxt a
o
  | Bool
otherwise = SchemaName -> Text
getSchemaTxt SchemaName
sn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ToTxt a => a -> Text
toTxt a
o

getIdentifierQualifiedObject :: (ToTxt a) => QualifiedObject a -> Either QErr C.GQLNameIdentifier
getIdentifierQualifiedObject :: forall a.
ToTxt a =>
QualifiedObject a -> Either QErr GQLNameIdentifier
getIdentifierQualifiedObject obj :: QualifiedObject a
obj@(QualifiedObject SchemaName
sn a
o) = do
  let tLst :: [Text]
tLst =
        if SchemaName
sn SchemaName -> SchemaName -> Bool
forall a. Eq a => a -> a -> Bool
== SchemaName
publicSchema
          then Text -> [Text]
C.fromSnake (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToTxt a => a -> Text
toTxt a
o
          else Text -> [Text]
C.fromSnake (SchemaName -> Text
getSchemaTxt SchemaName
sn) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
C.fromSnake (a -> Text
forall a. ToTxt a => a -> Text
toTxt a
o)
      gqlIdents :: Maybe GQLNameIdentifier
gqlIdents = do
        (Text
pref, [Text]
suffs) <- [Text] -> Maybe (Text, [Text])
forall a. [a] -> Maybe (a, [a])
uncons [Text]
tLst
        Name
prefName <- Text -> Maybe Name
G.mkName Text
pref
        [NameSuffix]
suffNames <- (Text -> Maybe NameSuffix) -> [Text] -> Maybe [NameSuffix]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Maybe NameSuffix
G.mkNameSuffix [Text]
suffs
        GQLNameIdentifier -> Maybe GQLNameIdentifier
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GQLNameIdentifier -> Maybe GQLNameIdentifier)
-> GQLNameIdentifier -> Maybe GQLNameIdentifier
forall a b. (a -> b) -> a -> b
$ (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple (Name
prefName, [NameSuffix]
suffNames)
  Maybe GQLNameIdentifier
gqlIdents
    Maybe GQLNameIdentifier
-> Either QErr GQLNameIdentifier -> Either QErr GQLNameIdentifier
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> Either QErr GQLNameIdentifier
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
      Code
ValidationFailed
      ( Text
"cannot include "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedObject a
obj
          QualifiedObject a -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the GraphQL schema because "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
C.toSnakeT [Text]
tLst
          Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not a valid GraphQL identifier"
      )

namingConventionSupport :: SupportedNamingCase
namingConventionSupport :: SupportedNamingCase
namingConventionSupport = SupportedNamingCase
AllConventions

qualifiedObjectToName :: (ToTxt a, MonadError QErr m) => QualifiedObject a -> m G.Name
qualifiedObjectToName :: forall a (m :: * -> *).
(ToTxt a, MonadError QErr m) =>
QualifiedObject a -> m Name
qualifiedObjectToName QualifiedObject a
objectName = do
  let textName :: Text
textName = QualifiedObject a -> Text
forall a. ToTxt a => QualifiedObject a -> Text
snakeCaseQualifiedObject QualifiedObject a
objectName
  Maybe Name -> m Name -> m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> Maybe Name
G.mkName Text
textName)
    (m Name -> m Name) -> m Name -> m Name
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed
    (Text -> m Name) -> Text -> m Name
forall a b. (a -> b) -> a -> b
$ Text
"cannot include "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedObject a
objectName
    QualifiedObject a -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the GraphQL schema because "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textName
    Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not a valid GraphQL identifier"

-- | Represents a database table qualified with the schema name.
type QualifiedTable = QualifiedObject TableName

type QualifiedFunction = QualifiedObject FunctionName

newtype PGDescription = PGDescription {PGDescription -> Text
getPGDescription :: Text}
  deriving stock (PGDescription -> PGDescription -> Bool
(PGDescription -> PGDescription -> Bool)
-> (PGDescription -> PGDescription -> Bool) -> Eq PGDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGDescription -> PGDescription -> Bool
== :: PGDescription -> PGDescription -> Bool
$c/= :: PGDescription -> PGDescription -> Bool
/= :: PGDescription -> PGDescription -> Bool
Eq, Eq PGDescription
Eq PGDescription
-> (PGDescription -> PGDescription -> Ordering)
-> (PGDescription -> PGDescription -> Bool)
-> (PGDescription -> PGDescription -> Bool)
-> (PGDescription -> PGDescription -> Bool)
-> (PGDescription -> PGDescription -> Bool)
-> (PGDescription -> PGDescription -> PGDescription)
-> (PGDescription -> PGDescription -> PGDescription)
-> Ord PGDescription
PGDescription -> PGDescription -> Bool
PGDescription -> PGDescription -> Ordering
PGDescription -> PGDescription -> PGDescription
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 :: PGDescription -> PGDescription -> Ordering
compare :: PGDescription -> PGDescription -> Ordering
$c< :: PGDescription -> PGDescription -> Bool
< :: PGDescription -> PGDescription -> Bool
$c<= :: PGDescription -> PGDescription -> Bool
<= :: PGDescription -> PGDescription -> Bool
$c> :: PGDescription -> PGDescription -> Bool
> :: PGDescription -> PGDescription -> Bool
$c>= :: PGDescription -> PGDescription -> Bool
>= :: PGDescription -> PGDescription -> Bool
$cmax :: PGDescription -> PGDescription -> PGDescription
max :: PGDescription -> PGDescription -> PGDescription
$cmin :: PGDescription -> PGDescription -> PGDescription
min :: PGDescription -> PGDescription -> PGDescription
Ord, Int -> PGDescription -> ShowS
[PGDescription] -> ShowS
PGDescription -> String
(Int -> PGDescription -> ShowS)
-> (PGDescription -> String)
-> ([PGDescription] -> ShowS)
-> Show PGDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGDescription -> ShowS
showsPrec :: Int -> PGDescription -> ShowS
$cshow :: PGDescription -> String
show :: PGDescription -> String
$cshowList :: [PGDescription] -> ShowS
showList :: [PGDescription] -> ShowS
Show)
  deriving newtype (Value -> Parser [PGDescription]
Value -> Parser PGDescription
(Value -> Parser PGDescription)
-> (Value -> Parser [PGDescription]) -> FromJSON PGDescription
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PGDescription
parseJSON :: Value -> Parser PGDescription
$cparseJSONList :: Value -> Parser [PGDescription]
parseJSONList :: Value -> Parser [PGDescription]
FromJSON, [PGDescription] -> Value
[PGDescription] -> Encoding
PGDescription -> Value
PGDescription -> Encoding
(PGDescription -> Value)
-> (PGDescription -> Encoding)
-> ([PGDescription] -> Value)
-> ([PGDescription] -> Encoding)
-> ToJSON PGDescription
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PGDescription -> Value
toJSON :: PGDescription -> Value
$ctoEncoding :: PGDescription -> Encoding
toEncoding :: PGDescription -> Encoding
$ctoJSONList :: [PGDescription] -> Value
toJSONList :: [PGDescription] -> Value
$ctoEncodingList :: [PGDescription] -> Encoding
toEncodingList :: [PGDescription] -> Encoding
ToJSON, Maybe ByteString -> Either Text PGDescription
(Maybe ByteString -> Either Text PGDescription)
-> FromCol PGDescription
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text PGDescription
fromCol :: Maybe ByteString -> Either Text PGDescription
PG.FromCol, PGDescription -> ()
(PGDescription -> ()) -> NFData PGDescription
forall a. (a -> ()) -> NFData a
$crnf :: PGDescription -> ()
rnf :: PGDescription -> ()
NFData, Eq PGDescription
Eq PGDescription
-> (Int -> PGDescription -> Int)
-> (PGDescription -> Int)
-> Hashable PGDescription
Int -> PGDescription -> Int
PGDescription -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PGDescription -> Int
hashWithSalt :: Int -> PGDescription -> Int
$chash :: PGDescription -> Int
hash :: PGDescription -> Int
Hashable)

newtype PGCol = PGCol {PGCol -> Text
getPGColTxt :: Text}
  deriving stock (Typeable PGCol
Typeable PGCol
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PGCol -> c PGCol)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PGCol)
-> (PGCol -> Constr)
-> (PGCol -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PGCol))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGCol))
-> ((forall b. Data b => b -> b) -> PGCol -> PGCol)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r)
-> (forall u. (forall d. Data d => d -> u) -> PGCol -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PGCol -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PGCol -> m PGCol)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PGCol -> m PGCol)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PGCol -> m PGCol)
-> Data PGCol
PGCol -> Constr
PGCol -> DataType
(forall b. Data b => b -> b) -> PGCol -> PGCol
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PGCol -> u
forall u. (forall d. Data d => d -> u) -> PGCol -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGCol
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGCol -> c PGCol
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGCol)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGCol)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGCol -> c PGCol
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGCol -> c PGCol
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGCol
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGCol
$ctoConstr :: PGCol -> Constr
toConstr :: PGCol -> Constr
$cdataTypeOf :: PGCol -> DataType
dataTypeOf :: PGCol -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGCol)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGCol)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGCol)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGCol)
$cgmapT :: (forall b. Data b => b -> b) -> PGCol -> PGCol
gmapT :: (forall b. Data b => b -> b) -> PGCol -> PGCol
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGCol -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PGCol -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PGCol -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGCol -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGCol -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGCol -> m PGCol
Data, PGCol -> PGCol -> Bool
(PGCol -> PGCol -> Bool) -> (PGCol -> PGCol -> Bool) -> Eq PGCol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGCol -> PGCol -> Bool
== :: PGCol -> PGCol -> Bool
$c/= :: PGCol -> PGCol -> Bool
/= :: PGCol -> PGCol -> Bool
Eq, (forall x. PGCol -> Rep PGCol x)
-> (forall x. Rep PGCol x -> PGCol) -> Generic PGCol
forall x. Rep PGCol x -> PGCol
forall x. PGCol -> Rep PGCol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PGCol -> Rep PGCol x
from :: forall x. PGCol -> Rep PGCol x
$cto :: forall x. Rep PGCol x -> PGCol
to :: forall x. Rep PGCol x -> PGCol
Generic, Eq PGCol
Eq PGCol
-> (PGCol -> PGCol -> Ordering)
-> (PGCol -> PGCol -> Bool)
-> (PGCol -> PGCol -> Bool)
-> (PGCol -> PGCol -> Bool)
-> (PGCol -> PGCol -> Bool)
-> (PGCol -> PGCol -> PGCol)
-> (PGCol -> PGCol -> PGCol)
-> Ord PGCol
PGCol -> PGCol -> Bool
PGCol -> PGCol -> Ordering
PGCol -> PGCol -> PGCol
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 :: PGCol -> PGCol -> Ordering
compare :: PGCol -> PGCol -> Ordering
$c< :: PGCol -> PGCol -> Bool
< :: PGCol -> PGCol -> Bool
$c<= :: PGCol -> PGCol -> Bool
<= :: PGCol -> PGCol -> Bool
$c> :: PGCol -> PGCol -> Bool
> :: PGCol -> PGCol -> Bool
$c>= :: PGCol -> PGCol -> Bool
>= :: PGCol -> PGCol -> Bool
$cmax :: PGCol -> PGCol -> PGCol
max :: PGCol -> PGCol -> PGCol
$cmin :: PGCol -> PGCol -> PGCol
min :: PGCol -> PGCol -> PGCol
Ord, Int -> PGCol -> ShowS
[PGCol] -> ShowS
PGCol -> String
(Int -> PGCol -> ShowS)
-> (PGCol -> String) -> ([PGCol] -> ShowS) -> Show PGCol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGCol -> ShowS
showsPrec :: Int -> PGCol -> ShowS
$cshow :: PGCol -> String
show :: PGCol -> String
$cshowList :: [PGCol] -> ShowS
showList :: [PGCol] -> ShowS
Show)
  deriving newtype (Value -> Parser [PGCol]
Value -> Parser PGCol
(Value -> Parser PGCol)
-> (Value -> Parser [PGCol]) -> FromJSON PGCol
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PGCol
parseJSON :: Value -> Parser PGCol
$cparseJSONList :: Value -> Parser [PGCol]
parseJSONList :: Value -> Parser [PGCol]
FromJSON, [PGCol] -> Value
[PGCol] -> Encoding
PGCol -> Value
PGCol -> Encoding
(PGCol -> Value)
-> (PGCol -> Encoding)
-> ([PGCol] -> Value)
-> ([PGCol] -> Encoding)
-> ToJSON PGCol
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PGCol -> Value
toJSON :: PGCol -> Value
$ctoEncoding :: PGCol -> Encoding
toEncoding :: PGCol -> Encoding
$ctoJSONList :: [PGCol] -> Value
toJSONList :: [PGCol] -> Value
$ctoEncodingList :: [PGCol] -> Encoding
toEncodingList :: [PGCol] -> Encoding
ToJSON, Eq PGCol
Eq PGCol
-> (Int -> PGCol -> Int) -> (PGCol -> Int) -> Hashable PGCol
Int -> PGCol -> Int
PGCol -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PGCol -> Int
hashWithSalt :: Int -> PGCol -> Int
$chash :: PGCol -> Int
hash :: PGCol -> Int
Hashable, PGCol -> PrepArg
(PGCol -> PrepArg) -> ToPrepArg PGCol
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: PGCol -> PrepArg
toPrepVal :: PGCol -> PrepArg
PG.ToPrepArg, Maybe ByteString -> Either Text PGCol
(Maybe ByteString -> Either Text PGCol) -> FromCol PGCol
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text PGCol
fromCol :: Maybe ByteString -> Either Text PGCol
PG.FromCol, ToJSONKeyFunction [PGCol]
ToJSONKeyFunction PGCol
ToJSONKeyFunction PGCol
-> ToJSONKeyFunction [PGCol] -> ToJSONKey PGCol
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction PGCol
toJSONKey :: ToJSONKeyFunction PGCol
$ctoJSONKeyList :: ToJSONKeyFunction [PGCol]
toJSONKeyList :: ToJSONKeyFunction [PGCol]
ToJSONKey, FromJSONKeyFunction [PGCol]
FromJSONKeyFunction PGCol
FromJSONKeyFunction PGCol
-> FromJSONKeyFunction [PGCol] -> FromJSONKey PGCol
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction PGCol
fromJSONKey :: FromJSONKeyFunction PGCol
$cfromJSONKeyList :: FromJSONKeyFunction [PGCol]
fromJSONKeyList :: FromJSONKeyFunction [PGCol]
FromJSONKey, PGCol -> ()
(PGCol -> ()) -> NFData PGCol
forall a. (a -> ()) -> NFData a
$crnf :: PGCol -> ()
rnf :: PGCol -> ()
NFData, String -> PGCol
(String -> PGCol) -> IsString PGCol
forall a. (String -> a) -> IsString a
$cfromString :: String -> PGCol
fromString :: String -> PGCol
IsString)

instance HasCodec PGCol where
  codec :: JSONCodec PGCol
codec = (Text -> PGCol)
-> (PGCol -> Text) -> Codec Value Text Text -> JSONCodec PGCol
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> PGCol
PGCol PGCol -> Text
getPGColTxt Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance IsIdentifier PGCol where
  toIdentifier :: PGCol -> Identifier
toIdentifier (PGCol Text
t) = Text -> Identifier
Identifier Text
t

instance ToSQL PGCol where
  toSQL :: PGCol -> Builder
toSQL = Identifier -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Identifier -> Builder)
-> (PGCol -> Identifier) -> PGCol -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGCol -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier

instance ToTxt PGCol where
  toTxt :: PGCol -> Text
toTxt = PGCol -> Text
getPGColTxt

instance ToErrorValue PGCol where
  toErrorValue :: PGCol -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage) -> (PGCol -> Text) -> PGCol -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGCol -> Text
getPGColTxt

unsafePGCol :: Text -> PGCol
unsafePGCol :: Text -> PGCol
unsafePGCol = Text -> PGCol
PGCol

showPGCols :: (Foldable t, Functor t) => t PGCol -> T.Text
showPGCols :: forall (t :: * -> *). (Foldable t, Functor t) => t PGCol -> Text
showPGCols = t Text -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList (t Text -> Text) -> (t PGCol -> t Text) -> t PGCol -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGCol -> Text) -> t PGCol -> t Text
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PGCol -> Text
getPGColTxt

data PGScalarType
  = PGSmallInt
  | PGInteger
  | PGBigInt
  | PGSerial
  | PGBigSerial
  | PGFloat
  | PGDouble
  | PGNumeric
  | PGMoney
  | PGBoolean
  | PGChar
  | PGVarchar
  | PGText
  | PGCitext
  | PGDate
  | PGTimeStamp
  | PGTimeStampTZ
  | PGTimeTZ
  | PGJSON
  | PGJSONB
  | PGGeometry
  | PGGeography
  | PGRaster
  | PGUUID
  | PGLtree
  | PGLquery
  | PGLtxtquery
  | PGArray PGScalarType
  | PGUnknown Text
  | PGCompositeScalar Text
  | PGEnumScalar Text
  deriving (Int -> PGScalarType -> ShowS
[PGScalarType] -> ShowS
PGScalarType -> String
(Int -> PGScalarType -> ShowS)
-> (PGScalarType -> String)
-> ([PGScalarType] -> ShowS)
-> Show PGScalarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGScalarType -> ShowS
showsPrec :: Int -> PGScalarType -> ShowS
$cshow :: PGScalarType -> String
show :: PGScalarType -> String
$cshowList :: [PGScalarType] -> ShowS
showList :: [PGScalarType] -> ShowS
Show, PGScalarType -> PGScalarType -> Bool
(PGScalarType -> PGScalarType -> Bool)
-> (PGScalarType -> PGScalarType -> Bool) -> Eq PGScalarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGScalarType -> PGScalarType -> Bool
== :: PGScalarType -> PGScalarType -> Bool
$c/= :: PGScalarType -> PGScalarType -> Bool
/= :: PGScalarType -> PGScalarType -> Bool
Eq, Eq PGScalarType
Eq PGScalarType
-> (PGScalarType -> PGScalarType -> Ordering)
-> (PGScalarType -> PGScalarType -> Bool)
-> (PGScalarType -> PGScalarType -> Bool)
-> (PGScalarType -> PGScalarType -> Bool)
-> (PGScalarType -> PGScalarType -> Bool)
-> (PGScalarType -> PGScalarType -> PGScalarType)
-> (PGScalarType -> PGScalarType -> PGScalarType)
-> Ord PGScalarType
PGScalarType -> PGScalarType -> Bool
PGScalarType -> PGScalarType -> Ordering
PGScalarType -> PGScalarType -> PGScalarType
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 :: PGScalarType -> PGScalarType -> Ordering
compare :: PGScalarType -> PGScalarType -> Ordering
$c< :: PGScalarType -> PGScalarType -> Bool
< :: PGScalarType -> PGScalarType -> Bool
$c<= :: PGScalarType -> PGScalarType -> Bool
<= :: PGScalarType -> PGScalarType -> Bool
$c> :: PGScalarType -> PGScalarType -> Bool
> :: PGScalarType -> PGScalarType -> Bool
$c>= :: PGScalarType -> PGScalarType -> Bool
>= :: PGScalarType -> PGScalarType -> Bool
$cmax :: PGScalarType -> PGScalarType -> PGScalarType
max :: PGScalarType -> PGScalarType -> PGScalarType
$cmin :: PGScalarType -> PGScalarType -> PGScalarType
min :: PGScalarType -> PGScalarType -> PGScalarType
Ord, (forall x. PGScalarType -> Rep PGScalarType x)
-> (forall x. Rep PGScalarType x -> PGScalarType)
-> Generic PGScalarType
forall x. Rep PGScalarType x -> PGScalarType
forall x. PGScalarType -> Rep PGScalarType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PGScalarType -> Rep PGScalarType x
from :: forall x. PGScalarType -> Rep PGScalarType x
$cto :: forall x. Rep PGScalarType x -> PGScalarType
to :: forall x. Rep PGScalarType x -> PGScalarType
Generic, Typeable PGScalarType
Typeable PGScalarType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PGScalarType -> c PGScalarType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PGScalarType)
-> (PGScalarType -> Constr)
-> (PGScalarType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PGScalarType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PGScalarType))
-> ((forall b. Data b => b -> b) -> PGScalarType -> PGScalarType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PGScalarType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PGScalarType -> r)
-> (forall u. (forall d. Data d => d -> u) -> PGScalarType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PGScalarType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType)
-> Data PGScalarType
PGScalarType -> Constr
PGScalarType -> DataType
(forall b. Data b => b -> b) -> PGScalarType -> PGScalarType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PGScalarType -> u
forall u. (forall d. Data d => d -> u) -> PGScalarType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PGScalarType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PGScalarType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGScalarType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGScalarType -> c PGScalarType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGScalarType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PGScalarType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGScalarType -> c PGScalarType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGScalarType -> c PGScalarType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGScalarType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGScalarType
$ctoConstr :: PGScalarType -> Constr
toConstr :: PGScalarType -> Constr
$cdataTypeOf :: PGScalarType -> DataType
dataTypeOf :: PGScalarType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGScalarType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGScalarType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PGScalarType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PGScalarType)
$cgmapT :: (forall b. Data b => b -> b) -> PGScalarType -> PGScalarType
gmapT :: (forall b. Data b => b -> b) -> PGScalarType -> PGScalarType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PGScalarType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PGScalarType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PGScalarType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PGScalarType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PGScalarType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PGScalarType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGScalarType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGScalarType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGScalarType -> m PGScalarType
Data)

instance NFData PGScalarType

instance Hashable PGScalarType

pgScalarTypeToText :: PGScalarType -> Text
pgScalarTypeToText :: PGScalarType -> Text
pgScalarTypeToText = \case
  PGScalarType
PGSmallInt -> Text
"smallint"
  PGScalarType
PGInteger -> Text
"integer"
  PGScalarType
PGBigInt -> Text
"bigint"
  PGScalarType
PGSerial -> Text
"serial"
  PGScalarType
PGBigSerial -> Text
"bigserial"
  PGScalarType
PGFloat -> Text
"real"
  PGScalarType
PGDouble -> Text
"float8"
  PGScalarType
PGNumeric -> Text
"numeric"
  PGScalarType
PGMoney -> Text
"money"
  PGScalarType
PGBoolean -> Text
"boolean"
  PGScalarType
PGChar -> Text
"bpchar"
  PGScalarType
PGVarchar -> Text
"varchar"
  PGScalarType
PGText -> Text
"text"
  PGScalarType
PGCitext -> Text
"citext"
  PGScalarType
PGDate -> Text
"date"
  PGScalarType
PGTimeStamp -> Text
"timestamp"
  PGScalarType
PGTimeStampTZ -> Text
"timestamptz"
  PGScalarType
PGTimeTZ -> Text
"timetz"
  PGScalarType
PGJSON -> Text
"json"
  PGScalarType
PGJSONB -> Text
"jsonb"
  PGScalarType
PGGeometry -> Text
"geometry"
  PGScalarType
PGGeography -> Text
"geography"
  PGScalarType
PGRaster -> Text
"raster"
  PGScalarType
PGUUID -> Text
"uuid"
  PGScalarType
PGLtree -> Text
"ltree"
  PGScalarType
PGLquery -> Text
"lquery"
  PGScalarType
PGLtxtquery -> Text
"ltxtquery"
  PGArray PGScalarType
t -> PGScalarType -> Text
pgScalarTypeToText PGScalarType
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[]"
  PGUnknown Text
t -> Text
t
  PGCompositeScalar Text
t -> Text
t
  PGEnumScalar Text
t -> Text
t

-- | Used for logical models validation.
instance HasCodec PGScalarType where
  codec :: JSONCodec PGScalarType
codec =
    (Text -> Either String PGScalarType)
-> (PGScalarType -> Text)
-> Codec Value Text Text
-> JSONCodec PGScalarType
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
AC.bimapCodec
      Text -> Either String PGScalarType
decodePGScalarType
      PGScalarType -> Text
pgScalarTypeToText
      Codec Value Text Text
AC.textCodec
      JSONCodec PGScalarType -> Text -> JSONCodec PGScalarType
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
AC.<?> Text
"Postgres Scalar Types"
    where
      -- We check that the types are one of the ones described in our docs
      -- <https://hasura.io/docs/latest/schema/postgres/postgresql-types>.
      decodePGScalarType :: Text -> Either String PGScalarType
      decodePGScalarType :: Text -> Either String PGScalarType
decodePGScalarType Text
t =
        Either String PGScalarType
-> (PGScalarType -> Either String PGScalarType)
-> Maybe PGScalarType
-> Either String PGScalarType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (String -> Either String PGScalarType
forall a b. a -> Either a b
Left (String -> Either String PGScalarType)
-> String -> Either String PGScalarType
forall a b. (a -> b) -> a -> b
$ String
"Did not recognize scalar type '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'")
          PGScalarType -> Either String PGScalarType
forall a b. b -> Either a b
Right
          -- For tables, etc. We accept all types. For native queries we want to be a bit more conservatives.
          (Text -> [(Text, PGScalarType)] -> Maybe PGScalarType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
typ ([(Text, PGScalarType)]
pgScalarTranslations [(Text, PGScalarType)]
-> [(Text, PGScalarType)] -> [(Text, PGScalarType)]
forall a. Semigroup a => a -> a -> a
<> [(Text, PGScalarType)]
pgKnownUnknowns))
        where
          typ :: Text
typ = Text -> Text
massage Text
t
          massage :: Text -> Text
massage = Text -> Text
stripPrecision (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
          stripPrecision :: Text -> Text
stripPrecision Text
usertype =
            Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
usertype
              (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe
              ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [ Text
prectype
                  | Text
prectype <- [Text]
typesWithPrecision,
                    Text
usertype Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prectype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" *\\([0-9]+\\)$")
                ]
              [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
prectype
                   | Text
prectype <- [Text]
typesWithPrecision2,
                     Text
usertype Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prectype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" *\\([0-9]+ *, *[0-9]+\\)$")
                 ]

          typesWithPrecision :: [Text]
          typesWithPrecision :: [Text]
typesWithPrecision =
            [ Text
"bit",
              Text
"bit varying",
              Text
"varbit",
              Text
"char",
              Text
"character",
              Text
"varchar",
              Text
"character varying"
            ]
          typesWithPrecision2 :: [Text]
          typesWithPrecision2 :: [Text]
typesWithPrecision2 =
            [ Text
"numeric",
              Text
"decimal"
            ]
          -- Types we describe as PGUnknown internally.
          pgKnownUnknowns :: [(Text, PGScalarType)]
pgKnownUnknowns =
            (Text -> (Text, PGScalarType)) -> [Text] -> [(Text, PGScalarType)]
forall a b. (a -> b) -> [a] -> [b]
map (,Text -> PGScalarType
PGUnknown Text
typ)
              ([Text] -> [(Text, PGScalarType)])
-> [Text] -> [(Text, PGScalarType)]
forall a b. (a -> b) -> a -> b
$ [ Text
"bit varying",
                  Text
"bit",
                  Text
"box",
                  Text
"bytea",
                  Text
"cidr",
                  Text
"circle",
                  Text
"inet",
                  Text
"interval",
                  Text
"line",
                  Text
"lseg",
                  Text
"macaddr",
                  Text
"macaddr8",
                  Text
"path",
                  Text
"pg_lsn",
                  Text
"point",
                  Text
"polygon",
                  Text
"serial2",
                  Text
"serial4",
                  Text
"smallserial",
                  Text
"time without time zone",
                  Text
"time",
                  Text
"tsquery",
                  Text
"tsvector",
                  Text
"txid_snapshot",
                  Text
"varbit",
                  Text
"xml"
                ]

instance ToSQL PGScalarType where
  toSQL :: PGScalarType -> Builder
toSQL =
    Text -> Builder
TB.text (Text -> Builder)
-> (PGScalarType -> Text) -> PGScalarType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      -- Format enum type names as identifiers to preserve case sensitivity
      -- https://github.com/hasura/graphql-engine/issues/4014
      PGEnumScalar Text
t -> Text -> Text
pgFmtIdentifier Text
t
      PGScalarType
scalarType -> PGScalarType -> Text
pgScalarTypeToText PGScalarType
scalarType

instance ToJSON PGScalarType where
  toJSON :: PGScalarType -> Value
toJSON = Text -> Value
String (Text -> Value) -> (PGScalarType -> Text) -> PGScalarType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGScalarType -> Text
pgScalarTypeToText

instance ToJSONKey PGScalarType where
  toJSONKey :: ToJSONKeyFunction PGScalarType
toJSONKey = (PGScalarType -> Text) -> ToJSONKeyFunction PGScalarType
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText PGScalarType -> Text
pgScalarTypeToText

instance ToTxt PGScalarType where
  toTxt :: PGScalarType -> Text
toTxt = PGScalarType -> Text
pgScalarTypeToText

instance ToErrorValue PGScalarType where
  toErrorValue :: PGScalarType -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (PGScalarType -> Text) -> PGScalarType -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGScalarType -> Text
pgScalarTypeToText

textToPGScalarType :: Text -> PGScalarType
textToPGScalarType :: Text -> PGScalarType
textToPGScalarType =
  Text -> PGScalarType
parse
  where
    lookupName :: Text -> PGScalarType
lookupName Text
txt =
      PGScalarType -> Maybe PGScalarType -> PGScalarType
forall a. a -> Maybe a -> a
fromMaybe
        (Text -> PGScalarType
PGUnknown Text
txt)
        (Text -> [(Text, PGScalarType)] -> Maybe PGScalarType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower Text
txt) [(Text, PGScalarType)]
pgScalarTranslations)
    parse :: Text -> PGScalarType
parse = \case
      Text
txt
        | Int -> Text -> Text
T.takeEnd Int
2 Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"[]" ->
            PGScalarType -> PGScalarType
PGArray (PGScalarType -> PGScalarType) -> PGScalarType -> PGScalarType
forall a b. (a -> b) -> a -> b
$ Text -> PGScalarType
lookupName (Int -> Text -> Text
T.dropEnd Int
2 Text
txt)
      Text
txt -> Text -> PGScalarType
lookupName Text
txt

-- Inlining this results in pretty terrible Core being generated by GHC.

{-# NOINLINE pgScalarTranslations #-}
pgScalarTranslations :: [(Text, PGScalarType)]
pgScalarTranslations :: [(Text, PGScalarType)]
pgScalarTranslations =
  [ (Text
"serial", PGScalarType
PGSerial),
    (Text
"bigserial", PGScalarType
PGBigSerial),
    (Text
"smallint", PGScalarType
PGSmallInt),
    (Text
"int2", PGScalarType
PGSmallInt),
    (Text
"int", PGScalarType
PGInteger),
    (Text
"integer", PGScalarType
PGInteger),
    (Text
"int4", PGScalarType
PGInteger),
    (Text
"bigint", PGScalarType
PGBigInt),
    (Text
"int8", PGScalarType
PGBigInt),
    (Text
"real", PGScalarType
PGFloat),
    (Text
"float4", PGScalarType
PGFloat),
    (Text
"double precision", PGScalarType
PGDouble),
    (Text
"float8", PGScalarType
PGDouble),
    (Text
"numeric", PGScalarType
PGNumeric),
    (Text
"decimal", PGScalarType
PGNumeric),
    (Text
"money", PGScalarType
PGMoney),
    (Text
"boolean", PGScalarType
PGBoolean),
    (Text
"bool", PGScalarType
PGBoolean),
    (Text
"bpchar", PGScalarType
PGChar),
    (Text
"char", PGScalarType
PGChar),
    (Text
"character", PGScalarType
PGChar),
    (Text
"varchar", PGScalarType
PGVarchar),
    (Text
"character varying", PGScalarType
PGVarchar),
    (Text
"text", PGScalarType
PGText),
    (Text
"citext", PGScalarType
PGCitext),
    (Text
"date", PGScalarType
PGDate),
    (Text
"timestamp", PGScalarType
PGTimeStamp),
    (Text
"timestamp without time zone", PGScalarType
PGTimeStamp),
    (Text
"timestamptz", PGScalarType
PGTimeStampTZ),
    (Text
"timestamp with time zone", PGScalarType
PGTimeStampTZ),
    (Text
"timetz", PGScalarType
PGTimeTZ),
    (Text
"time with time zone", PGScalarType
PGTimeTZ),
    (Text
"json", PGScalarType
PGJSON),
    (Text
"jsonb", PGScalarType
PGJSONB),
    (Text
"geometry", PGScalarType
PGGeometry),
    (Text
"geography", PGScalarType
PGGeography),
    (Text
"raster", PGScalarType
PGRaster),
    (Text
"uuid", PGScalarType
PGUUID),
    (Text
"ltree", PGScalarType
PGLtree),
    (Text
"lquery", PGScalarType
PGLquery),
    (Text
"ltxtquery", PGScalarType
PGLtxtquery)
  ]

instance FromJSON PGScalarType where
  parseJSON :: Value -> Parser PGScalarType
parseJSON (String Text
t) = PGScalarType -> Parser PGScalarType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (PGScalarType -> Parser PGScalarType)
-> PGScalarType -> Parser PGScalarType
forall a b. (a -> b) -> a -> b
$ Text -> PGScalarType
textToPGScalarType Text
t
  parseJSON (Object Object
o) = do
    PGTypeKind
typeType <- Object
o Object -> Key -> Parser PGTypeKind
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Text
typeName <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    PGScalarType -> Parser PGScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (PGScalarType -> Parser PGScalarType)
-> PGScalarType -> Parser PGScalarType
forall a b. (a -> b) -> a -> b
$ case PGTypeKind
typeType of
        PGTypeKind
PGKindEnum -> Text -> PGScalarType
PGEnumScalar Text
typeName
        PGTypeKind
PGKindComposite -> Text -> PGScalarType
PGCompositeScalar Text
typeName
        PGTypeKind
_ -> Text -> PGScalarType
textToPGScalarType Text
typeName
  parseJSON Value
_ = String -> Parser PGScalarType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting a string or object for PGScalarType"

isNumType :: PGScalarType -> Bool
isNumType :: PGScalarType -> Bool
isNumType PGScalarType
PGInteger = Bool
True
isNumType PGScalarType
PGSmallInt = Bool
True
isNumType PGScalarType
PGBigInt = Bool
True
isNumType PGScalarType
PGFloat = Bool
True
isNumType PGScalarType
PGDouble = Bool
True
isNumType PGScalarType
PGNumeric = Bool
True
isNumType PGScalarType
PGMoney = Bool
True
isNumType PGScalarType
_ = Bool
False

stringTypes :: [PGScalarType]
stringTypes :: [PGScalarType]
stringTypes = [PGScalarType
PGVarchar, PGScalarType
PGText, PGScalarType
PGCitext, PGScalarType
PGChar]

isStringType :: PGScalarType -> Bool
isStringType :: PGScalarType -> Bool
isStringType = (PGScalarType -> [PGScalarType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PGScalarType]
stringTypes)

jsonTypes :: [PGScalarType]
jsonTypes :: [PGScalarType]
jsonTypes = [PGScalarType
PGJSON, PGScalarType
PGJSONB]

isJSONType :: PGScalarType -> Bool
isJSONType :: PGScalarType -> Bool
isJSONType = (PGScalarType -> [PGScalarType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PGScalarType]
jsonTypes)

isComparableType :: PGScalarType -> Bool
isComparableType :: PGScalarType -> Bool
isComparableType PGScalarType
PGJSON = Bool
False
isComparableType PGScalarType
PGJSONB = Bool
False
isComparableType PGScalarType
PGGeometry = Bool
False
isComparableType PGScalarType
PGGeography = Bool
False
isComparableType PGScalarType
PGBoolean = Bool
False
isComparableType (PGUnknown Text
_) = Bool
False
isComparableType PGScalarType
_ = Bool
True

isBigNum :: PGScalarType -> Bool
isBigNum :: PGScalarType -> Bool
isBigNum = \case
  PGScalarType
PGBigInt -> Bool
True
  PGScalarType
PGBigSerial -> Bool
True
  PGScalarType
PGNumeric -> Bool
True
  PGScalarType
PGDouble -> Bool
True
  PGScalarType
PGMoney -> Bool
True
  PGScalarType
_ -> Bool
False

geoTypes :: [PGScalarType]
geoTypes :: [PGScalarType]
geoTypes = [PGScalarType
PGGeometry, PGScalarType
PGGeography]

isGeoType :: PGScalarType -> Bool
isGeoType :: PGScalarType -> Bool
isGeoType = (PGScalarType -> [PGScalarType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PGScalarType]
geoTypes)

data PGTypeKind
  = PGKindBase
  | PGKindComposite
  | PGKindDomain
  | PGKindEnum
  | PGKindRange
  | PGKindPseudo
  | PGKindUnknown Text
  deriving (Int -> PGTypeKind -> ShowS
[PGTypeKind] -> ShowS
PGTypeKind -> String
(Int -> PGTypeKind -> ShowS)
-> (PGTypeKind -> String)
-> ([PGTypeKind] -> ShowS)
-> Show PGTypeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGTypeKind -> ShowS
showsPrec :: Int -> PGTypeKind -> ShowS
$cshow :: PGTypeKind -> String
show :: PGTypeKind -> String
$cshowList :: [PGTypeKind] -> ShowS
showList :: [PGTypeKind] -> ShowS
Show, PGTypeKind -> PGTypeKind -> Bool
(PGTypeKind -> PGTypeKind -> Bool)
-> (PGTypeKind -> PGTypeKind -> Bool) -> Eq PGTypeKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGTypeKind -> PGTypeKind -> Bool
== :: PGTypeKind -> PGTypeKind -> Bool
$c/= :: PGTypeKind -> PGTypeKind -> Bool
/= :: PGTypeKind -> PGTypeKind -> Bool
Eq, Eq PGTypeKind
Eq PGTypeKind
-> (PGTypeKind -> PGTypeKind -> Ordering)
-> (PGTypeKind -> PGTypeKind -> Bool)
-> (PGTypeKind -> PGTypeKind -> Bool)
-> (PGTypeKind -> PGTypeKind -> Bool)
-> (PGTypeKind -> PGTypeKind -> Bool)
-> (PGTypeKind -> PGTypeKind -> PGTypeKind)
-> (PGTypeKind -> PGTypeKind -> PGTypeKind)
-> Ord PGTypeKind
PGTypeKind -> PGTypeKind -> Bool
PGTypeKind -> PGTypeKind -> Ordering
PGTypeKind -> PGTypeKind -> PGTypeKind
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 :: PGTypeKind -> PGTypeKind -> Ordering
compare :: PGTypeKind -> PGTypeKind -> Ordering
$c< :: PGTypeKind -> PGTypeKind -> Bool
< :: PGTypeKind -> PGTypeKind -> Bool
$c<= :: PGTypeKind -> PGTypeKind -> Bool
<= :: PGTypeKind -> PGTypeKind -> Bool
$c> :: PGTypeKind -> PGTypeKind -> Bool
> :: PGTypeKind -> PGTypeKind -> Bool
$c>= :: PGTypeKind -> PGTypeKind -> Bool
>= :: PGTypeKind -> PGTypeKind -> Bool
$cmax :: PGTypeKind -> PGTypeKind -> PGTypeKind
max :: PGTypeKind -> PGTypeKind -> PGTypeKind
$cmin :: PGTypeKind -> PGTypeKind -> PGTypeKind
min :: PGTypeKind -> PGTypeKind -> PGTypeKind
Ord, (forall x. PGTypeKind -> Rep PGTypeKind x)
-> (forall x. Rep PGTypeKind x -> PGTypeKind) -> Generic PGTypeKind
forall x. Rep PGTypeKind x -> PGTypeKind
forall x. PGTypeKind -> Rep PGTypeKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PGTypeKind -> Rep PGTypeKind x
from :: forall x. PGTypeKind -> Rep PGTypeKind x
$cto :: forall x. Rep PGTypeKind x -> PGTypeKind
to :: forall x. Rep PGTypeKind x -> PGTypeKind
Generic)

instance NFData PGTypeKind

instance Hashable PGTypeKind

instance FromJSON PGTypeKind where
  parseJSON :: Value -> Parser PGTypeKind
parseJSON = String -> (Text -> Parser PGTypeKind) -> Value -> Parser PGTypeKind
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"postgresTypeKind"
    ((Text -> Parser PGTypeKind) -> Value -> Parser PGTypeKind)
-> (Text -> Parser PGTypeKind) -> Value -> Parser PGTypeKind
forall a b. (a -> b) -> a -> b
$ \Text
t -> PGTypeKind -> Parser PGTypeKind
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PGTypeKind -> Parser PGTypeKind)
-> PGTypeKind -> Parser PGTypeKind
forall a b. (a -> b) -> a -> b
$ case Text
t of
      Text
"b" -> PGTypeKind
PGKindBase
      Text
"c" -> PGTypeKind
PGKindComposite
      Text
"d" -> PGTypeKind
PGKindDomain
      Text
"e" -> PGTypeKind
PGKindEnum
      Text
"r" -> PGTypeKind
PGKindRange
      Text
"p" -> PGTypeKind
PGKindPseudo
      Text
_ -> Text -> PGTypeKind
PGKindUnknown Text
t

instance ToJSON PGTypeKind where
  toJSON :: PGTypeKind -> Value
toJSON = \case
    PGTypeKind
PGKindBase -> Value
"b"
    PGTypeKind
PGKindComposite -> Value
"c"
    PGTypeKind
PGKindDomain -> Value
"d"
    PGTypeKind
PGKindEnum -> Value
"e"
    PGTypeKind
PGKindRange -> Value
"r"
    PGTypeKind
PGKindPseudo -> Value
"p"
    PGKindUnknown Text
t -> Text -> Value
String Text
t

data QualifiedPGType = QualifiedPGType
  { QualifiedPGType -> SchemaName
_qptSchema :: SchemaName,
    QualifiedPGType -> PGScalarType
_qptName :: PGScalarType,
    QualifiedPGType -> PGTypeKind
_qptType :: PGTypeKind
  }
  deriving (Int -> QualifiedPGType -> ShowS
[QualifiedPGType] -> ShowS
QualifiedPGType -> String
(Int -> QualifiedPGType -> ShowS)
-> (QualifiedPGType -> String)
-> ([QualifiedPGType] -> ShowS)
-> Show QualifiedPGType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QualifiedPGType -> ShowS
showsPrec :: Int -> QualifiedPGType -> ShowS
$cshow :: QualifiedPGType -> String
show :: QualifiedPGType -> String
$cshowList :: [QualifiedPGType] -> ShowS
showList :: [QualifiedPGType] -> ShowS
Show, QualifiedPGType -> QualifiedPGType -> Bool
(QualifiedPGType -> QualifiedPGType -> Bool)
-> (QualifiedPGType -> QualifiedPGType -> Bool)
-> Eq QualifiedPGType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QualifiedPGType -> QualifiedPGType -> Bool
== :: QualifiedPGType -> QualifiedPGType -> Bool
$c/= :: QualifiedPGType -> QualifiedPGType -> Bool
/= :: QualifiedPGType -> QualifiedPGType -> Bool
Eq, Eq QualifiedPGType
Eq QualifiedPGType
-> (QualifiedPGType -> QualifiedPGType -> Ordering)
-> (QualifiedPGType -> QualifiedPGType -> Bool)
-> (QualifiedPGType -> QualifiedPGType -> Bool)
-> (QualifiedPGType -> QualifiedPGType -> Bool)
-> (QualifiedPGType -> QualifiedPGType -> Bool)
-> (QualifiedPGType -> QualifiedPGType -> QualifiedPGType)
-> (QualifiedPGType -> QualifiedPGType -> QualifiedPGType)
-> Ord QualifiedPGType
QualifiedPGType -> QualifiedPGType -> Bool
QualifiedPGType -> QualifiedPGType -> Ordering
QualifiedPGType -> QualifiedPGType -> QualifiedPGType
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 :: QualifiedPGType -> QualifiedPGType -> Ordering
compare :: QualifiedPGType -> QualifiedPGType -> Ordering
$c< :: QualifiedPGType -> QualifiedPGType -> Bool
< :: QualifiedPGType -> QualifiedPGType -> Bool
$c<= :: QualifiedPGType -> QualifiedPGType -> Bool
<= :: QualifiedPGType -> QualifiedPGType -> Bool
$c> :: QualifiedPGType -> QualifiedPGType -> Bool
> :: QualifiedPGType -> QualifiedPGType -> Bool
$c>= :: QualifiedPGType -> QualifiedPGType -> Bool
>= :: QualifiedPGType -> QualifiedPGType -> Bool
$cmax :: QualifiedPGType -> QualifiedPGType -> QualifiedPGType
max :: QualifiedPGType -> QualifiedPGType -> QualifiedPGType
$cmin :: QualifiedPGType -> QualifiedPGType -> QualifiedPGType
min :: QualifiedPGType -> QualifiedPGType -> QualifiedPGType
Ord, (forall x. QualifiedPGType -> Rep QualifiedPGType x)
-> (forall x. Rep QualifiedPGType x -> QualifiedPGType)
-> Generic QualifiedPGType
forall x. Rep QualifiedPGType x -> QualifiedPGType
forall x. QualifiedPGType -> Rep QualifiedPGType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QualifiedPGType -> Rep QualifiedPGType x
from :: forall x. QualifiedPGType -> Rep QualifiedPGType x
$cto :: forall x. Rep QualifiedPGType x -> QualifiedPGType
to :: forall x. Rep QualifiedPGType x -> QualifiedPGType
Generic)

instance NFData QualifiedPGType

instance Hashable QualifiedPGType

instance FromJSON QualifiedPGType where
  parseJSON :: Value -> Parser QualifiedPGType
parseJSON = Options -> Value -> Parser QualifiedPGType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON QualifiedPGType where
  toJSON :: QualifiedPGType -> Value
toJSON = Options -> QualifiedPGType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: QualifiedPGType -> Encoding
toEncoding = Options -> QualifiedPGType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

isBaseType :: QualifiedPGType -> Bool
isBaseType :: QualifiedPGType -> Bool
isBaseType (QualifiedPGType SchemaName
_ PGScalarType
n PGTypeKind
ty) =
  Bool
notUnknown Bool -> Bool -> Bool
&& (PGTypeKind
ty PGTypeKind -> PGTypeKind -> Bool
forall a. Eq a => a -> a -> Bool
== PGTypeKind
PGKindBase)
  where
    notUnknown :: Bool
notUnknown = case PGScalarType
n of
      PGUnknown Text
_ -> Bool
False
      PGScalarType
_ -> Bool
True

typeToTable :: QualifiedPGType -> QualifiedTable
typeToTable :: QualifiedPGType -> QualifiedTable
typeToTable (QualifiedPGType SchemaName
sch PGScalarType
n PGTypeKind
_) =
  SchemaName -> TableName -> QualifiedTable
forall a. SchemaName -> a -> QualifiedObject a
QualifiedObject SchemaName
sch (TableName -> QualifiedTable) -> TableName -> QualifiedTable
forall a b. (a -> b) -> a -> b
$ Text -> TableName
TableName (Text -> TableName) -> Text -> TableName
forall a b. (a -> b) -> a -> b
$ PGScalarType -> Text
pgScalarTypeToText PGScalarType
n

mkFunctionArgScalarType :: QualifiedPGType -> PGScalarType
mkFunctionArgScalarType :: QualifiedPGType -> PGScalarType
mkFunctionArgScalarType (QualifiedPGType SchemaName
_schema PGScalarType
name PGTypeKind
type') =
  case PGTypeKind
type' of
    -- The suffix `_scalar` is added in
    -- the @mkScalarTypeName@ function.
    PGTypeKind
PGKindComposite -> Text -> PGScalarType
PGCompositeScalar (Text -> PGScalarType) -> Text -> PGScalarType
forall a b. (a -> b) -> a -> b
$ PGScalarType -> Text
forall a. ToTxt a => a -> Text
toTxt PGScalarType
name
    PGTypeKind
_ -> PGScalarType
name

-- | Metadata describing SQL functions at the DB level, i.e. below the GraphQL layer.
data PGRawFunctionInfo = PGRawFunctionInfo
  { PGRawFunctionInfo -> OID
rfiOid :: OID,
    PGRawFunctionInfo -> Bool
rfiHasVariadic :: Bool,
    PGRawFunctionInfo -> FunctionVolatility
rfiFunctionType :: FunctionVolatility,
    PGRawFunctionInfo -> SchemaName
rfiReturnTypeSchema :: SchemaName,
    PGRawFunctionInfo -> PGScalarType
rfiReturnTypeName :: PGScalarType,
    PGRawFunctionInfo -> PGTypeKind
rfiReturnTypeType :: PGTypeKind,
    PGRawFunctionInfo -> Bool
rfiReturnsSet :: Bool,
    PGRawFunctionInfo -> [QualifiedPGType]
rfiInputArgTypes :: [QualifiedPGType],
    PGRawFunctionInfo -> [FunctionArgName]
rfiInputArgNames :: [FunctionArgName],
    PGRawFunctionInfo -> Int
rfiDefaultArgs :: Int,
    PGRawFunctionInfo -> Bool
rfiReturnsTable :: Bool,
    PGRawFunctionInfo -> Maybe PGDescription
rfiDescription :: Maybe PGDescription
  }
  deriving (Int -> PGRawFunctionInfo -> ShowS
[PGRawFunctionInfo] -> ShowS
PGRawFunctionInfo -> String
(Int -> PGRawFunctionInfo -> ShowS)
-> (PGRawFunctionInfo -> String)
-> ([PGRawFunctionInfo] -> ShowS)
-> Show PGRawFunctionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGRawFunctionInfo -> ShowS
showsPrec :: Int -> PGRawFunctionInfo -> ShowS
$cshow :: PGRawFunctionInfo -> String
show :: PGRawFunctionInfo -> String
$cshowList :: [PGRawFunctionInfo] -> ShowS
showList :: [PGRawFunctionInfo] -> ShowS
Show, PGRawFunctionInfo -> PGRawFunctionInfo -> Bool
(PGRawFunctionInfo -> PGRawFunctionInfo -> Bool)
-> (PGRawFunctionInfo -> PGRawFunctionInfo -> Bool)
-> Eq PGRawFunctionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGRawFunctionInfo -> PGRawFunctionInfo -> Bool
== :: PGRawFunctionInfo -> PGRawFunctionInfo -> Bool
$c/= :: PGRawFunctionInfo -> PGRawFunctionInfo -> Bool
/= :: PGRawFunctionInfo -> PGRawFunctionInfo -> Bool
Eq, (forall x. PGRawFunctionInfo -> Rep PGRawFunctionInfo x)
-> (forall x. Rep PGRawFunctionInfo x -> PGRawFunctionInfo)
-> Generic PGRawFunctionInfo
forall x. Rep PGRawFunctionInfo x -> PGRawFunctionInfo
forall x. PGRawFunctionInfo -> Rep PGRawFunctionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PGRawFunctionInfo -> Rep PGRawFunctionInfo x
from :: forall x. PGRawFunctionInfo -> Rep PGRawFunctionInfo x
$cto :: forall x. Rep PGRawFunctionInfo x -> PGRawFunctionInfo
to :: forall x. Rep PGRawFunctionInfo x -> PGRawFunctionInfo
Generic)

instance NFData PGRawFunctionInfo

instance FromJSON PGRawFunctionInfo where
  parseJSON :: Value -> Parser PGRawFunctionInfo
parseJSON = Options -> Value -> Parser PGRawFunctionInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON PGRawFunctionInfo where
  toJSON :: PGRawFunctionInfo -> Value
toJSON = Options -> PGRawFunctionInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: PGRawFunctionInfo -> Encoding
toEncoding = Options -> PGRawFunctionInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

mkScalarTypeName :: (MonadError QErr m) => PGScalarType -> m G.Name
mkScalarTypeName :: forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName PGScalarType
PGInteger = Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._Int
mkScalarTypeName PGScalarType
PGBoolean = Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._Boolean
mkScalarTypeName PGScalarType
PGFloat = Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._Float
mkScalarTypeName PGScalarType
PGText = Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
mkScalarTypeName PGScalarType
PGVarchar = Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
mkScalarTypeName (PGCompositeScalar Text
compositeScalarType) =
  -- When the function argument is a row type argument
  -- then it's possible that there can be an object type
  -- with the table name depending upon whether the table
  -- is tracked or not. As a result, we get a conflict between
  -- both these types (scalar and object type with same name).
  -- To avoid this, we suffix the table name with `_scalar`
  -- and create a new scalar type
  (Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__scalar)
    (Name -> Name) -> m Name -> m Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Name
G.mkName Text
compositeScalarType
    Maybe Name -> m Name -> m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
      Code
ValidationFailed
      ( Text
"cannot use SQL type "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
compositeScalarType
          Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the GraphQL schema because its name is not a "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"valid GraphQL identifier"
      )
mkScalarTypeName (PGArray PGScalarType
innerScalarType) =
  -- previous to Postgres array changes, an array of a type was called `_thing`, and this made
  -- nice GraphQL names, so maintaining this
  Text -> Maybe Name
G.mkName (Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGScalarType -> Text
pgScalarTypeToText PGScalarType
innerScalarType)
    Maybe Name -> m Name -> m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
      Code
ValidationFailed
      ( Text
"cannot use SQL type "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGScalarType
innerScalarType
          PGScalarType -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the GraphQL schema because its name is not a "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"valid GraphQL identifier"
      )
mkScalarTypeName PGScalarType
scalarType =
  Text -> Maybe Name
G.mkName (PGScalarType -> Text
pgScalarTypeToText PGScalarType
scalarType)
    Maybe Name -> m Name -> m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
      Code
ValidationFailed
      ( Text
"cannot use SQL type "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGScalarType
scalarType
          PGScalarType -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the GraphQL schema because its name is not a "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"valid GraphQL identifier"
      )

instance IsIdentifier RelName where
  toIdentifier :: RelName -> Identifier
toIdentifier RelName
rn = Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ RelName -> Text
relNameToTxt RelName
rn

instance IsIdentifier FieldName where
  toIdentifier :: FieldName -> Identifier
toIdentifier (FieldName Text
f) = Text -> Identifier
Identifier Text
f

pgTypeOid :: PGScalarType -> PQ.Oid
pgTypeOid :: PGScalarType -> Oid
pgTypeOid = \case
  PGScalarType
PGSmallInt -> Oid
PTI.int2
  PGScalarType
PGInteger -> Oid
PTI.int4
  PGScalarType
PGBigInt -> Oid
PTI.int8
  PGScalarType
PGSerial -> Oid
PTI.int4
  PGScalarType
PGBigSerial -> Oid
PTI.int8
  PGScalarType
PGFloat -> Oid
PTI.float4
  PGScalarType
PGDouble -> Oid
PTI.float8
  PGScalarType
PGNumeric -> Oid
PTI.numeric
  PGScalarType
PGMoney -> Oid
PTI.numeric
  PGScalarType
PGBoolean -> Oid
PTI.bool
  PGScalarType
PGChar -> Oid
PTI.char
  PGScalarType
PGVarchar -> Oid
PTI.varchar
  PGScalarType
PGText -> Oid
PTI.text
  PGScalarType
PGCitext -> Oid
PTI.text -- Explict type cast to citext needed, See also Note [Type casting prepared params]
  PGScalarType
PGDate -> Oid
PTI.date
  PGScalarType
PGTimeStamp -> Oid
PTI.timestamp
  PGScalarType
PGTimeStampTZ -> Oid
PTI.timestamptz
  PGScalarType
PGTimeTZ -> Oid
PTI.timetz
  PGScalarType
PGJSON -> Oid
PTI.json
  PGScalarType
PGJSONB -> Oid
PTI.jsonb
  PGScalarType
PGGeometry -> Oid
PTI.text -- we are using the ST_GeomFromGeoJSON($i) instead of $i
  PGScalarType
PGGeography -> Oid
PTI.text
  PGScalarType
PGRaster -> Oid
PTI.text -- we are using the ST_RastFromHexWKB($i) instead of $i
  PGScalarType
PGUUID -> Oid
PTI.uuid
  PGScalarType
PGLtree -> Oid
PTI.text
  PGScalarType
PGLquery -> Oid
PTI.text
  PGScalarType
PGLtxtquery -> Oid
PTI.text
  PGUnknown Text
_ -> Oid
PTI.auto
  PGCompositeScalar Text
_ -> Oid
PTI.auto
  PGEnumScalar Text
_ -> Oid
PTI.auto
  PGArray PGScalarType
_ -> Oid
PTI.auto

--  Extra metadata for vanilla Postgres
data PGExtraTableMetadata = PGExtraTableMetadata
  { PGExtraTableMetadata -> SourceTableType
_petmTableType :: SourceTableType
  }
  deriving stock (PGExtraTableMetadata -> PGExtraTableMetadata -> Bool
(PGExtraTableMetadata -> PGExtraTableMetadata -> Bool)
-> (PGExtraTableMetadata -> PGExtraTableMetadata -> Bool)
-> Eq PGExtraTableMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGExtraTableMetadata -> PGExtraTableMetadata -> Bool
== :: PGExtraTableMetadata -> PGExtraTableMetadata -> Bool
$c/= :: PGExtraTableMetadata -> PGExtraTableMetadata -> Bool
/= :: PGExtraTableMetadata -> PGExtraTableMetadata -> Bool
Eq, (forall x. PGExtraTableMetadata -> Rep PGExtraTableMetadata x)
-> (forall x. Rep PGExtraTableMetadata x -> PGExtraTableMetadata)
-> Generic PGExtraTableMetadata
forall x. Rep PGExtraTableMetadata x -> PGExtraTableMetadata
forall x. PGExtraTableMetadata -> Rep PGExtraTableMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PGExtraTableMetadata -> Rep PGExtraTableMetadata x
from :: forall x. PGExtraTableMetadata -> Rep PGExtraTableMetadata x
$cto :: forall x. Rep PGExtraTableMetadata x -> PGExtraTableMetadata
to :: forall x. Rep PGExtraTableMetadata x -> PGExtraTableMetadata
Generic, Int -> PGExtraTableMetadata -> ShowS
[PGExtraTableMetadata] -> ShowS
PGExtraTableMetadata -> String
(Int -> PGExtraTableMetadata -> ShowS)
-> (PGExtraTableMetadata -> String)
-> ([PGExtraTableMetadata] -> ShowS)
-> Show PGExtraTableMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGExtraTableMetadata -> ShowS
showsPrec :: Int -> PGExtraTableMetadata -> ShowS
$cshow :: PGExtraTableMetadata -> String
show :: PGExtraTableMetadata -> String
$cshowList :: [PGExtraTableMetadata] -> ShowS
showList :: [PGExtraTableMetadata] -> ShowS
Show)
  deriving anyclass (Eq PGExtraTableMetadata
Eq PGExtraTableMetadata
-> (Int -> PGExtraTableMetadata -> Int)
-> (PGExtraTableMetadata -> Int)
-> Hashable PGExtraTableMetadata
Int -> PGExtraTableMetadata -> Int
PGExtraTableMetadata -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PGExtraTableMetadata -> Int
hashWithSalt :: Int -> PGExtraTableMetadata -> Int
$chash :: PGExtraTableMetadata -> Int
hash :: PGExtraTableMetadata -> Int
Hashable, PGExtraTableMetadata -> ()
(PGExtraTableMetadata -> ()) -> NFData PGExtraTableMetadata
forall a. (a -> ()) -> NFData a
$crnf :: PGExtraTableMetadata -> ()
rnf :: PGExtraTableMetadata -> ()
NFData)

instance ToJSON PGExtraTableMetadata where
  toJSON :: PGExtraTableMetadata -> Value
toJSON PGExtraTableMetadata {SourceTableType
_petmTableType :: PGExtraTableMetadata -> SourceTableType
_petmTableType :: SourceTableType
..} =
    [Pair] -> Value
object [Key
"table_type" Key -> SourceTableType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SourceTableType
_petmTableType]

instance FromJSON PGExtraTableMetadata where
  parseJSON :: Value -> Parser PGExtraTableMetadata
parseJSON = String
-> (Object -> Parser PGExtraTableMetadata)
-> Value
-> Parser PGExtraTableMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PGExtraTableMetadata" \Object
obj -> do
    SourceTableType
_petmTableType <- Object
obj Object -> Key -> Parser SourceTableType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table_type"
    PGExtraTableMetadata -> Parser PGExtraTableMetadata
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PGExtraTableMetadata {SourceTableType
_petmTableType :: SourceTableType
_petmTableType :: SourceTableType
..}