{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.Column
  ( ColumnType (..),
    _ColumnScalar,
    _ColumnEnumReference,
    isEnumColumn,
    isScalarColumnWhere,
    ValueParser,
    onlyNumCols,
    isNumCol,
    onlyComparableCols,
    isComparableCol,
    parseScalarValueColumnTypeWithContext,
    parseScalarValueColumnType,
    parseScalarValuesColumnTypeWithContext,
    parseScalarValuesColumnType,
    ColumnValue (..),
    ColumnMutability (..),
    ColumnInfo (..),
    NestedObjectInfo (..),
    RawColumnType (..),
    RawColumnInfo (..),
    PrimaryKeyColumns,
    getColInfos,
    EnumReference (..),
    EnumValues,
    EnumValue (..),
    EnumValueInfo (..),
    fromCol,
    ColumnValues,
    ColumnReference (..),
    columnReferenceType,
    columnReferenceNullable,
    NestedArrayInfo (..),
    StructuredColumnInfo (..),
    _SCIScalarColumn,
    _SCIObjectColumn,
    _SCIArrayColumn,
    structuredColumnInfoName,
    structuredColumnInfoColumn,
    structuredColumnInfoMutability,
    toScalarColumnInfo,
  )
where

import Autodocodec
import Control.Lens.TH
import Data.Aeson hiding ((.=))
import Data.Aeson.TH
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.Text (unpack)
import Data.Text.Extended
import Data.Tuple.Extra (uncurry3)
import Hasura.Base.Error
import Hasura.LogicalModel.Types (LogicalModelName)
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField.Name (ComputedFieldName)
import Hasura.SQL.Types
import Language.GraphQL.Draft.Syntax qualified as G

newtype EnumValue = EnumValue {EnumValue -> Name
getEnumValue :: G.Name}
  deriving stock (Int -> EnumValue -> ShowS
[EnumValue] -> ShowS
EnumValue -> String
(Int -> EnumValue -> ShowS)
-> (EnumValue -> String)
-> ([EnumValue] -> ShowS)
-> Show EnumValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValue -> ShowS
showsPrec :: Int -> EnumValue -> ShowS
$cshow :: EnumValue -> String
show :: EnumValue -> String
$cshowList :: [EnumValue] -> ShowS
showList :: [EnumValue] -> ShowS
Show, EnumValue -> EnumValue -> Bool
(EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool) -> Eq EnumValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValue -> EnumValue -> Bool
== :: EnumValue -> EnumValue -> Bool
$c/= :: EnumValue -> EnumValue -> Bool
/= :: EnumValue -> EnumValue -> Bool
Eq, Eq EnumValue
Eq EnumValue
-> (EnumValue -> EnumValue -> Ordering)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> EnumValue)
-> (EnumValue -> EnumValue -> EnumValue)
-> Ord EnumValue
EnumValue -> EnumValue -> Bool
EnumValue -> EnumValue -> Ordering
EnumValue -> EnumValue -> EnumValue
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 :: EnumValue -> EnumValue -> Ordering
compare :: EnumValue -> EnumValue -> Ordering
$c< :: EnumValue -> EnumValue -> Bool
< :: EnumValue -> EnumValue -> Bool
$c<= :: EnumValue -> EnumValue -> Bool
<= :: EnumValue -> EnumValue -> Bool
$c> :: EnumValue -> EnumValue -> Bool
> :: EnumValue -> EnumValue -> Bool
$c>= :: EnumValue -> EnumValue -> Bool
>= :: EnumValue -> EnumValue -> Bool
$cmax :: EnumValue -> EnumValue -> EnumValue
max :: EnumValue -> EnumValue -> EnumValue
$cmin :: EnumValue -> EnumValue -> EnumValue
min :: EnumValue -> EnumValue -> EnumValue
Ord, (forall x. EnumValue -> Rep EnumValue x)
-> (forall x. Rep EnumValue x -> EnumValue) -> Generic EnumValue
forall x. Rep EnumValue x -> EnumValue
forall x. EnumValue -> Rep EnumValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumValue -> Rep EnumValue x
from :: forall x. EnumValue -> Rep EnumValue x
$cto :: forall x. Rep EnumValue x -> EnumValue
to :: forall x. Rep EnumValue x -> EnumValue
Generic)
  deriving newtype (EnumValue -> ()
(EnumValue -> ()) -> NFData EnumValue
forall a. (a -> ()) -> NFData a
$crnf :: EnumValue -> ()
rnf :: EnumValue -> ()
NFData, Eq EnumValue
Eq EnumValue
-> (Int -> EnumValue -> Int)
-> (EnumValue -> Int)
-> Hashable EnumValue
Int -> EnumValue -> Int
EnumValue -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EnumValue -> Int
hashWithSalt :: Int -> EnumValue -> Int
$chash :: EnumValue -> Int
hash :: EnumValue -> Int
Hashable, [EnumValue] -> Value
[EnumValue] -> Encoding
EnumValue -> Value
EnumValue -> Encoding
(EnumValue -> Value)
-> (EnumValue -> Encoding)
-> ([EnumValue] -> Value)
-> ([EnumValue] -> Encoding)
-> ToJSON EnumValue
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EnumValue -> Value
toJSON :: EnumValue -> Value
$ctoEncoding :: EnumValue -> Encoding
toEncoding :: EnumValue -> Encoding
$ctoJSONList :: [EnumValue] -> Value
toJSONList :: [EnumValue] -> Value
$ctoEncodingList :: [EnumValue] -> Encoding
toEncodingList :: [EnumValue] -> Encoding
ToJSON, ToJSONKeyFunction [EnumValue]
ToJSONKeyFunction EnumValue
ToJSONKeyFunction EnumValue
-> ToJSONKeyFunction [EnumValue] -> ToJSONKey EnumValue
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction EnumValue
toJSONKey :: ToJSONKeyFunction EnumValue
$ctoJSONKeyList :: ToJSONKeyFunction [EnumValue]
toJSONKeyList :: ToJSONKeyFunction [EnumValue]
ToJSONKey, Value -> Parser [EnumValue]
Value -> Parser EnumValue
(Value -> Parser EnumValue)
-> (Value -> Parser [EnumValue]) -> FromJSON EnumValue
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EnumValue
parseJSON :: Value -> Parser EnumValue
$cparseJSONList :: Value -> Parser [EnumValue]
parseJSONList :: Value -> Parser [EnumValue]
FromJSON, FromJSONKeyFunction [EnumValue]
FromJSONKeyFunction EnumValue
FromJSONKeyFunction EnumValue
-> FromJSONKeyFunction [EnumValue] -> FromJSONKey EnumValue
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction EnumValue
fromJSONKey :: FromJSONKeyFunction EnumValue
$cfromJSONKeyList :: FromJSONKeyFunction [EnumValue]
fromJSONKeyList :: FromJSONKeyFunction [EnumValue]
FromJSONKey)

newtype EnumValueInfo = EnumValueInfo
  { EnumValueInfo -> Maybe Text
evComment :: Maybe Text
  }
  deriving stock (Int -> EnumValueInfo -> ShowS
[EnumValueInfo] -> ShowS
EnumValueInfo -> String
(Int -> EnumValueInfo -> ShowS)
-> (EnumValueInfo -> String)
-> ([EnumValueInfo] -> ShowS)
-> Show EnumValueInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValueInfo -> ShowS
showsPrec :: Int -> EnumValueInfo -> ShowS
$cshow :: EnumValueInfo -> String
show :: EnumValueInfo -> String
$cshowList :: [EnumValueInfo] -> ShowS
showList :: [EnumValueInfo] -> ShowS
Show, EnumValueInfo -> EnumValueInfo -> Bool
(EnumValueInfo -> EnumValueInfo -> Bool)
-> (EnumValueInfo -> EnumValueInfo -> Bool) -> Eq EnumValueInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValueInfo -> EnumValueInfo -> Bool
== :: EnumValueInfo -> EnumValueInfo -> Bool
$c/= :: EnumValueInfo -> EnumValueInfo -> Bool
/= :: EnumValueInfo -> EnumValueInfo -> Bool
Eq, Eq EnumValueInfo
Eq EnumValueInfo
-> (EnumValueInfo -> EnumValueInfo -> Ordering)
-> (EnumValueInfo -> EnumValueInfo -> Bool)
-> (EnumValueInfo -> EnumValueInfo -> Bool)
-> (EnumValueInfo -> EnumValueInfo -> Bool)
-> (EnumValueInfo -> EnumValueInfo -> Bool)
-> (EnumValueInfo -> EnumValueInfo -> EnumValueInfo)
-> (EnumValueInfo -> EnumValueInfo -> EnumValueInfo)
-> Ord EnumValueInfo
EnumValueInfo -> EnumValueInfo -> Bool
EnumValueInfo -> EnumValueInfo -> Ordering
EnumValueInfo -> EnumValueInfo -> EnumValueInfo
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 :: EnumValueInfo -> EnumValueInfo -> Ordering
compare :: EnumValueInfo -> EnumValueInfo -> Ordering
$c< :: EnumValueInfo -> EnumValueInfo -> Bool
< :: EnumValueInfo -> EnumValueInfo -> Bool
$c<= :: EnumValueInfo -> EnumValueInfo -> Bool
<= :: EnumValueInfo -> EnumValueInfo -> Bool
$c> :: EnumValueInfo -> EnumValueInfo -> Bool
> :: EnumValueInfo -> EnumValueInfo -> Bool
$c>= :: EnumValueInfo -> EnumValueInfo -> Bool
>= :: EnumValueInfo -> EnumValueInfo -> Bool
$cmax :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
max :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
$cmin :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
min :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
Ord, (forall x. EnumValueInfo -> Rep EnumValueInfo x)
-> (forall x. Rep EnumValueInfo x -> EnumValueInfo)
-> Generic EnumValueInfo
forall x. Rep EnumValueInfo x -> EnumValueInfo
forall x. EnumValueInfo -> Rep EnumValueInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumValueInfo -> Rep EnumValueInfo x
from :: forall x. EnumValueInfo -> Rep EnumValueInfo x
$cto :: forall x. Rep EnumValueInfo x -> EnumValueInfo
to :: forall x. Rep EnumValueInfo x -> EnumValueInfo
Generic)
  deriving newtype (EnumValueInfo -> ()
(EnumValueInfo -> ()) -> NFData EnumValueInfo
forall a. (a -> ()) -> NFData a
$crnf :: EnumValueInfo -> ()
rnf :: EnumValueInfo -> ()
NFData, Eq EnumValueInfo
Eq EnumValueInfo
-> (Int -> EnumValueInfo -> Int)
-> (EnumValueInfo -> Int)
-> Hashable EnumValueInfo
Int -> EnumValueInfo -> Int
EnumValueInfo -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EnumValueInfo -> Int
hashWithSalt :: Int -> EnumValueInfo -> Int
$chash :: EnumValueInfo -> Int
hash :: EnumValueInfo -> Int
Hashable)

$(deriveJSON hasuraJSON ''EnumValueInfo)

type EnumValues = HashMap.HashMap EnumValue EnumValueInfo

-- | Represents a reference to an “enum table,” a single-column Postgres table that is referenced
-- via foreign key.
data EnumReference (b :: BackendType) = EnumReference
  { forall (b :: BackendType). EnumReference b -> TableName b
erTable :: TableName b,
    forall (b :: BackendType). EnumReference b -> EnumValues
erValues :: EnumValues,
    forall (b :: BackendType). EnumReference b -> Maybe Name
erTableCustomName :: Maybe G.Name
  }
  deriving ((forall x. EnumReference b -> Rep (EnumReference b) x)
-> (forall x. Rep (EnumReference b) x -> EnumReference b)
-> Generic (EnumReference b)
forall x. Rep (EnumReference b) x -> EnumReference b
forall x. EnumReference b -> Rep (EnumReference b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (EnumReference b) x -> EnumReference b
forall (b :: BackendType) x.
EnumReference b -> Rep (EnumReference b) x
$cfrom :: forall (b :: BackendType) x.
EnumReference b -> Rep (EnumReference b) x
from :: forall x. EnumReference b -> Rep (EnumReference b) x
$cto :: forall (b :: BackendType) x.
Rep (EnumReference b) x -> EnumReference b
to :: forall x. Rep (EnumReference b) x -> EnumReference b
Generic)

deriving instance (Backend b) => Show (EnumReference b)

deriving instance (Backend b) => Eq (EnumReference b)

deriving instance (Backend b) => Ord (EnumReference b)

instance (Backend b) => NFData (EnumReference b)

instance (Backend b) => Hashable (EnumReference b)

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

instance (Backend b) => ToJSON (EnumReference b) where
  toJSON :: EnumReference b -> Value
toJSON = Options -> EnumReference b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

-- | The type we use for columns, which are currently always “scalars” (though
-- see the note about 'CollectableType'). Unlike 'ScalarType', which represents
-- a type that a backend knows about, this type characterizes distinctions we
-- make but the backend doesn’t.
data ColumnType (b :: BackendType)
  = -- | Ordinary Postgres columns.
    ColumnScalar (ScalarType b)
  | -- | Columns that reference enum tables (see "Hasura.RQL.Schema.Enum"). This is not actually a
    -- distinct type from the perspective of Postgres (at the time of this writing, we ensure they
    -- always have type @text@), but we really want to distinguish this case, since we treat it
    -- /completely/ differently in the GraphQL schema.
    ColumnEnumReference (EnumReference b)
  deriving (Int -> ColumnType b -> ShowS
[ColumnType b] -> ShowS
ColumnType b -> String
(Int -> ColumnType b -> ShowS)
-> (ColumnType b -> String)
-> ([ColumnType b] -> ShowS)
-> Show (ColumnType b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> ColumnType b -> ShowS
forall (b :: BackendType). Backend b => [ColumnType b] -> ShowS
forall (b :: BackendType). Backend b => ColumnType b -> String
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> ColumnType b -> ShowS
showsPrec :: Int -> ColumnType b -> ShowS
$cshow :: forall (b :: BackendType). Backend b => ColumnType b -> String
show :: ColumnType b -> String
$cshowList :: forall (b :: BackendType). Backend b => [ColumnType b] -> ShowS
showList :: [ColumnType b] -> ShowS
Show, ColumnType b -> ColumnType b -> Bool
(ColumnType b -> ColumnType b -> Bool)
-> (ColumnType b -> ColumnType b -> Bool) -> Eq (ColumnType b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
== :: ColumnType b -> ColumnType b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
/= :: ColumnType b -> ColumnType b -> Bool
Eq, Eq (ColumnType b)
Eq (ColumnType b)
-> (ColumnType b -> ColumnType b -> Ordering)
-> (ColumnType b -> ColumnType b -> Bool)
-> (ColumnType b -> ColumnType b -> Bool)
-> (ColumnType b -> ColumnType b -> Bool)
-> (ColumnType b -> ColumnType b -> Bool)
-> (ColumnType b -> ColumnType b -> ColumnType b)
-> (ColumnType b -> ColumnType b -> ColumnType b)
-> Ord (ColumnType b)
ColumnType b -> ColumnType b -> Bool
ColumnType b -> ColumnType b -> Ordering
ColumnType b -> ColumnType b -> ColumnType b
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 (b :: BackendType). Backend b => Eq (ColumnType b)
forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Ordering
forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> ColumnType b
$ccompare :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Ordering
compare :: ColumnType b -> ColumnType b -> Ordering
$c< :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
< :: ColumnType b -> ColumnType b -> Bool
$c<= :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
<= :: ColumnType b -> ColumnType b -> Bool
$c> :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
> :: ColumnType b -> ColumnType b -> Bool
$c>= :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Bool
>= :: ColumnType b -> ColumnType b -> Bool
$cmax :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> ColumnType b
max :: ColumnType b -> ColumnType b -> ColumnType b
$cmin :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> ColumnType b
min :: ColumnType b -> ColumnType b -> ColumnType b
Ord, (forall x. ColumnType b -> Rep (ColumnType b) x)
-> (forall x. Rep (ColumnType b) x -> ColumnType b)
-> Generic (ColumnType b)
forall x. Rep (ColumnType b) x -> ColumnType b
forall x. ColumnType b -> Rep (ColumnType b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (ColumnType b) x -> ColumnType b
forall (b :: BackendType) x. ColumnType b -> Rep (ColumnType b) x
$cfrom :: forall (b :: BackendType) x. ColumnType b -> Rep (ColumnType b) x
from :: forall x. ColumnType b -> Rep (ColumnType b) x
$cto :: forall (b :: BackendType) x. Rep (ColumnType b) x -> ColumnType b
to :: forall x. Rep (ColumnType b) x -> ColumnType b
Generic)

instance (Backend b) => NFData (ColumnType b)

instance (Backend b) => Hashable (ColumnType b)

instance (Backend b) => ToJSON (ColumnType b) where
  toJSON :: ColumnType b -> Value
toJSON = Options -> ColumnType b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ColumnType b -> Value)
-> Options -> ColumnType b -> Value
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
6}

$(makePrisms ''ColumnType)

instance (Backend b) => ToTxt (ColumnType b) where
  toTxt :: ColumnType b -> Text
toTxt = \case
    ColumnScalar ScalarType b
scalar -> ScalarType b -> Text
forall a. ToTxt a => a -> Text
toTxt ScalarType b
scalar
    ColumnEnumReference (EnumReference TableName b
tableName EnumValues
_ Maybe Name
tableCustomName) ->
      let tableTxtName :: Text
tableTxtName = TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tableName
       in Text -> (Name -> Text) -> Maybe Name -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
tableTxtName Name -> Text
forall a. ToTxt a => a -> Text
toTxt Maybe Name
tableCustomName

-- | A parser to parse a json value with enforcing column type
type ValueParser b m v =
  CollectableType (ColumnType b) -> Value -> m v

data ColumnValue (b :: BackendType) = ColumnValue
  { forall (b :: BackendType). ColumnValue b -> ColumnType b
cvType :: ColumnType b,
    forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue :: ScalarValue b
  }

deriving instance (Backend b) => Eq (ColumnValue b)

deriving instance (Backend b) => Show (ColumnValue b)

isScalarColumnWhere :: (ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere :: forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere ScalarType b -> Bool
f = \case
  ColumnScalar ScalarType b
scalar -> ScalarType b -> Bool
f ScalarType b
scalar
  ColumnEnumReference EnumReference b
_ -> Bool
False

isEnumColumn :: ColumnType b -> Bool
isEnumColumn :: forall (b :: BackendType). ColumnType b -> Bool
isEnumColumn (ColumnEnumReference EnumReference b
_) = Bool
True
isEnumColumn ColumnType b
_ = Bool
False

-- | Note: Unconditionally accepts null values and returns 'PGNull'.
parseScalarValueColumnTypeWithContext ::
  forall m b.
  (MonadError QErr m, Backend b) =>
  ScalarTypeParsingContext b ->
  ColumnType b ->
  Value ->
  m (ScalarValue b)
parseScalarValueColumnTypeWithContext :: forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnTypeWithContext ScalarTypeParsingContext b
context ColumnType b
columnType Value
value = case ColumnType b
columnType of
  ColumnScalar ScalarType b
scalarType -> do
    Either QErr (ScalarValue b) -> m (ScalarValue b)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr (ScalarValue b) -> m (ScalarValue b))
-> Either QErr (ScalarValue b) -> m (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
ScalarTypeParsingContext b
-> ScalarType b -> Value -> Either QErr (ScalarValue b)
parseScalarValue @b ScalarTypeParsingContext b
context ScalarType b
scalarType Value
value
  ColumnEnumReference (EnumReference TableName b
tableName EnumValues
enumValues Maybe Name
_) ->
    Maybe Name -> m (ScalarValue b)
parseEnumValue (Maybe Name -> m (ScalarValue b))
-> m (Maybe Name) -> m (ScalarValue b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> m (Maybe Name)
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
value
    where
      parseEnumValue :: Maybe G.Name -> m (ScalarValue b)
      parseEnumValue :: Maybe Name -> m (ScalarValue b)
parseEnumValue Maybe Name
enumValueName = do
        Maybe Name -> (Name -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Name
enumValueName \Name
evn -> do
          let enums :: [Name]
enums = (EnumValue -> Name) -> [EnumValue] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map EnumValue -> Name
getEnumValue ([EnumValue] -> [Name]) -> [EnumValue] -> [Name]
forall a b. (a -> b) -> a -> b
$ EnumValues -> [EnumValue]
forall k v. HashMap k v -> [k]
HashMap.keys EnumValues
enumValues
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Name
evn Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
enums)
            (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload
            (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"expected one of the values "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Name] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList ([Name] -> [Name]
forall a. Ord a => [a] -> [a]
sort [Name]
enums)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for type "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall (b :: BackendType). Backend b => TableName b -> Text
snakeCaseTableName @b TableName b
tableName
            Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
", given "
            Text -> Name -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name
evn
        ScalarValue b -> m (ScalarValue b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue b -> m (ScalarValue b))
-> ScalarValue b -> m (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Backend b => Maybe Text -> ScalarValue b
textToScalarValue @b (Maybe Text -> ScalarValue b) -> Maybe Text -> ScalarValue b
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName (Name -> Text) -> Maybe Name -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
enumValueName

-- | Note: Unconditionally accepts null values and returns 'PGNull'.
parseScalarValueColumnType ::
  forall m b r.
  (MonadError QErr m, Backend b, MonadReader r m, Has (ScalarTypeParsingContext b) r) =>
  ColumnType b ->
  Value ->
  m (ScalarValue b)
parseScalarValueColumnType :: forall (m :: * -> *) (b :: BackendType) r.
(MonadError QErr m, Backend b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnType ColumnType b
columnType Value
value = do
  ScalarTypeParsingContext b
scalarTypeParsingContext <- (r -> ScalarTypeParsingContext b) -> m (ScalarTypeParsingContext b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> ScalarTypeParsingContext b
forall a t. Has a t => t -> a
getter
  ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnTypeWithContext ScalarTypeParsingContext b
scalarTypeParsingContext ColumnType b
columnType Value
value

parseScalarValuesColumnTypeWithContext ::
  forall m b.
  (MonadError QErr m, Backend b) =>
  ScalarTypeParsingContext b ->
  ColumnType b ->
  [Value] ->
  m [ScalarValue b]
parseScalarValuesColumnTypeWithContext :: forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> [Value] -> m [ScalarValue b]
parseScalarValuesColumnTypeWithContext ScalarTypeParsingContext b
context ColumnType b
columnType =
  (Value -> m (ScalarValue b)) -> [Value] -> m [ScalarValue b]
forall (m :: * -> *) a b. QErrM m => (a -> m b) -> [a] -> m [b]
indexedMapM (ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnTypeWithContext ScalarTypeParsingContext b
context ColumnType b
columnType)

parseScalarValuesColumnType ::
  forall m b r.
  (MonadError QErr m, Backend b, MonadReader r m, Has (ScalarTypeParsingContext b) r) =>
  ColumnType b ->
  [Value] ->
  m [ScalarValue b]
parseScalarValuesColumnType :: forall (m :: * -> *) (b :: BackendType) r.
(MonadError QErr m, Backend b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
ColumnType b -> [Value] -> m [ScalarValue b]
parseScalarValuesColumnType ColumnType b
columnType [Value]
values = do
  ScalarTypeParsingContext b
scalarTypeParsingContext <- (r -> ScalarTypeParsingContext b) -> m (ScalarTypeParsingContext b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> ScalarTypeParsingContext b
forall a t. Has a t => t -> a
getter
  ScalarTypeParsingContext b
-> ColumnType b -> [Value] -> m [ScalarValue b]
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> [Value] -> m [ScalarValue b]
parseScalarValuesColumnTypeWithContext ScalarTypeParsingContext b
scalarTypeParsingContext ColumnType b
columnType [Value]
values

data RawColumnType (b :: BackendType)
  = RawColumnTypeScalar (ScalarType b)
  | RawColumnTypeObject (XNestedObjects b) G.Name
  | RawColumnTypeArray (XNestedObjects b) (RawColumnType b) Bool
  deriving stock ((forall x. RawColumnType b -> Rep (RawColumnType b) x)
-> (forall x. Rep (RawColumnType b) x -> RawColumnType b)
-> Generic (RawColumnType b)
forall x. Rep (RawColumnType b) x -> RawColumnType b
forall x. RawColumnType b -> Rep (RawColumnType b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (RawColumnType b) x -> RawColumnType b
forall (b :: BackendType) x.
RawColumnType b -> Rep (RawColumnType b) x
$cfrom :: forall (b :: BackendType) x.
RawColumnType b -> Rep (RawColumnType b) x
from :: forall x. RawColumnType b -> Rep (RawColumnType b) x
$cto :: forall (b :: BackendType) x.
Rep (RawColumnType b) x -> RawColumnType b
to :: forall x. Rep (RawColumnType b) x -> RawColumnType b
Generic)
  deriving ([RawColumnType b] -> Value
[RawColumnType b] -> Encoding
RawColumnType b -> Value
RawColumnType b -> Encoding
(RawColumnType b -> Value)
-> (RawColumnType b -> Encoding)
-> ([RawColumnType b] -> Value)
-> ([RawColumnType b] -> Encoding)
-> ToJSON (RawColumnType b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (b :: BackendType). Backend b => [RawColumnType b] -> Value
forall (b :: BackendType).
Backend b =>
[RawColumnType b] -> Encoding
forall (b :: BackendType). Backend b => RawColumnType b -> Value
forall (b :: BackendType). Backend b => RawColumnType b -> Encoding
$ctoJSON :: forall (b :: BackendType). Backend b => RawColumnType b -> Value
toJSON :: RawColumnType b -> Value
$ctoEncoding :: forall (b :: BackendType). Backend b => RawColumnType b -> Encoding
toEncoding :: RawColumnType b -> Encoding
$ctoJSONList :: forall (b :: BackendType). Backend b => [RawColumnType b] -> Value
toJSONList :: [RawColumnType b] -> Value
$ctoEncodingList :: forall (b :: BackendType).
Backend b =>
[RawColumnType b] -> Encoding
toEncodingList :: [RawColumnType b] -> Encoding
ToJSON, Value -> Parser [RawColumnType b]
Value -> Parser (RawColumnType b)
(Value -> Parser (RawColumnType b))
-> (Value -> Parser [RawColumnType b])
-> FromJSON (RawColumnType b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [RawColumnType b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (RawColumnType b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (RawColumnType b)
parseJSON :: Value -> Parser (RawColumnType b)
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [RawColumnType b]
parseJSONList :: Value -> Parser [RawColumnType b]
FromJSON) via Autodocodec (RawColumnType b)

deriving instance (Backend b) => Eq (RawColumnType b)

deriving instance (Backend b) => Ord (RawColumnType b)

deriving anyclass instance (Backend b) => Hashable (RawColumnType b)

deriving instance (Backend b) => Show (RawColumnType b)

instance (Backend b) => NFData (RawColumnType b)

instance (Backend b) => HasCodec (RawColumnType b) where
  codec :: JSONCodec (RawColumnType b)
codec =
    Text -> JSONCodec (RawColumnType b) -> JSONCodec (RawColumnType b)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"RawColumnType"
      (JSONCodec (RawColumnType b) -> JSONCodec (RawColumnType b))
-> JSONCodec (RawColumnType b) -> JSONCodec (RawColumnType b)
forall a b. (a -> b) -> a -> b
$
      -- For backwards compatibility we want to serialize and deserialize
      -- RawColumnTypeScalar as a ScalarType.
      -- Note: we need to use `codecViaAeson` instead of `codec` because the `HasCodec` instance
      -- for `PGScalarType` has diverged from the `ToJSON`/`FromJSON` instances.
      Codec Value (ScalarType b) (RawColumnType b)
-> JSONCodec (RawColumnType b)
-> (RawColumnType b -> Either (ScalarType b) (RawColumnType b))
-> JSONCodec (RawColumnType b)
forall context input output input' newInput.
Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodec
        ((ScalarType b -> RawColumnType b)
-> (ScalarType b -> ScalarType b)
-> Codec Value (ScalarType b) (ScalarType b)
-> Codec Value (ScalarType b) (RawColumnType b)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec ScalarType b -> RawColumnType b
forall (b :: BackendType). ScalarType b -> RawColumnType b
RawColumnTypeScalar ScalarType b -> ScalarType b
forall a. a -> a
id (Codec Value (ScalarType b) (ScalarType b)
 -> Codec Value (ScalarType b) (RawColumnType b))
-> Codec Value (ScalarType b) (ScalarType b)
-> Codec Value (ScalarType b) (RawColumnType b)
forall a b. (a -> b) -> a -> b
$ Text -> Codec Value (ScalarType b) (ScalarType b)
forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"ScalarType")
        (Text
-> ObjectCodec (RawColumnType b) (RawColumnType b)
-> JSONCodec (RawColumnType b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
Autodocodec.object Text
"ColumnTypeNonScalar" (ObjectCodec (RawColumnType b) (RawColumnType b)
 -> JSONCodec (RawColumnType b))
-> ObjectCodec (RawColumnType b) (RawColumnType b)
-> JSONCodec (RawColumnType b)
forall a b. (a -> b) -> a -> b
$ Text
-> (RawColumnType b -> (Text, ObjectCodec (RawColumnType b) ()))
-> HashMap Text (Text, ObjectCodec Void (RawColumnType b))
-> ObjectCodec (RawColumnType b) (RawColumnType b)
forall input output.
Text
-> (input -> (Text, ObjectCodec input ()))
-> HashMap Text (Text, ObjectCodec Void output)
-> ObjectCodec input output
discriminatedUnionCodec Text
"type" RawColumnType b -> (Text, ObjectCodec (RawColumnType b) ())
enc HashMap Text (Text, ObjectCodec Void (RawColumnType b))
dec)
        \case
          RawColumnTypeScalar ScalarType b
scalar -> ScalarType b -> Either (ScalarType b) (RawColumnType b)
forall a b. a -> Either a b
Left ScalarType b
scalar
          RawColumnType b
ct -> RawColumnType b -> Either (ScalarType b) (RawColumnType b)
forall a b. b -> Either a b
Right RawColumnType b
ct
    where
      enc :: RawColumnType b -> (Text, ObjectCodec (RawColumnType b) ())
enc = \case
        RawColumnTypeScalar ScalarType b
_ -> String -> (Text, ObjectCodec (RawColumnType b) ())
forall a. HasCallStack => String -> a
error String
"unexpected RawColumnTypeScalar"
        RawColumnTypeObject XNestedObjects b
_ Name
objectName -> (Text
"object", Name
-> Codec Object Name (XNestedObjects b, Name)
-> ObjectCodec (RawColumnType b) ()
forall b context any a.
b -> Codec context b any -> Codec context a ()
mapToEncoder Name
objectName Codec Object Name (XNestedObjects b, Name)
columnTypeObjectCodec)
        RawColumnTypeArray XNestedObjects b
_ RawColumnType b
columnType Bool
isNullable -> (Text
"array", (RawColumnType b, Bool)
-> Codec
     Object
     (RawColumnType b, Bool)
     (XNestedObjects b, RawColumnType b, Bool)
-> ObjectCodec (RawColumnType b) ()
forall b context any a.
b -> Codec context b any -> Codec context a ()
mapToEncoder (RawColumnType b
columnType, Bool
isNullable) Codec
  Object
  (RawColumnType b, Bool)
  (XNestedObjects b, RawColumnType b, Bool)
columnTypeArrayCodec)
      dec :: HashMap Text (Text, ObjectCodec Void (RawColumnType b))
dec =
        [(Text, (Text, ObjectCodec Void (RawColumnType b)))]
-> HashMap Text (Text, ObjectCodec Void (RawColumnType b))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
          [ (Text
"object", (Text
"ColumnTypeObject", ((XNestedObjects b, Name) -> RawColumnType b)
-> Codec Object Name (XNestedObjects b, Name)
-> ObjectCodec Void (RawColumnType b)
forall b a context any.
(b -> a) -> Codec context any b -> Codec context Void a
mapToDecoder ((XNestedObjects b -> Name -> RawColumnType b)
-> (XNestedObjects b, Name) -> RawColumnType b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XNestedObjects b -> Name -> RawColumnType b
forall (b :: BackendType).
XNestedObjects b -> Name -> RawColumnType b
RawColumnTypeObject) Codec Object Name (XNestedObjects b, Name)
columnTypeObjectCodec)),
            (Text
"array", (Text
"ColumnTypeArray", ((XNestedObjects b, RawColumnType b, Bool) -> RawColumnType b)
-> Codec
     Object
     (RawColumnType b, Bool)
     (XNestedObjects b, RawColumnType b, Bool)
-> ObjectCodec Void (RawColumnType b)
forall b a context any.
(b -> a) -> Codec context any b -> Codec context Void a
mapToDecoder ((XNestedObjects b -> RawColumnType b -> Bool -> RawColumnType b)
-> (XNestedObjects b, RawColumnType b, Bool) -> RawColumnType b
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 XNestedObjects b -> RawColumnType b -> Bool -> RawColumnType b
forall (b :: BackendType).
XNestedObjects b -> RawColumnType b -> Bool -> RawColumnType b
RawColumnTypeArray) Codec
  Object
  (RawColumnType b, Bool)
  (XNestedObjects b, RawColumnType b, Bool)
columnTypeArrayCodec))
          ]
      columnTypeObjectCodec :: Codec Object Name (XNestedObjects b, Name)
columnTypeObjectCodec = (,) (XNestedObjects b -> Name -> (XNestedObjects b, Name))
-> Codec Object Name (XNestedObjects b)
-> Codec Object Name (Name -> (XNestedObjects b, Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec Object Name (XNestedObjects b)
forall void. ObjectCodec void (XNestedObjects b)
xNestedObjectsCodec Codec Object Name (Name -> (XNestedObjects b, Name))
-> Codec Object Name Name
-> Codec Object Name (XNestedObjects b, Name)
forall a b.
Codec Object Name (a -> b)
-> Codec Object Name a -> Codec Object Name b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Codec Object Name Name
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      columnTypeArrayCodec :: Codec
  Object
  (RawColumnType b, Bool)
  (XNestedObjects b, RawColumnType b, Bool)
columnTypeArrayCodec = (,,) (XNestedObjects b
 -> RawColumnType b
 -> Bool
 -> (XNestedObjects b, RawColumnType b, Bool))
-> Codec Object (RawColumnType b, Bool) (XNestedObjects b)
-> Codec
     Object
     (RawColumnType b, Bool)
     (RawColumnType b
      -> Bool -> (XNestedObjects b, RawColumnType b, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec Object (RawColumnType b, Bool) (XNestedObjects b)
forall void. ObjectCodec void (XNestedObjects b)
xNestedObjectsCodec Codec
  Object
  (RawColumnType b, Bool)
  (RawColumnType b
   -> Bool -> (XNestedObjects b, RawColumnType b, Bool))
-> Codec Object (RawColumnType b, Bool) (RawColumnType b)
-> Codec
     Object
     (RawColumnType b, Bool)
     (Bool -> (XNestedObjects b, RawColumnType b, Bool))
forall a b.
Codec Object (RawColumnType b, Bool) (a -> b)
-> Codec Object (RawColumnType b, Bool) a
-> Codec Object (RawColumnType b, Bool) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (RawColumnType b) (RawColumnType b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"element_type" ObjectCodec (RawColumnType b) (RawColumnType b)
-> ((RawColumnType b, Bool) -> RawColumnType b)
-> Codec Object (RawColumnType b, Bool) (RawColumnType b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (RawColumnType b, Bool) -> RawColumnType b
forall a b. (a, b) -> a
fst Codec
  Object
  (RawColumnType b, Bool)
  (Bool -> (XNestedObjects b, RawColumnType b, Bool))
-> Codec Object (RawColumnType b, Bool) Bool
-> Codec
     Object
     (RawColumnType b, Bool)
     (XNestedObjects b, RawColumnType b, Bool)
forall a b.
Codec Object (RawColumnType b, Bool) (a -> b)
-> Codec Object (RawColumnType b, Bool) a
-> Codec Object (RawColumnType b, Bool) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"nullable" ObjectCodec Bool Bool
-> ((RawColumnType b, Bool) -> Bool)
-> Codec Object (RawColumnType b, Bool) Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (RawColumnType b, Bool) -> Bool
forall a b. (a, b) -> b
snd
      xNestedObjectsCodec :: ObjectCodec void (XNestedObjects b)
      xNestedObjectsCodec :: forall void. ObjectCodec void (XNestedObjects b)
xNestedObjectsCodec =
        (() -> Either String (XNestedObjects b))
-> (void -> void)
-> Codec Object void ()
-> Codec Object void (XNestedObjects b)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec () -> Either String (XNestedObjects b)
forall void. void -> Either String (XNestedObjects b)
supportsNestedObjects void -> void
forall a. a -> a
id (() -> Codec Object void ()
forall output input. output -> ObjectCodec input output
pureCodec ())
      supportsNestedObjects :: void -> Either String (XNestedObjects b)
      supportsNestedObjects :: forall void. void -> Either String (XNestedObjects b)
supportsNestedObjects void
_ = (QErr -> String)
-> Either QErr (XNestedObjects b)
-> Either String (XNestedObjects b)
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft (Text -> String
unpack (Text -> String) -> (QErr -> Text) -> QErr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QErr -> Text
showQErr) (Either QErr (XNestedObjects b)
 -> Either String (XNestedObjects b))
-> Either QErr (XNestedObjects b)
-> Either String (XNestedObjects b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
Either QErr (XNestedObjects b)
backendSupportsNestedObjects @b

-- | “Raw” column info, as stored in the catalog (but not in the schema cache). Instead of
-- containing a 'PGColumnType', it only contains a 'PGScalarType', which is combined with the
-- 'pcirReferences' field and other table data to eventually resolve the type to a 'PGColumnType'.
data RawColumnInfo (b :: BackendType) = RawColumnInfo
  { forall (b :: BackendType). RawColumnInfo b -> Column b
rciName :: Column b,
    -- | The “ordinal position” of the column according to Postgres. Numbering starts at 1 and
    -- increases. Dropping a column does /not/ cause the columns to be renumbered, so a column can be
    -- consistently identified by its position.
    forall (b :: BackendType). RawColumnInfo b -> Int
rciPosition :: Int,
    forall (b :: BackendType). RawColumnInfo b -> RawColumnType b
rciType :: RawColumnType b,
    forall (b :: BackendType). RawColumnInfo b -> Bool
rciIsNullable :: Bool,
    forall (b :: BackendType). RawColumnInfo b -> Maybe Description
rciDescription :: Maybe G.Description,
    forall (b :: BackendType). RawColumnInfo b -> ColumnMutability
rciMutability :: ColumnMutability
  }
  deriving ((forall x. RawColumnInfo b -> Rep (RawColumnInfo b) x)
-> (forall x. Rep (RawColumnInfo b) x -> RawColumnInfo b)
-> Generic (RawColumnInfo b)
forall x. Rep (RawColumnInfo b) x -> RawColumnInfo b
forall x. RawColumnInfo b -> Rep (RawColumnInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (RawColumnInfo b) x -> RawColumnInfo b
forall (b :: BackendType) x.
RawColumnInfo b -> Rep (RawColumnInfo b) x
$cfrom :: forall (b :: BackendType) x.
RawColumnInfo b -> Rep (RawColumnInfo b) x
from :: forall x. RawColumnInfo b -> Rep (RawColumnInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (RawColumnInfo b) x -> RawColumnInfo b
to :: forall x. Rep (RawColumnInfo b) x -> RawColumnInfo b
Generic)

deriving instance (Backend b) => Eq (RawColumnInfo b)

deriving instance (Backend b) => Show (RawColumnInfo b)

instance (Backend b) => NFData (RawColumnInfo b)

instance (Backend b) => ToJSON (RawColumnInfo b) where
  toJSON :: RawColumnInfo b -> Value
toJSON = Options -> RawColumnInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

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

-- | Indicates whether a column may participate in certain mutations.
--
-- For example, identity columns may sometimes be insertable but rarely
-- updatable, depending on the backend and how they're declared.
--
-- This guides the schema parsers such that they only generate fields for
-- columns where they're valid without having to model the exact circumstances
-- which cause a column to appear or not.
--
-- See <https://github.com/hasura/graphql-engine/blob/master/rfcs/column-mutability.md>.
data ColumnMutability = ColumnMutability
  { ColumnMutability -> Bool
_cmIsInsertable :: Bool,
    ColumnMutability -> Bool
_cmIsUpdatable :: Bool
  }
  deriving (ColumnMutability -> ColumnMutability -> Bool
(ColumnMutability -> ColumnMutability -> Bool)
-> (ColumnMutability -> ColumnMutability -> Bool)
-> Eq ColumnMutability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnMutability -> ColumnMutability -> Bool
== :: ColumnMutability -> ColumnMutability -> Bool
$c/= :: ColumnMutability -> ColumnMutability -> Bool
/= :: ColumnMutability -> ColumnMutability -> Bool
Eq, Eq ColumnMutability
Eq ColumnMutability
-> (ColumnMutability -> ColumnMutability -> Ordering)
-> (ColumnMutability -> ColumnMutability -> Bool)
-> (ColumnMutability -> ColumnMutability -> Bool)
-> (ColumnMutability -> ColumnMutability -> Bool)
-> (ColumnMutability -> ColumnMutability -> Bool)
-> (ColumnMutability -> ColumnMutability -> ColumnMutability)
-> (ColumnMutability -> ColumnMutability -> ColumnMutability)
-> Ord ColumnMutability
ColumnMutability -> ColumnMutability -> Bool
ColumnMutability -> ColumnMutability -> Ordering
ColumnMutability -> ColumnMutability -> ColumnMutability
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 :: ColumnMutability -> ColumnMutability -> Ordering
compare :: ColumnMutability -> ColumnMutability -> Ordering
$c< :: ColumnMutability -> ColumnMutability -> Bool
< :: ColumnMutability -> ColumnMutability -> Bool
$c<= :: ColumnMutability -> ColumnMutability -> Bool
<= :: ColumnMutability -> ColumnMutability -> Bool
$c> :: ColumnMutability -> ColumnMutability -> Bool
> :: ColumnMutability -> ColumnMutability -> Bool
$c>= :: ColumnMutability -> ColumnMutability -> Bool
>= :: ColumnMutability -> ColumnMutability -> Bool
$cmax :: ColumnMutability -> ColumnMutability -> ColumnMutability
max :: ColumnMutability -> ColumnMutability -> ColumnMutability
$cmin :: ColumnMutability -> ColumnMutability -> ColumnMutability
min :: ColumnMutability -> ColumnMutability -> ColumnMutability
Ord, (forall x. ColumnMutability -> Rep ColumnMutability x)
-> (forall x. Rep ColumnMutability x -> ColumnMutability)
-> Generic ColumnMutability
forall x. Rep ColumnMutability x -> ColumnMutability
forall x. ColumnMutability -> Rep ColumnMutability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnMutability -> Rep ColumnMutability x
from :: forall x. ColumnMutability -> Rep ColumnMutability x
$cto :: forall x. Rep ColumnMutability x -> ColumnMutability
to :: forall x. Rep ColumnMutability x -> ColumnMutability
Generic, Int -> ColumnMutability -> ShowS
[ColumnMutability] -> ShowS
ColumnMutability -> String
(Int -> ColumnMutability -> ShowS)
-> (ColumnMutability -> String)
-> ([ColumnMutability] -> ShowS)
-> Show ColumnMutability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnMutability -> ShowS
showsPrec :: Int -> ColumnMutability -> ShowS
$cshow :: ColumnMutability -> String
show :: ColumnMutability -> String
$cshowList :: [ColumnMutability] -> ShowS
showList :: [ColumnMutability] -> ShowS
Show)

instance NFData ColumnMutability

instance Hashable ColumnMutability

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

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

-- | “Resolved” column info, produced from a 'RawColumnInfo' value that has been combined with
-- other schema information to produce a 'PGColumnType'.
data ColumnInfo (b :: BackendType) = ColumnInfo
  { forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn :: Column b,
    -- | field name exposed in GraphQL interface
    forall (b :: BackendType). ColumnInfo b -> Name
ciName :: G.Name,
    forall (b :: BackendType). ColumnInfo b -> Int
ciPosition :: Int,
    forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType :: ColumnType b,
    forall (b :: BackendType). ColumnInfo b -> Bool
ciIsNullable :: Bool,
    forall (b :: BackendType). ColumnInfo b -> Maybe Description
ciDescription :: Maybe G.Description,
    forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciMutability :: ColumnMutability
  }
  deriving ((forall x. ColumnInfo b -> Rep (ColumnInfo b) x)
-> (forall x. Rep (ColumnInfo b) x -> ColumnInfo b)
-> Generic (ColumnInfo b)
forall x. Rep (ColumnInfo b) x -> ColumnInfo b
forall x. ColumnInfo b -> Rep (ColumnInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (ColumnInfo b) x -> ColumnInfo b
forall (b :: BackendType) x. ColumnInfo b -> Rep (ColumnInfo b) x
$cfrom :: forall (b :: BackendType) x. ColumnInfo b -> Rep (ColumnInfo b) x
from :: forall x. ColumnInfo b -> Rep (ColumnInfo b) x
$cto :: forall (b :: BackendType) x. Rep (ColumnInfo b) x -> ColumnInfo b
to :: forall x. Rep (ColumnInfo b) x -> ColumnInfo b
Generic)

deriving instance (Backend b) => Eq (ColumnInfo b)

deriving instance (Backend b) => Ord (ColumnInfo b)

deriving instance (Backend b) => Show (ColumnInfo b)

instance (Backend b) => NFData (ColumnInfo b)

instance (Backend b) => Hashable (ColumnInfo b)

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

data NestedObjectInfo b = NestedObjectInfo
  { forall (b :: BackendType). NestedObjectInfo b -> XNestedObjects b
_noiSupportsNestedObjects :: XNestedObjects b,
    forall (b :: BackendType). NestedObjectInfo b -> Column b
_noiColumn :: Column b,
    forall (b :: BackendType). NestedObjectInfo b -> Name
_noiName :: G.Name,
    forall (b :: BackendType). NestedObjectInfo b -> LogicalModelName
_noiType :: LogicalModelName,
    forall (b :: BackendType). NestedObjectInfo b -> Bool
_noiIsNullable :: Bool,
    forall (b :: BackendType). NestedObjectInfo b -> Maybe Description
_noiDescription :: Maybe G.Description,
    forall (b :: BackendType). NestedObjectInfo b -> ColumnMutability
_noiMutability :: ColumnMutability
  }
  deriving ((forall x. NestedObjectInfo b -> Rep (NestedObjectInfo b) x)
-> (forall x. Rep (NestedObjectInfo b) x -> NestedObjectInfo b)
-> Generic (NestedObjectInfo b)
forall x. Rep (NestedObjectInfo b) x -> NestedObjectInfo b
forall x. NestedObjectInfo b -> Rep (NestedObjectInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (NestedObjectInfo b) x -> NestedObjectInfo b
forall (b :: BackendType) x.
NestedObjectInfo b -> Rep (NestedObjectInfo b) x
$cfrom :: forall (b :: BackendType) x.
NestedObjectInfo b -> Rep (NestedObjectInfo b) x
from :: forall x. NestedObjectInfo b -> Rep (NestedObjectInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (NestedObjectInfo b) x -> NestedObjectInfo b
to :: forall x. Rep (NestedObjectInfo b) x -> NestedObjectInfo b
Generic)

deriving instance (Backend b) => Eq (NestedObjectInfo b)

deriving instance (Backend b) => Ord (NestedObjectInfo b)

deriving instance (Backend b) => Show (NestedObjectInfo b)

instance (Backend b) => NFData (NestedObjectInfo b)

instance (Backend b) => Hashable (NestedObjectInfo b)

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

data NestedArrayInfo b = NestedArrayInfo
  { forall (b :: BackendType). NestedArrayInfo b -> XNestedObjects b
_naiSupportsNestedArrays :: XNestedObjects b,
    forall (b :: BackendType). NestedArrayInfo b -> Bool
_naiIsNullable :: Bool,
    forall (b :: BackendType).
NestedArrayInfo b -> StructuredColumnInfo b
_naiColumnInfo :: StructuredColumnInfo b
  }
  deriving ((forall x. NestedArrayInfo b -> Rep (NestedArrayInfo b) x)
-> (forall x. Rep (NestedArrayInfo b) x -> NestedArrayInfo b)
-> Generic (NestedArrayInfo b)
forall x. Rep (NestedArrayInfo b) x -> NestedArrayInfo b
forall x. NestedArrayInfo b -> Rep (NestedArrayInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (NestedArrayInfo b) x -> NestedArrayInfo b
forall (b :: BackendType) x.
NestedArrayInfo b -> Rep (NestedArrayInfo b) x
$cfrom :: forall (b :: BackendType) x.
NestedArrayInfo b -> Rep (NestedArrayInfo b) x
from :: forall x. NestedArrayInfo b -> Rep (NestedArrayInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (NestedArrayInfo b) x -> NestedArrayInfo b
to :: forall x. Rep (NestedArrayInfo b) x -> NestedArrayInfo b
Generic)

deriving instance (Backend b) => Eq (NestedArrayInfo b)

deriving instance (Backend b) => Ord (NestedArrayInfo b)

deriving instance (Backend b) => Show (NestedArrayInfo b)

instance (Backend b) => NFData (NestedArrayInfo b)

instance (Backend b) => Hashable (NestedArrayInfo b)

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

data StructuredColumnInfo b
  = SCIScalarColumn (ColumnInfo b)
  | SCIObjectColumn (NestedObjectInfo b)
  | SCIArrayColumn (NestedArrayInfo b)
  deriving ((forall x.
 StructuredColumnInfo b -> Rep (StructuredColumnInfo b) x)
-> (forall x.
    Rep (StructuredColumnInfo b) x -> StructuredColumnInfo b)
-> Generic (StructuredColumnInfo b)
forall x. Rep (StructuredColumnInfo b) x -> StructuredColumnInfo b
forall x. StructuredColumnInfo b -> Rep (StructuredColumnInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (StructuredColumnInfo b) x -> StructuredColumnInfo b
forall (b :: BackendType) x.
StructuredColumnInfo b -> Rep (StructuredColumnInfo b) x
$cfrom :: forall (b :: BackendType) x.
StructuredColumnInfo b -> Rep (StructuredColumnInfo b) x
from :: forall x. StructuredColumnInfo b -> Rep (StructuredColumnInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (StructuredColumnInfo b) x -> StructuredColumnInfo b
to :: forall x. Rep (StructuredColumnInfo b) x -> StructuredColumnInfo b
Generic)

deriving instance (Backend b) => Eq (StructuredColumnInfo b)

deriving instance (Backend b) => Ord (StructuredColumnInfo b)

deriving instance (Backend b) => Show (StructuredColumnInfo b)

instance (Backend b) => NFData (StructuredColumnInfo b)

instance (Backend b) => Hashable (StructuredColumnInfo b)

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

structuredColumnInfoName :: StructuredColumnInfo b -> G.Name
structuredColumnInfoName :: forall (b :: BackendType). StructuredColumnInfo b -> Name
structuredColumnInfoName = \case
  SCIScalarColumn ColumnInfo {Bool
Int
Maybe Description
Name
Column b
ColumnType b
ColumnMutability
ciColumn :: forall (b :: BackendType). ColumnInfo b -> Column b
ciName :: forall (b :: BackendType). ColumnInfo b -> Name
ciPosition :: forall (b :: BackendType). ColumnInfo b -> Int
ciType :: forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciIsNullable :: forall (b :: BackendType). ColumnInfo b -> Bool
ciDescription :: forall (b :: BackendType). ColumnInfo b -> Maybe Description
ciMutability :: forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciColumn :: Column b
ciName :: Name
ciPosition :: Int
ciType :: ColumnType b
ciIsNullable :: Bool
ciDescription :: Maybe Description
ciMutability :: ColumnMutability
..} -> Name
ciName
  SCIObjectColumn NestedObjectInfo {Bool
Maybe Description
Name
Column b
XNestedObjects b
LogicalModelName
ColumnMutability
_noiSupportsNestedObjects :: forall (b :: BackendType). NestedObjectInfo b -> XNestedObjects b
_noiColumn :: forall (b :: BackendType). NestedObjectInfo b -> Column b
_noiName :: forall (b :: BackendType). NestedObjectInfo b -> Name
_noiType :: forall (b :: BackendType). NestedObjectInfo b -> LogicalModelName
_noiIsNullable :: forall (b :: BackendType). NestedObjectInfo b -> Bool
_noiDescription :: forall (b :: BackendType). NestedObjectInfo b -> Maybe Description
_noiMutability :: forall (b :: BackendType). NestedObjectInfo b -> ColumnMutability
_noiSupportsNestedObjects :: XNestedObjects b
_noiColumn :: Column b
_noiName :: Name
_noiType :: LogicalModelName
_noiIsNullable :: Bool
_noiDescription :: Maybe Description
_noiMutability :: ColumnMutability
..} -> Name
_noiName
  SCIArrayColumn NestedArrayInfo {Bool
XNestedObjects b
StructuredColumnInfo b
_naiSupportsNestedArrays :: forall (b :: BackendType). NestedArrayInfo b -> XNestedObjects b
_naiIsNullable :: forall (b :: BackendType). NestedArrayInfo b -> Bool
_naiColumnInfo :: forall (b :: BackendType).
NestedArrayInfo b -> StructuredColumnInfo b
_naiSupportsNestedArrays :: XNestedObjects b
_naiIsNullable :: Bool
_naiColumnInfo :: StructuredColumnInfo b
..} -> StructuredColumnInfo b -> Name
forall (b :: BackendType). StructuredColumnInfo b -> Name
structuredColumnInfoName StructuredColumnInfo b
_naiColumnInfo

structuredColumnInfoColumn :: StructuredColumnInfo b -> Column b
structuredColumnInfoColumn :: forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn = \case
  SCIScalarColumn ColumnInfo {Bool
Int
Maybe Description
Name
Column b
ColumnType b
ColumnMutability
ciColumn :: forall (b :: BackendType). ColumnInfo b -> Column b
ciName :: forall (b :: BackendType). ColumnInfo b -> Name
ciPosition :: forall (b :: BackendType). ColumnInfo b -> Int
ciType :: forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciIsNullable :: forall (b :: BackendType). ColumnInfo b -> Bool
ciDescription :: forall (b :: BackendType). ColumnInfo b -> Maybe Description
ciMutability :: forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciColumn :: Column b
ciName :: Name
ciPosition :: Int
ciType :: ColumnType b
ciIsNullable :: Bool
ciDescription :: Maybe Description
ciMutability :: ColumnMutability
..} -> Column b
ciColumn
  SCIObjectColumn NestedObjectInfo {Bool
Maybe Description
Name
Column b
XNestedObjects b
LogicalModelName
ColumnMutability
_noiSupportsNestedObjects :: forall (b :: BackendType). NestedObjectInfo b -> XNestedObjects b
_noiColumn :: forall (b :: BackendType). NestedObjectInfo b -> Column b
_noiName :: forall (b :: BackendType). NestedObjectInfo b -> Name
_noiType :: forall (b :: BackendType). NestedObjectInfo b -> LogicalModelName
_noiIsNullable :: forall (b :: BackendType). NestedObjectInfo b -> Bool
_noiDescription :: forall (b :: BackendType). NestedObjectInfo b -> Maybe Description
_noiMutability :: forall (b :: BackendType). NestedObjectInfo b -> ColumnMutability
_noiSupportsNestedObjects :: XNestedObjects b
_noiColumn :: Column b
_noiName :: Name
_noiType :: LogicalModelName
_noiIsNullable :: Bool
_noiDescription :: Maybe Description
_noiMutability :: ColumnMutability
..} -> Column b
_noiColumn
  SCIArrayColumn NestedArrayInfo {Bool
XNestedObjects b
StructuredColumnInfo b
_naiSupportsNestedArrays :: forall (b :: BackendType). NestedArrayInfo b -> XNestedObjects b
_naiIsNullable :: forall (b :: BackendType). NestedArrayInfo b -> Bool
_naiColumnInfo :: forall (b :: BackendType).
NestedArrayInfo b -> StructuredColumnInfo b
_naiSupportsNestedArrays :: XNestedObjects b
_naiIsNullable :: Bool
_naiColumnInfo :: StructuredColumnInfo b
..} -> StructuredColumnInfo b -> Column b
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn StructuredColumnInfo b
_naiColumnInfo

structuredColumnInfoMutability :: StructuredColumnInfo b -> ColumnMutability
structuredColumnInfoMutability :: forall (b :: BackendType).
StructuredColumnInfo b -> ColumnMutability
structuredColumnInfoMutability = \case
  SCIScalarColumn ColumnInfo {Bool
Int
Maybe Description
Name
Column b
ColumnType b
ColumnMutability
ciColumn :: forall (b :: BackendType). ColumnInfo b -> Column b
ciName :: forall (b :: BackendType). ColumnInfo b -> Name
ciPosition :: forall (b :: BackendType). ColumnInfo b -> Int
ciType :: forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciIsNullable :: forall (b :: BackendType). ColumnInfo b -> Bool
ciDescription :: forall (b :: BackendType). ColumnInfo b -> Maybe Description
ciMutability :: forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciColumn :: Column b
ciName :: Name
ciPosition :: Int
ciType :: ColumnType b
ciIsNullable :: Bool
ciDescription :: Maybe Description
ciMutability :: ColumnMutability
..} -> ColumnMutability
ciMutability
  SCIObjectColumn NestedObjectInfo {Bool
Maybe Description
Name
Column b
XNestedObjects b
LogicalModelName
ColumnMutability
_noiSupportsNestedObjects :: forall (b :: BackendType). NestedObjectInfo b -> XNestedObjects b
_noiColumn :: forall (b :: BackendType). NestedObjectInfo b -> Column b
_noiName :: forall (b :: BackendType). NestedObjectInfo b -> Name
_noiType :: forall (b :: BackendType). NestedObjectInfo b -> LogicalModelName
_noiIsNullable :: forall (b :: BackendType). NestedObjectInfo b -> Bool
_noiDescription :: forall (b :: BackendType). NestedObjectInfo b -> Maybe Description
_noiMutability :: forall (b :: BackendType). NestedObjectInfo b -> ColumnMutability
_noiSupportsNestedObjects :: XNestedObjects b
_noiColumn :: Column b
_noiName :: Name
_noiType :: LogicalModelName
_noiIsNullable :: Bool
_noiDescription :: Maybe Description
_noiMutability :: ColumnMutability
..} -> ColumnMutability
_noiMutability
  SCIArrayColumn NestedArrayInfo {Bool
XNestedObjects b
StructuredColumnInfo b
_naiSupportsNestedArrays :: forall (b :: BackendType). NestedArrayInfo b -> XNestedObjects b
_naiIsNullable :: forall (b :: BackendType). NestedArrayInfo b -> Bool
_naiColumnInfo :: forall (b :: BackendType).
NestedArrayInfo b -> StructuredColumnInfo b
_naiSupportsNestedArrays :: XNestedObjects b
_naiIsNullable :: Bool
_naiColumnInfo :: StructuredColumnInfo b
..} -> StructuredColumnInfo b -> ColumnMutability
forall (b :: BackendType).
StructuredColumnInfo b -> ColumnMutability
structuredColumnInfoMutability StructuredColumnInfo b
_naiColumnInfo

toScalarColumnInfo :: StructuredColumnInfo b -> Maybe (ColumnInfo b)
toScalarColumnInfo :: forall (b :: BackendType).
StructuredColumnInfo b -> Maybe (ColumnInfo b)
toScalarColumnInfo = \case
  SCIScalarColumn ColumnInfo b
ci -> ColumnInfo b -> Maybe (ColumnInfo b)
forall a. a -> Maybe a
Just ColumnInfo b
ci
  StructuredColumnInfo b
_ -> Maybe (ColumnInfo b)
forall a. Maybe a
Nothing

$(makePrisms ''StructuredColumnInfo)

type PrimaryKeyColumns b = NESeq (ColumnInfo b)

onlyNumCols :: forall b. (Backend b) => [ColumnInfo b] -> [ColumnInfo b]
onlyNumCols :: forall (b :: BackendType).
Backend b =>
[ColumnInfo b] -> [ColumnInfo b]
onlyNumCols = (ColumnInfo b -> Bool) -> [ColumnInfo b] -> [ColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter ColumnInfo b -> Bool
forall (b :: BackendType). Backend b => ColumnInfo b -> Bool
isNumCol

isNumCol :: forall b. (Backend b) => ColumnInfo b -> Bool
isNumCol :: forall (b :: BackendType). Backend b => ColumnInfo b -> Bool
isNumCol = (ScalarType b -> Bool) -> ColumnType b -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (forall (b :: BackendType). Backend b => ScalarType b -> Bool
isNumType @b) (ColumnType b -> Bool)
-> (ColumnInfo b -> ColumnType b) -> ColumnInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType

onlyComparableCols :: forall b. (Backend b) => [ColumnInfo b] -> [ColumnInfo b]
onlyComparableCols :: forall (b :: BackendType).
Backend b =>
[ColumnInfo b] -> [ColumnInfo b]
onlyComparableCols = (ColumnInfo b -> Bool) -> [ColumnInfo b] -> [ColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter (forall (b :: BackendType). Backend b => ColumnInfo b -> Bool
isComparableCol @b)

isComparableCol :: forall b. (Backend b) => ColumnInfo b -> Bool
isComparableCol :: forall (b :: BackendType). Backend b => ColumnInfo b -> Bool
isComparableCol = (ScalarType b -> Bool) -> ColumnType b -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (forall (b :: BackendType). Backend b => ScalarType b -> Bool
isComparableType @b) (ColumnType b -> Bool)
-> (ColumnInfo b -> ColumnType b) -> ColumnInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType

getColInfos :: (Backend b) => [Column b] -> [ColumnInfo b] -> [ColumnInfo b]
getColInfos :: forall (b :: BackendType).
Backend b =>
[Column b] -> [ColumnInfo b] -> [ColumnInfo b]
getColInfos [Column b]
cols [ColumnInfo b]
allColInfos =
  ((ColumnInfo b -> Bool) -> [ColumnInfo b] -> [ColumnInfo b])
-> [ColumnInfo b] -> (ColumnInfo b -> Bool) -> [ColumnInfo b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ColumnInfo b -> Bool) -> [ColumnInfo b] -> [ColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter [ColumnInfo b]
allColInfos ((ColumnInfo b -> Bool) -> [ColumnInfo b])
-> (ColumnInfo b -> Bool) -> [ColumnInfo b]
forall a b. (a -> b) -> a -> b
$ \ColumnInfo b
ci -> ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
ci Column b -> [Column b] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Column b]
cols

fromCol :: (Backend b) => Column b -> FieldName
fromCol :: forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol = Text -> FieldName
FieldName (Text -> FieldName) -> (Column b -> Text) -> Column b -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column b -> Text
forall a. ToTxt a => a -> Text
toTxt

type ColumnValues b a = HashMap (Column b) a

-- | Represents a reference to a source column, possibly casted an arbitrary
-- number of times. Used within 'parseBoolExpOperations' for bookkeeping.
data ColumnReference (b :: BackendType)
  = ColumnReferenceColumn (ColumnInfo b)
  | ColumnReferenceComputedField ComputedFieldName (ScalarType b)
  | ColumnReferenceCast (ColumnReference b) (ColumnType b)

-- | Whether the column referred to might be null. Currently we can only tell
-- for references that refer to proper relation columns.
columnReferenceNullable :: ColumnReference (b :: BackendType) -> Maybe Bool
columnReferenceNullable :: forall (b :: BackendType). ColumnReference b -> Maybe Bool
columnReferenceNullable (ColumnReferenceColumn ColumnInfo b
ci) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> Bool
forall (b :: BackendType). ColumnInfo b -> Bool
ciIsNullable ColumnInfo b
ci
columnReferenceNullable ColumnReference b
_ = Maybe Bool
forall a. Maybe a
Nothing

columnReferenceType :: ColumnReference backend -> ColumnType backend
columnReferenceType :: forall (backend :: BackendType).
ColumnReference backend -> ColumnType backend
columnReferenceType = \case
  ColumnReferenceColumn ColumnInfo backend
column -> ColumnInfo backend -> ColumnType backend
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo backend
column
  ColumnReferenceComputedField ComputedFieldName
_ ScalarType backend
scalarType -> ScalarType backend -> ColumnType backend
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType backend
scalarType
  ColumnReferenceCast ColumnReference backend
_ ColumnType backend
targetType -> ColumnType backend
targetType

instance (Backend b) => ToTxt (ColumnReference b) where
  toTxt :: ColumnReference b -> Text
toTxt = \case
    ColumnReferenceColumn ColumnInfo b
column -> Column b -> Text
forall a. ToTxt a => a -> Text
toTxt (Column b -> Text) -> Column b -> Text
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
column
    ColumnReferenceComputedField ComputedFieldName
name ScalarType b
_ -> ComputedFieldName -> Text
forall a. ToTxt a => a -> Text
toTxt ComputedFieldName
name
    ColumnReferenceCast ColumnReference b
reference ColumnType b
targetType ->
      ColumnReference b -> Text
forall a. ToTxt a => a -> Text
toTxt ColumnReference b
reference Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnType b -> Text
forall a. ToTxt a => a -> Text
toTxt ColumnType b
targetType