-- | A scalar type to be used for logical models and resolvers.
module Hasura.LogicalModel.NullableScalarType
  ( NullableScalarType (..),
    nullableScalarTypeMapCodec,
  )
where

import Autodocodec (Autodocodec (Autodocodec), HasCodec (codec), HasObjectCodec (..), bimapCodec)
import Autodocodec qualified as AC
import Data.Aeson (ToJSON, Value)
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Hasura.Prelude hiding (first)
import Hasura.RQL.Types.Backend (Backend (..))
import Hasura.RQL.Types.BackendTag (backendPrefix)

-- | A ScalarType that can be nullable with an optional description
data NullableScalarType b = NullableScalarType
  { forall (b :: BackendType). NullableScalarType b -> ScalarType b
nstType :: ScalarType b,
    forall (b :: BackendType). NullableScalarType b -> Bool
nstNullable :: Bool,
    forall (b :: BackendType). NullableScalarType b -> Maybe Text
nstDescription :: Maybe Text
  }
  deriving ((forall x. NullableScalarType b -> Rep (NullableScalarType b) x)
-> (forall x. Rep (NullableScalarType b) x -> NullableScalarType b)
-> Generic (NullableScalarType b)
forall x. Rep (NullableScalarType b) x -> NullableScalarType b
forall x. NullableScalarType b -> Rep (NullableScalarType b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (NullableScalarType b) x -> NullableScalarType b
forall (b :: BackendType) x.
NullableScalarType b -> Rep (NullableScalarType b) x
$cfrom :: forall (b :: BackendType) x.
NullableScalarType b -> Rep (NullableScalarType b) x
from :: forall x. NullableScalarType b -> Rep (NullableScalarType b) x
$cto :: forall (b :: BackendType) x.
Rep (NullableScalarType b) x -> NullableScalarType b
to :: forall x. Rep (NullableScalarType b) x -> NullableScalarType b
Generic)

instance (Backend b) => HasCodec (NullableScalarType b) where
  codec :: JSONCodec (NullableScalarType b)
codec =
    Text
-> JSONCodec (NullableScalarType b)
-> JSONCodec (NullableScalarType b)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.CommentCodec
      (Text
"A scalar type that can be nullable with an optional description")
      (JSONCodec (NullableScalarType b)
 -> JSONCodec (NullableScalarType b))
-> JSONCodec (NullableScalarType b)
-> JSONCodec (NullableScalarType b)
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec (NullableScalarType b) (NullableScalarType b)
-> JSONCodec (NullableScalarType 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
"NullableScalarType")
      (ObjectCodec (NullableScalarType b) (NullableScalarType b)
 -> JSONCodec (NullableScalarType b))
-> ObjectCodec (NullableScalarType b) (NullableScalarType b)
-> JSONCodec (NullableScalarType b)
forall a b. (a -> b) -> a -> b
$ ObjectCodec (NullableScalarType b) (NullableScalarType b)
forall object. HasObjectCodec object => JSONObjectCodec object
AC.objectCodec

instance (Backend b) => HasObjectCodec (NullableScalarType b) where
  objectCodec :: JSONObjectCodec (NullableScalarType b)
objectCodec =
    ScalarType b -> Bool -> Maybe Text -> NullableScalarType b
forall (b :: BackendType).
ScalarType b -> Bool -> Maybe Text -> NullableScalarType b
NullableScalarType
      (ScalarType b -> Bool -> Maybe Text -> NullableScalarType b)
-> Codec Object (NullableScalarType b) (ScalarType b)
-> Codec
     Object
     (NullableScalarType b)
     (Bool -> Maybe Text -> NullableScalarType b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (ScalarType b) (ScalarType b)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"type" Text
columnDoc
      ObjectCodec (ScalarType b) (ScalarType b)
-> (NullableScalarType b -> ScalarType b)
-> Codec Object (NullableScalarType b) (ScalarType b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= NullableScalarType b -> ScalarType b
forall (b :: BackendType). NullableScalarType b -> ScalarType b
nstType
        Codec
  Object
  (NullableScalarType b)
  (Bool -> Maybe Text -> NullableScalarType b)
-> Codec Object (NullableScalarType b) Bool
-> Codec
     Object (NullableScalarType b) (Maybe Text -> NullableScalarType b)
forall a b.
Codec Object (NullableScalarType b) (a -> b)
-> Codec Object (NullableScalarType b) a
-> Codec Object (NullableScalarType b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Bool -> Text -> ObjectCodec Bool Bool
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
AC.optionalFieldWithDefault Text
"nullable" Bool
False Text
nullableDoc
      ObjectCodec Bool Bool
-> (NullableScalarType b -> Bool)
-> Codec Object (NullableScalarType b) Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= NullableScalarType b -> Bool
forall (b :: BackendType). NullableScalarType b -> Bool
nstNullable
        Codec
  Object (NullableScalarType b) (Maybe Text -> NullableScalarType b)
-> Codec Object (NullableScalarType b) (Maybe Text)
-> JSONObjectCodec (NullableScalarType b)
forall a b.
Codec Object (NullableScalarType b) (a -> b)
-> Codec Object (NullableScalarType b) a
-> Codec Object (NullableScalarType b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
AC.optionalField Text
"description" Text
descriptionDoc
      ObjectCodec (Maybe Text) (Maybe Text)
-> (NullableScalarType b -> Maybe Text)
-> Codec Object (NullableScalarType b) (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= NullableScalarType b -> Maybe Text
forall (b :: BackendType). NullableScalarType b -> Maybe Text
nstDescription
    where
      columnDoc :: Text
columnDoc = Text
"The base scalar type"
      nullableDoc :: Text
nullableDoc = Text
"Whether the type is nullable"
      descriptionDoc :: Text
descriptionDoc = Text
"Optional description text which appears in the GraphQL Schema"

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

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

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

instance (Backend b) => Hashable (NullableScalarType b)

instance (Backend b) => NFData (NullableScalarType b)

-----

data MergedObject a b = MergedObject
  { forall a b. MergedObject a b -> a
moFst :: a,
    forall a b. MergedObject a b -> b
moSnd :: b
  }

instance (HasObjectCodec a, HasObjectCodec b) => HasObjectCodec (MergedObject a b) where
  objectCodec :: JSONObjectCodec (MergedObject a b)
objectCodec = a -> b -> MergedObject a b
forall a b. a -> b -> MergedObject a b
MergedObject (a -> b -> MergedObject a b)
-> Codec Object (MergedObject a b) a
-> Codec Object (MergedObject a b) (b -> MergedObject a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Either String a)
-> (MergedObject a b -> a)
-> Codec Object a a
-> Codec Object (MergedObject a b) a
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec a -> Either String a
forall a b. b -> Either a b
Right MergedObject a b -> a
forall a b. MergedObject a b -> a
moFst Codec Object a a
forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec Codec Object (MergedObject a b) (b -> MergedObject a b)
-> Codec Object (MergedObject a b) b
-> JSONObjectCodec (MergedObject a b)
forall a b.
Codec Object (MergedObject a b) (a -> b)
-> Codec Object (MergedObject a b) a
-> Codec Object (MergedObject a b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> Either String b)
-> (MergedObject a b -> b)
-> Codec Object b b
-> Codec Object (MergedObject a b) b
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec b -> Either String b
forall a b. b -> Either a b
Right MergedObject a b -> b
forall a b. MergedObject a b -> b
moSnd Codec Object b b
forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec

newtype NameField a = NameField {forall a. NameField a -> a
nameField :: a}

instance (HasCodec a) => HasObjectCodec (NameField a) where
  objectCodec :: JSONObjectCodec (NameField a)
objectCodec = a -> NameField a
forall a. a -> NameField a
NameField (a -> NameField a)
-> Codec Object (NameField a) a -> JSONObjectCodec (NameField a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec a a
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"name" Text
"name" ObjectCodec a a
-> (NameField a -> a) -> Codec Object (NameField a) a
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= NameField a -> a
forall a. NameField a -> a
nameField

-- we parse in as an array of NullableScalarTypeFromArray and then turn into
-- InsOrdHashMap because JSON objects cannot be depended on for ordering
nullableScalarTypeMapCodec ::
  forall b.
  (Backend b) =>
  AC.Codec
    Value
    (InsOrdHashMap.InsOrdHashMap (Column b) (NullableScalarType b))
    (InsOrdHashMap.InsOrdHashMap (Column b) (NullableScalarType b))
nullableScalarTypeMapCodec :: forall (b :: BackendType).
Backend b =>
Codec
  Value
  (InsOrdHashMap (Column b) (NullableScalarType b))
  (InsOrdHashMap (Column b) (NullableScalarType b))
nullableScalarTypeMapCodec =
  ([MergedObject (NameField (Column b)) (NullableScalarType b)]
 -> InsOrdHashMap (Column b) (NullableScalarType b))
-> (InsOrdHashMap (Column b) (NullableScalarType b)
    -> [MergedObject (NameField (Column b)) (NullableScalarType b)])
-> Codec
     Value
     [MergedObject (NameField (Column b)) (NullableScalarType b)]
     [MergedObject (NameField (Column b)) (NullableScalarType b)]
-> Codec
     Value
     (InsOrdHashMap (Column b) (NullableScalarType b))
     (InsOrdHashMap (Column b) (NullableScalarType b))
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
AC.dimapCodec
    ( [(Column b, NullableScalarType b)]
-> InsOrdHashMap (Column b) (NullableScalarType b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
        ([(Column b, NullableScalarType b)]
 -> InsOrdHashMap (Column b) (NullableScalarType b))
-> ([MergedObject (NameField (Column b)) (NullableScalarType b)]
    -> [(Column b, NullableScalarType b)])
-> [MergedObject (NameField (Column b)) (NullableScalarType b)]
-> InsOrdHashMap (Column b) (NullableScalarType b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MergedObject (NameField (Column b)) (NullableScalarType b)
 -> (Column b, NullableScalarType b))
-> [MergedObject (NameField (Column b)) (NullableScalarType b)]
-> [(Column b, NullableScalarType b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ( \(MergedObject (NameField Column b
name) NullableScalarType b
nst) ->
              (Column b
name, NullableScalarType b
nst)
          )
    )
    ( ((Column b, NullableScalarType b)
 -> MergedObject (NameField (Column b)) (NullableScalarType b))
-> [(Column b, NullableScalarType b)]
-> [MergedObject (NameField (Column b)) (NullableScalarType b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Column b
fld, NullableScalarType b
nst) -> NameField (Column b)
-> NullableScalarType b
-> MergedObject (NameField (Column b)) (NullableScalarType b)
forall a b. a -> b -> MergedObject a b
MergedObject (Column b -> NameField (Column b)
forall a. a -> NameField a
NameField Column b
fld) NullableScalarType b
nst) ([(Column b, NullableScalarType b)]
 -> [MergedObject (NameField (Column b)) (NullableScalarType b)])
-> (InsOrdHashMap (Column b) (NullableScalarType b)
    -> [(Column b, NullableScalarType b)])
-> InsOrdHashMap (Column b) (NullableScalarType b)
-> [MergedObject (NameField (Column b)) (NullableScalarType b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap (Column b) (NullableScalarType b)
-> [(Column b, NullableScalarType b)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList
    )
    ( ValueCodec
  (MergedObject (NameField (Column b)) (NullableScalarType b))
  (MergedObject (NameField (Column b)) (NullableScalarType b))
-> Codec
     Value
     [MergedObject (NameField (Column b)) (NullableScalarType b)]
     [MergedObject (NameField (Column b)) (NullableScalarType b)]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
AC.listCodec
        (ValueCodec
   (MergedObject (NameField (Column b)) (NullableScalarType b))
   (MergedObject (NameField (Column b)) (NullableScalarType b))
 -> Codec
      Value
      [MergedObject (NameField (Column b)) (NullableScalarType b)]
      [MergedObject (NameField (Column b)) (NullableScalarType b)])
-> ValueCodec
     (MergedObject (NameField (Column b)) (NullableScalarType b))
     (MergedObject (NameField (Column b)) (NullableScalarType b))
-> Codec
     Value
     [MergedObject (NameField (Column b)) (NullableScalarType b)]
     [MergedObject (NameField (Column b)) (NullableScalarType b)]
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec
     (MergedObject (NameField (Column b)) (NullableScalarType b))
     (MergedObject (NameField (Column b)) (NullableScalarType b))
-> ValueCodec
     (MergedObject (NameField (Column b)) (NullableScalarType b))
     (MergedObject (NameField (Column b)) (NullableScalarType b))
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"NullableScalarType"
        (ObjectCodec
   (MergedObject (NameField (Column b)) (NullableScalarType b))
   (MergedObject (NameField (Column b)) (NullableScalarType b))
 -> ValueCodec
      (MergedObject (NameField (Column b)) (NullableScalarType b))
      (MergedObject (NameField (Column b)) (NullableScalarType b)))
-> ObjectCodec
     (MergedObject (NameField (Column b)) (NullableScalarType b))
     (MergedObject (NameField (Column b)) (NullableScalarType b))
-> ValueCodec
     (MergedObject (NameField (Column b)) (NullableScalarType b))
     (MergedObject (NameField (Column b)) (NullableScalarType b))
forall a b. (a -> b) -> a -> b
$ forall object. HasObjectCodec object => JSONObjectCodec object
AC.objectCodec @(MergedObject (NameField (Column b)) (NullableScalarType b))
    )