{-# LANGUAGE TemplateHaskell #-}

-- | Postgres types related to computed fields
module Hasura.Backends.Postgres.Types.ComputedField
  ( ComputedFieldDefinition (..),
    FunctionTableArgument (..),
    FunctionSessionArgument (..),
    ComputedFieldImplicitArguments (..),
    fromComputedFieldImplicitArguments,
    ComputedFieldReturn (..),
    _CFRScalar,
    _CFRSetofTable,
  )
where

import Control.Lens.TH (makePrisms)
import Data.Aeson.Casing
import Data.Aeson.Extended
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Types.Function
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.Types.Function

data ComputedFieldDefinition = ComputedFieldDefinition
  { ComputedFieldDefinition -> QualifiedFunction
_cfdFunction :: QualifiedFunction,
    ComputedFieldDefinition -> Maybe FunctionArgName
_cfdTableArgument :: Maybe FunctionArgName,
    ComputedFieldDefinition -> Maybe FunctionArgName
_cfdSessionArgument :: Maybe FunctionArgName
  }
  deriving (Int -> ComputedFieldDefinition -> ShowS
[ComputedFieldDefinition] -> ShowS
ComputedFieldDefinition -> String
(Int -> ComputedFieldDefinition -> ShowS)
-> (ComputedFieldDefinition -> String)
-> ([ComputedFieldDefinition] -> ShowS)
-> Show ComputedFieldDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputedFieldDefinition] -> ShowS
$cshowList :: [ComputedFieldDefinition] -> ShowS
show :: ComputedFieldDefinition -> String
$cshow :: ComputedFieldDefinition -> String
showsPrec :: Int -> ComputedFieldDefinition -> ShowS
$cshowsPrec :: Int -> ComputedFieldDefinition -> ShowS
Show, ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
(ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> (ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> Eq ComputedFieldDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
$c/= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
== :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
$c== :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
Eq, (forall x.
 ComputedFieldDefinition -> Rep ComputedFieldDefinition x)
-> (forall x.
    Rep ComputedFieldDefinition x -> ComputedFieldDefinition)
-> Generic ComputedFieldDefinition
forall x. Rep ComputedFieldDefinition x -> ComputedFieldDefinition
forall x. ComputedFieldDefinition -> Rep ComputedFieldDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComputedFieldDefinition x -> ComputedFieldDefinition
$cfrom :: forall x. ComputedFieldDefinition -> Rep ComputedFieldDefinition x
Generic)

instance NFData ComputedFieldDefinition

instance Hashable ComputedFieldDefinition

instance Cacheable ComputedFieldDefinition

instance ToJSON ComputedFieldDefinition where
  toJSON :: ComputedFieldDefinition -> Value
toJSON = Options -> ComputedFieldDefinition -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON ComputedFieldDefinition where
  parseJSON :: Value -> Parser ComputedFieldDefinition
parseJSON = Options -> Value -> Parser ComputedFieldDefinition
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

-- | The function table argument is either the very first argument or the named
-- argument with an index. The index is 0 if the named argument is the first.
data FunctionTableArgument
  = FTAFirst
  | FTANamed
      FunctionArgName
      -- ^ argument name
      Int
      -- ^ argument index
  deriving (Int -> FunctionTableArgument -> ShowS
[FunctionTableArgument] -> ShowS
FunctionTableArgument -> String
(Int -> FunctionTableArgument -> ShowS)
-> (FunctionTableArgument -> String)
-> ([FunctionTableArgument] -> ShowS)
-> Show FunctionTableArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionTableArgument] -> ShowS
$cshowList :: [FunctionTableArgument] -> ShowS
show :: FunctionTableArgument -> String
$cshow :: FunctionTableArgument -> String
showsPrec :: Int -> FunctionTableArgument -> ShowS
$cshowsPrec :: Int -> FunctionTableArgument -> ShowS
Show, FunctionTableArgument -> FunctionTableArgument -> Bool
(FunctionTableArgument -> FunctionTableArgument -> Bool)
-> (FunctionTableArgument -> FunctionTableArgument -> Bool)
-> Eq FunctionTableArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionTableArgument -> FunctionTableArgument -> Bool
$c/= :: FunctionTableArgument -> FunctionTableArgument -> Bool
== :: FunctionTableArgument -> FunctionTableArgument -> Bool
$c== :: FunctionTableArgument -> FunctionTableArgument -> Bool
Eq, (forall x. FunctionTableArgument -> Rep FunctionTableArgument x)
-> (forall x. Rep FunctionTableArgument x -> FunctionTableArgument)
-> Generic FunctionTableArgument
forall x. Rep FunctionTableArgument x -> FunctionTableArgument
forall x. FunctionTableArgument -> Rep FunctionTableArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionTableArgument x -> FunctionTableArgument
$cfrom :: forall x. FunctionTableArgument -> Rep FunctionTableArgument x
Generic)

instance Cacheable FunctionTableArgument

instance NFData FunctionTableArgument

instance Hashable FunctionTableArgument

instance ToJSON FunctionTableArgument where
  toJSON :: FunctionTableArgument -> Value
toJSON FunctionTableArgument
FTAFirst = Text -> Value
String Text
"first_argument"
  toJSON (FTANamed FunctionArgName
argName Int
_) = [Pair] -> Value
object [Key
"name" Key -> FunctionArgName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FunctionArgName
argName]

-- | The session argument, which passes Hasura session variables to a
-- SQL function as a JSON object.
data FunctionSessionArgument
  = FunctionSessionArgument
      FunctionArgName
      -- ^ The argument name
      Int
      -- ^ The ordinal position in the function input parameters
  deriving (Int -> FunctionSessionArgument -> ShowS
[FunctionSessionArgument] -> ShowS
FunctionSessionArgument -> String
(Int -> FunctionSessionArgument -> ShowS)
-> (FunctionSessionArgument -> String)
-> ([FunctionSessionArgument] -> ShowS)
-> Show FunctionSessionArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionSessionArgument] -> ShowS
$cshowList :: [FunctionSessionArgument] -> ShowS
show :: FunctionSessionArgument -> String
$cshow :: FunctionSessionArgument -> String
showsPrec :: Int -> FunctionSessionArgument -> ShowS
$cshowsPrec :: Int -> FunctionSessionArgument -> ShowS
Show, FunctionSessionArgument -> FunctionSessionArgument -> Bool
(FunctionSessionArgument -> FunctionSessionArgument -> Bool)
-> (FunctionSessionArgument -> FunctionSessionArgument -> Bool)
-> Eq FunctionSessionArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionSessionArgument -> FunctionSessionArgument -> Bool
$c/= :: FunctionSessionArgument -> FunctionSessionArgument -> Bool
== :: FunctionSessionArgument -> FunctionSessionArgument -> Bool
$c== :: FunctionSessionArgument -> FunctionSessionArgument -> Bool
Eq, (forall x.
 FunctionSessionArgument -> Rep FunctionSessionArgument x)
-> (forall x.
    Rep FunctionSessionArgument x -> FunctionSessionArgument)
-> Generic FunctionSessionArgument
forall x. Rep FunctionSessionArgument x -> FunctionSessionArgument
forall x. FunctionSessionArgument -> Rep FunctionSessionArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionSessionArgument x -> FunctionSessionArgument
$cfrom :: forall x. FunctionSessionArgument -> Rep FunctionSessionArgument x
Generic)

instance Cacheable FunctionSessionArgument

instance NFData FunctionSessionArgument

instance Hashable FunctionSessionArgument

instance ToJSON FunctionSessionArgument where
  toJSON :: FunctionSessionArgument -> Value
toJSON (FunctionSessionArgument FunctionArgName
argName Int
_) = FunctionArgName -> Value
forall a. ToJSON a => a -> Value
toJSON FunctionArgName
argName

data ComputedFieldImplicitArguments = ComputedFieldImplicitArguments
  { ComputedFieldImplicitArguments -> FunctionTableArgument
_cffaTableArgument :: FunctionTableArgument,
    ComputedFieldImplicitArguments -> Maybe FunctionSessionArgument
_cffaSessionArgument :: Maybe FunctionSessionArgument
  }
  deriving stock (Int -> ComputedFieldImplicitArguments -> ShowS
[ComputedFieldImplicitArguments] -> ShowS
ComputedFieldImplicitArguments -> String
(Int -> ComputedFieldImplicitArguments -> ShowS)
-> (ComputedFieldImplicitArguments -> String)
-> ([ComputedFieldImplicitArguments] -> ShowS)
-> Show ComputedFieldImplicitArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputedFieldImplicitArguments] -> ShowS
$cshowList :: [ComputedFieldImplicitArguments] -> ShowS
show :: ComputedFieldImplicitArguments -> String
$cshow :: ComputedFieldImplicitArguments -> String
showsPrec :: Int -> ComputedFieldImplicitArguments -> ShowS
$cshowsPrec :: Int -> ComputedFieldImplicitArguments -> ShowS
Show, ComputedFieldImplicitArguments
-> ComputedFieldImplicitArguments -> Bool
(ComputedFieldImplicitArguments
 -> ComputedFieldImplicitArguments -> Bool)
-> (ComputedFieldImplicitArguments
    -> ComputedFieldImplicitArguments -> Bool)
-> Eq ComputedFieldImplicitArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputedFieldImplicitArguments
-> ComputedFieldImplicitArguments -> Bool
$c/= :: ComputedFieldImplicitArguments
-> ComputedFieldImplicitArguments -> Bool
== :: ComputedFieldImplicitArguments
-> ComputedFieldImplicitArguments -> Bool
$c== :: ComputedFieldImplicitArguments
-> ComputedFieldImplicitArguments -> Bool
Eq, (forall x.
 ComputedFieldImplicitArguments
 -> Rep ComputedFieldImplicitArguments x)
-> (forall x.
    Rep ComputedFieldImplicitArguments x
    -> ComputedFieldImplicitArguments)
-> Generic ComputedFieldImplicitArguments
forall x.
Rep ComputedFieldImplicitArguments x
-> ComputedFieldImplicitArguments
forall x.
ComputedFieldImplicitArguments
-> Rep ComputedFieldImplicitArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ComputedFieldImplicitArguments x
-> ComputedFieldImplicitArguments
$cfrom :: forall x.
ComputedFieldImplicitArguments
-> Rep ComputedFieldImplicitArguments x
Generic)

instance NFData ComputedFieldImplicitArguments

instance Hashable ComputedFieldImplicitArguments

instance Cacheable ComputedFieldImplicitArguments

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

fromComputedFieldImplicitArguments ::
  v ->
  ComputedFieldImplicitArguments ->
  [ArgumentExp v]
fromComputedFieldImplicitArguments :: v -> ComputedFieldImplicitArguments -> [ArgumentExp v]
fromComputedFieldImplicitArguments v
_ (ComputedFieldImplicitArguments FunctionTableArgument
_ Maybe FunctionSessionArgument
Nothing) = [ArgumentExp v
forall a. ArgumentExp a
AETableRow] -- No session argument
fromComputedFieldImplicitArguments v
sess (ComputedFieldImplicitArguments FunctionTableArgument
FTAFirst Maybe FunctionSessionArgument
_) = [ArgumentExp v
forall a. ArgumentExp a
AETableRow, v -> ArgumentExp v
forall a. a -> ArgumentExp a
AESession v
sess]
fromComputedFieldImplicitArguments v
sess (ComputedFieldImplicitArguments (FTANamed FunctionArgName
_ Int
0) Maybe FunctionSessionArgument
_) = [ArgumentExp v
forall a. ArgumentExp a
AETableRow, v -> ArgumentExp v
forall a. a -> ArgumentExp a
AESession v
sess] -- Index is 0 implies table argument is first
fromComputedFieldImplicitArguments v
sess ComputedFieldImplicitArguments
_ = [v -> ArgumentExp v
forall a. a -> ArgumentExp a
AESession v
sess, ArgumentExp v
forall a. ArgumentExp a
AETableRow]

data ComputedFieldReturn
  = CFRScalar PGScalarType
  | CFRSetofTable QualifiedTable
  deriving (Int -> ComputedFieldReturn -> ShowS
[ComputedFieldReturn] -> ShowS
ComputedFieldReturn -> String
(Int -> ComputedFieldReturn -> ShowS)
-> (ComputedFieldReturn -> String)
-> ([ComputedFieldReturn] -> ShowS)
-> Show ComputedFieldReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputedFieldReturn] -> ShowS
$cshowList :: [ComputedFieldReturn] -> ShowS
show :: ComputedFieldReturn -> String
$cshow :: ComputedFieldReturn -> String
showsPrec :: Int -> ComputedFieldReturn -> ShowS
$cshowsPrec :: Int -> ComputedFieldReturn -> ShowS
Show, ComputedFieldReturn -> ComputedFieldReturn -> Bool
(ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> (ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> Eq ComputedFieldReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
$c/= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
== :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
$c== :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
Eq, (forall x. ComputedFieldReturn -> Rep ComputedFieldReturn x)
-> (forall x. Rep ComputedFieldReturn x -> ComputedFieldReturn)
-> Generic ComputedFieldReturn
forall x. Rep ComputedFieldReturn x -> ComputedFieldReturn
forall x. ComputedFieldReturn -> Rep ComputedFieldReturn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComputedFieldReturn x -> ComputedFieldReturn
$cfrom :: forall x. ComputedFieldReturn -> Rep ComputedFieldReturn x
Generic)

instance Cacheable ComputedFieldReturn

instance NFData ComputedFieldReturn

instance Hashable ComputedFieldReturn

instance ToJSON ComputedFieldReturn where
  toJSON :: ComputedFieldReturn -> Value
toJSON =
    Options -> ComputedFieldReturn -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ComputedFieldReturn -> Value)
-> Options -> ComputedFieldReturn -> Value
forall a b. (a -> b) -> a -> b
$
      Options
defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3,
          sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject String
"type" String
"info"
        }

$(makePrisms ''ComputedFieldReturn)