{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Server.Deriving.Utils.Proxy ( conNameProxy, isRecordProxy, selNameProxy, symbolName, ContextValue (..), ) where import Data.Morpheus.Kind (DerivingKind) import Data.Morpheus.Server.Types.Internal ( GQLTypeOptions (..), ) import Data.Morpheus.Types.Internal.AST ( FieldName, TypeName, packName, ) import Data.Text ( pack, ) import qualified Data.Text as T import GHC.Generics ( C, Constructor, M1 (..), Meta, S, Selector, U1 (..), conIsRecord, conName, selName, ) import GHC.TypeLits import Relude hiding (undefined) import Prelude (undefined) conNameProxy :: forall f (c :: Meta). Constructor c => GQLTypeOptions -> f c -> TypeName conNameProxy :: forall (f :: Meta -> *) (c :: Meta). Constructor c => GQLTypeOptions -> f c -> TypeName conNameProxy GQLTypeOptions options f c _ = forall a (t :: NAME). NamePacking a => a -> Name t packName forall a b. (a -> b) -> a -> b $ String -> Text pack forall a b. (a -> b) -> a -> b $ GQLTypeOptions -> String -> String constructorTagModifier GQLTypeOptions options forall a b. (a -> b) -> a -> b $ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Constructor c => t c f a -> String conName (forall a. HasCallStack => a undefined :: M1 C c U1 a) selNameProxy :: forall f (s :: Meta). Selector s => GQLTypeOptions -> f s -> FieldName selNameProxy :: forall (f :: Meta -> *) (s :: Meta). Selector s => GQLTypeOptions -> f s -> FieldName selNameProxy GQLTypeOptions options f s _ = String -> FieldName fromHaskellName forall a b. (a -> b) -> a -> b $ GQLTypeOptions -> String -> String fieldLabelModifier GQLTypeOptions options forall a b. (a -> b) -> a -> b $ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Selector s => t s f a -> String selName (forall a. HasCallStack => a undefined :: M1 S s f a) fromHaskellName :: String -> FieldName fromHaskellName :: String -> FieldName fromHaskellName String hsName | Bool -> Bool not (forall (t :: * -> *) a. Foldable t => t a -> Bool null String hsName) Bool -> Bool -> Bool && (Text -> Char T.last Text name forall a. Eq a => a -> a -> Bool == Char '\'') = forall a (t :: NAME). NamePacking a => a -> Name t packName (Text -> Text T.init Text name) | Bool otherwise = forall a (t :: NAME). NamePacking a => a -> Name t packName Text name where name :: Text name = String -> Text T.pack String hsName {-# INLINE fromHaskellName #-} isRecordProxy :: forall f (c :: Meta). Constructor c => f c -> Bool isRecordProxy :: forall (f :: Meta -> *) (c :: Meta). Constructor c => f c -> Bool isRecordProxy f c _ = forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Constructor c => t c f a -> Bool conIsRecord (forall a. HasCallStack => a undefined :: (M1 C c f a)) symbolName :: KnownSymbol a => f a -> FieldName symbolName :: forall (a :: Symbol) (f :: Symbol -> *). KnownSymbol a => f a -> FieldName symbolName = forall a. IsString a => String -> a fromString forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> String symbolVal newtype ContextValue (kind :: DerivingKind) a = ContextValue { forall (kind :: DerivingKind) a. ContextValue kind a -> a unContextValue :: a }