{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Error.Warning
  ( renderGQLErrors,
    deprecatedEnum,
    deprecatedField,
    gqlWarnings,
  )
where

import Data.Aeson (encode)
import Data.ByteString.Lazy.Char8 (unpack)
import Data.Morpheus.Error.Utils (errorMessage)
import Data.Morpheus.Types.Internal.AST.Base
  ( Description,
    FieldName,
    GQLErrors,
    Ref (..),
    msg,
  )
import Language.Haskell.TH (Q, reportWarning)
import Relude

renderGQLErrors :: GQLErrors -> String
renderGQLErrors :: GQLErrors -> String
renderGQLErrors = ByteString -> String
unpack (ByteString -> String)
-> (GQLErrors -> ByteString) -> GQLErrors -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLErrors -> ByteString
forall a. ToJSON a => a -> ByteString
encode

deprecatedEnum :: FieldName -> Ref -> Maybe Description -> GQLErrors
deprecatedEnum :: FieldName -> Ref -> Maybe Description -> GQLErrors
deprecatedEnum FieldName
typeName Ref {Position
refPosition :: Ref -> Position
refPosition :: Position
refPosition, FieldName
refName :: Ref -> FieldName
refName :: FieldName
refName} Maybe Description
reason =
  Position -> Message -> GQLErrors
errorMessage Position
refPosition (Message -> GQLErrors) -> Message -> GQLErrors
forall a b. (a -> b) -> a -> b
$
    Message
"the enum value "
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
typeName
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"."
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
refName
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" is deprecated."
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Description -> Message
forall a. Msg a => a -> Message
msg (Description
-> (Description -> Description) -> Maybe Description -> Description
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Description
"" (Description
" " Description -> Description -> Description
forall a. Semigroup a => a -> a -> a
<>) Maybe Description
reason)

deprecatedField :: FieldName -> Ref -> Maybe Description -> GQLErrors
deprecatedField :: FieldName -> Ref -> Maybe Description -> GQLErrors
deprecatedField FieldName
typeName Ref {Position
refPosition :: Position
refPosition :: Ref -> Position
refPosition, FieldName
refName :: FieldName
refName :: Ref -> FieldName
refName} Maybe Description
reason =
  Position -> Message -> GQLErrors
errorMessage Position
refPosition (Message -> GQLErrors) -> Message -> GQLErrors
forall a b. (a -> b) -> a -> b
$
    Message
"the field "
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
typeName
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"."
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
refName
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" is deprecated."
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Description -> Message
forall a. Msg a => a -> Message
msg (Description
-> (Description -> Description) -> Maybe Description -> Description
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Description
"" (Description
" " Description -> Description -> Description
forall a. Semigroup a => a -> a -> a
<>) Maybe Description
reason)

gqlWarnings :: GQLErrors -> Q ()
gqlWarnings :: GQLErrors -> Q ()
gqlWarnings [] = () -> Q ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
gqlWarnings GQLErrors
warnings = (GQLError -> Q ()) -> GQLErrors -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ GQLError -> Q ()
forall a. ToJSON a => a -> Q ()
handleWarning GQLErrors
warnings
  where
    handleWarning :: a -> Q ()
handleWarning a
warning =
      String -> Q ()
reportWarning (String
"Morpheus GraphQL Warning: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (ByteString -> String
unpack (ByteString -> String) -> (a -> ByteString) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode) a
warning)