{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.OperationType
  ( OperationType (..),
    QUERY,
    MUTATION,
    SUBSCRIPTION,
    toOperationType,
  )
where

import Data.Char (toLower)
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
  )
import Data.Morpheus.Types.Internal.AST.Error (Msg (..))
import Data.Morpheus.Types.Internal.AST.Name (TypeName)
import Language.Haskell.TH.Syntax
  ( Lift,
  )
import Relude hiding
  ( ByteString,
    decodeUtf8,
    intercalate,
  )

type QUERY = 'Query

type MUTATION = 'Mutation

type SUBSCRIPTION = 'Subscription

data OperationType
  = Query
  | Subscription
  | Mutation
  deriving
    ( Int -> OperationType -> ShowS
[OperationType] -> ShowS
OperationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationType] -> ShowS
$cshowList :: [OperationType] -> ShowS
show :: OperationType -> String
$cshow :: OperationType -> String
showsPrec :: Int -> OperationType -> ShowS
$cshowsPrec :: Int -> OperationType -> ShowS
Show,
      OperationType -> OperationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationType -> OperationType -> Bool
$c/= :: OperationType -> OperationType -> Bool
== :: OperationType -> OperationType -> Bool
$c== :: OperationType -> OperationType -> Bool
Eq,
      forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => OperationType -> m Exp
forall (m :: * -> *).
Quote m =>
OperationType -> Code m OperationType
liftTyped :: forall (m :: * -> *).
Quote m =>
OperationType -> Code m OperationType
$cliftTyped :: forall (m :: * -> *).
Quote m =>
OperationType -> Code m OperationType
lift :: forall (m :: * -> *). Quote m => OperationType -> m Exp
$clift :: forall (m :: * -> *). Quote m => OperationType -> m Exp
Lift,
      forall x. Rep OperationType x -> OperationType
forall x. OperationType -> Rep OperationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OperationType x -> OperationType
$cfrom :: forall x. OperationType -> Rep OperationType x
Generic,
      Eq OperationType
Int -> OperationType -> Int
OperationType -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OperationType -> Int
$chash :: OperationType -> Int
hashWithSalt :: Int -> OperationType -> Int
$chashWithSalt :: Int -> OperationType -> Int
Hashable
    )

instance RenderGQL OperationType where
  renderGQL :: OperationType -> Rendering
renderGQL = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show

toOperationType :: TypeName -> Maybe OperationType
toOperationType :: TypeName -> Maybe OperationType
toOperationType TypeName
"Subscription" = forall a. a -> Maybe a
Just OperationType
Subscription
toOperationType TypeName
"Mutation" = forall a. a -> Maybe a
Just OperationType
Mutation
toOperationType TypeName
"Query" = forall a. a -> Maybe a
Just OperationType
Query
toOperationType TypeName
_ = forall a. Maybe a
Nothing
{-# INLINE toOperationType #-}

instance Msg OperationType where
  msg :: OperationType -> GQLError
msg OperationType
Query = forall a. Msg a => a -> GQLError
msg (TypeName
"query" :: TypeName)
  msg OperationType
Mutation = forall a. Msg a => a -> GQLError
msg (TypeName
"mutation" :: TypeName)
  msg OperationType
Subscription = forall a. Msg a => a -> GQLError
msg (TypeName
"subscription" :: TypeName)