{-# LANGUAGE RecordWildCards #-}

module Data.Morpheus.Server.Deriving.Utils.AST
  ( argumentsToObject,
  )
where

import Data.Morpheus.Types.Internal.AST
  ( Argument (..),
    Arguments,
    ObjectEntry (..),
    VALID,
    Value (..),
  )

argumentsToObject :: Arguments VALID -> Value VALID
argumentsToObject :: Arguments VALID -> Value VALID
argumentsToObject = forall (stage :: Stage). Object stage -> Value stage
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {s :: Stage}. Argument s -> ObjectEntry s
toEntry
  where
    toEntry :: Argument s -> ObjectEntry s
toEntry Argument {Value s
FieldName
Position
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentName :: forall (valid :: Stage). Argument valid -> FieldName
argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
argumentValue :: Value s
argumentName :: FieldName
argumentPosition :: Position
..} = forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
argumentName Value s
argumentValue