{-# 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
  }