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