-- | We are in the process of building DTO types incrementally. We use
-- placeholder types in positions in data structures that are not fully-defined
-- yet. For example 'PlaceholderObject' represents some unspecified JSON object,
-- and 'PlaceholderArray' represents an array whose contents are not yet
-- specified.
--
-- We are transitioning from converting 'Hasura.RQL.Types.Metadata' directly to
-- JSON to converting it to 'Hasura.Server.API.DTO.Metadata.MetadataDTO'
-- instead. Serialization and deserialization for placeholder values is
-- delegated to the old JSON serialization code.
module Hasura.Metadata.DTO.Placeholder
  ( PlaceholderArray (..),
    PlaceholderObject (..),
    IsPlaceholder (..),
    placeholderCodecViaJSON,
  )
where

import Autodocodec (Autodocodec, HasCodec (codec), JSONCodec, bimapCodec, codecViaAeson, dimapCodec, valueCodec, vectorCodec, (<?>))
import Autodocodec.OpenAPI ()
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as JSON
import Data.Aeson.Ordered qualified as AO
import Data.Aeson.Types qualified as JSON
import Data.OpenApi qualified as OpenApi
import Data.Vector qualified as V
import Hasura.Prelude

-- TODO: Store ordered aeson values in placeholders instead of stock aeson
-- values so that we can preserve order. We want to do that after #4842 is
-- merged so we can use 'toOrderedJSONVia' to produce the appropriate codecs.

-- | Stands in for an array that we have not had time to fully specify yet.
-- Generated OpenAPI documentation for 'PlaceholderArray' will permit an array
-- of values of any type, and a note will be appended to the documentation
-- string for the value explaining that this is a temporary placeholder.
newtype PlaceholderArray = PlaceholderArray JSON.Array
  deriving newtype (Int -> PlaceholderArray -> ShowS
[PlaceholderArray] -> ShowS
PlaceholderArray -> String
(Int -> PlaceholderArray -> ShowS)
-> (PlaceholderArray -> String)
-> ([PlaceholderArray] -> ShowS)
-> Show PlaceholderArray
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaceholderArray] -> ShowS
$cshowList :: [PlaceholderArray] -> ShowS
show :: PlaceholderArray -> String
$cshow :: PlaceholderArray -> String
showsPrec :: Int -> PlaceholderArray -> ShowS
$cshowsPrec :: Int -> PlaceholderArray -> ShowS
Show, PlaceholderArray -> PlaceholderArray -> Bool
(PlaceholderArray -> PlaceholderArray -> Bool)
-> (PlaceholderArray -> PlaceholderArray -> Bool)
-> Eq PlaceholderArray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaceholderArray -> PlaceholderArray -> Bool
$c/= :: PlaceholderArray -> PlaceholderArray -> Bool
== :: PlaceholderArray -> PlaceholderArray -> Bool
$c== :: PlaceholderArray -> PlaceholderArray -> Bool
Eq, Value -> Parser [PlaceholderArray]
Value -> Parser PlaceholderArray
(Value -> Parser PlaceholderArray)
-> (Value -> Parser [PlaceholderArray])
-> FromJSON PlaceholderArray
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PlaceholderArray]
$cparseJSONList :: Value -> Parser [PlaceholderArray]
parseJSON :: Value -> Parser PlaceholderArray
$cparseJSON :: Value -> Parser PlaceholderArray
FromJSON, [PlaceholderArray] -> Value
[PlaceholderArray] -> Encoding
PlaceholderArray -> Value
PlaceholderArray -> Encoding
(PlaceholderArray -> Value)
-> (PlaceholderArray -> Encoding)
-> ([PlaceholderArray] -> Value)
-> ([PlaceholderArray] -> Encoding)
-> ToJSON PlaceholderArray
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PlaceholderArray] -> Encoding
$ctoEncodingList :: [PlaceholderArray] -> Encoding
toJSONList :: [PlaceholderArray] -> Value
$ctoJSONList :: [PlaceholderArray] -> Value
toEncoding :: PlaceholderArray -> Encoding
$ctoEncoding :: PlaceholderArray -> Encoding
toJSON :: PlaceholderArray -> Value
$ctoJSON :: PlaceholderArray -> Value
ToJSON)
  deriving stock ((forall x. PlaceholderArray -> Rep PlaceholderArray x)
-> (forall x. Rep PlaceholderArray x -> PlaceholderArray)
-> Generic PlaceholderArray
forall x. Rep PlaceholderArray x -> PlaceholderArray
forall x. PlaceholderArray -> Rep PlaceholderArray x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlaceholderArray x -> PlaceholderArray
$cfrom :: forall x. PlaceholderArray -> Rep PlaceholderArray x
Generic)
  deriving (Typeable PlaceholderArray
Typeable PlaceholderArray
-> (Proxy PlaceholderArray
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PlaceholderArray
Proxy PlaceholderArray -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy PlaceholderArray -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy PlaceholderArray -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable PlaceholderArray
OpenApi.ToSchema) via (Autodocodec PlaceholderArray)

-- | Stands in for an object that we have not had time to fully specify yet.
-- Generated OpenAPI documentation for 'PlaceholderObject' will permit an object
-- with any keys with any types of values. A note will be appended to the
-- documentation string for the value explaining that this is a temporary
-- placeholder.
newtype PlaceholderObject = PlaceholderObject JSON.Object
  deriving newtype (Int -> PlaceholderObject -> ShowS
[PlaceholderObject] -> ShowS
PlaceholderObject -> String
(Int -> PlaceholderObject -> ShowS)
-> (PlaceholderObject -> String)
-> ([PlaceholderObject] -> ShowS)
-> Show PlaceholderObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaceholderObject] -> ShowS
$cshowList :: [PlaceholderObject] -> ShowS
show :: PlaceholderObject -> String
$cshow :: PlaceholderObject -> String
showsPrec :: Int -> PlaceholderObject -> ShowS
$cshowsPrec :: Int -> PlaceholderObject -> ShowS
Show, PlaceholderObject -> PlaceholderObject -> Bool
(PlaceholderObject -> PlaceholderObject -> Bool)
-> (PlaceholderObject -> PlaceholderObject -> Bool)
-> Eq PlaceholderObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaceholderObject -> PlaceholderObject -> Bool
$c/= :: PlaceholderObject -> PlaceholderObject -> Bool
== :: PlaceholderObject -> PlaceholderObject -> Bool
$c== :: PlaceholderObject -> PlaceholderObject -> Bool
Eq, Value -> Parser [PlaceholderObject]
Value -> Parser PlaceholderObject
(Value -> Parser PlaceholderObject)
-> (Value -> Parser [PlaceholderObject])
-> FromJSON PlaceholderObject
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PlaceholderObject]
$cparseJSONList :: Value -> Parser [PlaceholderObject]
parseJSON :: Value -> Parser PlaceholderObject
$cparseJSON :: Value -> Parser PlaceholderObject
FromJSON, [PlaceholderObject] -> Value
[PlaceholderObject] -> Encoding
PlaceholderObject -> Value
PlaceholderObject -> Encoding
(PlaceholderObject -> Value)
-> (PlaceholderObject -> Encoding)
-> ([PlaceholderObject] -> Value)
-> ([PlaceholderObject] -> Encoding)
-> ToJSON PlaceholderObject
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PlaceholderObject] -> Encoding
$ctoEncodingList :: [PlaceholderObject] -> Encoding
toJSONList :: [PlaceholderObject] -> Value
$ctoJSONList :: [PlaceholderObject] -> Value
toEncoding :: PlaceholderObject -> Encoding
$ctoEncoding :: PlaceholderObject -> Encoding
toJSON :: PlaceholderObject -> Value
$ctoJSON :: PlaceholderObject -> Value
ToJSON)
  deriving stock ((forall x. PlaceholderObject -> Rep PlaceholderObject x)
-> (forall x. Rep PlaceholderObject x -> PlaceholderObject)
-> Generic PlaceholderObject
forall x. Rep PlaceholderObject x -> PlaceholderObject
forall x. PlaceholderObject -> Rep PlaceholderObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlaceholderObject x -> PlaceholderObject
$cfrom :: forall x. PlaceholderObject -> Rep PlaceholderObject x
Generic)
  deriving (Typeable PlaceholderObject
Typeable PlaceholderObject
-> (Proxy PlaceholderObject
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PlaceholderObject
Proxy PlaceholderObject -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy PlaceholderObject -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy PlaceholderObject -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable PlaceholderObject
OpenApi.ToSchema) via (Autodocodec PlaceholderObject)

instance HasCodec PlaceholderArray where
  codec :: JSONCodec PlaceholderArray
codec = (Array -> PlaceholderArray)
-> (PlaceholderArray -> Array)
-> Codec Value Array Array
-> JSONCodec PlaceholderArray
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Array -> PlaceholderArray
mapOutput PlaceholderArray -> Array
mapInput (ValueCodec Value Value -> Codec Value Array Array
forall input output.
ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
vectorCodec ValueCodec Value Value
valueCodec) JSONCodec PlaceholderArray -> Text -> JSONCodec PlaceholderArray
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
documentation
    where
      mapOutput :: Array -> PlaceholderArray
mapOutput = Array -> PlaceholderArray
PlaceholderArray
      mapInput :: PlaceholderArray -> Array
mapInput (PlaceholderArray Array
a) = Array
a
      documentation :: Text
documentation =
        Text
"\n\narray of values of unspecified type - this is a placeholder that will eventually be replaced with a more detailed description"

instance HasCodec PlaceholderObject where
  codec :: JSONCodec PlaceholderObject
codec = Text -> JSONCodec PlaceholderObject
forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"\n\nobject with unspecified properties - this is a placeholder that will eventually be replaced with a more detailed description"

class IsPlaceholder p a | a -> p where
  -- | Use this function to mark an Aeson type (Array or Object) as
  -- a temporary placeholder in a larger data structure.
  placeholder :: a -> p

instance IsPlaceholder PlaceholderArray JSON.Array where
  placeholder :: Array -> PlaceholderArray
placeholder = Array -> PlaceholderArray
PlaceholderArray

instance IsPlaceholder PlaceholderObject JSON.Object where
  placeholder :: Object -> PlaceholderObject
placeholder = Object -> PlaceholderObject
PlaceholderObject

instance IsPlaceholder PlaceholderArray AO.Array where
  placeholder :: Array -> PlaceholderArray
placeholder = Array -> PlaceholderArray
PlaceholderArray (Array -> PlaceholderArray)
-> (Array -> Array) -> Array -> PlaceholderArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> (Array -> [Value]) -> Array -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value) -> [Value] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Value
AO.fromOrdered ([Value] -> [Value]) -> (Array -> [Value]) -> Array -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
V.toList

instance IsPlaceholder PlaceholderObject AO.Object where
  placeholder :: Object -> PlaceholderObject
placeholder = Object -> PlaceholderObject
PlaceholderObject (Object -> PlaceholderObject)
-> (Object -> Object) -> Object -> PlaceholderObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Object
AO.fromOrderedObject

-- | This placeholder can be used in a codec to represent any type of data that
-- has `FromJSON` and `ToJSON` instances. Generated OpenAPI specifications based
-- on this codec will not show any information about the internal structure of
-- the type so ideally uses of this placeholder should eventually be replaced
-- with more descriptive codecs.
placeholderCodecViaJSON :: (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON :: JSONCodec a
placeholderCodecViaJSON =
  (Value -> Either String a)
-> (a -> Value) -> ValueCodec Value Value -> JSONCodec a
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Value -> Either String a
dec a -> Value
enc ValueCodec Value Value
valueCodec
    JSONCodec a -> Text -> JSONCodec a
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"value with unspecified type - this is a placeholder that will eventually be replaced with a more detailed description"
  where
    dec :: Value -> Either String a
dec = (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON
    enc :: a -> Value
enc = a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON