{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Types.Internal.AST.Name ( Name, packName, unpackName, FieldName, TypeName, unitTypeName, unitFieldName, isNotSystemTypeName, isNotSystemFieldName, intercalate, NAME (..), FragmentName, ) where import Data.Aeson ( FromJSON, ToJSON (..), ) import Data.Morpheus.Rendering.RenderGQL ( RenderGQL (..), fromText, renderGQL, ) import Data.Morpheus.Types.Internal.AST.Error ( Msg (..), ) #if MIN_VERSION_aeson(2,0,0) import Data.Aeson.Key (Key) import qualified Data.Aeson.Key as A #endif import qualified Data.Text as T #if MIN_VERSION_template_haskell(2,17,0) import Language.Haskell.TH ( Quote, Code, unsafeCodeCoerce, stringE ) import Language.Haskell.TH.Syntax( Lift(..) ) # else import Language.Haskell.TH ( stringE, ) import Language.Haskell.TH.Syntax ( Lift (..), Q, TExp, unsafeTExpCoerce, ) #endif import Relude hiding ( ByteString, decodeUtf8, intercalate, ) data NAME = TYPE | FIELD | FRAGMENT newtype Name (t :: NAME) = Name {Name t -> Text _unpackName :: Text} deriving ((forall x. Name t -> Rep (Name t) x) -> (forall x. Rep (Name t) x -> Name t) -> Generic (Name t) forall x. Rep (Name t) x -> Name t forall x. Name t -> Rep (Name t) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall (t :: NAME) x. Rep (Name t) x -> Name t forall (t :: NAME) x. Name t -> Rep (Name t) x $cto :: forall (t :: NAME) x. Rep (Name t) x -> Name t $cfrom :: forall (t :: NAME) x. Name t -> Rep (Name t) x Generic) deriving newtype ( Int -> Name t -> ShowS [Name t] -> ShowS Name t -> String (Int -> Name t -> ShowS) -> (Name t -> String) -> ([Name t] -> ShowS) -> Show (Name t) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall (t :: NAME). Int -> Name t -> ShowS forall (t :: NAME). [Name t] -> ShowS forall (t :: NAME). Name t -> String showList :: [Name t] -> ShowS $cshowList :: forall (t :: NAME). [Name t] -> ShowS show :: Name t -> String $cshow :: forall (t :: NAME). Name t -> String showsPrec :: Int -> Name t -> ShowS $cshowsPrec :: forall (t :: NAME). Int -> Name t -> ShowS Show, Eq (Name t) Eq (Name t) -> (Name t -> Name t -> Ordering) -> (Name t -> Name t -> Bool) -> (Name t -> Name t -> Bool) -> (Name t -> Name t -> Bool) -> (Name t -> Name t -> Bool) -> (Name t -> Name t -> Name t) -> (Name t -> Name t -> Name t) -> Ord (Name t) Name t -> Name t -> Bool Name t -> Name t -> Ordering Name t -> Name t -> Name t forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall (t :: NAME). Eq (Name t) forall (t :: NAME). Name t -> Name t -> Bool forall (t :: NAME). Name t -> Name t -> Ordering forall (t :: NAME). Name t -> Name t -> Name t min :: Name t -> Name t -> Name t $cmin :: forall (t :: NAME). Name t -> Name t -> Name t max :: Name t -> Name t -> Name t $cmax :: forall (t :: NAME). Name t -> Name t -> Name t >= :: Name t -> Name t -> Bool $c>= :: forall (t :: NAME). Name t -> Name t -> Bool > :: Name t -> Name t -> Bool $c> :: forall (t :: NAME). Name t -> Name t -> Bool <= :: Name t -> Name t -> Bool $c<= :: forall (t :: NAME). Name t -> Name t -> Bool < :: Name t -> Name t -> Bool $c< :: forall (t :: NAME). Name t -> Name t -> Bool compare :: Name t -> Name t -> Ordering $ccompare :: forall (t :: NAME). Name t -> Name t -> Ordering $cp1Ord :: forall (t :: NAME). Eq (Name t) Ord, Name t -> Name t -> Bool (Name t -> Name t -> Bool) -> (Name t -> Name t -> Bool) -> Eq (Name t) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (t :: NAME). Name t -> Name t -> Bool /= :: Name t -> Name t -> Bool $c/= :: forall (t :: NAME). Name t -> Name t -> Bool == :: Name t -> Name t -> Bool $c== :: forall (t :: NAME). Name t -> Name t -> Bool Eq, String -> Name t (String -> Name t) -> IsString (Name t) forall a. (String -> a) -> IsString a forall (t :: NAME). String -> Name t fromString :: String -> Name t $cfromString :: forall (t :: NAME). String -> Name t IsString, Name t -> String (Name t -> String) -> ToString (Name t) forall a. (a -> String) -> ToString a forall (t :: NAME). Name t -> String toString :: Name t -> String $ctoString :: forall (t :: NAME). Name t -> String ToString, Int -> Name t -> Int Name t -> Int (Int -> Name t -> Int) -> (Name t -> Int) -> Hashable (Name t) forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a forall (t :: NAME). Int -> Name t -> Int forall (t :: NAME). Name t -> Int hash :: Name t -> Int $chash :: forall (t :: NAME). Name t -> Int hashWithSalt :: Int -> Name t -> Int $chashWithSalt :: forall (t :: NAME). Int -> Name t -> Int Hashable, b -> Name t -> Name t NonEmpty (Name t) -> Name t Name t -> Name t -> Name t (Name t -> Name t -> Name t) -> (NonEmpty (Name t) -> Name t) -> (forall b. Integral b => b -> Name t -> Name t) -> Semigroup (Name t) forall b. Integral b => b -> Name t -> Name t forall a. (a -> a -> a) -> (NonEmpty a -> a) -> (forall b. Integral b => b -> a -> a) -> Semigroup a forall (t :: NAME). NonEmpty (Name t) -> Name t forall (t :: NAME). Name t -> Name t -> Name t forall (t :: NAME) b. Integral b => b -> Name t -> Name t stimes :: b -> Name t -> Name t $cstimes :: forall (t :: NAME) b. Integral b => b -> Name t -> Name t sconcat :: NonEmpty (Name t) -> Name t $csconcat :: forall (t :: NAME). NonEmpty (Name t) -> Name t <> :: Name t -> Name t -> Name t $c<> :: forall (t :: NAME). Name t -> Name t -> Name t Semigroup, Value -> Parser [Name t] Value -> Parser (Name t) (Value -> Parser (Name t)) -> (Value -> Parser [Name t]) -> FromJSON (Name t) forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a forall (t :: NAME). Value -> Parser [Name t] forall (t :: NAME). Value -> Parser (Name t) parseJSONList :: Value -> Parser [Name t] $cparseJSONList :: forall (t :: NAME). Value -> Parser [Name t] parseJSON :: Value -> Parser (Name t) $cparseJSON :: forall (t :: NAME). Value -> Parser (Name t) FromJSON, [Name t] -> Encoding [Name t] -> Value Name t -> Encoding Name t -> Value (Name t -> Value) -> (Name t -> Encoding) -> ([Name t] -> Value) -> ([Name t] -> Encoding) -> ToJSON (Name t) forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a forall (t :: NAME). [Name t] -> Encoding forall (t :: NAME). [Name t] -> Value forall (t :: NAME). Name t -> Encoding forall (t :: NAME). Name t -> Value toEncodingList :: [Name t] -> Encoding $ctoEncodingList :: forall (t :: NAME). [Name t] -> Encoding toJSONList :: [Name t] -> Value $ctoJSONList :: forall (t :: NAME). [Name t] -> Value toEncoding :: Name t -> Encoding $ctoEncoding :: forall (t :: NAME). Name t -> Encoding toJSON :: Name t -> Value $ctoJSON :: forall (t :: NAME). Name t -> Value ToJSON ) instance Msg (Name t) where msg :: Name t -> GQLError msg Name t name = Text -> GQLError forall a. Msg a => a -> GQLError msg (Text -> GQLError) -> Text -> GQLError forall a b. (a -> b) -> a -> b $ Text "\"" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Name t -> Text forall (t :: NAME). Name t -> Text _unpackName Name t name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\"" class NamePacking a where packName :: a -> Name t unpackName :: Name t -> a instance NamePacking Text where packName :: Text -> Name t packName = Text -> Name t forall (t :: NAME). Text -> Name t Name unpackName :: Name t -> Text unpackName = Name t -> Text forall (t :: NAME). Name t -> Text _unpackName #if MIN_VERSION_aeson(2,0,0) instance NamePacking Key where packName :: Key -> Name t packName = Text -> Name t forall (t :: NAME). Text -> Name t Name (Text -> Name t) -> (Key -> Text) -> Key -> Name t forall b c a. (b -> c) -> (a -> b) -> a -> c . Key -> Text A.toText unpackName :: Name t -> Key unpackName = Text -> Key A.fromText (Text -> Key) -> (Name t -> Text) -> Name t -> Key forall b c a. (b -> c) -> (a -> b) -> a -> c . Name t -> Text forall (t :: NAME). Name t -> Text _unpackName #endif instance Lift (Name t) where lift :: Name t -> Q Exp lift = String -> Q Exp stringE (String -> Q Exp) -> (Name t -> String) -> Name t -> Q Exp forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack (Text -> String) -> (Name t -> Text) -> Name t -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Name t -> Text forall a (t :: NAME). NamePacking a => Name t -> a unpackName #if MIN_VERSION_template_haskell(2,17,0) liftTyped = liftTypedString . unpackName where liftTypedString :: (Quote m) => Text -> Code m (Name t) liftTypedString = unsafeCodeCoerce . stringE . T.unpack {-# INLINE liftTypedString #-} #elif MIN_VERSION_template_haskell(2,16,0) liftTyped :: Name t -> Q (TExp (Name t)) liftTyped = Text -> Q (TExp (Name t)) forall a. IsString a => Text -> Q (TExp a) liftTypedString (Text -> Q (TExp (Name t))) -> (Name t -> Text) -> Name t -> Q (TExp (Name t)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Name t -> Text forall a (t :: NAME). NamePacking a => Name t -> a unpackName where liftTypedString :: IsString a => Text -> Q (TExp a) liftTypedString :: Text -> Q (TExp a) liftTypedString = Q Exp -> Q (TExp a) forall a. Q Exp -> Q (TExp a) unsafeTExpCoerce (Q Exp -> Q (TExp a)) -> (Text -> Q Exp) -> Text -> Q (TExp a) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Q Exp stringE (String -> Q Exp) -> (Text -> String) -> Text -> Q Exp forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack {-# INLINE liftTypedString #-} #endif instance RenderGQL (Name a) where renderGQL :: Name a -> Rendering renderGQL = Text -> Rendering fromText (Text -> Rendering) -> (Name a -> Text) -> Name a -> Rendering forall b c a. (b -> c) -> (a -> b) -> a -> c . Name a -> Text forall a (t :: NAME). NamePacking a => Name t -> a unpackName type FieldName = Name 'FIELD type TypeName = Name 'TYPE type FragmentName = Name 'FRAGMENT intercalate :: Name t1 -> [Name t2] -> Name t3 intercalate :: Name t1 -> [Name t2] -> Name t3 intercalate (Name Text x) = Text -> Name t3 forall (t :: NAME). Text -> Name t Name (Text -> Name t3) -> ([Name t2] -> Text) -> [Name t2] -> Name t3 forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> [Text] -> Text T.intercalate Text x ([Text] -> Text) -> ([Name t2] -> [Text]) -> [Name t2] -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . (Name t2 -> Text) -> [Name t2] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Name t2 -> Text forall a (t :: NAME). NamePacking a => Name t -> a unpackName {-# INLINE intercalate #-} unitTypeName :: TypeName unitTypeName :: TypeName unitTypeName = TypeName "Unit" {-# INLINE unitTypeName #-} unitFieldName :: FieldName unitFieldName :: FieldName unitFieldName = FieldName "_" {-# INLINE unitFieldName #-} isNotSystemTypeName :: TypeName -> Bool isNotSystemTypeName :: TypeName -> Bool isNotSystemTypeName = ( TypeName -> [TypeName] -> Bool forall (f :: * -> *) a. (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool `notElem` [ TypeName "__Schema", TypeName "__Type", TypeName "__Directive", TypeName "__TypeKind", TypeName "__Field", TypeName "__DirectiveLocation", TypeName "__InputValue", TypeName "__EnumValue", TypeName "String", TypeName "Float", TypeName "Int", TypeName "Boolean", TypeName "ID" ] ) {-# INLINE isNotSystemTypeName #-} isNotSystemFieldName :: FieldName -> Bool isNotSystemFieldName :: FieldName -> Bool isNotSystemFieldName = ( FieldName -> [FieldName] -> Bool forall (f :: * -> *) a. (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool `notElem` [ FieldName "__typename", FieldName "__schema", FieldName "__type" ] ) {-# INLINE isNotSystemFieldName #-}