{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.Function
  ( DBFunctionsMetadata,
    FunctionArgName (..),
    FunctionCache,
    FunctionConfig (..),
    FunctionCustomRootFields (..),
    FunctionExposedAs (..),
    FunctionInfo (..),
    FunctionInputArgument,
    FunctionPermissionInfo (..),
    FunctionPermissionsMap,
    FunctionVolatility (..),
    InputArgument (..),
    FunctionArgsExpG (..),
    FunctionArgsExp,
    emptyFunctionConfig,
    emptyFunctionCustomRootFields,
    fiComment,
    fiDescription,
    fiExposedAs,
    fiGQLAggregateName,
    fiGQLArgsName,
    fiGQLName,
    fiInputArgs,
    fiJsonAggSelect,
    fiPermissions,
    fiReturnType,
    fiSQLName,
    fiSystemDefined,
    fiVolatility,
    fpmRole,
    funcTypToTxt,
    getFunctionAggregateGQLName,
    getFunctionArgsGQLName,
    getFunctionGQLName,
    getInputArgs,
    emptyFunctionArgsExp,
    _IASessionVariables,
    _IAUserProvided,
  )
where

import Control.Lens
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Char (toLower)
import Data.HashMap.Strict qualified as HM
import Data.List.Extended as LE
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Incremental (Cacheable)
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.SQL.Backend
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G
import Language.Haskell.TH.Syntax

-- | https://www.postgresql.org/docs/current/xfunc-volatility.html
data FunctionVolatility
  = FTVOLATILE
  | FTIMMUTABLE
  | FTSTABLE
  deriving (FunctionVolatility -> FunctionVolatility -> Bool
(FunctionVolatility -> FunctionVolatility -> Bool)
-> (FunctionVolatility -> FunctionVolatility -> Bool)
-> Eq FunctionVolatility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionVolatility -> FunctionVolatility -> Bool
$c/= :: FunctionVolatility -> FunctionVolatility -> Bool
== :: FunctionVolatility -> FunctionVolatility -> Bool
$c== :: FunctionVolatility -> FunctionVolatility -> Bool
Eq, (forall x. FunctionVolatility -> Rep FunctionVolatility x)
-> (forall x. Rep FunctionVolatility x -> FunctionVolatility)
-> Generic FunctionVolatility
forall x. Rep FunctionVolatility x -> FunctionVolatility
forall x. FunctionVolatility -> Rep FunctionVolatility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionVolatility x -> FunctionVolatility
$cfrom :: forall x. FunctionVolatility -> Rep FunctionVolatility x
Generic)

instance NFData FunctionVolatility

instance Cacheable FunctionVolatility

$(deriveJSON defaultOptions {constructorTagModifier = drop 2} ''FunctionVolatility)

funcTypToTxt :: FunctionVolatility -> Text
funcTypToTxt :: FunctionVolatility -> Text
funcTypToTxt FunctionVolatility
FTVOLATILE = Text
"VOLATILE"
funcTypToTxt FunctionVolatility
FTIMMUTABLE = Text
"IMMUTABLE"
funcTypToTxt FunctionVolatility
FTSTABLE = Text
"STABLE"

instance Show FunctionVolatility where
  show :: FunctionVolatility -> String
show = Text -> String
T.unpack (Text -> String)
-> (FunctionVolatility -> Text) -> FunctionVolatility -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionVolatility -> Text
funcTypToTxt

newtype FunctionArgName = FunctionArgName {FunctionArgName -> Text
getFuncArgNameTxt :: Text}
  deriving (Int -> FunctionArgName -> ShowS
[FunctionArgName] -> ShowS
FunctionArgName -> String
(Int -> FunctionArgName -> ShowS)
-> (FunctionArgName -> String)
-> ([FunctionArgName] -> ShowS)
-> Show FunctionArgName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionArgName] -> ShowS
$cshowList :: [FunctionArgName] -> ShowS
show :: FunctionArgName -> String
$cshow :: FunctionArgName -> String
showsPrec :: Int -> FunctionArgName -> ShowS
$cshowsPrec :: Int -> FunctionArgName -> ShowS
Show, FunctionArgName -> FunctionArgName -> Bool
(FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> Eq FunctionArgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionArgName -> FunctionArgName -> Bool
$c/= :: FunctionArgName -> FunctionArgName -> Bool
== :: FunctionArgName -> FunctionArgName -> Bool
$c== :: FunctionArgName -> FunctionArgName -> Bool
Eq, Eq FunctionArgName
Eq FunctionArgName
-> (FunctionArgName -> FunctionArgName -> Ordering)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> FunctionArgName)
-> (FunctionArgName -> FunctionArgName -> FunctionArgName)
-> Ord FunctionArgName
FunctionArgName -> FunctionArgName -> Bool
FunctionArgName -> FunctionArgName -> Ordering
FunctionArgName -> FunctionArgName -> FunctionArgName
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 :: FunctionArgName -> FunctionArgName -> FunctionArgName
$cmin :: FunctionArgName -> FunctionArgName -> FunctionArgName
max :: FunctionArgName -> FunctionArgName -> FunctionArgName
$cmax :: FunctionArgName -> FunctionArgName -> FunctionArgName
>= :: FunctionArgName -> FunctionArgName -> Bool
$c>= :: FunctionArgName -> FunctionArgName -> Bool
> :: FunctionArgName -> FunctionArgName -> Bool
$c> :: FunctionArgName -> FunctionArgName -> Bool
<= :: FunctionArgName -> FunctionArgName -> Bool
$c<= :: FunctionArgName -> FunctionArgName -> Bool
< :: FunctionArgName -> FunctionArgName -> Bool
$c< :: FunctionArgName -> FunctionArgName -> Bool
compare :: FunctionArgName -> FunctionArgName -> Ordering
$ccompare :: FunctionArgName -> FunctionArgName -> Ordering
$cp1Ord :: Eq FunctionArgName
Ord, FunctionArgName -> ()
(FunctionArgName -> ()) -> NFData FunctionArgName
forall a. (a -> ()) -> NFData a
rnf :: FunctionArgName -> ()
$crnf :: FunctionArgName -> ()
NFData, [FunctionArgName] -> Value
[FunctionArgName] -> Encoding
FunctionArgName -> Value
FunctionArgName -> Encoding
(FunctionArgName -> Value)
-> (FunctionArgName -> Encoding)
-> ([FunctionArgName] -> Value)
-> ([FunctionArgName] -> Encoding)
-> ToJSON FunctionArgName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FunctionArgName] -> Encoding
$ctoEncodingList :: [FunctionArgName] -> Encoding
toJSONList :: [FunctionArgName] -> Value
$ctoJSONList :: [FunctionArgName] -> Value
toEncoding :: FunctionArgName -> Encoding
$ctoEncoding :: FunctionArgName -> Encoding
toJSON :: FunctionArgName -> Value
$ctoJSON :: FunctionArgName -> Value
ToJSON, ToJSONKeyFunction [FunctionArgName]
ToJSONKeyFunction FunctionArgName
ToJSONKeyFunction FunctionArgName
-> ToJSONKeyFunction [FunctionArgName] -> ToJSONKey FunctionArgName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [FunctionArgName]
$ctoJSONKeyList :: ToJSONKeyFunction [FunctionArgName]
toJSONKey :: ToJSONKeyFunction FunctionArgName
$ctoJSONKey :: ToJSONKeyFunction FunctionArgName
ToJSONKey, Value -> Parser [FunctionArgName]
Value -> Parser FunctionArgName
(Value -> Parser FunctionArgName)
-> (Value -> Parser [FunctionArgName]) -> FromJSON FunctionArgName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FunctionArgName]
$cparseJSONList :: Value -> Parser [FunctionArgName]
parseJSON :: Value -> Parser FunctionArgName
$cparseJSON :: Value -> Parser FunctionArgName
FromJSON, FromJSONKeyFunction [FunctionArgName]
FromJSONKeyFunction FunctionArgName
FromJSONKeyFunction FunctionArgName
-> FromJSONKeyFunction [FunctionArgName]
-> FromJSONKey FunctionArgName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [FunctionArgName]
$cfromJSONKeyList :: FromJSONKeyFunction [FunctionArgName]
fromJSONKey :: FromJSONKeyFunction FunctionArgName
$cfromJSONKey :: FromJSONKeyFunction FunctionArgName
FromJSONKey, FunctionArgName -> Text
(FunctionArgName -> Text) -> ToTxt FunctionArgName
forall a. (a -> Text) -> ToTxt a
toTxt :: FunctionArgName -> Text
$ctoTxt :: FunctionArgName -> Text
ToTxt, String -> FunctionArgName
(String -> FunctionArgName) -> IsString FunctionArgName
forall a. (String -> a) -> IsString a
fromString :: String -> FunctionArgName
$cfromString :: String -> FunctionArgName
IsString, (forall x. FunctionArgName -> Rep FunctionArgName x)
-> (forall x. Rep FunctionArgName x -> FunctionArgName)
-> Generic FunctionArgName
forall x. Rep FunctionArgName x -> FunctionArgName
forall x. FunctionArgName -> Rep FunctionArgName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionArgName x -> FunctionArgName
$cfrom :: forall x. FunctionArgName -> Rep FunctionArgName x
Generic, Eq FunctionArgName
Eq FunctionArgName
-> (Accesses -> FunctionArgName -> FunctionArgName -> Bool)
-> Cacheable FunctionArgName
Accesses -> FunctionArgName -> FunctionArgName -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> FunctionArgName -> FunctionArgName -> Bool
$cunchanged :: Accesses -> FunctionArgName -> FunctionArgName -> Bool
$cp1Cacheable :: Eq FunctionArgName
Cacheable, Int -> FunctionArgName -> Int
FunctionArgName -> Int
(Int -> FunctionArgName -> Int)
-> (FunctionArgName -> Int) -> Hashable FunctionArgName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FunctionArgName -> Int
$chash :: FunctionArgName -> Int
hashWithSalt :: Int -> FunctionArgName -> Int
$chashWithSalt :: Int -> FunctionArgName -> Int
Hashable, FunctionArgName -> Q Exp
FunctionArgName -> Q (TExp FunctionArgName)
(FunctionArgName -> Q Exp)
-> (FunctionArgName -> Q (TExp FunctionArgName))
-> Lift FunctionArgName
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FunctionArgName -> Q (TExp FunctionArgName)
$cliftTyped :: FunctionArgName -> Q (TExp FunctionArgName)
lift :: FunctionArgName -> Q Exp
$clift :: FunctionArgName -> Q Exp
Lift, Typeable FunctionArgName
DataType
Constr
Typeable FunctionArgName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionArgName)
-> (FunctionArgName -> Constr)
-> (FunctionArgName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionArgName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionArgName))
-> ((forall b. Data b => b -> b)
    -> FunctionArgName -> FunctionArgName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FunctionArgName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FunctionArgName -> m FunctionArgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionArgName -> m FunctionArgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionArgName -> m FunctionArgName)
-> Data FunctionArgName
FunctionArgName -> DataType
FunctionArgName -> Constr
(forall b. Data b => b -> b) -> FunctionArgName -> FunctionArgName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArgName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u
forall u. (forall d. Data d => d -> u) -> FunctionArgName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArgName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionArgName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArgName)
$cFunctionArgName :: Constr
$tFunctionArgName :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
gmapMp :: (forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
gmapM :: (forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
gmapQi :: Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u
gmapQ :: (forall d. Data d => d -> u) -> FunctionArgName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionArgName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
gmapT :: (forall b. Data b => b -> b) -> FunctionArgName -> FunctionArgName
$cgmapT :: (forall b. Data b => b -> b) -> FunctionArgName -> FunctionArgName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArgName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArgName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FunctionArgName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionArgName)
dataTypeOf :: FunctionArgName -> DataType
$cdataTypeOf :: FunctionArgName -> DataType
toConstr :: FunctionArgName -> Constr
$ctoConstr :: FunctionArgName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArgName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArgName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName
$cp1Data :: Typeable FunctionArgName
Data)

data InputArgument a
  = IAUserProvided a
  | IASessionVariables FunctionArgName
  deriving (Int -> InputArgument a -> ShowS
[InputArgument a] -> ShowS
InputArgument a -> String
(Int -> InputArgument a -> ShowS)
-> (InputArgument a -> String)
-> ([InputArgument a] -> ShowS)
-> Show (InputArgument a)
forall a. Show a => Int -> InputArgument a -> ShowS
forall a. Show a => [InputArgument a] -> ShowS
forall a. Show a => InputArgument a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputArgument a] -> ShowS
$cshowList :: forall a. Show a => [InputArgument a] -> ShowS
show :: InputArgument a -> String
$cshow :: forall a. Show a => InputArgument a -> String
showsPrec :: Int -> InputArgument a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> InputArgument a -> ShowS
Show, InputArgument a -> InputArgument a -> Bool
(InputArgument a -> InputArgument a -> Bool)
-> (InputArgument a -> InputArgument a -> Bool)
-> Eq (InputArgument a)
forall a. Eq a => InputArgument a -> InputArgument a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputArgument a -> InputArgument a -> Bool
$c/= :: forall a. Eq a => InputArgument a -> InputArgument a -> Bool
== :: InputArgument a -> InputArgument a -> Bool
$c== :: forall a. Eq a => InputArgument a -> InputArgument a -> Bool
Eq, a -> InputArgument b -> InputArgument a
(a -> b) -> InputArgument a -> InputArgument b
(forall a b. (a -> b) -> InputArgument a -> InputArgument b)
-> (forall a b. a -> InputArgument b -> InputArgument a)
-> Functor InputArgument
forall a b. a -> InputArgument b -> InputArgument a
forall a b. (a -> b) -> InputArgument a -> InputArgument b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> InputArgument b -> InputArgument a
$c<$ :: forall a b. a -> InputArgument b -> InputArgument a
fmap :: (a -> b) -> InputArgument a -> InputArgument b
$cfmap :: forall a b. (a -> b) -> InputArgument a -> InputArgument b
Functor)

$( deriveToJSON
     defaultOptions
       { constructorTagModifier = snakeCase . drop 2,
         sumEncoding = TaggedObject "type" "argument"
       }
     ''InputArgument
 )
$(makePrisms ''InputArgument)

type FunctionInputArgument b = InputArgument (FunctionArgument b)

-- | Indicates whether the user requested the corresponding function to be
-- tracked as a mutation or a query/subscription, in @track_function@.
data FunctionExposedAs = FEAQuery | FEAMutation
  deriving (Int -> FunctionExposedAs -> ShowS
[FunctionExposedAs] -> ShowS
FunctionExposedAs -> String
(Int -> FunctionExposedAs -> ShowS)
-> (FunctionExposedAs -> String)
-> ([FunctionExposedAs] -> ShowS)
-> Show FunctionExposedAs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionExposedAs] -> ShowS
$cshowList :: [FunctionExposedAs] -> ShowS
show :: FunctionExposedAs -> String
$cshow :: FunctionExposedAs -> String
showsPrec :: Int -> FunctionExposedAs -> ShowS
$cshowsPrec :: Int -> FunctionExposedAs -> ShowS
Show, FunctionExposedAs -> FunctionExposedAs -> Bool
(FunctionExposedAs -> FunctionExposedAs -> Bool)
-> (FunctionExposedAs -> FunctionExposedAs -> Bool)
-> Eq FunctionExposedAs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionExposedAs -> FunctionExposedAs -> Bool
$c/= :: FunctionExposedAs -> FunctionExposedAs -> Bool
== :: FunctionExposedAs -> FunctionExposedAs -> Bool
$c== :: FunctionExposedAs -> FunctionExposedAs -> Bool
Eq, (forall x. FunctionExposedAs -> Rep FunctionExposedAs x)
-> (forall x. Rep FunctionExposedAs x -> FunctionExposedAs)
-> Generic FunctionExposedAs
forall x. Rep FunctionExposedAs x -> FunctionExposedAs
forall x. FunctionExposedAs -> Rep FunctionExposedAs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionExposedAs x -> FunctionExposedAs
$cfrom :: forall x. FunctionExposedAs -> Rep FunctionExposedAs x
Generic)

instance NFData FunctionExposedAs

instance Cacheable FunctionExposedAs

$( deriveJSON
     defaultOptions {sumEncoding = UntaggedValue, constructorTagModifier = map toLower . drop 3}
     ''FunctionExposedAs
 )

newtype FunctionPermissionInfo = FunctionPermissionInfo
  { FunctionPermissionInfo -> RoleName
_fpmRole :: RoleName
  }
  deriving (Int -> FunctionPermissionInfo -> ShowS
[FunctionPermissionInfo] -> ShowS
FunctionPermissionInfo -> String
(Int -> FunctionPermissionInfo -> ShowS)
-> (FunctionPermissionInfo -> String)
-> ([FunctionPermissionInfo] -> ShowS)
-> Show FunctionPermissionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionPermissionInfo] -> ShowS
$cshowList :: [FunctionPermissionInfo] -> ShowS
show :: FunctionPermissionInfo -> String
$cshow :: FunctionPermissionInfo -> String
showsPrec :: Int -> FunctionPermissionInfo -> ShowS
$cshowsPrec :: Int -> FunctionPermissionInfo -> ShowS
Show, FunctionPermissionInfo -> FunctionPermissionInfo -> Bool
(FunctionPermissionInfo -> FunctionPermissionInfo -> Bool)
-> (FunctionPermissionInfo -> FunctionPermissionInfo -> Bool)
-> Eq FunctionPermissionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionPermissionInfo -> FunctionPermissionInfo -> Bool
$c/= :: FunctionPermissionInfo -> FunctionPermissionInfo -> Bool
== :: FunctionPermissionInfo -> FunctionPermissionInfo -> Bool
$c== :: FunctionPermissionInfo -> FunctionPermissionInfo -> Bool
Eq, (forall x. FunctionPermissionInfo -> Rep FunctionPermissionInfo x)
-> (forall x.
    Rep FunctionPermissionInfo x -> FunctionPermissionInfo)
-> Generic FunctionPermissionInfo
forall x. Rep FunctionPermissionInfo x -> FunctionPermissionInfo
forall x. FunctionPermissionInfo -> Rep FunctionPermissionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionPermissionInfo x -> FunctionPermissionInfo
$cfrom :: forall x. FunctionPermissionInfo -> Rep FunctionPermissionInfo x
Generic)

instance Cacheable FunctionPermissionInfo

$(makeLenses ''FunctionPermissionInfo)
$(deriveJSON hasuraJSON ''FunctionPermissionInfo)

type FunctionPermissionsMap = HashMap RoleName FunctionPermissionInfo

-- | Custom root fields for functions. When set, will be the names exposed
--   to the user in the schema.
--
--   See rfcs/function-root-field-customisation.md for more information.
data FunctionCustomRootFields = FunctionCustomRootFields
  { FunctionCustomRootFields -> Maybe Name
_fcrfFunction :: Maybe G.Name,
    FunctionCustomRootFields -> Maybe Name
_fcrfFunctionAggregate :: Maybe G.Name
  }
  deriving (Int -> FunctionCustomRootFields -> ShowS
[FunctionCustomRootFields] -> ShowS
FunctionCustomRootFields -> String
(Int -> FunctionCustomRootFields -> ShowS)
-> (FunctionCustomRootFields -> String)
-> ([FunctionCustomRootFields] -> ShowS)
-> Show FunctionCustomRootFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionCustomRootFields] -> ShowS
$cshowList :: [FunctionCustomRootFields] -> ShowS
show :: FunctionCustomRootFields -> String
$cshow :: FunctionCustomRootFields -> String
showsPrec :: Int -> FunctionCustomRootFields -> ShowS
$cshowsPrec :: Int -> FunctionCustomRootFields -> ShowS
Show, FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
(FunctionCustomRootFields -> FunctionCustomRootFields -> Bool)
-> (FunctionCustomRootFields -> FunctionCustomRootFields -> Bool)
-> Eq FunctionCustomRootFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
$c/= :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
== :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
$c== :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
Eq, (forall x.
 FunctionCustomRootFields -> Rep FunctionCustomRootFields x)
-> (forall x.
    Rep FunctionCustomRootFields x -> FunctionCustomRootFields)
-> Generic FunctionCustomRootFields
forall x.
Rep FunctionCustomRootFields x -> FunctionCustomRootFields
forall x.
FunctionCustomRootFields -> Rep FunctionCustomRootFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep FunctionCustomRootFields x -> FunctionCustomRootFields
$cfrom :: forall x.
FunctionCustomRootFields -> Rep FunctionCustomRootFields x
Generic)

instance NFData FunctionCustomRootFields

instance Cacheable FunctionCustomRootFields

$(deriveToJSON hasuraJSON {omitNothingFields = True} ''FunctionCustomRootFields)

instance FromJSON FunctionCustomRootFields where
  parseJSON :: Value -> Parser FunctionCustomRootFields
parseJSON = String
-> (Object -> Parser FunctionCustomRootFields)
-> Value
-> Parser FunctionCustomRootFields
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser FunctionCustomRootFields)
 -> Value -> Parser FunctionCustomRootFields)
-> (Object -> Parser FunctionCustomRootFields)
-> Value
-> Parser FunctionCustomRootFields
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Maybe Name
function <- Object
obj Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"function"
    Maybe Name
functionAggregate <- Object
obj Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"function_aggregate"

    case (Maybe Name
function, Maybe Name
functionAggregate) of
      (Just Name
f, Just Name
fa)
        | Name
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
fa ->
          String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$
            Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
              Text
"the following custom root field names are duplicated: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall a. ToTxt a => a -> Text
toTxt Name
f Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" and " Text -> Text -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name -> Text
forall a. ToTxt a => a -> Text
toTxt Name
fa
      (Maybe Name, Maybe Name)
_ ->
        () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    FunctionCustomRootFields -> Parser FunctionCustomRootFields
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionCustomRootFields -> Parser FunctionCustomRootFields)
-> FunctionCustomRootFields -> Parser FunctionCustomRootFields
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Maybe Name -> FunctionCustomRootFields
FunctionCustomRootFields Maybe Name
function Maybe Name
functionAggregate

-- | A function custom root fields without custom names set. This is the default.
emptyFunctionCustomRootFields :: FunctionCustomRootFields
emptyFunctionCustomRootFields :: FunctionCustomRootFields
emptyFunctionCustomRootFields =
  FunctionCustomRootFields :: Maybe Name -> Maybe Name -> FunctionCustomRootFields
FunctionCustomRootFields
    { _fcrfFunction :: Maybe Name
_fcrfFunction = Maybe Name
forall a. Maybe a
Nothing,
      _fcrfFunctionAggregate :: Maybe Name
_fcrfFunctionAggregate = Maybe Name
forall a. Maybe a
Nothing
    }

-- | Tracked SQL function metadata. See 'buildFunctionInfo'.
data FunctionInfo (b :: BackendType) = FunctionInfo
  { FunctionInfo b -> FunctionName b
_fiSQLName :: FunctionName b,
    FunctionInfo b -> Name
_fiGQLName :: G.Name,
    FunctionInfo b -> Name
_fiGQLArgsName :: G.Name,
    FunctionInfo b -> Name
_fiGQLAggregateName :: G.Name,
    FunctionInfo b -> SystemDefined
_fiSystemDefined :: SystemDefined,
    FunctionInfo b -> FunctionVolatility
_fiVolatility :: FunctionVolatility,
    -- | In which part of the schema should this function be exposed?
    --
    -- See 'mkFunctionInfo' and '_fcExposedAs'.
    FunctionInfo b -> FunctionExposedAs
_fiExposedAs :: FunctionExposedAs,
    FunctionInfo b -> Seq (FunctionInputArgument b)
_fiInputArgs :: Seq.Seq (FunctionInputArgument b),
    -- | NOTE: when a table is created, a new composite type of the same name is
    -- automatically created; so strictly speaking this field means "the function
    -- returns the composite type corresponding to this table".
    FunctionInfo b -> TableName b
_fiReturnType :: TableName b,
    -- | this field represents the description of the function as present on the database
    FunctionInfo b -> Maybe Text
_fiDescription :: Maybe Text,
    -- | Roles to which the function is accessible
    FunctionInfo b -> FunctionPermissionsMap
_fiPermissions :: FunctionPermissionsMap,
    FunctionInfo b -> JsonAggSelect
_fiJsonAggSelect :: JsonAggSelect,
    FunctionInfo b -> Maybe Text
_fiComment :: Maybe Text
  }
  deriving ((forall x. FunctionInfo b -> Rep (FunctionInfo b) x)
-> (forall x. Rep (FunctionInfo b) x -> FunctionInfo b)
-> Generic (FunctionInfo b)
forall x. Rep (FunctionInfo b) x -> FunctionInfo b
forall x. FunctionInfo b -> Rep (FunctionInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (FunctionInfo b) x -> FunctionInfo b
forall (b :: BackendType) x.
FunctionInfo b -> Rep (FunctionInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (FunctionInfo b) x -> FunctionInfo b
$cfrom :: forall (b :: BackendType) x.
FunctionInfo b -> Rep (FunctionInfo b) x
Generic)

deriving instance Backend b => Show (FunctionInfo b)

deriving instance Backend b => Eq (FunctionInfo b)

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

$(makeLenses ''FunctionInfo)

-- | Apply function name customization to function arguments, as detailed in
-- 'rfcs/function-root-field-customisation.md'.  We want the different
-- variations of a function (i.e. basic, aggregate) to share the same type name
-- for their arguments.
getFunctionArgsGQLName ::
  -- | The GQL version of the DB name of the function
  G.Name ->
  FunctionConfig ->
  -- | Custom function for setting naming case
  (G.Name -> G.Name) ->
  G.Name
getFunctionArgsGQLName :: Name -> FunctionConfig -> (Name -> Name) -> Name
getFunctionArgsGQLName
  Name
funcGivenName
  FunctionConfig {Maybe Name
Maybe FunctionArgName
Maybe FunctionExposedAs
FunctionCustomRootFields
_fcCustomName :: FunctionConfig -> Maybe Name
_fcCustomRootFields :: FunctionConfig -> FunctionCustomRootFields
_fcExposedAs :: FunctionConfig -> Maybe FunctionExposedAs
_fcSessionArgument :: FunctionConfig -> Maybe FunctionArgName
_fcCustomName :: Maybe Name
_fcCustomRootFields :: FunctionCustomRootFields
_fcExposedAs :: Maybe FunctionExposedAs
_fcSessionArgument :: Maybe FunctionArgName
..}
  Name -> Name
setCase =
    Name -> Name
setCase (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
funcGivenName Maybe Name
_fcCustomName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__args

-- | Apply function name customization to the basic function variation, as
-- detailed in 'rfcs/function-root-field-customisation.md'.
getFunctionGQLName ::
  G.Name ->
  FunctionConfig ->
  -- | Custom function for setting naming case
  (G.Name -> G.Name) ->
  G.Name
getFunctionGQLName :: Name -> FunctionConfig -> (Name -> Name) -> Name
getFunctionGQLName
  Name
funcGivenName
  FunctionConfig
    { _fcCustomRootFields :: FunctionConfig -> FunctionCustomRootFields
_fcCustomRootFields = FunctionCustomRootFields {Maybe Name
_fcrfFunctionAggregate :: Maybe Name
_fcrfFunction :: Maybe Name
_fcrfFunctionAggregate :: FunctionCustomRootFields -> Maybe Name
_fcrfFunction :: FunctionCustomRootFields -> Maybe Name
..},
      Maybe Name
Maybe FunctionArgName
Maybe FunctionExposedAs
_fcCustomName :: Maybe Name
_fcExposedAs :: Maybe FunctionExposedAs
_fcSessionArgument :: Maybe FunctionArgName
_fcCustomName :: FunctionConfig -> Maybe Name
_fcExposedAs :: FunctionConfig -> Maybe FunctionExposedAs
_fcSessionArgument :: FunctionConfig -> Maybe FunctionArgName
..
    }
  Name -> Name
setCase =
    [Maybe Name] -> Maybe Name
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Maybe Name
_fcrfFunction,
        Maybe Name
_fcCustomName
      ]
      Maybe Name -> (Maybe Name -> Name) -> Name
forall a b. a -> (a -> b) -> b
& Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (Name -> Name
setCase Name
funcGivenName)

-- | Apply function name customization to the aggregate function variation, as
-- detailed in 'rfcs/function-root-field-customisation.md'.
getFunctionAggregateGQLName ::
  G.Name ->
  FunctionConfig ->
  -- | Custom function for setting naming case
  (G.Name -> G.Name) ->
  G.Name
getFunctionAggregateGQLName :: Name -> FunctionConfig -> (Name -> Name) -> Name
getFunctionAggregateGQLName
  Name
funcGivenName
  FunctionConfig
    { _fcCustomRootFields :: FunctionConfig -> FunctionCustomRootFields
_fcCustomRootFields = FunctionCustomRootFields {Maybe Name
_fcrfFunctionAggregate :: Maybe Name
_fcrfFunction :: Maybe Name
_fcrfFunctionAggregate :: FunctionCustomRootFields -> Maybe Name
_fcrfFunction :: FunctionCustomRootFields -> Maybe Name
..},
      Maybe Name
Maybe FunctionArgName
Maybe FunctionExposedAs
_fcCustomName :: Maybe Name
_fcExposedAs :: Maybe FunctionExposedAs
_fcSessionArgument :: Maybe FunctionArgName
_fcCustomName :: FunctionConfig -> Maybe Name
_fcExposedAs :: FunctionConfig -> Maybe FunctionExposedAs
_fcSessionArgument :: FunctionConfig -> Maybe FunctionArgName
..
    }
  Name -> Name
setCase =
    [Maybe Name] -> Maybe Name
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Maybe Name
_fcrfFunctionAggregate,
        Maybe Name
_fcCustomName Maybe Name -> (Name -> Name) -> Maybe Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__aggregate)
      ]
      Maybe Name -> (Maybe Name -> Name) -> Name
forall a b. a -> (a -> b) -> b
& Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (Name -> Name
setCase (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name
funcGivenName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__aggregate)

getInputArgs :: FunctionInfo b -> Seq.Seq (FunctionArgument b)
getInputArgs :: FunctionInfo b -> Seq (FunctionArgument b)
getInputArgs =
  [FunctionArgument b] -> Seq (FunctionArgument b)
forall a. [a] -> Seq a
Seq.fromList ([FunctionArgument b] -> Seq (FunctionArgument b))
-> (FunctionInfo b -> [FunctionArgument b])
-> FunctionInfo b
-> Seq (FunctionArgument b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InputArgument (FunctionArgument b) -> Maybe (FunctionArgument b))
-> [InputArgument (FunctionArgument b)] -> [FunctionArgument b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (InputArgument (FunctionArgument b)
-> Getting
     (First (FunctionArgument b))
     (InputArgument (FunctionArgument b))
     (FunctionArgument b)
-> Maybe (FunctionArgument b)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (FunctionArgument b))
  (InputArgument (FunctionArgument b))
  (FunctionArgument b)
forall a a. Prism (InputArgument a) (InputArgument a) a a
_IAUserProvided) ([InputArgument (FunctionArgument b)] -> [FunctionArgument b])
-> (FunctionInfo b -> [InputArgument (FunctionArgument b)])
-> FunctionInfo b
-> [FunctionArgument b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (InputArgument (FunctionArgument b))
-> [InputArgument (FunctionArgument b)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (InputArgument (FunctionArgument b))
 -> [InputArgument (FunctionArgument b)])
-> (FunctionInfo b -> Seq (InputArgument (FunctionArgument b)))
-> FunctionInfo b
-> [InputArgument (FunctionArgument b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionInfo b -> Seq (InputArgument (FunctionArgument b))
forall (b :: BackendType).
FunctionInfo b -> Seq (FunctionInputArgument b)
_fiInputArgs

type FunctionCache b = HashMap (FunctionName b) (FunctionInfo b) -- info of all functions

-- Metadata requests related types

-- | Tracked function configuration, and payload of the 'pg_track_function' and
-- 'pg_set_function_customization' API calls.
data FunctionConfig = FunctionConfig
  { FunctionConfig -> Maybe FunctionArgName
_fcSessionArgument :: Maybe FunctionArgName,
    -- | In which top-level field should we expose this function?
    --
    -- The user might omit this, in which case we'll infer the location from the
    -- SQL functions volatility. See 'mkFunctionInfo' or the @track_function@ API
    -- docs for details of validation, etc.
    FunctionConfig -> Maybe FunctionExposedAs
_fcExposedAs :: Maybe FunctionExposedAs,
    FunctionConfig -> FunctionCustomRootFields
_fcCustomRootFields :: FunctionCustomRootFields,
    FunctionConfig -> Maybe Name
_fcCustomName :: Maybe G.Name
  }
  deriving (Int -> FunctionConfig -> ShowS
[FunctionConfig] -> ShowS
FunctionConfig -> String
(Int -> FunctionConfig -> ShowS)
-> (FunctionConfig -> String)
-> ([FunctionConfig] -> ShowS)
-> Show FunctionConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionConfig] -> ShowS
$cshowList :: [FunctionConfig] -> ShowS
show :: FunctionConfig -> String
$cshow :: FunctionConfig -> String
showsPrec :: Int -> FunctionConfig -> ShowS
$cshowsPrec :: Int -> FunctionConfig -> ShowS
Show, FunctionConfig -> FunctionConfig -> Bool
(FunctionConfig -> FunctionConfig -> Bool)
-> (FunctionConfig -> FunctionConfig -> Bool) -> Eq FunctionConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionConfig -> FunctionConfig -> Bool
$c/= :: FunctionConfig -> FunctionConfig -> Bool
== :: FunctionConfig -> FunctionConfig -> Bool
$c== :: FunctionConfig -> FunctionConfig -> Bool
Eq, (forall x. FunctionConfig -> Rep FunctionConfig x)
-> (forall x. Rep FunctionConfig x -> FunctionConfig)
-> Generic FunctionConfig
forall x. Rep FunctionConfig x -> FunctionConfig
forall x. FunctionConfig -> Rep FunctionConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionConfig x -> FunctionConfig
$cfrom :: forall x. FunctionConfig -> Rep FunctionConfig x
Generic)

instance NFData FunctionConfig

instance Cacheable FunctionConfig

instance FromJSON FunctionConfig where
  parseJSON :: Value -> Parser FunctionConfig
parseJSON = String
-> (Object -> Parser FunctionConfig)
-> Value
-> Parser FunctionConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FunctionConfig" ((Object -> Parser FunctionConfig)
 -> Value -> Parser FunctionConfig)
-> (Object -> Parser FunctionConfig)
-> Value
-> Parser FunctionConfig
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> FunctionConfig
FunctionConfig
      (Maybe FunctionArgName
 -> Maybe FunctionExposedAs
 -> FunctionCustomRootFields
 -> Maybe Name
 -> FunctionConfig)
-> Parser (Maybe FunctionArgName)
-> Parser
     (Maybe FunctionExposedAs
      -> FunctionCustomRootFields -> Maybe Name -> FunctionConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe FunctionArgName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"session_argument"
      Parser
  (Maybe FunctionExposedAs
   -> FunctionCustomRootFields -> Maybe Name -> FunctionConfig)
-> Parser (Maybe FunctionExposedAs)
-> Parser
     (FunctionCustomRootFields -> Maybe Name -> FunctionConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe FunctionExposedAs)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exposed_as"
      Parser (FunctionCustomRootFields -> Maybe Name -> FunctionConfig)
-> Parser FunctionCustomRootFields
-> Parser (Maybe Name -> FunctionConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe FunctionCustomRootFields)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_root_fields" Parser (Maybe FunctionCustomRootFields)
-> FunctionCustomRootFields -> Parser FunctionCustomRootFields
forall a. Parser (Maybe a) -> a -> Parser a
.!= FunctionCustomRootFields
emptyFunctionCustomRootFields
      Parser (Maybe Name -> FunctionConfig)
-> Parser (Maybe Name) -> Parser FunctionConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_name"

$(deriveToJSON hasuraJSON {omitNothingFields = True} ''FunctionConfig)

-- | The default function config; v1 of the API implies this.
emptyFunctionConfig :: FunctionConfig
emptyFunctionConfig :: FunctionConfig
emptyFunctionConfig = Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> FunctionConfig
FunctionConfig Maybe FunctionArgName
forall a. Maybe a
Nothing Maybe FunctionExposedAs
forall a. Maybe a
Nothing FunctionCustomRootFields
emptyFunctionCustomRootFields Maybe Name
forall a. Maybe a
Nothing

-- Lists are used to model overloaded functions.
type DBFunctionsMetadata b = HashMap (FunctionName b) [RawFunctionInfo b]

data FunctionArgsExpG a = FunctionArgsExp
  { FunctionArgsExpG a -> [a]
_faePositional :: [a],
    FunctionArgsExpG a -> HashMap Text a
_faeNamed :: (HM.HashMap Text a)
  }
  deriving stock (Int -> FunctionArgsExpG a -> ShowS
[FunctionArgsExpG a] -> ShowS
FunctionArgsExpG a -> String
(Int -> FunctionArgsExpG a -> ShowS)
-> (FunctionArgsExpG a -> String)
-> ([FunctionArgsExpG a] -> ShowS)
-> Show (FunctionArgsExpG a)
forall a. Show a => Int -> FunctionArgsExpG a -> ShowS
forall a. Show a => [FunctionArgsExpG a] -> ShowS
forall a. Show a => FunctionArgsExpG a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionArgsExpG a] -> ShowS
$cshowList :: forall a. Show a => [FunctionArgsExpG a] -> ShowS
show :: FunctionArgsExpG a -> String
$cshow :: forall a. Show a => FunctionArgsExpG a -> String
showsPrec :: Int -> FunctionArgsExpG a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FunctionArgsExpG a -> ShowS
Show, FunctionArgsExpG a -> FunctionArgsExpG a -> Bool
(FunctionArgsExpG a -> FunctionArgsExpG a -> Bool)
-> (FunctionArgsExpG a -> FunctionArgsExpG a -> Bool)
-> Eq (FunctionArgsExpG a)
forall a. Eq a => FunctionArgsExpG a -> FunctionArgsExpG a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionArgsExpG a -> FunctionArgsExpG a -> Bool
$c/= :: forall a. Eq a => FunctionArgsExpG a -> FunctionArgsExpG a -> Bool
== :: FunctionArgsExpG a -> FunctionArgsExpG a -> Bool
$c== :: forall a. Eq a => FunctionArgsExpG a -> FunctionArgsExpG a -> Bool
Eq, a -> FunctionArgsExpG b -> FunctionArgsExpG a
(a -> b) -> FunctionArgsExpG a -> FunctionArgsExpG b
(forall a b. (a -> b) -> FunctionArgsExpG a -> FunctionArgsExpG b)
-> (forall a b. a -> FunctionArgsExpG b -> FunctionArgsExpG a)
-> Functor FunctionArgsExpG
forall a b. a -> FunctionArgsExpG b -> FunctionArgsExpG a
forall a b. (a -> b) -> FunctionArgsExpG a -> FunctionArgsExpG b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FunctionArgsExpG b -> FunctionArgsExpG a
$c<$ :: forall a b. a -> FunctionArgsExpG b -> FunctionArgsExpG a
fmap :: (a -> b) -> FunctionArgsExpG a -> FunctionArgsExpG b
$cfmap :: forall a b. (a -> b) -> FunctionArgsExpG a -> FunctionArgsExpG b
Functor, FunctionArgsExpG a -> Bool
(a -> m) -> FunctionArgsExpG a -> m
(a -> b -> b) -> b -> FunctionArgsExpG a -> b
(forall m. Monoid m => FunctionArgsExpG m -> m)
-> (forall m a. Monoid m => (a -> m) -> FunctionArgsExpG a -> m)
-> (forall m a. Monoid m => (a -> m) -> FunctionArgsExpG a -> m)
-> (forall a b. (a -> b -> b) -> b -> FunctionArgsExpG a -> b)
-> (forall a b. (a -> b -> b) -> b -> FunctionArgsExpG a -> b)
-> (forall b a. (b -> a -> b) -> b -> FunctionArgsExpG a -> b)
-> (forall b a. (b -> a -> b) -> b -> FunctionArgsExpG a -> b)
-> (forall a. (a -> a -> a) -> FunctionArgsExpG a -> a)
-> (forall a. (a -> a -> a) -> FunctionArgsExpG a -> a)
-> (forall a. FunctionArgsExpG a -> [a])
-> (forall a. FunctionArgsExpG a -> Bool)
-> (forall a. FunctionArgsExpG a -> Int)
-> (forall a. Eq a => a -> FunctionArgsExpG a -> Bool)
-> (forall a. Ord a => FunctionArgsExpG a -> a)
-> (forall a. Ord a => FunctionArgsExpG a -> a)
-> (forall a. Num a => FunctionArgsExpG a -> a)
-> (forall a. Num a => FunctionArgsExpG a -> a)
-> Foldable FunctionArgsExpG
forall a. Eq a => a -> FunctionArgsExpG a -> Bool
forall a. Num a => FunctionArgsExpG a -> a
forall a. Ord a => FunctionArgsExpG a -> a
forall m. Monoid m => FunctionArgsExpG m -> m
forall a. FunctionArgsExpG a -> Bool
forall a. FunctionArgsExpG a -> Int
forall a. FunctionArgsExpG a -> [a]
forall a. (a -> a -> a) -> FunctionArgsExpG a -> a
forall m a. Monoid m => (a -> m) -> FunctionArgsExpG a -> m
forall b a. (b -> a -> b) -> b -> FunctionArgsExpG a -> b
forall a b. (a -> b -> b) -> b -> FunctionArgsExpG a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: FunctionArgsExpG a -> a
$cproduct :: forall a. Num a => FunctionArgsExpG a -> a
sum :: FunctionArgsExpG a -> a
$csum :: forall a. Num a => FunctionArgsExpG a -> a
minimum :: FunctionArgsExpG a -> a
$cminimum :: forall a. Ord a => FunctionArgsExpG a -> a
maximum :: FunctionArgsExpG a -> a
$cmaximum :: forall a. Ord a => FunctionArgsExpG a -> a
elem :: a -> FunctionArgsExpG a -> Bool
$celem :: forall a. Eq a => a -> FunctionArgsExpG a -> Bool
length :: FunctionArgsExpG a -> Int
$clength :: forall a. FunctionArgsExpG a -> Int
null :: FunctionArgsExpG a -> Bool
$cnull :: forall a. FunctionArgsExpG a -> Bool
toList :: FunctionArgsExpG a -> [a]
$ctoList :: forall a. FunctionArgsExpG a -> [a]
foldl1 :: (a -> a -> a) -> FunctionArgsExpG a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FunctionArgsExpG a -> a
foldr1 :: (a -> a -> a) -> FunctionArgsExpG a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FunctionArgsExpG a -> a
foldl' :: (b -> a -> b) -> b -> FunctionArgsExpG a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FunctionArgsExpG a -> b
foldl :: (b -> a -> b) -> b -> FunctionArgsExpG a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FunctionArgsExpG a -> b
foldr' :: (a -> b -> b) -> b -> FunctionArgsExpG a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FunctionArgsExpG a -> b
foldr :: (a -> b -> b) -> b -> FunctionArgsExpG a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FunctionArgsExpG a -> b
foldMap' :: (a -> m) -> FunctionArgsExpG a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FunctionArgsExpG a -> m
foldMap :: (a -> m) -> FunctionArgsExpG a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FunctionArgsExpG a -> m
fold :: FunctionArgsExpG m -> m
$cfold :: forall m. Monoid m => FunctionArgsExpG m -> m
Foldable, Functor FunctionArgsExpG
Foldable FunctionArgsExpG
Functor FunctionArgsExpG
-> Foldable FunctionArgsExpG
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FunctionArgsExpG a -> f (FunctionArgsExpG b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    FunctionArgsExpG (f a) -> f (FunctionArgsExpG a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FunctionArgsExpG a -> m (FunctionArgsExpG b))
-> (forall (m :: * -> *) a.
    Monad m =>
    FunctionArgsExpG (m a) -> m (FunctionArgsExpG a))
-> Traversable FunctionArgsExpG
(a -> f b) -> FunctionArgsExpG a -> f (FunctionArgsExpG b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FunctionArgsExpG (m a) -> m (FunctionArgsExpG a)
forall (f :: * -> *) a.
Applicative f =>
FunctionArgsExpG (f a) -> f (FunctionArgsExpG a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FunctionArgsExpG a -> m (FunctionArgsExpG b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FunctionArgsExpG a -> f (FunctionArgsExpG b)
sequence :: FunctionArgsExpG (m a) -> m (FunctionArgsExpG a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FunctionArgsExpG (m a) -> m (FunctionArgsExpG a)
mapM :: (a -> m b) -> FunctionArgsExpG a -> m (FunctionArgsExpG b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FunctionArgsExpG a -> m (FunctionArgsExpG b)
sequenceA :: FunctionArgsExpG (f a) -> f (FunctionArgsExpG a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FunctionArgsExpG (f a) -> f (FunctionArgsExpG a)
traverse :: (a -> f b) -> FunctionArgsExpG a -> f (FunctionArgsExpG b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FunctionArgsExpG a -> f (FunctionArgsExpG b)
$cp2Traversable :: Foldable FunctionArgsExpG
$cp1Traversable :: Functor FunctionArgsExpG
Traversable, (forall x. FunctionArgsExpG a -> Rep (FunctionArgsExpG a) x)
-> (forall x. Rep (FunctionArgsExpG a) x -> FunctionArgsExpG a)
-> Generic (FunctionArgsExpG a)
forall x. Rep (FunctionArgsExpG a) x -> FunctionArgsExpG a
forall x. FunctionArgsExpG a -> Rep (FunctionArgsExpG a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FunctionArgsExpG a) x -> FunctionArgsExpG a
forall a x. FunctionArgsExpG a -> Rep (FunctionArgsExpG a) x
$cto :: forall a x. Rep (FunctionArgsExpG a) x -> FunctionArgsExpG a
$cfrom :: forall a x. FunctionArgsExpG a -> Rep (FunctionArgsExpG a) x
Generic)

instance (Hashable a) => Hashable (FunctionArgsExpG a)

instance (Cacheable a) => Cacheable (FunctionArgsExpG a)

instance (NFData a) => NFData (FunctionArgsExpG a)

type FunctionArgsExp b v = FunctionArgsExpG (FunctionArgumentExp b v)

emptyFunctionArgsExp :: FunctionArgsExpG a
emptyFunctionArgsExp :: FunctionArgsExpG a
emptyFunctionArgsExp = [a] -> HashMap Text a -> FunctionArgsExpG a
forall a. [a] -> HashMap Text a -> FunctionArgsExpG a
FunctionArgsExp [] HashMap Text a
forall k v. HashMap k v
HM.empty