-- | 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 J
import Data.Aeson.Ordered qualified as AO
import Data.Aeson.Types qualified as J
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 J.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
$cshowsPrec :: Int -> PlaceholderArray -> ShowS
showsPrec :: Int -> PlaceholderArray -> ShowS
$cshow :: PlaceholderArray -> String
show :: PlaceholderArray -> String
$cshowList :: [PlaceholderArray] -> ShowS
showList :: [PlaceholderArray] -> ShowS
Show, PlaceholderArray -> PlaceholderArray -> Bool
(PlaceholderArray -> PlaceholderArray -> Bool)
-> (PlaceholderArray -> PlaceholderArray -> Bool)
-> Eq PlaceholderArray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlaceholderArray -> PlaceholderArray -> Bool
== :: PlaceholderArray -> PlaceholderArray -> Bool
$c/= :: PlaceholderArray -> PlaceholderArray -> Bool
/= :: 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
$cparseJSON :: Value -> Parser PlaceholderArray
parseJSON :: Value -> Parser PlaceholderArray
$cparseJSONList :: Value -> Parser [PlaceholderArray]
parseJSONList :: 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
$ctoJSON :: PlaceholderArray -> Value
toJSON :: PlaceholderArray -> Value
$ctoEncoding :: PlaceholderArray -> Encoding
toEncoding :: PlaceholderArray -> Encoding
$ctoJSONList :: [PlaceholderArray] -> Value
toJSONList :: [PlaceholderArray] -> Value
$ctoEncodingList :: [PlaceholderArray] -> Encoding
toEncodingList :: [PlaceholderArray] -> Encoding
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
$cfrom :: forall x. PlaceholderArray -> Rep PlaceholderArray x
from :: forall x. PlaceholderArray -> Rep PlaceholderArray x
$cto :: forall x. Rep PlaceholderArray x -> PlaceholderArray
to :: forall x. Rep PlaceholderArray x -> PlaceholderArray
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
$cdeclareNamedSchema :: Proxy PlaceholderArray -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PlaceholderArray -> Declare (Definitions Schema) NamedSchema
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 J.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
$cshowsPrec :: Int -> PlaceholderObject -> ShowS
showsPrec :: Int -> PlaceholderObject -> ShowS
$cshow :: PlaceholderObject -> String
show :: PlaceholderObject -> String
$cshowList :: [PlaceholderObject] -> ShowS
showList :: [PlaceholderObject] -> ShowS
Show, PlaceholderObject -> PlaceholderObject -> Bool
(PlaceholderObject -> PlaceholderObject -> Bool)
-> (PlaceholderObject -> PlaceholderObject -> Bool)
-> Eq PlaceholderObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlaceholderObject -> PlaceholderObject -> Bool
== :: PlaceholderObject -> PlaceholderObject -> Bool
$c/= :: PlaceholderObject -> PlaceholderObject -> Bool
/= :: 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
$cparseJSON :: Value -> Parser PlaceholderObject
parseJSON :: Value -> Parser PlaceholderObject
$cparseJSONList :: Value -> Parser [PlaceholderObject]
parseJSONList :: 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
$ctoJSON :: PlaceholderObject -> Value
toJSON :: PlaceholderObject -> Value
$ctoEncoding :: PlaceholderObject -> Encoding
toEncoding :: PlaceholderObject -> Encoding
$ctoJSONList :: [PlaceholderObject] -> Value
toJSONList :: [PlaceholderObject] -> Value
$ctoEncodingList :: [PlaceholderObject] -> Encoding
toEncodingList :: [PlaceholderObject] -> Encoding
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
$cfrom :: forall x. PlaceholderObject -> Rep PlaceholderObject x
from :: forall x. PlaceholderObject -> Rep PlaceholderObject x
$cto :: forall x. Rep PlaceholderObject x -> PlaceholderObject
to :: forall x. Rep PlaceholderObject x -> PlaceholderObject
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
$cdeclareNamedSchema :: Proxy PlaceholderObject -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PlaceholderObject -> Declare (Definitions Schema) NamedSchema
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 J.Array where
  placeholder :: Array -> PlaceholderArray
placeholder = Array -> PlaceholderArray
PlaceholderArray

instance IsPlaceholder PlaceholderObject J.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 :: forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON =
  (Value -> Either String a)
-> (a -> Value) -> ValueCodec Value Value -> Codec Value a 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
    Codec Value a a -> Text -> Codec Value a 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
J.parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
J.parseJSON
    enc :: a -> Value
enc = a -> Value
forall a. ToJSON a => a -> Value
J.toJSON