{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

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

import Data.Aeson (encode)
import Data.ByteString.Lazy.Char8 (unpack)
import Data.Morpheus.Types.Internal.AST.Base
  ( Description,
    Position (..),
  )
import Data.Morpheus.Types.Internal.AST.Error
  ( GQLError (..),
    GQLErrors,
    PropName (..),
    msg,
  )
import Data.Morpheus.Types.Internal.AST.Name
  ( FieldName,
    TypeName,
  )
import qualified Data.Text as T
import Language.Haskell.TH
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
. [GQLError] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([GQLError] -> ByteString)
-> (GQLErrors -> [GQLError]) -> GQLErrors -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLErrors -> [GQLError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

deprecatedField :: TypeName -> FieldName -> Maybe Description -> GQLError
deprecatedField :: TypeName -> FieldName -> Maybe Description -> GQLError
deprecatedField TypeName
typeName FieldName
refName Maybe Description
reason =
  GQLError
"the field "
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeName -> FieldName
forall a b. Coercible a b => a -> b
coerce TypeName
typeName FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
"." FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
refName)
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" is deprecated."
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> Description -> GQLError
forall a. Msg a => a -> GQLError
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 :: [GQLError] -> Q ()
gqlWarnings :: [GQLError] -> Q ()
gqlWarnings [] = () -> Q ()
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
gqlWarnings [GQLError]
warnings = (GQLError -> Q ()) -> [GQLError] -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> Q ()
reportWarning (String -> Q ()) -> (GQLError -> String) -> GQLError -> Q ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> String
printWarning) [GQLError]
warnings

printWarning :: GQLError -> String
printWarning :: GQLError -> String
printWarning = String -> String -> GQLError -> String
printError String
"warning" String
"\x1b[33m"

printError :: String -> String -> GQLError -> String
printError :: String -> String -> GQLError -> String
printError String
label String
color GQLError
warning =
  String -> String
withColor (String
label String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":")
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
description
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
loc
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
printedPath
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"
  where
    propPath :: [PropName]
propPath = [[PropName]] -> [PropName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PropName]] -> [PropName]) -> [[PropName]] -> [PropName]
forall a b. (a -> b) -> a -> b
$ Maybe [PropName] -> [[PropName]]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe [PropName] -> [[PropName]])
-> Maybe [PropName] -> [[PropName]]
forall a b. (a -> b) -> a -> b
$ GQLError -> Maybe [PropName]
path GQLError
warning
    propLoc :: [Position]
propLoc = [[Position]] -> [Position]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Position]] -> [Position]) -> [[Position]] -> [Position]
forall a b. (a -> b) -> a -> b
$ Maybe [Position] -> [[Position]]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe [Position] -> [[Position]])
-> Maybe [Position] -> [[Position]]
forall a b. (a -> b) -> a -> b
$ GQLError -> Maybe [Position]
locations GQLError
warning
    description :: String
description = String
indent String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
withColor (Description -> String
forall a. ToString a => a -> String
toString (GQLError -> Description
message GQLError
warning))
    loc :: String
loc
      | [Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Position]
propLoc = String
""
      | Bool
otherwise = String
indent String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  locations: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Position -> String) -> [Position] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Position -> String
printLocation [Position]
propLoc
    printedPath :: String
printedPath
      | [PropName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PropName]
propPath = String
""
      | Bool
otherwise = String
indent String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  path: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ((PropName -> String) -> [PropName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PropName -> String
printPath [PropName]
propPath)

    withColor :: String -> String
    withColor :: String -> String
withColor String
x = String
color String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\x1b[0m"

indent :: String
indent :: String
indent = String
"\n      "

printPath :: PropName -> String
printPath :: PropName -> String
printPath (PropIndex Int
x) = Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
x
printPath (PropName Description
x) = Description -> String
T.unpack Description
x

printLocation :: Position -> String
printLocation :: Position -> String
printLocation Position {Int
line :: Int
column :: Int
line :: Position -> Int
column :: Position -> Int
..} = Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
line String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
column