{-# LANGUAGE OverloadedLists #-}

module Hasura.RQL.Types.NamingCase
  ( NamingCase (..),
    parseNamingConventionFromText,
  )
where

import Autodocodec qualified as AC
import Data.Aeson qualified as J
import Hasura.Prelude

-- | Represents the different possible type cases for fields and types, i.e.
--   @HasuraCase@ and @GraphqlCase@ (@CamelCase@ fields and @PascalCase@ types).
data NamingCase = HasuraCase | GraphqlCase
  deriving (NamingCase -> NamingCase -> Bool
(NamingCase -> NamingCase -> Bool)
-> (NamingCase -> NamingCase -> Bool) -> Eq NamingCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamingCase -> NamingCase -> Bool
== :: NamingCase -> NamingCase -> Bool
$c/= :: NamingCase -> NamingCase -> Bool
/= :: NamingCase -> NamingCase -> Bool
Eq, Int -> NamingCase -> ShowS
[NamingCase] -> ShowS
NamingCase -> String
(Int -> NamingCase -> ShowS)
-> (NamingCase -> String)
-> ([NamingCase] -> ShowS)
-> Show NamingCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamingCase -> ShowS
showsPrec :: Int -> NamingCase -> ShowS
$cshow :: NamingCase -> String
show :: NamingCase -> String
$cshowList :: [NamingCase] -> ShowS
showList :: [NamingCase] -> ShowS
Show, (forall x. NamingCase -> Rep NamingCase x)
-> (forall x. Rep NamingCase x -> NamingCase) -> Generic NamingCase
forall x. Rep NamingCase x -> NamingCase
forall x. NamingCase -> Rep NamingCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamingCase -> Rep NamingCase x
from :: forall x. NamingCase -> Rep NamingCase x
$cto :: forall x. Rep NamingCase x -> NamingCase
to :: forall x. Rep NamingCase x -> NamingCase
Generic)

instance AC.HasCodec NamingCase where
  codec :: JSONCodec NamingCase
codec =
    Text -> JSONCodec NamingCase -> JSONCodec NamingCase
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.named Text
"NamingCase"
      (JSONCodec NamingCase -> JSONCodec NamingCase)
-> JSONCodec NamingCase -> JSONCodec NamingCase
forall a b. (a -> b) -> a -> b
$ NonEmpty (NamingCase, Text) -> JSONCodec NamingCase
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
AC.stringConstCodec [(NamingCase
HasuraCase, Text
"hasura-default"), (NamingCase
GraphqlCase, Text
"graphql-default")]

instance J.ToJSON NamingCase where
  toJSON :: NamingCase -> Value
toJSON NamingCase
HasuraCase = Text -> Value
J.String Text
"hasura-default"
  toJSON NamingCase
GraphqlCase = Text -> Value
J.String Text
"graphql-default"

instance J.FromJSON NamingCase where
  parseJSON :: Value -> Parser NamingCase
parseJSON = String -> (Text -> Parser NamingCase) -> Value -> Parser NamingCase
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"NamingCase" ((Text -> Parser NamingCase) -> Value -> Parser NamingCase)
-> (Text -> Parser NamingCase) -> Value -> Parser NamingCase
forall a b. (a -> b) -> a -> b
$ \Text
s -> case Text -> Either String NamingCase
parseNamingConventionFromText Text
s of
    (Right NamingCase
nc) -> NamingCase -> Parser NamingCase
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamingCase
nc
    (Left String
err) -> String -> Parser NamingCase
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err

-- Used for both the environment variable and JSON.
parseNamingConventionFromText :: Text -> Either String NamingCase
parseNamingConventionFromText :: Text -> Either String NamingCase
parseNamingConventionFromText Text
"hasura-default" = NamingCase -> Either String NamingCase
forall a b. b -> Either a b
Right NamingCase
HasuraCase
parseNamingConventionFromText Text
"graphql-default" = NamingCase -> Either String NamingCase
forall a b. b -> Either a b
Right NamingCase
GraphqlCase
parseNamingConventionFromText Text
_ = String -> Either String NamingCase
forall a b. a -> Either a b
Left String
"naming_convention can either be \"hasura-default\" or \"graphql-default\""