{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Instances that're slow to compile.
module Hasura.Backends.MySQL.Types.Instances () where

import Autodocodec (HasCodec (codec), named)
import Control.DeepSeq
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Aeson.Extended
import Data.Aeson.TH qualified as J
import Data.Aeson.Types
import Data.Pool
import Data.Text.Extended (ToTxt (..))
import Database.MySQL.Base (Connection)
import Database.MySQL.Base.Types qualified as MySQLTypes (Type (..))
import Hasura.Backends.MySQL.Types.Internal
import Hasura.Base.ErrorValue qualified as ErrorValue
import Hasura.Base.ToErrorValue
import Hasura.Incremental.Internal.Dependency
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Prelude
import Language.Haskell.TH
import Language.Haskell.TH.Syntax

----
---- Countable instances

-- These instances must be defined before the TH-defined instances below.

deriving instance Generic (Countable n)

instance Hashable n => Hashable (Countable n)

instance Cacheable n => Cacheable (Countable n)

deriving instance Eq n => Eq (Countable n)

deriving instance Show n => Show (Countable n)

deriving instance Data n => Data (Countable n)

instance NFData n => NFData (Countable n)

instance ToJSON n => ToJSON (Countable n)

instance FromJSON n => FromJSON (Countable n)

----
---- TH-defined instances

$( concat <$> for
     [ ''ScalarType
     ]
     \name ->
       [d|
         deriving instance Generic $(conT name)

         instance Hashable $(conT name)

         instance Cacheable $(conT name)

         deriving instance Data $(conT name)

         instance NFData $(conT name)
         |]
 )

$( fmap concat $ for
     [''Aliased]
     \name ->
       [d|
         deriving instance Generic ($(conT name) a)

         instance Hashable a => Hashable ($(conT name) a)

         instance Cacheable a => Cacheable ($(conT name) a)

         deriving instance Eq a => Eq ($(conT name) a)

         instance NFData a => NFData ($(conT name) a)

         deriving instance Show a => Show ($(conT name) a)

         deriving instance Functor $(conT name)

         deriving instance Data a => Data ($(conT name) a)
         |]
 )

$( concat <$> for
     [ ''Where,
       ''Aggregate,
       ''EntityAlias,
       ''OrderBy,
       ''JoinAlias,
       ''Reselect,
       ''Expression,
       ''NullsOrder,
       ''Order,
       ''Top,
       ''TableName,
       ''Select,
       ''FieldName,
       ''FieldOrigin,
       ''Projection,
       ''From,
       ''Join,
       ''Op,
       ''JoinType
     ]
     \name ->
       [d|
         deriving instance Generic $(conT name)

         instance Hashable $(conT name)

         instance Cacheable $(conT name)

         deriving instance Eq $(conT name)

         deriving instance Show $(conT name)

         deriving instance Data $(conT name)

         instance NFData $(conT name)
         |]
 )

$( concat <$> for
     [''TableName, ''ScalarType]
     \name -> [d|deriving instance Ord $(conT name)|]
 )

$( concat <$> for
     [''TableName, ''NullsOrder, ''Order]
     \name -> [d|deriving instance Lift $(conT name)|]
 )

$( concat <$> for
     [''Order, ''NullsOrder, ''ScalarType, ''FieldName]
     \name ->
       [d|
         instance ToJSON $(conT name) where
           toJSON = genericToJSON hasuraJSON

         instance FromJSON $(conT name) where
           parseJSON = genericParseJSON hasuraJSON
         |]
 )

----
---- Manually-defined instances

instance ToTxt TableName where
  toTxt :: TableName -> Text
toTxt TableName {Maybe Text
Text
schema :: TableName -> Maybe Text
name :: TableName -> Text
schema :: Maybe Text
name :: Text
..} = Text
name

instance FromJSON TableName where
  parseJSON :: Value -> Parser TableName
parseJSON v :: Value
v@(String Text
_) =
    Text -> Maybe Text -> TableName
TableName (Text -> Maybe Text -> TableName)
-> Parser Text -> Parser (Maybe Text -> TableName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (Maybe Text -> TableName)
-> Parser (Maybe Text) -> Parser TableName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
  parseJSON (Object Object
o) =
    Text -> Maybe Text -> TableName
TableName
      (Text -> Maybe Text -> TableName)
-> Parser Text -> Parser (Maybe Text -> TableName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (Maybe Text -> TableName)
-> Parser (Maybe Text) -> Parser TableName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schema"
  parseJSON Value
_ =
    String -> Parser TableName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting a string/object for TableName"

instance ToJSON TableName where
  toJSON :: TableName -> Value
toJSON TableName {Maybe Text
Text
schema :: Maybe Text
name :: Text
schema :: TableName -> Maybe Text
name :: TableName -> Text
..} = [Pair] -> Value
object [Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name, Key
"schema" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
schema]

instance ToJSONKey TableName where
  toJSONKey :: ToJSONKeyFunction TableName
toJSONKey =
    (TableName -> Text) -> ToJSONKeyFunction TableName
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((TableName -> Text) -> ToJSONKeyFunction TableName)
-> (TableName -> Text) -> ToJSONKeyFunction TableName
forall a b. (a -> b) -> a -> b
$ \(TableName {Maybe Text
schema :: Maybe Text
schema :: TableName -> Maybe Text
schema, Text
name :: Text
name :: TableName -> Text
name}) ->
      Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Maybe Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

instance ToJSONKey ScalarType

instance ToTxt ScalarType where
  toTxt :: Type -> Text
toTxt = Type -> Text
forall a. Show a => a -> Text
tshow

instance ToErrorValue ScalarType where
  toErrorValue :: Type -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage) -> (Type -> Text) -> Type -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Text
forall a. Show a => a -> Text
tshow

deriving newtype instance Monoid Where

deriving newtype instance Semigroup Where

instance Monoid Top where
  mempty :: Top
mempty = Top
NoTop

instance Semigroup Top where
  (<>) :: Top -> Top -> Top
  <> :: Top -> Top -> Top
(<>) Top
NoTop Top
x = Top
x
  (<>) Top
x Top
NoTop = Top
x
  (<>) (Top Int
x) (Top Int
y) = Int -> Top
Top (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y)

instance J.FromJSON ConnPoolSettings where
  parseJSON :: Value -> Parser ConnPoolSettings
parseJSON = String
-> (Object -> Parser ConnPoolSettings)
-> Value
-> Parser ConnPoolSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"MySQL pool settings" ((Object -> Parser ConnPoolSettings)
 -> Value -> Parser ConnPoolSettings)
-> (Object -> Parser ConnPoolSettings)
-> Value
-> Parser ConnPoolSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Word -> Word -> ConnPoolSettings
ConnPoolSettings
      (Word -> Word -> ConnPoolSettings)
-> Parser Word -> Parser (Word -> ConnPoolSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"max_connections" Parser (Maybe Word) -> Word -> Parser Word
forall a. Parser (Maybe a) -> a -> Parser a
J..!= ConnPoolSettings -> Word
_cscMaxConnections ConnPoolSettings
defaultConnPoolSettings
      Parser (Word -> ConnPoolSettings)
-> Parser Word -> Parser ConnPoolSettings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"idle_timeout" Parser (Maybe Word) -> Word -> Parser Word
forall a. Parser (Maybe a) -> a -> Parser a
J..!= ConnPoolSettings -> Word
_cscIdleTimeout ConnPoolSettings
defaultConnPoolSettings

$(J.deriveToJSON hasuraJSON ''ConnPoolSettings)

instance J.ToJSON Expression where
  toJSON :: Expression -> Value
toJSON (ValueExpression ScalarValue
scalarValue) = ScalarValue -> Value
forall a. ToJSON a => a -> Value
J.toJSON ScalarValue
scalarValue
  toJSON Expression
expr = String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"ToJSON: not implemented" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expression -> String
forall a. Show a => a -> String
show Expression
expr -- https://github.com/hasura/graphql-engine-mono/issues/1951

instance J.FromJSON Expression where
  parseJSON :: Value -> Parser Expression
parseJSON Value
value = ScalarValue -> Expression
ValueExpression (ScalarValue -> Expression)
-> Parser ScalarValue -> Parser Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ScalarValue
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
value

$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) {J.omitNothingFields = False} ''ConnSourceConfig)

-- TODO: Write a proper codec, and use it to derive FromJSON and ToJSON
-- instances.
instance HasCodec ConnSourceConfig where
  codec :: JSONCodec ConnSourceConfig
codec = Text -> JSONCodec ConnSourceConfig -> JSONCodec ConnSourceConfig
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"MySQLConnConfiguration" (JSONCodec ConnSourceConfig -> JSONCodec ConnSourceConfig)
-> JSONCodec ConnSourceConfig -> JSONCodec ConnSourceConfig
forall a b. (a -> b) -> a -> b
$ JSONCodec ConnSourceConfig
forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON

instance J.ToJSON (Pool Connection) where
  toJSON :: Pool Connection -> Value
toJSON = Value -> Pool Connection -> Value
forall a b. a -> b -> a
const (Text -> Value
J.String Text
"_REDACTED_")

instance Eq (Pool Connection) where
  Pool Connection
_ == :: Pool Connection -> Pool Connection -> Bool
== Pool Connection
_ = Bool
True

instance Cacheable SourceConfig where
  unchanged :: Accesses -> SourceConfig -> SourceConfig -> Bool
unchanged Accesses
_ = SourceConfig -> SourceConfig -> Bool
forall a. Eq a => a -> a -> Bool
(==)

deriving instance Eq SourceConfig

deriving instance Generic SourceConfig

deriving instance J.ToJSON SourceConfig

deriving instance Cacheable ConnPoolSettings

deriving instance Cacheable ConnSourceConfig