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

module Hasura.RQL.Types.Column
  ( ColumnType (..),
    _ColumnScalar,
    _ColumnEnumReference,
    isEnumColumn,
    isScalarColumnWhere,
    ValueParser,
    onlyNumCols,
    isNumCol,
    onlyComparableCols,
    parseScalarValueColumnType,
    parseScalarValuesColumnType,
    ColumnValue (..),
    ColumnMutability (..),
    ColumnInfo (..),
    RawColumnInfo (..),
    PrimaryKeyColumns,
    getColInfos,
    EnumReference (..),
    EnumValues,
    EnumValue (..),
    EnumValueInfo (..),
    fromCol,
    ColumnValues,
    ColumnReference (..),
    columnReferenceType,
  )
where

import Control.Lens.TH
import Data.Aeson
import Data.Aeson.TH
import Data.HashMap.Strict qualified as M
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Language.GraphQL.Draft.Syntax qualified as G

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

newtype EnumValueInfo = EnumValueInfo
  { EnumValueInfo -> Maybe Text
evComment :: Maybe Text
  }
  deriving (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
showList :: [EnumValueInfo] -> ShowS
$cshowList :: [EnumValueInfo] -> ShowS
show :: EnumValueInfo -> String
$cshow :: EnumValueInfo -> String
showsPrec :: Int -> EnumValueInfo -> ShowS
$cshowsPrec :: Int -> EnumValueInfo -> ShowS
Show, EnumValueInfo -> EnumValueInfo -> Bool
(EnumValueInfo -> EnumValueInfo -> Bool)
-> (EnumValueInfo -> EnumValueInfo -> Bool) -> Eq EnumValueInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumValueInfo -> EnumValueInfo -> Bool
$c/= :: EnumValueInfo -> EnumValueInfo -> Bool
== :: EnumValueInfo -> EnumValueInfo -> Bool
$c== :: 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
min :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
$cmin :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
max :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
$cmax :: EnumValueInfo -> EnumValueInfo -> EnumValueInfo
>= :: EnumValueInfo -> EnumValueInfo -> Bool
$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
compare :: EnumValueInfo -> EnumValueInfo -> Ordering
$ccompare :: EnumValueInfo -> EnumValueInfo -> Ordering
$cp1Ord :: Eq EnumValueInfo
Ord, EnumValueInfo -> ()
(EnumValueInfo -> ()) -> NFData EnumValueInfo
forall a. (a -> ()) -> NFData a
rnf :: EnumValueInfo -> ()
$crnf :: EnumValueInfo -> ()
NFData, Int -> EnumValueInfo -> Int
EnumValueInfo -> Int
(Int -> EnumValueInfo -> Int)
-> (EnumValueInfo -> Int) -> Hashable EnumValueInfo
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: EnumValueInfo -> Int
$chash :: EnumValueInfo -> Int
hashWithSalt :: Int -> EnumValueInfo -> Int
$chashWithSalt :: Int -> EnumValueInfo -> Int
Hashable, Eq EnumValueInfo
Eq EnumValueInfo
-> (Accesses -> EnumValueInfo -> EnumValueInfo -> Bool)
-> Cacheable EnumValueInfo
Accesses -> EnumValueInfo -> EnumValueInfo -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> EnumValueInfo -> EnumValueInfo -> Bool
$cunchanged :: Accesses -> EnumValueInfo -> EnumValueInfo -> Bool
$cp1Cacheable :: Eq EnumValueInfo
Cacheable)

$(deriveJSON hasuraJSON ''EnumValueInfo)

type EnumValues = M.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
  { EnumReference b -> TableName b
erTable :: TableName b,
    EnumReference b -> EnumValues
erValues :: EnumValues,
    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
$cto :: forall (b :: BackendType) x.
Rep (EnumReference b) x -> EnumReference b
$cfrom :: forall (b :: BackendType) x.
EnumReference b -> Rep (EnumReference b) x
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) => Cacheable (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
showList :: [ColumnType b] -> ShowS
$cshowList :: forall (b :: BackendType). Backend b => [ColumnType b] -> ShowS
show :: ColumnType b -> String
$cshow :: forall (b :: BackendType). Backend b => ColumnType b -> String
showsPrec :: Int -> ColumnType b -> ShowS
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> 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
/= :: 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
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
min :: ColumnType b -> ColumnType b -> ColumnType b
$cmin :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> ColumnType b
max :: ColumnType b -> ColumnType b -> ColumnType b
$cmax :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> ColumnType 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
$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
compare :: ColumnType b -> ColumnType b -> Ordering
$ccompare :: forall (b :: BackendType).
Backend b =>
ColumnType b -> ColumnType b -> Ordering
$cp1Ord :: forall (b :: BackendType). Backend b => Eq (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
$cto :: forall (b :: BackendType) x. Rep (ColumnType b) x -> ColumnType b
$cfrom :: forall (b :: BackendType) x. ColumnType b -> Rep (ColumnType b) x
Generic)

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

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

instance (Backend b) => Cacheable (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
  { ColumnValue b -> ColumnType b
cvType :: ColumnType b,
    ColumnValue b -> ScalarValue b
cvValue :: ScalarValue b
  }

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

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

isScalarColumnWhere :: (ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere :: (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 :: ColumnType b -> Bool
isEnumColumn (ColumnEnumReference EnumReference b
_) = Bool
True
isEnumColumn ColumnType b
_ = Bool
False

-- | Note: Unconditionally accepts null values and returns 'PGNull'.
parseScalarValueColumnType ::
  forall m b.
  (MonadError QErr m, Backend b) =>
  ColumnType b ->
  Value ->
  m (ScalarValue b)
parseScalarValueColumnType :: ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnType ColumnType b
columnType Value
value = case ColumnType b
columnType of
  ColumnScalar ScalarType b
scalarType -> 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
$ ScalarType b -> Value -> Either QErr (ScalarValue b)
forall (b :: BackendType).
Backend b =>
ScalarType b -> Value -> Either QErr (ScalarValue b)
parseScalarValue @b ScalarType b
scalarType Value
value
  ColumnEnumReference (EnumReference TableName b
tableName EnumValues
enumValues Maybe Name
_) ->
    -- maybe (pure $ PGNull PGText) parseEnumValue =<< decodeValue value
    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 (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust 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]
M.keys EnumValues
enumValues
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Name
evn Name -> [Name] -> 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]
enums
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for type "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
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 (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
$ Backend b => Maybe Text -> ScalarValue 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

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

-- | “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
  { 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.
    RawColumnInfo b -> Int
rciPosition :: Int,
    RawColumnInfo b -> ScalarType b
rciType :: ScalarType b,
    RawColumnInfo b -> Bool
rciIsNullable :: Bool,
    RawColumnInfo b -> Maybe Description
rciDescription :: Maybe G.Description,
    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
$cto :: forall (b :: BackendType) x.
Rep (RawColumnInfo b) x -> RawColumnInfo b
$cfrom :: forall (b :: BackendType) x.
RawColumnInfo b -> Rep (RawColumnInfo b) x
Generic)

deriving instance Backend b => Eq (RawColumnInfo b)

deriving instance Backend b => Show (RawColumnInfo b)

instance Backend b => NFData (RawColumnInfo b)

instance Backend b => Cacheable (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
/= :: ColumnMutability -> ColumnMutability -> Bool
$c/= :: ColumnMutability -> ColumnMutability -> Bool
== :: ColumnMutability -> ColumnMutability -> Bool
$c== :: ColumnMutability -> ColumnMutability -> Bool
Eq, (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
$cto :: forall x. Rep ColumnMutability x -> ColumnMutability
$cfrom :: forall x. ColumnMutability -> Rep ColumnMutability x
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
showList :: [ColumnMutability] -> ShowS
$cshowList :: [ColumnMutability] -> ShowS
show :: ColumnMutability -> String
$cshow :: ColumnMutability -> String
showsPrec :: Int -> ColumnMutability -> ShowS
$cshowsPrec :: Int -> ColumnMutability -> ShowS
Show)

instance Cacheable ColumnMutability

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
  { ColumnInfo b -> Column b
ciColumn :: Column b,
    -- | field name exposed in GraphQL interface
    ColumnInfo b -> Name
ciName :: G.Name,
    ColumnInfo b -> Int
ciPosition :: Int,
    ColumnInfo b -> ColumnType b
ciType :: ColumnType b,
    ColumnInfo b -> Bool
ciIsNullable :: Bool,
    ColumnInfo b -> Maybe Description
ciDescription :: Maybe G.Description,
    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
$cto :: forall (b :: BackendType) x. Rep (ColumnInfo b) x -> ColumnInfo b
$cfrom :: forall (b :: BackendType) x. ColumnInfo b -> Rep (ColumnInfo b) x
Generic)

deriving instance Backend b => Eq (ColumnInfo b)

deriving instance Backend b => Show (ColumnInfo b)

instance Backend b => Cacheable (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

type PrimaryKeyColumns b = NESeq (ColumnInfo b)

onlyNumCols :: forall b. Backend b => [ColumnInfo b] -> [ColumnInfo b]
onlyNumCols :: [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 :: ColumnInfo b -> Bool
isNumCol = (ScalarType b -> Bool) -> ColumnType b -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (Backend b => ScalarType b -> Bool
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 :: [ColumnInfo b] -> [ColumnInfo b]
onlyComparableCols = (ColumnInfo b -> Bool) -> [ColumnInfo b] -> [ColumnInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ScalarType b -> Bool) -> ColumnType b -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (Backend b => ScalarType b -> Bool
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 :: [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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Column b]
cols

fromCol :: Backend b => Column b -> FieldName
fromCol :: 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)

columnReferenceType :: ColumnReference backend -> ColumnType backend
columnReferenceType :: 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