module Hasura.Function.Common
  ( getFunctionAggregateGQLName,
    getFunctionArgsGQLName,
    getFunctionGQLName,
    getInputArgs,
  )
where

import Control.Lens
import Data.Sequence qualified as Seq
import Hasura.Function.Cache
import Hasura.Function.Lenses
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Language.GraphQL.Draft.Syntax qualified as G

-- | 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 b ->
  -- | Custom function for setting naming case
  (G.Name -> G.Name) ->
  G.Name
getFunctionArgsGQLName :: forall (b :: BackendType).
Name -> FunctionConfig b -> (Name -> Name) -> Name
getFunctionArgsGQLName
  Name
funcGivenName
  FunctionConfig {Maybe Name
Maybe (FunctionReturnType b)
Maybe FunctionExposedAs
Maybe FunctionArgName
FunctionCustomRootFields
_fcSessionArgument :: Maybe FunctionArgName
_fcExposedAs :: Maybe FunctionExposedAs
_fcCustomRootFields :: FunctionCustomRootFields
_fcCustomName :: Maybe Name
_fcResponse :: Maybe (FunctionReturnType b)
_fcSessionArgument :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionArgName
_fcExposedAs :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionExposedAs
_fcCustomRootFields :: forall (b :: BackendType).
FunctionConfig b -> FunctionCustomRootFields
_fcCustomName :: forall (b :: BackendType). FunctionConfig b -> Maybe Name
_fcResponse :: forall (b :: BackendType).
FunctionConfig b -> Maybe (FunctionReturnType b)
..}
  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 b ->
  -- | Custom function for setting naming case
  (G.Name -> G.Name) ->
  G.Name
getFunctionGQLName :: forall (b :: BackendType).
Name -> FunctionConfig b -> (Name -> Name) -> Name
getFunctionGQLName
  Name
funcGivenName
  FunctionConfig
    { _fcCustomRootFields :: forall (b :: BackendType).
FunctionConfig b -> FunctionCustomRootFields
_fcCustomRootFields = FunctionCustomRootFields {Maybe Name
_fcrfFunction :: Maybe Name
_fcrfFunctionAggregate :: Maybe Name
_fcrfFunction :: FunctionCustomRootFields -> Maybe Name
_fcrfFunctionAggregate :: FunctionCustomRootFields -> Maybe Name
..},
      Maybe Name
Maybe (FunctionReturnType b)
Maybe FunctionExposedAs
Maybe FunctionArgName
_fcSessionArgument :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionArgName
_fcExposedAs :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionExposedAs
_fcCustomName :: forall (b :: BackendType). FunctionConfig b -> Maybe Name
_fcResponse :: forall (b :: BackendType).
FunctionConfig b -> Maybe (FunctionReturnType b)
_fcSessionArgument :: Maybe FunctionArgName
_fcExposedAs :: Maybe FunctionExposedAs
_fcCustomName :: Maybe Name
_fcResponse :: Maybe (FunctionReturnType b)
..
    }
  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 b ->
  -- | Custom function for setting naming case
  (G.Name -> G.Name) ->
  G.Name
getFunctionAggregateGQLName :: forall (b :: BackendType).
Name -> FunctionConfig b -> (Name -> Name) -> Name
getFunctionAggregateGQLName
  Name
funcGivenName
  FunctionConfig
    { _fcCustomRootFields :: forall (b :: BackendType).
FunctionConfig b -> FunctionCustomRootFields
_fcCustomRootFields = FunctionCustomRootFields {Maybe Name
_fcrfFunction :: FunctionCustomRootFields -> Maybe Name
_fcrfFunctionAggregate :: FunctionCustomRootFields -> Maybe Name
_fcrfFunction :: Maybe Name
_fcrfFunctionAggregate :: Maybe Name
..},
      Maybe Name
Maybe (FunctionReturnType b)
Maybe FunctionExposedAs
Maybe FunctionArgName
_fcSessionArgument :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionArgName
_fcExposedAs :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionExposedAs
_fcCustomName :: forall (b :: BackendType). FunctionConfig b -> Maybe Name
_fcResponse :: forall (b :: BackendType).
FunctionConfig b -> Maybe (FunctionReturnType b)
_fcSessionArgument :: Maybe FunctionArgName
_fcExposedAs :: Maybe FunctionExposedAs
_fcCustomName :: Maybe Name
_fcResponse :: Maybe (FunctionReturnType b)
..
    }
  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 :: forall (b :: BackendType).
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 a b. (a -> Maybe b) -> [a] -> [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 a1 a2 (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a1 (f a2) -> p (InputArgument a1) (f (InputArgument a2))
_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 a. Seq a -> [a]
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