{-# LANGUAGE UndecidableInstances #-}

module Hasura.LogicalModelResolver.Metadata
  ( InlineLogicalModelMetadata (..),
    LogicalModelIdentifier (..),
  )
where

import Autodocodec (Autodocodec (Autodocodec), HasCodec)
import Autodocodec qualified as AC
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashMap.Strict.InsOrd.Autodocodec (sortedElemsCodec)
import Hasura.LogicalModel.Types
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Prelude hiding (first)
import Hasura.RQL.Types.Backend (Backend (..))
import Hasura.RQL.Types.BackendTag (backendPrefix)
import Hasura.RQL.Types.BackendType (BackendType)
import Hasura.RQL.Types.Permission (SelPermDef, _pdRole)
import Hasura.RQL.Types.Roles (RoleName)

-- | the name of a Logical Model, or an inline Logical Model
data LogicalModelIdentifier (b :: BackendType)
  = LMILogicalModelName LogicalModelName
  | LMIInlineLogicalModel (InlineLogicalModelMetadata b)
  deriving ((forall x.
 LogicalModelIdentifier b -> Rep (LogicalModelIdentifier b) x)
-> (forall x.
    Rep (LogicalModelIdentifier b) x -> LogicalModelIdentifier b)
-> Generic (LogicalModelIdentifier b)
forall x.
Rep (LogicalModelIdentifier b) x -> LogicalModelIdentifier b
forall x.
LogicalModelIdentifier b -> Rep (LogicalModelIdentifier b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (LogicalModelIdentifier b) x -> LogicalModelIdentifier b
forall (b :: BackendType) x.
LogicalModelIdentifier b -> Rep (LogicalModelIdentifier b) x
$cfrom :: forall (b :: BackendType) x.
LogicalModelIdentifier b -> Rep (LogicalModelIdentifier b) x
from :: forall x.
LogicalModelIdentifier b -> Rep (LogicalModelIdentifier b) x
$cto :: forall (b :: BackendType) x.
Rep (LogicalModelIdentifier b) x -> LogicalModelIdentifier b
to :: forall x.
Rep (LogicalModelIdentifier b) x -> LogicalModelIdentifier b
Generic)

deriving stock instance (Backend b) => Eq (LogicalModelIdentifier b)

deriving stock instance (Backend b) => Show (LogicalModelIdentifier b)

-- | forgive me, I really did try and do this the native Autodocodec way
-- and everything I did kept freezing the whole of HGE
instance (Backend b) => HasCodec (LogicalModelIdentifier b) where
  codec :: JSONCodec (LogicalModelIdentifier b)
codec =
    Text
-> JSONCodec (LogicalModelIdentifier b)
-> JSONCodec (LogicalModelIdentifier b)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.CommentCodec
      (Text
"A name or definition of a Logical Model")
      (JSONCodec (LogicalModelIdentifier b)
 -> JSONCodec (LogicalModelIdentifier b))
-> JSONCodec (LogicalModelIdentifier b)
-> JSONCodec (LogicalModelIdentifier b)
forall a b. (a -> b) -> a -> b
$ JSONCodec (LogicalModelIdentifier b)
forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON

instance (Backend b) => FromJSON (LogicalModelIdentifier b) where
  parseJSON :: Value -> Parser (LogicalModelIdentifier b)
parseJSON Value
j =
    (LogicalModelName -> LogicalModelIdentifier b
forall (b :: BackendType).
LogicalModelName -> LogicalModelIdentifier b
LMILogicalModelName (LogicalModelName -> LogicalModelIdentifier b)
-> Parser LogicalModelName -> Parser (LogicalModelIdentifier b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LogicalModelName
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j)
      Parser (LogicalModelIdentifier b)
-> Parser (LogicalModelIdentifier b)
-> Parser (LogicalModelIdentifier b)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (InlineLogicalModelMetadata b -> LogicalModelIdentifier b
forall (b :: BackendType).
InlineLogicalModelMetadata b -> LogicalModelIdentifier b
LMIInlineLogicalModel (InlineLogicalModelMetadata b -> LogicalModelIdentifier b)
-> Parser (InlineLogicalModelMetadata b)
-> Parser (LogicalModelIdentifier b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (InlineLogicalModelMetadata b)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j)

instance (Backend b) => ToJSON (LogicalModelIdentifier b) where
  toJSON :: LogicalModelIdentifier b -> Value
toJSON (LMILogicalModelName LogicalModelName
t) = LogicalModelName -> Value
forall a. ToJSON a => a -> Value
toJSON LogicalModelName
t
  toJSON (LMIInlineLogicalModel InlineLogicalModelMetadata b
t) = InlineLogicalModelMetadata b -> Value
forall a. ToJSON a => a -> Value
toJSON InlineLogicalModelMetadata b
t

-- | Description of an inline logical model to use in metadata (before schema cache)
-- this has no name - it is up to the resolving user (ie, the Native Query,
-- etc) to give the generated type a name
data InlineLogicalModelMetadata (b :: BackendType) = InlineLogicalModelMetadata
  { forall (b :: BackendType).
InlineLogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields :: InsOrdHashMap.InsOrdHashMap (Column b) (LogicalModelField b),
    forall (b :: BackendType).
InlineLogicalModelMetadata b
-> InsOrdHashMap RoleName (SelPermDef b)
_ilmmSelectPermissions :: InsOrdHashMap RoleName (SelPermDef b)
  }
  deriving ((forall x.
 InlineLogicalModelMetadata b
 -> Rep (InlineLogicalModelMetadata b) x)
-> (forall x.
    Rep (InlineLogicalModelMetadata b) x
    -> InlineLogicalModelMetadata b)
-> Generic (InlineLogicalModelMetadata b)
forall x.
Rep (InlineLogicalModelMetadata b) x
-> InlineLogicalModelMetadata b
forall x.
InlineLogicalModelMetadata b
-> Rep (InlineLogicalModelMetadata b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (InlineLogicalModelMetadata b) x
-> InlineLogicalModelMetadata b
forall (b :: BackendType) x.
InlineLogicalModelMetadata b
-> Rep (InlineLogicalModelMetadata b) x
$cfrom :: forall (b :: BackendType) x.
InlineLogicalModelMetadata b
-> Rep (InlineLogicalModelMetadata b) x
from :: forall x.
InlineLogicalModelMetadata b
-> Rep (InlineLogicalModelMetadata b) x
$cto :: forall (b :: BackendType) x.
Rep (InlineLogicalModelMetadata b) x
-> InlineLogicalModelMetadata b
to :: forall x.
Rep (InlineLogicalModelMetadata b) x
-> InlineLogicalModelMetadata b
Generic)

instance (Backend b) => HasCodec (InlineLogicalModelMetadata b) where
  codec :: JSONCodec (InlineLogicalModelMetadata b)
codec =
    Text
-> JSONCodec (InlineLogicalModelMetadata b)
-> JSONCodec (InlineLogicalModelMetadata b)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.CommentCodec
      (Text
"A return type.")
      (JSONCodec (InlineLogicalModelMetadata b)
 -> JSONCodec (InlineLogicalModelMetadata b))
-> JSONCodec (InlineLogicalModelMetadata b)
-> JSONCodec (InlineLogicalModelMetadata b)
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec
     (InlineLogicalModelMetadata b) (InlineLogicalModelMetadata b)
-> JSONCodec (InlineLogicalModelMetadata b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (forall (b :: BackendType). HasTag b => Text
backendPrefix @b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"InlineLogicalModelMetadata")
      (ObjectCodec
   (InlineLogicalModelMetadata b) (InlineLogicalModelMetadata b)
 -> JSONCodec (InlineLogicalModelMetadata b))
-> ObjectCodec
     (InlineLogicalModelMetadata b) (InlineLogicalModelMetadata b)
-> JSONCodec (InlineLogicalModelMetadata b)
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap RoleName (SelPermDef b)
-> InlineLogicalModelMetadata b
forall (b :: BackendType).
InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap RoleName (SelPermDef b)
-> InlineLogicalModelMetadata b
InlineLogicalModelMetadata
      (InsOrdHashMap (Column b) (LogicalModelField b)
 -> InsOrdHashMap RoleName (SelPermDef b)
 -> InlineLogicalModelMetadata b)
-> Codec
     Object
     (InlineLogicalModelMetadata b)
     (InsOrdHashMap (Column b) (LogicalModelField b))
-> Codec
     Object
     (InlineLogicalModelMetadata b)
     (InsOrdHashMap RoleName (SelPermDef b)
      -> InlineLogicalModelMetadata b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueCodec
     (InsOrdHashMap (Column b) (LogicalModelField b))
     (InsOrdHashMap (Column b) (LogicalModelField b))
-> Text
-> ObjectCodec
     (InsOrdHashMap (Column b) (LogicalModelField b))
     (InsOrdHashMap (Column b) (LogicalModelField b))
forall input output.
Text -> ValueCodec input output -> Text -> ObjectCodec input output
AC.requiredFieldWith Text
"fields" ValueCodec
  (InsOrdHashMap (Column b) (LogicalModelField b))
  (InsOrdHashMap (Column b) (LogicalModelField b))
forall (b :: BackendType).
Backend b =>
Codec
  Value
  (InsOrdHashMap (Column b) (LogicalModelField b))
  (InsOrdHashMap (Column b) (LogicalModelField b))
logicalModelFieldMapCodec Text
fieldsDoc
      ObjectCodec
  (InsOrdHashMap (Column b) (LogicalModelField b))
  (InsOrdHashMap (Column b) (LogicalModelField b))
-> (InlineLogicalModelMetadata b
    -> InsOrdHashMap (Column b) (LogicalModelField b))
-> Codec
     Object
     (InlineLogicalModelMetadata b)
     (InsOrdHashMap (Column b) (LogicalModelField b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InlineLogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
forall (b :: BackendType).
InlineLogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields
        Codec
  Object
  (InlineLogicalModelMetadata b)
  (InsOrdHashMap RoleName (SelPermDef b)
   -> InlineLogicalModelMetadata b)
-> Codec
     Object
     (InlineLogicalModelMetadata b)
     (InsOrdHashMap RoleName (SelPermDef b))
-> ObjectCodec
     (InlineLogicalModelMetadata b) (InlineLogicalModelMetadata b)
forall a b.
Codec Object (InlineLogicalModelMetadata b) (a -> b)
-> Codec Object (InlineLogicalModelMetadata b) a
-> Codec Object (InlineLogicalModelMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> (SelPermDef b -> RoleName)
-> ObjectCodec
     (InsOrdHashMap RoleName (SelPermDef b))
     (InsOrdHashMap RoleName (SelPermDef b))
forall {k} {a}.
(Eq a, HasCodec a, Hashable k, Ord k, ToTxt k) =>
Text
-> (a -> k) -> ObjectCodec (InsOrdHashMap k a) (InsOrdHashMap k a)
optSortedList Text
"select_permissions" SelPermDef b -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole
      ObjectCodec
  (InsOrdHashMap RoleName (SelPermDef b))
  (InsOrdHashMap RoleName (SelPermDef b))
-> (InlineLogicalModelMetadata b
    -> InsOrdHashMap RoleName (SelPermDef b))
-> Codec
     Object
     (InlineLogicalModelMetadata b)
     (InsOrdHashMap RoleName (SelPermDef b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InlineLogicalModelMetadata b
-> InsOrdHashMap RoleName (SelPermDef b)
forall (b :: BackendType).
InlineLogicalModelMetadata b
-> InsOrdHashMap RoleName (SelPermDef b)
_ilmmSelectPermissions
    where
      fieldsDoc :: Text
fieldsDoc = Text
"Return types for the logical model"

      optSortedList :: Text
-> (a -> k) -> ObjectCodec (InsOrdHashMap k a) (InsOrdHashMap k a)
optSortedList Text
name a -> k
keyForElem =
        Text
-> JSONCodec (InsOrdHashMap k a)
-> InsOrdHashMap k a
-> ObjectCodec (InsOrdHashMap k a) (InsOrdHashMap k a)
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
AC.optionalFieldWithOmittedDefaultWith' Text
name ((a -> k) -> JSONCodec (InsOrdHashMap k a)
forall a k.
(HasCodec a, Hashable k, Ord k, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodec a -> k
keyForElem) InsOrdHashMap k a
forall a. Monoid a => a
mempty

deriving via
  (Autodocodec (InlineLogicalModelMetadata b))
  instance
    (Backend b) => FromJSON (InlineLogicalModelMetadata b)

deriving via
  (Autodocodec (InlineLogicalModelMetadata b))
  instance
    (Backend b) => ToJSON (InlineLogicalModelMetadata b)

deriving stock instance (Backend b) => Eq (InlineLogicalModelMetadata b)

deriving stock instance (Backend b) => Show (InlineLogicalModelMetadata b)