{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.Relationships.Local
  ( ArrRelDef,
    ArrRelUsing,
    ArrRelUsingFKeyOn (..),
    Nullable (..),
    ObjRelDef,
    ObjRelUsing,
    ObjRelUsingChoice (..),
    RelDef (..),
    RelTarget (..),
    RelInfo (..),
    RelManualTableConfig (..),
    RelManualNativeQueryConfig (..),
    RelManualCommon (..),
    RelUsing (..),
    WithTable (..),
    boolToNullable,
    fromRel,
    rdComment,
    rdName,
    rdUsing,
  )
where

import Autodocodec (HasCodec (codec), HasObjectCodec, dimapCodec, disjointEitherCodec, optionalField', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (optionalFieldOrIncludedNull', typeableName)
import Control.Lens (makeLenses)
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types
import Data.Text qualified as T
import Data.Typeable (Typeable)
import Hasura.NativeQuery.Types (NativeQueryName)
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendTag (backendPrefix)
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common

data RelDef a = RelDef
  { forall a. RelDef a -> RelName
_rdName :: RelName,
    forall a. RelDef a -> a
_rdUsing :: a,
    forall a. RelDef a -> Maybe Text
_rdComment :: Maybe T.Text
  }
  deriving (Int -> RelDef a -> ShowS
[RelDef a] -> ShowS
RelDef a -> String
(Int -> RelDef a -> ShowS)
-> (RelDef a -> String) -> ([RelDef a] -> ShowS) -> Show (RelDef a)
forall a. Show a => Int -> RelDef a -> ShowS
forall a. Show a => [RelDef a] -> ShowS
forall a. Show a => RelDef a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RelDef a -> ShowS
showsPrec :: Int -> RelDef a -> ShowS
$cshow :: forall a. Show a => RelDef a -> String
show :: RelDef a -> String
$cshowList :: forall a. Show a => [RelDef a] -> ShowS
showList :: [RelDef a] -> ShowS
Show, RelDef a -> RelDef a -> Bool
(RelDef a -> RelDef a -> Bool)
-> (RelDef a -> RelDef a -> Bool) -> Eq (RelDef a)
forall a. Eq a => RelDef a -> RelDef a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RelDef a -> RelDef a -> Bool
== :: RelDef a -> RelDef a -> Bool
$c/= :: forall a. Eq a => RelDef a -> RelDef a -> Bool
/= :: RelDef a -> RelDef a -> Bool
Eq, (forall x. RelDef a -> Rep (RelDef a) x)
-> (forall x. Rep (RelDef a) x -> RelDef a) -> Generic (RelDef a)
forall x. Rep (RelDef a) x -> RelDef a
forall x. RelDef a -> Rep (RelDef a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RelDef a) x -> RelDef a
forall a x. RelDef a -> Rep (RelDef a) x
$cfrom :: forall a x. RelDef a -> Rep (RelDef a) x
from :: forall x. RelDef a -> Rep (RelDef a) x
$cto :: forall a x. Rep (RelDef a) x -> RelDef a
to :: forall x. Rep (RelDef a) x -> RelDef a
Generic)

instance (HasCodec a, Typeable a) => HasCodec (RelDef a) where
  codec :: JSONCodec (RelDef a)
codec = Text -> ObjectCodec (RelDef a) (RelDef a) -> JSONCodec (RelDef a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"RelDef_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @a) ObjectCodec (RelDef a) (RelDef a)
forall object. HasObjectCodec object => JSONObjectCodec object
AC.objectCodec

instance (HasCodec a) => HasObjectCodec (RelDef a) where
  objectCodec :: JSONObjectCodec (RelDef a)
objectCodec =
    RelName -> a -> Maybe Text -> RelDef a
forall a. RelName -> a -> Maybe Text -> RelDef a
RelDef
      (RelName -> a -> Maybe Text -> RelDef a)
-> Codec Object (RelDef a) RelName
-> Codec Object (RelDef a) (a -> Maybe Text -> RelDef a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RelName RelName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec RelName RelName
-> (RelDef a -> RelName) -> Codec Object (RelDef a) RelName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelDef a -> RelName
forall a. RelDef a -> RelName
_rdName
        Codec Object (RelDef a) (a -> Maybe Text -> RelDef a)
-> Codec Object (RelDef a) a
-> Codec Object (RelDef a) (Maybe Text -> RelDef a)
forall a b.
Codec Object (RelDef a) (a -> b)
-> Codec Object (RelDef a) a -> Codec Object (RelDef a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec a a
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"using"
      ObjectCodec a a -> (RelDef a -> a) -> Codec Object (RelDef a) a
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelDef a -> a
forall a. RelDef a -> a
_rdUsing
        Codec Object (RelDef a) (Maybe Text -> RelDef a)
-> Codec Object (RelDef a) (Maybe Text)
-> JSONObjectCodec (RelDef a)
forall a b.
Codec Object (RelDef a) (a -> b)
-> Codec Object (RelDef a) a -> Codec Object (RelDef a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"comment"
      ObjectCodec (Maybe Text) (Maybe Text)
-> (RelDef a -> Maybe Text) -> Codec Object (RelDef a) (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelDef a -> Maybe Text
forall a. RelDef a -> Maybe Text
_rdComment

instance (FromJSON a) => FromJSON (RelDef a) where
  parseJSON :: Value -> Parser (RelDef a)
parseJSON = Options -> Value -> Parser (RelDef a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

$(makeLenses ''RelDef)

instance (ToJSON a) => ToJSON (RelDef a) where
  toJSON :: RelDef a -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (RelDef a -> [Pair]) -> RelDef a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelDef a -> [Pair]
forall v. KeyValue v => RelDef a -> [v]
forall a v. (ToAesonPairs a, KeyValue v) => a -> [v]
toAesonPairs

instance (ToJSON a) => ToAesonPairs (RelDef a) where
  toAesonPairs :: forall v. KeyValue v => RelDef a -> [v]
toAesonPairs (RelDef RelName
rn a
ru Maybe Text
rc) =
    [ Key
"name" Key -> RelName -> v
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> v
.= RelName
rn,
      Key
"using" Key -> a -> v
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> v
.= a
ru,
      Key
"comment" Key -> Maybe Text -> v
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> v
.= Maybe Text
rc
    ]

data RelManualTableConfig (b :: BackendType) = RelManualTableConfig
  { forall (b :: BackendType). RelManualTableConfig b -> TableName b
rmtTable :: TableName b,
    forall (b :: BackendType).
RelManualTableConfig b -> RelManualCommon b
rmtCommon :: RelManualCommon b
  }
  deriving ((forall x.
 RelManualTableConfig b -> Rep (RelManualTableConfig b) x)
-> (forall x.
    Rep (RelManualTableConfig b) x -> RelManualTableConfig b)
-> Generic (RelManualTableConfig b)
forall x. Rep (RelManualTableConfig b) x -> RelManualTableConfig b
forall x. RelManualTableConfig b -> Rep (RelManualTableConfig b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (RelManualTableConfig b) x -> RelManualTableConfig b
forall (b :: BackendType) x.
RelManualTableConfig b -> Rep (RelManualTableConfig b) x
$cfrom :: forall (b :: BackendType) x.
RelManualTableConfig b -> Rep (RelManualTableConfig b) x
from :: forall x. RelManualTableConfig b -> Rep (RelManualTableConfig b) x
$cto :: forall (b :: BackendType) x.
Rep (RelManualTableConfig b) x -> RelManualTableConfig b
to :: forall x. Rep (RelManualTableConfig b) x -> RelManualTableConfig b
Generic)
  deriving (Value -> Parser [RelManualTableConfig b]
Value -> Parser (RelManualTableConfig b)
(Value -> Parser (RelManualTableConfig b))
-> (Value -> Parser [RelManualTableConfig b])
-> FromJSON (RelManualTableConfig b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [RelManualTableConfig b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (RelManualTableConfig b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (RelManualTableConfig b)
parseJSON :: Value -> Parser (RelManualTableConfig b)
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [RelManualTableConfig b]
parseJSONList :: Value -> Parser [RelManualTableConfig b]
FromJSON, [RelManualTableConfig b] -> Value
[RelManualTableConfig b] -> Encoding
RelManualTableConfig b -> Value
RelManualTableConfig b -> Encoding
(RelManualTableConfig b -> Value)
-> (RelManualTableConfig b -> Encoding)
-> ([RelManualTableConfig b] -> Value)
-> ([RelManualTableConfig b] -> Encoding)
-> ToJSON (RelManualTableConfig b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (b :: BackendType).
Backend b =>
[RelManualTableConfig b] -> Value
forall (b :: BackendType).
Backend b =>
[RelManualTableConfig b] -> Encoding
forall (b :: BackendType).
Backend b =>
RelManualTableConfig b -> Value
forall (b :: BackendType).
Backend b =>
RelManualTableConfig b -> Encoding
$ctoJSON :: forall (b :: BackendType).
Backend b =>
RelManualTableConfig b -> Value
toJSON :: RelManualTableConfig b -> Value
$ctoEncoding :: forall (b :: BackendType).
Backend b =>
RelManualTableConfig b -> Encoding
toEncoding :: RelManualTableConfig b -> Encoding
$ctoJSONList :: forall (b :: BackendType).
Backend b =>
[RelManualTableConfig b] -> Value
toJSONList :: [RelManualTableConfig b] -> Value
$ctoEncodingList :: forall (b :: BackendType).
Backend b =>
[RelManualTableConfig b] -> Encoding
toEncodingList :: [RelManualTableConfig b] -> Encoding
ToJSON) via AC.Autodocodec (RelManualTableConfig b)

deriving instance (Backend b) => Eq (RelManualTableConfig b)

deriving instance (Backend b) => Show (RelManualTableConfig b)

data RelManualNativeQueryConfig (b :: BackendType) = RelManualNativeQueryConfig
  { forall (b :: BackendType).
RelManualNativeQueryConfig b -> NativeQueryName
rmnNativeQueryName :: NativeQueryName,
    forall (b :: BackendType).
RelManualNativeQueryConfig b -> RelManualCommon b
rmnCommon :: RelManualCommon b
  }
  deriving ((forall x.
 RelManualNativeQueryConfig b
 -> Rep (RelManualNativeQueryConfig b) x)
-> (forall x.
    Rep (RelManualNativeQueryConfig b) x
    -> RelManualNativeQueryConfig b)
-> Generic (RelManualNativeQueryConfig b)
forall x.
Rep (RelManualNativeQueryConfig b) x
-> RelManualNativeQueryConfig b
forall x.
RelManualNativeQueryConfig b
-> Rep (RelManualNativeQueryConfig b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (RelManualNativeQueryConfig b) x
-> RelManualNativeQueryConfig b
forall (b :: BackendType) x.
RelManualNativeQueryConfig b
-> Rep (RelManualNativeQueryConfig b) x
$cfrom :: forall (b :: BackendType) x.
RelManualNativeQueryConfig b
-> Rep (RelManualNativeQueryConfig b) x
from :: forall x.
RelManualNativeQueryConfig b
-> Rep (RelManualNativeQueryConfig b) x
$cto :: forall (b :: BackendType) x.
Rep (RelManualNativeQueryConfig b) x
-> RelManualNativeQueryConfig b
to :: forall x.
Rep (RelManualNativeQueryConfig b) x
-> RelManualNativeQueryConfig b
Generic)

deriving instance (Backend b) => Eq (RelManualNativeQueryConfig b)

deriving instance (Backend b) => Show (RelManualNativeQueryConfig b)

data RelManualCommon (b :: BackendType) = RelManualCommon
  { forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns :: HashMap (Column b) (Column b),
    forall (b :: BackendType). RelManualCommon b -> Maybe InsertOrder
rmInsertOrder :: Maybe InsertOrder
  }
  deriving ((forall x. RelManualCommon b -> Rep (RelManualCommon b) x)
-> (forall x. Rep (RelManualCommon b) x -> RelManualCommon b)
-> Generic (RelManualCommon b)
forall x. Rep (RelManualCommon b) x -> RelManualCommon b
forall x. RelManualCommon b -> Rep (RelManualCommon b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (RelManualCommon b) x -> RelManualCommon b
forall (b :: BackendType) x.
RelManualCommon b -> Rep (RelManualCommon b) x
$cfrom :: forall (b :: BackendType) x.
RelManualCommon b -> Rep (RelManualCommon b) x
from :: forall x. RelManualCommon b -> Rep (RelManualCommon b) x
$cto :: forall (b :: BackendType) x.
Rep (RelManualCommon b) x -> RelManualCommon b
to :: forall x. Rep (RelManualCommon b) x -> RelManualCommon b
Generic)

deriving instance (Backend b) => Eq (RelManualCommon b)

deriving instance (Backend b) => Show (RelManualCommon b)

instance (Backend b) => HasCodec (RelManualTableConfig b) where
  codec :: JSONCodec (RelManualTableConfig b)
codec =
    Text
-> ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
-> JSONCodec (RelManualTableConfig 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
"RelManualTableConfig")
      (ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
 -> JSONCodec (RelManualTableConfig b))
-> ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
-> JSONCodec (RelManualTableConfig b)
forall a b. (a -> b) -> a -> b
$ TableName b -> RelManualCommon b -> RelManualTableConfig b
forall (b :: BackendType).
TableName b -> RelManualCommon b -> RelManualTableConfig b
RelManualTableConfig
      (TableName b -> RelManualCommon b -> RelManualTableConfig b)
-> Codec Object (RelManualTableConfig b) (TableName b)
-> Codec
     Object
     (RelManualTableConfig b)
     (RelManualCommon b -> RelManualTableConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (TableName b) (TableName b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"remote_table"
      ObjectCodec (TableName b) (TableName b)
-> (RelManualTableConfig b -> TableName b)
-> Codec Object (RelManualTableConfig b) (TableName b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelManualTableConfig b -> TableName b
forall (b :: BackendType). RelManualTableConfig b -> TableName b
rmtTable
        Codec
  Object
  (RelManualTableConfig b)
  (RelManualCommon b -> RelManualTableConfig b)
-> Codec Object (RelManualTableConfig b) (RelManualCommon b)
-> ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
forall a b.
Codec Object (RelManualTableConfig b) (a -> b)
-> Codec Object (RelManualTableConfig b) a
-> Codec Object (RelManualTableConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSONObjectCodec (RelManualCommon b)
forall object. HasObjectCodec object => JSONObjectCodec object
AC.objectCodec
      JSONObjectCodec (RelManualCommon b)
-> (RelManualTableConfig b -> RelManualCommon b)
-> Codec Object (RelManualTableConfig b) (RelManualCommon b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelManualTableConfig b -> RelManualCommon b
forall (b :: BackendType).
RelManualTableConfig b -> RelManualCommon b
rmtCommon

instance (Backend b) => HasCodec (RelManualNativeQueryConfig b) where
  codec :: JSONCodec (RelManualNativeQueryConfig b)
codec =
    Text
-> ObjectCodec
     (RelManualNativeQueryConfig b) (RelManualNativeQueryConfig b)
-> JSONCodec (RelManualNativeQueryConfig 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
"RelManualNativeQueryConfig")
      (ObjectCodec
   (RelManualNativeQueryConfig b) (RelManualNativeQueryConfig b)
 -> JSONCodec (RelManualNativeQueryConfig b))
-> ObjectCodec
     (RelManualNativeQueryConfig b) (RelManualNativeQueryConfig b)
-> JSONCodec (RelManualNativeQueryConfig b)
forall a b. (a -> b) -> a -> b
$ NativeQueryName
-> RelManualCommon b -> RelManualNativeQueryConfig b
forall (b :: BackendType).
NativeQueryName
-> RelManualCommon b -> RelManualNativeQueryConfig b
RelManualNativeQueryConfig
      (NativeQueryName
 -> RelManualCommon b -> RelManualNativeQueryConfig b)
-> Codec Object (RelManualNativeQueryConfig b) NativeQueryName
-> Codec
     Object
     (RelManualNativeQueryConfig b)
     (RelManualCommon b -> RelManualNativeQueryConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec NativeQueryName NativeQueryName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"remote_native_query"
      ObjectCodec NativeQueryName NativeQueryName
-> (RelManualNativeQueryConfig b -> NativeQueryName)
-> Codec Object (RelManualNativeQueryConfig b) NativeQueryName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelManualNativeQueryConfig b -> NativeQueryName
forall (b :: BackendType).
RelManualNativeQueryConfig b -> NativeQueryName
rmnNativeQueryName
        Codec
  Object
  (RelManualNativeQueryConfig b)
  (RelManualCommon b -> RelManualNativeQueryConfig b)
-> Codec Object (RelManualNativeQueryConfig b) (RelManualCommon b)
-> ObjectCodec
     (RelManualNativeQueryConfig b) (RelManualNativeQueryConfig b)
forall a b.
Codec Object (RelManualNativeQueryConfig b) (a -> b)
-> Codec Object (RelManualNativeQueryConfig b) a
-> Codec Object (RelManualNativeQueryConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSONObjectCodec (RelManualCommon b)
forall object. HasObjectCodec object => JSONObjectCodec object
AC.objectCodec
      JSONObjectCodec (RelManualCommon b)
-> (RelManualNativeQueryConfig b -> RelManualCommon b)
-> Codec Object (RelManualNativeQueryConfig b) (RelManualCommon b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelManualNativeQueryConfig b -> RelManualCommon b
forall (b :: BackendType).
RelManualNativeQueryConfig b -> RelManualCommon b
rmnCommon

instance (Backend b) => AC.HasObjectCodec (RelManualCommon b) where
  objectCodec :: JSONObjectCodec (RelManualCommon b)
objectCodec =
    HashMap (Column b) (Column b)
-> Maybe InsertOrder -> RelManualCommon b
forall (b :: BackendType).
HashMap (Column b) (Column b)
-> Maybe InsertOrder -> RelManualCommon b
RelManualCommon
      (HashMap (Column b) (Column b)
 -> Maybe InsertOrder -> RelManualCommon b)
-> Codec Object (RelManualCommon b) (HashMap (Column b) (Column b))
-> Codec
     Object (RelManualCommon b) (Maybe InsertOrder -> RelManualCommon b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ObjectCodec
     (HashMap (Column b) (Column b)) (HashMap (Column b) (Column b))
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"column_mapping"
      ObjectCodec
  (HashMap (Column b) (Column b)) (HashMap (Column b) (Column b))
-> (RelManualCommon b -> HashMap (Column b) (Column b))
-> Codec Object (RelManualCommon b) (HashMap (Column b) (Column b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelManualCommon b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns
        Codec
  Object (RelManualCommon b) (Maybe InsertOrder -> RelManualCommon b)
-> Codec Object (RelManualCommon b) (Maybe InsertOrder)
-> JSONObjectCodec (RelManualCommon b)
forall a b.
Codec Object (RelManualCommon b) (a -> b)
-> Codec Object (RelManualCommon b) a
-> Codec Object (RelManualCommon b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe InsertOrder) (Maybe InsertOrder)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrIncludedNull' Text
"insertion_order"
      ObjectCodec (Maybe InsertOrder) (Maybe InsertOrder)
-> (RelManualCommon b -> Maybe InsertOrder)
-> Codec Object (RelManualCommon b) (Maybe InsertOrder)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RelManualCommon b -> Maybe InsertOrder
forall (b :: BackendType). RelManualCommon b -> Maybe InsertOrder
rmInsertOrder

data RelUsing (b :: BackendType) a
  = RUFKeyOn a
  | RUManual (RelManualTableConfig b)
  deriving (Int -> RelUsing b a -> ShowS
[RelUsing b a] -> ShowS
RelUsing b a -> String
(Int -> RelUsing b a -> ShowS)
-> (RelUsing b a -> String)
-> ([RelUsing b a] -> ShowS)
-> Show (RelUsing b a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType) a.
(Backend b, Show a) =>
Int -> RelUsing b a -> ShowS
forall (b :: BackendType) a.
(Backend b, Show a) =>
[RelUsing b a] -> ShowS
forall (b :: BackendType) a.
(Backend b, Show a) =>
RelUsing b a -> String
$cshowsPrec :: forall (b :: BackendType) a.
(Backend b, Show a) =>
Int -> RelUsing b a -> ShowS
showsPrec :: Int -> RelUsing b a -> ShowS
$cshow :: forall (b :: BackendType) a.
(Backend b, Show a) =>
RelUsing b a -> String
show :: RelUsing b a -> String
$cshowList :: forall (b :: BackendType) a.
(Backend b, Show a) =>
[RelUsing b a] -> ShowS
showList :: [RelUsing b a] -> ShowS
Show, RelUsing b a -> RelUsing b a -> Bool
(RelUsing b a -> RelUsing b a -> Bool)
-> (RelUsing b a -> RelUsing b a -> Bool) -> Eq (RelUsing b a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType) a.
(Backend b, Eq a) =>
RelUsing b a -> RelUsing b a -> Bool
$c== :: forall (b :: BackendType) a.
(Backend b, Eq a) =>
RelUsing b a -> RelUsing b a -> Bool
== :: RelUsing b a -> RelUsing b a -> Bool
$c/= :: forall (b :: BackendType) a.
(Backend b, Eq a) =>
RelUsing b a -> RelUsing b a -> Bool
/= :: RelUsing b a -> RelUsing b a -> Bool
Eq, (forall x. RelUsing b a -> Rep (RelUsing b a) x)
-> (forall x. Rep (RelUsing b a) x -> RelUsing b a)
-> Generic (RelUsing b a)
forall x. Rep (RelUsing b a) x -> RelUsing b a
forall x. RelUsing b a -> Rep (RelUsing b a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) a x. Rep (RelUsing b a) x -> RelUsing b a
forall (b :: BackendType) a x. RelUsing b a -> Rep (RelUsing b a) x
$cfrom :: forall (b :: BackendType) a x. RelUsing b a -> Rep (RelUsing b a) x
from :: forall x. RelUsing b a -> Rep (RelUsing b a) x
$cto :: forall (b :: BackendType) a x. Rep (RelUsing b a) x -> RelUsing b a
to :: forall x. Rep (RelUsing b a) x -> RelUsing b a
Generic)

instance (Backend b, HasCodec a, Typeable a) => HasCodec (RelUsing b a) where
  codec :: JSONCodec (RelUsing b a)
codec = (Either a (RelManualTableConfig b) -> RelUsing b a)
-> (RelUsing b a -> Either a (RelManualTableConfig b))
-> Codec
     Value
     (Either a (RelManualTableConfig b))
     (Either a (RelManualTableConfig b))
-> JSONCodec (RelUsing b a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either a (RelManualTableConfig b) -> RelUsing b a
forall {a} {b :: BackendType}.
Either a (RelManualTableConfig b) -> RelUsing b a
dec RelUsing b a -> Either a (RelManualTableConfig b)
forall {b :: BackendType} {a}.
RelUsing b a -> Either a (RelManualTableConfig b)
enc (Codec
   Value
   (Either a (RelManualTableConfig b))
   (Either a (RelManualTableConfig b))
 -> JSONCodec (RelUsing b a))
-> Codec
     Value
     (Either a (RelManualTableConfig b))
     (Either a (RelManualTableConfig b))
-> JSONCodec (RelUsing b a)
forall a b. (a -> b) -> a -> b
$ Codec Value a a
-> Codec Value (RelManualTableConfig b) (RelManualTableConfig b)
-> Codec
     Value
     (Either a (RelManualTableConfig b))
     (Either a (RelManualTableConfig b))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec Codec Value a a
fkCodec Codec Value (RelManualTableConfig b) (RelManualTableConfig b)
manualCodec
    where
      fkCodec :: Codec Value a a
fkCodec =
        Text -> ObjectCodec a a -> Codec Value a a
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"RUFKeyOn_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @a)
          (ObjectCodec a a -> Codec Value a a)
-> ObjectCodec a a -> Codec Value a a
forall a b. (a -> b) -> a -> b
$ Text -> ObjectCodec a a
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"foreign_key_constraint_on"

      manualCodec :: Codec Value (RelManualTableConfig b) (RelManualTableConfig b)
manualCodec =
        Text
-> ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
-> Codec Value (RelManualTableConfig b) (RelManualTableConfig 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
"RUManual")
          (ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
 -> Codec Value (RelManualTableConfig b) (RelManualTableConfig b))
-> ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
-> Codec Value (RelManualTableConfig b) (RelManualTableConfig b)
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec (RelManualTableConfig b) (RelManualTableConfig b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"manual_configuration"

      dec :: Either a (RelManualTableConfig b) -> RelUsing b a
dec = (a -> RelUsing b a)
-> (RelManualTableConfig b -> RelUsing b a)
-> Either a (RelManualTableConfig b)
-> RelUsing b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> RelUsing b a
forall (b :: BackendType) a. a -> RelUsing b a
RUFKeyOn RelManualTableConfig b -> RelUsing b a
forall (b :: BackendType) a. RelManualTableConfig b -> RelUsing b a
RUManual
      enc :: RelUsing b a -> Either a (RelManualTableConfig b)
enc (RUFKeyOn a
fkey) = a -> Either a (RelManualTableConfig b)
forall a b. a -> Either a b
Left a
fkey
      enc (RUManual RelManualTableConfig b
manual) = RelManualTableConfig b -> Either a (RelManualTableConfig b)
forall a b. b -> Either a b
Right RelManualTableConfig b
manual

instance (Backend b, ToJSON a) => ToJSON (RelUsing b a) where
  toJSON :: RelUsing b a -> Value
toJSON (RUFKeyOn a
fkey) =
    [Pair] -> Value
object [Key
"foreign_key_constraint_on" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= a
fkey]
  toJSON (RUManual RelManualTableConfig b
manual) =
    [Pair] -> Value
object [Key
"manual_configuration" Key -> RelManualTableConfig b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RelManualTableConfig b
manual]

instance (FromJSON a, Backend b) => FromJSON (RelUsing b a) where
  parseJSON :: Value -> Parser (RelUsing b a)
parseJSON (Object Object
o) = do
    let fkeyOnM :: Maybe Value
fkeyOnM = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"foreign_key_constraint_on" Object
o
        manualM :: Maybe Value
manualM = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"manual_configuration" Object
o
        msgFrag :: String
msgFrag = String
"one of foreign_key_constraint_on/manual_configuration should be present"
    case (Maybe Value
fkeyOnM, Maybe Value
manualM) of
      (Maybe Value
Nothing, Maybe Value
Nothing) -> String -> Parser (RelUsing b a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (RelUsing b a))
-> String -> Parser (RelUsing b a)
forall a b. (a -> b) -> a -> b
$ String
"atleast " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msgFrag
      (Just Value
a, Maybe Value
Nothing) -> a -> RelUsing b a
forall (b :: BackendType) a. a -> RelUsing b a
RUFKeyOn (a -> RelUsing b a) -> Parser a -> Parser (RelUsing b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a
      (Maybe Value
Nothing, Just Value
b) -> RelManualTableConfig b -> RelUsing b a
forall (b :: BackendType) a. RelManualTableConfig b -> RelUsing b a
RUManual (RelManualTableConfig b -> RelUsing b a)
-> Parser (RelManualTableConfig b) -> Parser (RelUsing b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (RelManualTableConfig b)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b
      (Maybe Value, Maybe Value)
_ -> String -> Parser (RelUsing b a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (RelUsing b a))
-> String -> Parser (RelUsing b a)
forall a b. (a -> b) -> a -> b
$ String
"only " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msgFrag
  parseJSON Value
_ =
    String -> Parser (RelUsing b a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"using should be an object"

data ArrRelUsingFKeyOn (b :: BackendType) = ArrRelUsingFKeyOn
  { forall (b :: BackendType). ArrRelUsingFKeyOn b -> TableName b
arufTable :: TableName b,
    forall (b :: BackendType).
ArrRelUsingFKeyOn b -> NonEmpty (Column b)
arufColumns :: NonEmpty (Column b)
  }
  deriving ((forall x. ArrRelUsingFKeyOn b -> Rep (ArrRelUsingFKeyOn b) x)
-> (forall x. Rep (ArrRelUsingFKeyOn b) x -> ArrRelUsingFKeyOn b)
-> Generic (ArrRelUsingFKeyOn b)
forall x. Rep (ArrRelUsingFKeyOn b) x -> ArrRelUsingFKeyOn b
forall x. ArrRelUsingFKeyOn b -> Rep (ArrRelUsingFKeyOn b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (ArrRelUsingFKeyOn b) x -> ArrRelUsingFKeyOn b
forall (b :: BackendType) x.
ArrRelUsingFKeyOn b -> Rep (ArrRelUsingFKeyOn b) x
$cfrom :: forall (b :: BackendType) x.
ArrRelUsingFKeyOn b -> Rep (ArrRelUsingFKeyOn b) x
from :: forall x. ArrRelUsingFKeyOn b -> Rep (ArrRelUsingFKeyOn b) x
$cto :: forall (b :: BackendType) x.
Rep (ArrRelUsingFKeyOn b) x -> ArrRelUsingFKeyOn b
to :: forall x. Rep (ArrRelUsingFKeyOn b) x -> ArrRelUsingFKeyOn b
Generic)

deriving instance (Backend b) => Eq (ArrRelUsingFKeyOn b)

deriving instance (Backend b) => Show (ArrRelUsingFKeyOn b)

-- TODO: This has to move to a common module
data WithTable b a = WithTable
  { forall (b :: BackendType) a. WithTable b a -> SourceName
wtSource :: SourceName,
    forall (b :: BackendType) a. WithTable b a -> TableName b
wtName :: TableName b,
    forall (b :: BackendType) a. WithTable b a -> a
wtInfo :: a
  }

deriving instance (Backend b, Show a) => Show (WithTable b a)

deriving instance (Backend b, Eq a) => Eq (WithTable b a)

instance (FromJSON a, Backend b) => FromJSON (WithTable b a) where
  parseJSON :: Value -> Parser (WithTable b a)
parseJSON v :: Value
v@(Object Object
o) =
    SourceName -> TableName b -> a -> WithTable b a
forall (b :: BackendType) a.
SourceName -> TableName b -> a -> WithTable b a
WithTable
      (SourceName -> TableName b -> a -> WithTable b a)
-> Parser SourceName -> Parser (TableName b -> a -> WithTable b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> a -> WithTable b a)
-> Parser (TableName b) -> Parser (a -> WithTable b a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (a -> WithTable b a) -> Parser a -> Parser (WithTable b a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON Value
_ =
    String -> Parser (WithTable b a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting an Object with key 'table'"

instance (ToAesonPairs a, Backend b) => ToJSON (WithTable b a) where
  toJSON :: WithTable b a -> Value
toJSON (WithTable SourceName
sourceName TableName b
tn a
rel) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SourceName
sourceName) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: (Key
"table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableName b
tn) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: a -> [Pair]
forall v. KeyValue v => a -> [v]
forall a v. (ToAesonPairs a, KeyValue v) => a -> [v]
toAesonPairs a
rel

data ObjRelUsingChoice b
  = SameTable (NonEmpty (Column b))
  | RemoteTable (TableName b) (NonEmpty (Column b))
  deriving ((forall x. ObjRelUsingChoice b -> Rep (ObjRelUsingChoice b) x)
-> (forall x. Rep (ObjRelUsingChoice b) x -> ObjRelUsingChoice b)
-> Generic (ObjRelUsingChoice b)
forall x. Rep (ObjRelUsingChoice b) x -> ObjRelUsingChoice b
forall x. ObjRelUsingChoice b -> Rep (ObjRelUsingChoice b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (ObjRelUsingChoice b) x -> ObjRelUsingChoice b
forall (b :: BackendType) x.
ObjRelUsingChoice b -> Rep (ObjRelUsingChoice b) x
$cfrom :: forall (b :: BackendType) x.
ObjRelUsingChoice b -> Rep (ObjRelUsingChoice b) x
from :: forall x. ObjRelUsingChoice b -> Rep (ObjRelUsingChoice b) x
$cto :: forall (b :: BackendType) x.
Rep (ObjRelUsingChoice b) x -> ObjRelUsingChoice b
to :: forall x. Rep (ObjRelUsingChoice b) x -> ObjRelUsingChoice b
Generic)

deriving instance (Backend b) => Eq (ObjRelUsingChoice b)

deriving instance (Backend b) => Show (ObjRelUsingChoice b)

instance (Backend b) => HasCodec (ObjRelUsingChoice b) where
  codec :: JSONCodec (ObjRelUsingChoice b)
codec = (Either
   (Either (Column b) (NonEmpty (Column b)))
   (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
 -> ObjRelUsingChoice b)
-> (ObjRelUsingChoice b
    -> Either
         (Either (Column b) (NonEmpty (Column b)))
         (Either
            (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> Codec
     Value
     (Either
        (Either (Column b) (NonEmpty (Column b)))
        (Either
           (TableName b, Column b) (TableName b, NonEmpty (Column b))))
     (Either
        (Either (Column b) (NonEmpty (Column b)))
        (Either
           (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> JSONCodec (ObjRelUsingChoice b)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either
  (Either (Column b) (NonEmpty (Column b)))
  (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
-> ObjRelUsingChoice b
forall {b :: BackendType}.
Either
  (Either (Column b) (NonEmpty (Column b)))
  (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
-> ObjRelUsingChoice b
dec ObjRelUsingChoice b
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall {b :: BackendType}.
ObjRelUsingChoice b
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
enc (Codec
   Value
   (Either
      (Either (Column b) (NonEmpty (Column b)))
      (Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b))))
   (Either
      (Either (Column b) (NonEmpty (Column b)))
      (Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b))))
 -> JSONCodec (ObjRelUsingChoice b))
-> Codec
     Value
     (Either
        (Either (Column b) (NonEmpty (Column b)))
        (Either
           (TableName b, Column b) (TableName b, NonEmpty (Column b))))
     (Either
        (Either (Column b) (NonEmpty (Column b)))
        (Either
           (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> JSONCodec (ObjRelUsingChoice b)
forall a b. (a -> b) -> a -> b
$ Codec
  Value
  (Either (Column b) (NonEmpty (Column b)))
  (Either (Column b) (NonEmpty (Column b)))
-> Codec
     Value
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
-> Codec
     Value
     (Either
        (Either (Column b) (NonEmpty (Column b)))
        (Either
           (TableName b, Column b) (TableName b, NonEmpty (Column b))))
     (Either
        (Either (Column b) (NonEmpty (Column b)))
        (Either
           (TableName b, Column b) (TableName b, NonEmpty (Column b))))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec Codec
  Value
  (Either (Column b) (NonEmpty (Column b)))
  (Either (Column b) (NonEmpty (Column b)))
sameTableCodec Codec
  Value
  (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
  (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
remoteTableCodec
    where
      sameTableCodec :: AC.JSONCodec (Either (Column b) (NonEmpty (Column b)))
      sameTableCodec :: Codec
  Value
  (Either (Column b) (NonEmpty (Column b)))
  (Either (Column b) (NonEmpty (Column b)))
sameTableCodec = Codec Value (Column b) (Column b)
-> Codec Value (NonEmpty (Column b)) (NonEmpty (Column b))
-> Codec
     Value
     (Either (Column b) (NonEmpty (Column b)))
     (Either (Column b) (NonEmpty (Column b)))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec Codec Value (Column b) (Column b)
forall value. HasCodec value => JSONCodec value
codec Codec Value (NonEmpty (Column b)) (NonEmpty (Column b))
forall value. HasCodec value => JSONCodec value
codec

      remoteTableCodec :: AC.JSONCodec (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
      remoteTableCodec :: Codec
  Value
  (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
  (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
remoteTableCodec =
        forall (b :: BackendType).
Backend b =>
Text
-> JSONCodec
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
singleOrMultipleRelColumnsCodec @b
          (Text
 -> Codec
      Value
      (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
      (Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> Text
-> Codec
     Value
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). HasTag b => Text
backendPrefix @b
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ObjRelRemoteTable"

      dec :: Either
  (Either (Column b) (NonEmpty (Column b)))
  (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
-> ObjRelUsingChoice b
dec = \case
        Left (Left Column b
col) -> NonEmpty (Column b) -> ObjRelUsingChoice b
forall (b :: BackendType).
NonEmpty (Column b) -> ObjRelUsingChoice b
SameTable (NonEmpty (Column b) -> ObjRelUsingChoice b)
-> NonEmpty (Column b) -> ObjRelUsingChoice b
forall a b. (a -> b) -> a -> b
$ Column b -> NonEmpty (Column b)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Column b
col
        Left (Right NonEmpty (Column b)
cols) -> NonEmpty (Column b) -> ObjRelUsingChoice b
forall (b :: BackendType).
NonEmpty (Column b) -> ObjRelUsingChoice b
SameTable (NonEmpty (Column b) -> ObjRelUsingChoice b)
-> NonEmpty (Column b) -> ObjRelUsingChoice b
forall a b. (a -> b) -> a -> b
$ NonEmpty (Column b)
cols
        Right (Left (TableName b
qt, Column b
col)) -> TableName b -> NonEmpty (Column b) -> ObjRelUsingChoice b
forall (b :: BackendType).
TableName b -> NonEmpty (Column b) -> ObjRelUsingChoice b
RemoteTable TableName b
qt (NonEmpty (Column b) -> ObjRelUsingChoice b)
-> NonEmpty (Column b) -> ObjRelUsingChoice b
forall a b. (a -> b) -> a -> b
$ Column b -> NonEmpty (Column b)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Column b
col
        Right (Right (TableName b
qt, NonEmpty (Column b)
cols)) -> TableName b -> NonEmpty (Column b) -> ObjRelUsingChoice b
forall (b :: BackendType).
TableName b -> NonEmpty (Column b) -> ObjRelUsingChoice b
RemoteTable TableName b
qt (NonEmpty (Column b) -> ObjRelUsingChoice b)
-> NonEmpty (Column b) -> ObjRelUsingChoice b
forall a b. (a -> b) -> a -> b
$ NonEmpty (Column b)
cols

      enc :: ObjRelUsingChoice b
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
enc = \case
        SameTable (Column b
col :| []) -> Either (Column b) (NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. a -> Either a b
Left (Either (Column b) (NonEmpty (Column b))
 -> Either
      (Either (Column b) (NonEmpty (Column b)))
      (Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> Either (Column b) (NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. (a -> b) -> a -> b
$ Column b -> Either (Column b) (NonEmpty (Column b))
forall a b. a -> Either a b
Left Column b
col
        SameTable NonEmpty (Column b)
cols -> Either (Column b) (NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. a -> Either a b
Left (Either (Column b) (NonEmpty (Column b))
 -> Either
      (Either (Column b) (NonEmpty (Column b)))
      (Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> Either (Column b) (NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. (a -> b) -> a -> b
$ NonEmpty (Column b) -> Either (Column b) (NonEmpty (Column b))
forall a b. b -> Either a b
Right NonEmpty (Column b)
cols
        RemoteTable TableName b
qt (Column b
col :| []) -> Either (TableName b, Column b) (TableName b, NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. b -> Either a b
Right (Either (TableName b, Column b) (TableName b, NonEmpty (Column b))
 -> Either
      (Either (Column b) (NonEmpty (Column b)))
      (Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. (a -> b) -> a -> b
$ (TableName b, Column b)
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
forall a b. a -> Either a b
Left (TableName b
qt, Column b
col)
        RemoteTable TableName b
qt NonEmpty (Column b)
cols -> Either (TableName b, Column b) (TableName b, NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. b -> Either a b
Right (Either (TableName b, Column b) (TableName b, NonEmpty (Column b))
 -> Either
      (Either (Column b) (NonEmpty (Column b)))
      (Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b))))
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
-> Either
     (Either (Column b) (NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall a b. (a -> b) -> a -> b
$ (TableName b, NonEmpty (Column b))
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
forall a b. b -> Either a b
Right (TableName b
qt, NonEmpty (Column b)
cols)

singleOrMultipleRelColumnsCodec ::
  forall b.
  (Backend b) =>
  Text ->
  AC.JSONCodec
    ( Either
        (TableName b, Column b)
        (TableName b, NonEmpty (Column b))
    )
singleOrMultipleRelColumnsCodec :: forall (b :: BackendType).
Backend b =>
Text
-> JSONCodec
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
singleOrMultipleRelColumnsCodec Text
codecName =
  Codec Value (TableName b, Column b) (TableName b, Column b)
-> Codec
     Value
     (TableName b, NonEmpty (Column b))
     (TableName b, NonEmpty (Column b))
-> Codec
     Value
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
    ( Text
-> ObjectCodec (TableName b, Column b) (TableName b, Column b)
-> Codec Value (TableName b, Column b) (TableName b, Column b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
codecName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"SingleColumn")
        (ObjectCodec (TableName b, Column b) (TableName b, Column b)
 -> Codec Value (TableName b, Column b) (TableName b, Column b))
-> ObjectCodec (TableName b, Column b) (TableName b, Column b)
-> Codec Value (TableName b, Column b) (TableName b, Column b)
forall a b. (a -> b) -> a -> b
$ (,)
        (TableName b -> Column b -> (TableName b, Column b))
-> Codec Object (TableName b, Column b) (TableName b)
-> Codec
     Object
     (TableName b, Column b)
     (Column b -> (TableName b, Column b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (TableName b) (TableName b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"table"
        ObjectCodec (TableName b) (TableName b)
-> ((TableName b, Column b) -> TableName b)
-> Codec Object (TableName b, Column b) (TableName b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= (TableName b, Column b) -> TableName b
forall a b. (a, b) -> a
fst
          Codec
  Object
  (TableName b, Column b)
  (Column b -> (TableName b, Column b))
-> Codec Object (TableName b, Column b) (Column b)
-> ObjectCodec (TableName b, Column b) (TableName b, Column b)
forall a b.
Codec Object (TableName b, Column b) (a -> b)
-> Codec Object (TableName b, Column b) a
-> Codec Object (TableName b, Column b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Column b) (Column b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"column"
        ObjectCodec (Column b) (Column b)
-> ((TableName b, Column b) -> Column b)
-> Codec Object (TableName b, Column b) (Column b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= (TableName b, Column b) -> Column b
forall a b. (a, b) -> b
snd
    )
    ( Text
-> ObjectCodec
     (TableName b, NonEmpty (Column b))
     (TableName b, NonEmpty (Column b))
-> Codec
     Value
     (TableName b, NonEmpty (Column b))
     (TableName b, NonEmpty (Column b))
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
codecName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"MultipleColumns")
        (ObjectCodec
   (TableName b, NonEmpty (Column b))
   (TableName b, NonEmpty (Column b))
 -> Codec
      Value
      (TableName b, NonEmpty (Column b))
      (TableName b, NonEmpty (Column b)))
-> ObjectCodec
     (TableName b, NonEmpty (Column b))
     (TableName b, NonEmpty (Column b))
-> Codec
     Value
     (TableName b, NonEmpty (Column b))
     (TableName b, NonEmpty (Column b))
forall a b. (a -> b) -> a -> b
$ (,)
        (TableName b
 -> NonEmpty (Column b) -> (TableName b, NonEmpty (Column b)))
-> Codec Object (TableName b, NonEmpty (Column b)) (TableName b)
-> Codec
     Object
     (TableName b, NonEmpty (Column b))
     (NonEmpty (Column b) -> (TableName b, NonEmpty (Column b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (TableName b) (TableName b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"table"
        ObjectCodec (TableName b) (TableName b)
-> ((TableName b, NonEmpty (Column b)) -> TableName b)
-> Codec Object (TableName b, NonEmpty (Column b)) (TableName b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= (TableName b, NonEmpty (Column b)) -> TableName b
forall a b. (a, b) -> a
fst
          Codec
  Object
  (TableName b, NonEmpty (Column b))
  (NonEmpty (Column b) -> (TableName b, NonEmpty (Column b)))
-> Codec
     Object (TableName b, NonEmpty (Column b)) (NonEmpty (Column b))
-> ObjectCodec
     (TableName b, NonEmpty (Column b))
     (TableName b, NonEmpty (Column b))
forall a b.
Codec Object (TableName b, NonEmpty (Column b)) (a -> b)
-> Codec Object (TableName b, NonEmpty (Column b)) a
-> Codec Object (TableName b, NonEmpty (Column b)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (NonEmpty (Column b)) (NonEmpty (Column b))
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"columns"
        ObjectCodec (NonEmpty (Column b)) (NonEmpty (Column b))
-> ((TableName b, NonEmpty (Column b)) -> NonEmpty (Column b))
-> Codec
     Object (TableName b, NonEmpty (Column b)) (NonEmpty (Column b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= (TableName b, NonEmpty (Column b)) -> NonEmpty (Column b)
forall a b. (a, b) -> b
snd
    )

instance (Backend b) => ToJSON (ObjRelUsingChoice b) where
  toJSON :: ObjRelUsingChoice b -> Value
toJSON = \case
    SameTable (Column b
col :| []) -> Column b -> Value
forall a. ToJSON a => a -> Value
toJSON Column b
col
    SameTable NonEmpty (Column b)
cols -> NonEmpty (Column b) -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty (Column b)
cols
    RemoteTable TableName b
qt (Column b
lcol :| []) ->
      [Pair] -> Value
object
        [ Key
"table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableName b
qt,
          Key
"column" Key -> Column b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Column b
lcol
        ]
    RemoteTable TableName b
qt NonEmpty (Column b)
lcols ->
      [Pair] -> Value
object
        [ Key
"table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableName b
qt,
          Key
"columns" Key -> NonEmpty (Column b) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NonEmpty (Column b)
lcols
        ]

instance (Backend b) => FromJSON (ObjRelUsingChoice b) where
  parseJSON :: Value -> Parser (ObjRelUsingChoice b)
parseJSON = \case
    Object Object
o -> do
      TableName b
table <- Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Maybe Value
column <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"column"
      Maybe Value
columns <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"columns"
      NonEmpty (Column b)
cols <- case (Maybe Value
column, Maybe Value
columns) of
        (Just Value
col, Maybe Value
Nothing) -> Value -> Parser (NonEmpty (Column b))
parseColumns Value
col
        (Maybe Value
Nothing, Just Value
cols) -> Value -> Parser (NonEmpty (Column b))
parseColumns Value
cols
        (Maybe Value, Maybe Value)
_ -> String -> Parser (NonEmpty (Column b))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected exactly one of 'column' or 'columns'"
      ObjRelUsingChoice b -> Parser (ObjRelUsingChoice b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjRelUsingChoice b -> Parser (ObjRelUsingChoice b))
-> ObjRelUsingChoice b -> Parser (ObjRelUsingChoice b)
forall a b. (a -> b) -> a -> b
$ TableName b -> NonEmpty (Column b) -> ObjRelUsingChoice b
forall (b :: BackendType).
TableName b -> NonEmpty (Column b) -> ObjRelUsingChoice b
RemoteTable TableName b
table NonEmpty (Column b)
cols
    Value
val -> NonEmpty (Column b) -> ObjRelUsingChoice b
forall (b :: BackendType).
NonEmpty (Column b) -> ObjRelUsingChoice b
SameTable (NonEmpty (Column b) -> ObjRelUsingChoice b)
-> Parser (NonEmpty (Column b)) -> Parser (ObjRelUsingChoice b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NonEmpty (Column b))
parseColumns Value
val
    where
      parseColumns :: Value -> Parser (NonEmpty (Column b))
      parseColumns :: Value -> Parser (NonEmpty (Column b))
parseColumns = \case
        v :: Value
v@(String Text
_) -> Column b -> NonEmpty (Column b)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column b -> NonEmpty (Column b))
-> Parser (Column b) -> Parser (NonEmpty (Column b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Column b)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        v :: Value
v@(Array Array
_) -> Value -> Parser (NonEmpty (Column b))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        Value
_ -> String -> Parser (NonEmpty (Column b))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected string or array"

instance (Backend b) => HasCodec (ArrRelUsingFKeyOn b) where
  codec :: JSONCodec (ArrRelUsingFKeyOn b)
codec =
    (Either (TableName b, Column b) (TableName b, NonEmpty (Column b))
 -> ArrRelUsingFKeyOn b)
-> (ArrRelUsingFKeyOn b
    -> Either
         (TableName b, Column b) (TableName b, NonEmpty (Column b)))
-> Codec
     Value
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
-> JSONCodec (ArrRelUsingFKeyOn b)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either (TableName b, Column b) (TableName b, NonEmpty (Column b))
-> ArrRelUsingFKeyOn b
dec ArrRelUsingFKeyOn b
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
enc
      (Codec
   Value
   (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
   (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
 -> JSONCodec (ArrRelUsingFKeyOn b))
-> Codec
     Value
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
-> JSONCodec (ArrRelUsingFKeyOn b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
Text
-> JSONCodec
     (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
singleOrMultipleRelColumnsCodec @b (forall (b :: BackendType). HasTag b => Text
backendPrefix @b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ArrRelUsingFKeyOn")
    where
      dec :: (Either (TableName b, Column b) (TableName b, NonEmpty (Column b))) -> ArrRelUsingFKeyOn b
      dec :: Either (TableName b, Column b) (TableName b, NonEmpty (Column b))
-> ArrRelUsingFKeyOn b
dec = \case
        Left (TableName b
qt, Column b
col) -> TableName b -> NonEmpty (Column b) -> ArrRelUsingFKeyOn b
forall (b :: BackendType).
TableName b -> NonEmpty (Column b) -> ArrRelUsingFKeyOn b
ArrRelUsingFKeyOn TableName b
qt (Column b -> NonEmpty (Column b)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Column b
col)
        Right (TableName b
qt, NonEmpty (Column b)
cols) -> TableName b -> NonEmpty (Column b) -> ArrRelUsingFKeyOn b
forall (b :: BackendType).
TableName b -> NonEmpty (Column b) -> ArrRelUsingFKeyOn b
ArrRelUsingFKeyOn TableName b
qt NonEmpty (Column b)
cols

      enc :: ArrRelUsingFKeyOn b -> (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
      enc :: ArrRelUsingFKeyOn b
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
enc = \case
        ArrRelUsingFKeyOn TableName b
qt (Column b
col :| []) -> (TableName b, Column b)
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
forall a b. a -> Either a b
Left (TableName b
qt, Column b
col)
        ArrRelUsingFKeyOn TableName b
qt NonEmpty (Column b)
cols -> (TableName b, NonEmpty (Column b))
-> Either
     (TableName b, Column b) (TableName b, NonEmpty (Column b))
forall a b. b -> Either a b
Right (TableName b
qt, NonEmpty (Column b)
cols)

instance (Backend b) => ToJSON (ArrRelUsingFKeyOn b) where
  toJSON :: ArrRelUsingFKeyOn b -> Value
toJSON ArrRelUsingFKeyOn {arufTable :: forall (b :: BackendType). ArrRelUsingFKeyOn b -> TableName b
arufTable = TableName b
_arufTable, arufColumns :: forall (b :: BackendType).
ArrRelUsingFKeyOn b -> NonEmpty (Column b)
arufColumns = NonEmpty (Column b)
_arufColumns} =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableName b
_arufTable)
      Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: case NonEmpty (Column b)
_arufColumns of
        Column b
col :| [] -> [Key
"column" Key -> Column b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Column b
col]
        NonEmpty (Column b)
cols -> [Key
"columns" Key -> NonEmpty (Column b) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NonEmpty (Column b)
cols]

instance (Backend b) => FromJSON (ArrRelUsingFKeyOn b) where
  parseJSON :: Value -> Parser (ArrRelUsingFKeyOn b)
parseJSON = \case
    Object Object
o -> do
      TableName b
table <- Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Maybe Value
column <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"column"
      Maybe Value
columns <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"columns"
      NonEmpty (Column b)
cols <- case (Maybe Value
column, Maybe Value
columns) of
        (Just Value
col, Maybe Value
Nothing) -> Value -> Parser (NonEmpty (Column b))
parseColumns Value
col
        (Maybe Value
Nothing, Just Value
cols) -> Value -> Parser (NonEmpty (Column b))
parseColumns Value
cols
        (Maybe Value, Maybe Value)
_ -> String -> Parser (NonEmpty (Column b))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected exactly one of 'column' or 'columns'"
      ArrRelUsingFKeyOn b -> Parser (ArrRelUsingFKeyOn b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrRelUsingFKeyOn b -> Parser (ArrRelUsingFKeyOn b))
-> ArrRelUsingFKeyOn b -> Parser (ArrRelUsingFKeyOn b)
forall a b. (a -> b) -> a -> b
$ TableName b -> NonEmpty (Column b) -> ArrRelUsingFKeyOn b
forall (b :: BackendType).
TableName b -> NonEmpty (Column b) -> ArrRelUsingFKeyOn b
ArrRelUsingFKeyOn TableName b
table NonEmpty (Column b)
cols
    Value
_ -> String -> Parser (ArrRelUsingFKeyOn b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting object { table, columns }."
    where
      parseColumns :: Value -> Parser (NonEmpty (Column b))
      parseColumns :: Value -> Parser (NonEmpty (Column b))
parseColumns = \case
        v :: Value
v@(String Text
_) -> Column b -> NonEmpty (Column b)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column b -> NonEmpty (Column b))
-> Parser (Column b) -> Parser (NonEmpty (Column b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Column b)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        v :: Value
v@(Array Array
_) -> Value -> Parser (NonEmpty (Column b))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        Value
_ -> String -> Parser (NonEmpty (Column b))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected string or array"

type ArrRelUsing b = RelUsing b (ArrRelUsingFKeyOn b)

type ArrRelDef b = RelDef (ArrRelUsing b)

type ObjRelUsing b = RelUsing b (ObjRelUsingChoice b)

type ObjRelDef b = RelDef (ObjRelUsing b)

---

data RelTarget b
  = RelTargetTable (TableName b)
  | RelTargetNativeQuery NativeQueryName
  deriving ((forall x. RelTarget b -> Rep (RelTarget b) x)
-> (forall x. Rep (RelTarget b) x -> RelTarget b)
-> Generic (RelTarget b)
forall x. Rep (RelTarget b) x -> RelTarget b
forall x. RelTarget b -> Rep (RelTarget b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (RelTarget b) x -> RelTarget b
forall (b :: BackendType) x. RelTarget b -> Rep (RelTarget b) x
$cfrom :: forall (b :: BackendType) x. RelTarget b -> Rep (RelTarget b) x
from :: forall x. RelTarget b -> Rep (RelTarget b) x
$cto :: forall (b :: BackendType) x. Rep (RelTarget b) x -> RelTarget b
to :: forall x. Rep (RelTarget b) x -> RelTarget b
Generic)

deriving instance (Backend b) => Eq (RelTarget b)

deriving instance (Backend b) => Ord (RelTarget b)

deriving instance (Backend b) => Show (RelTarget b)

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

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

instance (Backend b) => FromJSON (RelTarget b) where
  parseJSON :: Value -> Parser (RelTarget b)
parseJSON = Options -> Value -> Parser (RelTarget b)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance (Backend b) => ToJSON (RelTarget b) where
  toJSON :: RelTarget b -> Value
toJSON = Options -> RelTarget b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

---

data RelInfo (b :: BackendType) = RelInfo
  { forall (b :: BackendType). RelInfo b -> RelName
riName :: RelName,
    forall (b :: BackendType). RelInfo b -> RelType
riType :: RelType,
    forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping :: HashMap (Column b) (Column b),
    forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget :: RelTarget b,
    forall (b :: BackendType). RelInfo b -> Bool
riIsManual :: Bool,
    forall (b :: BackendType). RelInfo b -> InsertOrder
riInsertOrder :: InsertOrder
  }
  deriving ((forall x. RelInfo b -> Rep (RelInfo b) x)
-> (forall x. Rep (RelInfo b) x -> RelInfo b)
-> Generic (RelInfo b)
forall x. Rep (RelInfo b) x -> RelInfo b
forall x. RelInfo b -> Rep (RelInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (RelInfo b) x -> RelInfo b
forall (b :: BackendType) x. RelInfo b -> Rep (RelInfo b) x
$cfrom :: forall (b :: BackendType) x. RelInfo b -> Rep (RelInfo b) x
from :: forall x. RelInfo b -> Rep (RelInfo b) x
$cto :: forall (b :: BackendType) x. Rep (RelInfo b) x -> RelInfo b
to :: forall x. Rep (RelInfo b) x -> RelInfo b
Generic)

deriving instance (Backend b) => Show (RelInfo b)

deriving instance (Backend b) => Eq (RelInfo b)

deriving instance (Backend b) => Ord (RelInfo b)

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

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

instance (Backend b) => FromJSON (RelInfo b) where
  parseJSON :: Value -> Parser (RelInfo b)
parseJSON = Options -> Value -> Parser (RelInfo b)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance (Backend b) => ToJSON (RelInfo b) where
  toJSON :: RelInfo b -> Value
toJSON = Options -> RelInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

data Nullable = Nullable | NotNullable
  deriving (Nullable -> Nullable -> Bool
(Nullable -> Nullable -> Bool)
-> (Nullable -> Nullable -> Bool) -> Eq Nullable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nullable -> Nullable -> Bool
== :: Nullable -> Nullable -> Bool
$c/= :: Nullable -> Nullable -> Bool
/= :: Nullable -> Nullable -> Bool
Eq, Int -> Nullable -> ShowS
[Nullable] -> ShowS
Nullable -> String
(Int -> Nullable -> ShowS)
-> (Nullable -> String) -> ([Nullable] -> ShowS) -> Show Nullable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Nullable -> ShowS
showsPrec :: Int -> Nullable -> ShowS
$cshow :: Nullable -> String
show :: Nullable -> String
$cshowList :: [Nullable] -> ShowS
showList :: [Nullable] -> ShowS
Show, (forall x. Nullable -> Rep Nullable x)
-> (forall x. Rep Nullable x -> Nullable) -> Generic Nullable
forall x. Rep Nullable x -> Nullable
forall x. Nullable -> Rep Nullable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Nullable -> Rep Nullable x
from :: forall x. Nullable -> Rep Nullable x
$cto :: forall x. Rep Nullable x -> Nullable
to :: forall x. Rep Nullable x -> Nullable
Generic)

instance NFData Nullable

instance Hashable Nullable

boolToNullable :: Bool -> Nullable
boolToNullable :: Bool -> Nullable
boolToNullable Bool
True = Nullable
Nullable
boolToNullable Bool
False = Nullable
NotNullable

instance FromJSON Nullable where
  parseJSON :: Value -> Parser Nullable
parseJSON = (Bool -> Nullable) -> Parser Bool -> Parser Nullable
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Nullable
boolToNullable (Parser Bool -> Parser Nullable)
-> (Value -> Parser Bool) -> Value -> Parser Nullable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON Nullable where
  toJSON :: Nullable -> Value
toJSON =
    Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> (Nullable -> Bool) -> Nullable -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Nullable
Nullable -> Bool
True
      Nullable
NotNullable -> Bool
False

fromRel :: RelName -> FieldName
fromRel :: RelName -> FieldName
fromRel = Text -> FieldName
FieldName (Text -> FieldName) -> (RelName -> Text) -> RelName -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelName -> Text
relNameToTxt