module Hasura.RQL.Types.ResultCustomization
  ( AliasMapping,
    singletonAliasMapping,
    ResultCustomizer,
    applyResultCustomizer,
    applyAliasMapping,
    modifyFieldByName,
    customizeTypeNameString,
  )
where

import Data.Aeson.Ordered qualified as JO
import Data.HashMap.Strict as HashMap
import Data.Monoid (Endo (..))
import Hasura.Prelude
import Language.GraphQL.Draft.Syntax qualified as G

-- | Mapping that can be provided to a ResultCustomizer
-- to map top-level field aliases that were not available at field parse time.
-- E.g. for aliases created in the remote server query for remote joins.
newtype AliasMapping = AliasMapping {AliasMapping -> Name -> Name
unAliasMapping :: G.Name -> G.Name}
  deriving (NonEmpty AliasMapping -> AliasMapping
AliasMapping -> AliasMapping -> AliasMapping
(AliasMapping -> AliasMapping -> AliasMapping)
-> (NonEmpty AliasMapping -> AliasMapping)
-> (forall b. Integral b => b -> AliasMapping -> AliasMapping)
-> Semigroup AliasMapping
forall b. Integral b => b -> AliasMapping -> AliasMapping
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: AliasMapping -> AliasMapping -> AliasMapping
<> :: AliasMapping -> AliasMapping -> AliasMapping
$csconcat :: NonEmpty AliasMapping -> AliasMapping
sconcat :: NonEmpty AliasMapping -> AliasMapping
$cstimes :: forall b. Integral b => b -> AliasMapping -> AliasMapping
stimes :: forall b. Integral b => b -> AliasMapping -> AliasMapping
Semigroup, Semigroup AliasMapping
AliasMapping
Semigroup AliasMapping
-> AliasMapping
-> (AliasMapping -> AliasMapping -> AliasMapping)
-> ([AliasMapping] -> AliasMapping)
-> Monoid AliasMapping
[AliasMapping] -> AliasMapping
AliasMapping -> AliasMapping -> AliasMapping
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: AliasMapping
mempty :: AliasMapping
$cmappend :: AliasMapping -> AliasMapping -> AliasMapping
mappend :: AliasMapping -> AliasMapping -> AliasMapping
$cmconcat :: [AliasMapping] -> AliasMapping
mconcat :: [AliasMapping] -> AliasMapping
Monoid) via (Endo G.Name)

-- | AliasMapping that maps a single field name to an alias
singletonAliasMapping :: G.Name -> G.Name -> AliasMapping
singletonAliasMapping :: Name -> Name -> AliasMapping
singletonAliasMapping Name
fieldName Name
alias = (Name -> Name) -> AliasMapping
AliasMapping ((Name -> Name) -> AliasMapping) -> (Name -> Name) -> AliasMapping
forall a b. (a -> b) -> a -> b
$ \Name
fieldName' ->
  if Name
fieldName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
fieldName'
    then Name
alias
    else Name
fieldName'

-- | Function to modify JSON values returned from the remote server
-- e.g. to map values of __typename fields to customized type names.
-- The customizer uses Maybe to allow short-circuiting subtrees
-- where no customizations are needed.
newtype ResultCustomizer = ResultCustomizer {ResultCustomizer -> AliasMapping -> Value -> Value
unResultCustomizer :: AliasMapping -> JO.Value -> JO.Value}
  deriving (NonEmpty ResultCustomizer -> ResultCustomizer
ResultCustomizer -> ResultCustomizer -> ResultCustomizer
(ResultCustomizer -> ResultCustomizer -> ResultCustomizer)
-> (NonEmpty ResultCustomizer -> ResultCustomizer)
-> (forall b.
    Integral b =>
    b -> ResultCustomizer -> ResultCustomizer)
-> Semigroup ResultCustomizer
forall b. Integral b => b -> ResultCustomizer -> ResultCustomizer
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ResultCustomizer -> ResultCustomizer -> ResultCustomizer
<> :: ResultCustomizer -> ResultCustomizer -> ResultCustomizer
$csconcat :: NonEmpty ResultCustomizer -> ResultCustomizer
sconcat :: NonEmpty ResultCustomizer -> ResultCustomizer
$cstimes :: forall b. Integral b => b -> ResultCustomizer -> ResultCustomizer
stimes :: forall b. Integral b => b -> ResultCustomizer -> ResultCustomizer
Semigroup, Semigroup ResultCustomizer
ResultCustomizer
Semigroup ResultCustomizer
-> ResultCustomizer
-> (ResultCustomizer -> ResultCustomizer -> ResultCustomizer)
-> ([ResultCustomizer] -> ResultCustomizer)
-> Monoid ResultCustomizer
[ResultCustomizer] -> ResultCustomizer
ResultCustomizer -> ResultCustomizer -> ResultCustomizer
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ResultCustomizer
mempty :: ResultCustomizer
$cmappend :: ResultCustomizer -> ResultCustomizer -> ResultCustomizer
mappend :: ResultCustomizer -> ResultCustomizer -> ResultCustomizer
$cmconcat :: [ResultCustomizer] -> ResultCustomizer
mconcat :: [ResultCustomizer] -> ResultCustomizer
Monoid) via (AliasMapping -> Endo JO.Value)

instance Show ResultCustomizer where
  show :: ResultCustomizer -> String
show ResultCustomizer
_ = String
"(ResultCustomizer <function>)"

-- | Apply a ResultCustomizer to a JSON value
applyResultCustomizer :: ResultCustomizer -> JO.Value -> JO.Value
applyResultCustomizer :: ResultCustomizer -> Value -> Value
applyResultCustomizer = ((AliasMapping -> Value -> Value) -> AliasMapping -> Value -> Value
forall a b. (a -> b) -> a -> b
$ AliasMapping
forall a. Monoid a => a
mempty) ((AliasMapping -> Value -> Value) -> Value -> Value)
-> (ResultCustomizer -> AliasMapping -> Value -> Value)
-> ResultCustomizer
-> Value
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultCustomizer -> AliasMapping -> Value -> Value
unResultCustomizer

-- | Apply an AliasMapping to a ResultCustomizer.
applyAliasMapping :: AliasMapping -> ResultCustomizer -> ResultCustomizer
applyAliasMapping :: AliasMapping -> ResultCustomizer -> ResultCustomizer
applyAliasMapping AliasMapping
aliasMapping (ResultCustomizer AliasMapping -> Value -> Value
m) =
  (AliasMapping -> Value -> Value) -> ResultCustomizer
ResultCustomizer ((AliasMapping -> Value -> Value) -> ResultCustomizer)
-> (AliasMapping -> Value -> Value) -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ AliasMapping -> Value -> Value
m (AliasMapping -> Value -> Value)
-> (AliasMapping -> AliasMapping) -> AliasMapping -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AliasMapping -> AliasMapping -> AliasMapping
forall a. Semigroup a => a -> a -> a
<> AliasMapping
aliasMapping)

-- | Take a ResultCustomizer for a JSON subtree, and a fieldName,
-- and produce a ResultCustomizer for a parent object or array of objects
-- that applies the subtree customizer to the subtree at the given fieldName.
modifyFieldByName :: G.Name -> ResultCustomizer -> ResultCustomizer
modifyFieldByName :: Name -> ResultCustomizer -> ResultCustomizer
modifyFieldByName Name
fieldName ResultCustomizer {AliasMapping -> Value -> Value
unResultCustomizer :: ResultCustomizer -> AliasMapping -> Value -> Value
unResultCustomizer :: AliasMapping -> Value -> Value
..} =
  (AliasMapping -> Value -> Value) -> ResultCustomizer
ResultCustomizer ((AliasMapping -> Value -> Value) -> ResultCustomizer)
-> (AliasMapping -> Value -> Value) -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ \AliasMapping {Name -> Name
unAliasMapping :: AliasMapping -> Name -> Name
unAliasMapping :: Name -> Name
..} ->
    let applyCustomizer :: Value -> Value
applyCustomizer = AliasMapping -> Value -> Value
unResultCustomizer AliasMapping
forall a. Monoid a => a
mempty
        modifyFieldByName' :: Value -> Value
modifyFieldByName' = \case
          JO.Object Object
o -> Object -> Value
JO.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> Text -> Object -> Object
JO.adjust Value -> Value
applyCustomizer (Name -> Text
G.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Name
unAliasMapping Name
fieldName) Object
o
          JO.Array Array
a -> Array -> Value
JO.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
modifyFieldByName' (Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array
a
          Value
v -> Value
v
     in Value -> Value
modifyFieldByName'

-- | Create a RemoteResultCustomizer that applies the typeNameMap
-- to a JSON string value, e.g. for use in customizing a __typename field value.
customizeTypeNameString :: HashMap G.Name G.Name -> ResultCustomizer
customizeTypeNameString :: HashMap Name Name -> ResultCustomizer
customizeTypeNameString HashMap Name Name
typeNameMap | HashMap Name Name -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Name Name
typeNameMap = ResultCustomizer
forall a. Monoid a => a
mempty
customizeTypeNameString HashMap Name Name
typeNameMap =
  (AliasMapping -> Value -> Value) -> ResultCustomizer
ResultCustomizer ((AliasMapping -> Value -> Value) -> ResultCustomizer)
-> (AliasMapping -> Value -> Value) -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ \AliasMapping
_aliasMapping -> \case
    JO.String Text
t -> Text -> Value
JO.String
      (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t
      (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ do
        -- This function is only meant to be applied on type names, and creating a
        -- GraphQL name out of the string should never fail. If it nonetheless
        -- fails, we assume there will not be customization information and we
        -- return it unmodified.
        Name
typeName <- Text -> Maybe Name
G.mkName Text
t
        Name -> Text
G.unName (Name -> Text) -> Maybe Name -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> HashMap Name Name -> Maybe Name
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
typeName HashMap Name Name
typeNameMap
    Value
v -> Value
v