{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.QueryCollection
  ( CollectionName (..),
    CollectionDef (..),
    cdQueries,
    CreateCollection (..),
    ccName,
    ccDefinition,
    ccComment,
    RenameCollection (..),
    rcName,
    rcNewName,
    AddQueryToCollection (..),
    DropQueryFromCollection (..),
    DropCollection (..),
    GQLQuery (..),
    GQLQueryWithText (..),
    QueryName (..),
    ListedQuery (..),
    getGQLQuery,
    getGQLQueryText,
    QueryCollections,
    collectionQueries,
  )
where

import Autodocodec (HasCodec (..), bimapCodec, dimapCodec, optionalField', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (graphQLExecutableDocumentCodec)
import Control.Lens
import Data.Aeson
import Data.Text qualified as T
import Data.Text.Extended
import Data.Text.NonEmpty
import Database.PG.Query qualified as PG
import Hasura.Prelude
import Language.GraphQL.Draft.Parser qualified as G
import Language.GraphQL.Draft.Syntax qualified as G

newtype CollectionName = CollectionName {CollectionName -> NonEmptyText
unCollectionName :: NonEmptyText}
  deriving
    ( Int -> CollectionName -> ShowS
[CollectionName] -> ShowS
CollectionName -> String
(Int -> CollectionName -> ShowS)
-> (CollectionName -> String)
-> ([CollectionName] -> ShowS)
-> Show CollectionName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectionName -> ShowS
showsPrec :: Int -> CollectionName -> ShowS
$cshow :: CollectionName -> String
show :: CollectionName -> String
$cshowList :: [CollectionName] -> ShowS
showList :: [CollectionName] -> ShowS
Show,
      CollectionName -> CollectionName -> Bool
(CollectionName -> CollectionName -> Bool)
-> (CollectionName -> CollectionName -> Bool) -> Eq CollectionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollectionName -> CollectionName -> Bool
== :: CollectionName -> CollectionName -> Bool
$c/= :: CollectionName -> CollectionName -> Bool
/= :: CollectionName -> CollectionName -> Bool
Eq,
      Eq CollectionName
Eq CollectionName
-> (CollectionName -> CollectionName -> Ordering)
-> (CollectionName -> CollectionName -> Bool)
-> (CollectionName -> CollectionName -> Bool)
-> (CollectionName -> CollectionName -> Bool)
-> (CollectionName -> CollectionName -> Bool)
-> (CollectionName -> CollectionName -> CollectionName)
-> (CollectionName -> CollectionName -> CollectionName)
-> Ord CollectionName
CollectionName -> CollectionName -> Bool
CollectionName -> CollectionName -> Ordering
CollectionName -> CollectionName -> CollectionName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CollectionName -> CollectionName -> Ordering
compare :: CollectionName -> CollectionName -> Ordering
$c< :: CollectionName -> CollectionName -> Bool
< :: CollectionName -> CollectionName -> Bool
$c<= :: CollectionName -> CollectionName -> Bool
<= :: CollectionName -> CollectionName -> Bool
$c> :: CollectionName -> CollectionName -> Bool
> :: CollectionName -> CollectionName -> Bool
$c>= :: CollectionName -> CollectionName -> Bool
>= :: CollectionName -> CollectionName -> Bool
$cmax :: CollectionName -> CollectionName -> CollectionName
max :: CollectionName -> CollectionName -> CollectionName
$cmin :: CollectionName -> CollectionName -> CollectionName
min :: CollectionName -> CollectionName -> CollectionName
Ord,
      Eq CollectionName
Eq CollectionName
-> (Int -> CollectionName -> Int)
-> (CollectionName -> Int)
-> Hashable CollectionName
Int -> CollectionName -> Int
CollectionName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CollectionName -> Int
hashWithSalt :: Int -> CollectionName -> Int
$chash :: CollectionName -> Int
hash :: CollectionName -> Int
Hashable,
      [CollectionName] -> Value
[CollectionName] -> Encoding
CollectionName -> Value
CollectionName -> Encoding
(CollectionName -> Value)
-> (CollectionName -> Encoding)
-> ([CollectionName] -> Value)
-> ([CollectionName] -> Encoding)
-> ToJSON CollectionName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CollectionName -> Value
toJSON :: CollectionName -> Value
$ctoEncoding :: CollectionName -> Encoding
toEncoding :: CollectionName -> Encoding
$ctoJSONList :: [CollectionName] -> Value
toJSONList :: [CollectionName] -> Value
$ctoEncodingList :: [CollectionName] -> Encoding
toEncodingList :: [CollectionName] -> Encoding
ToJSON,
      ToJSONKeyFunction [CollectionName]
ToJSONKeyFunction CollectionName
ToJSONKeyFunction CollectionName
-> ToJSONKeyFunction [CollectionName] -> ToJSONKey CollectionName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction CollectionName
toJSONKey :: ToJSONKeyFunction CollectionName
$ctoJSONKeyList :: ToJSONKeyFunction [CollectionName]
toJSONKeyList :: ToJSONKeyFunction [CollectionName]
ToJSONKey,
      Value -> Parser [CollectionName]
Value -> Parser CollectionName
(Value -> Parser CollectionName)
-> (Value -> Parser [CollectionName]) -> FromJSON CollectionName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CollectionName
parseJSON :: Value -> Parser CollectionName
$cparseJSONList :: Value -> Parser [CollectionName]
parseJSONList :: Value -> Parser [CollectionName]
FromJSON,
      Maybe ByteString -> Either Text CollectionName
(Maybe ByteString -> Either Text CollectionName)
-> FromCol CollectionName
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text CollectionName
fromCol :: Maybe ByteString -> Either Text CollectionName
PG.FromCol,
      CollectionName -> PrepArg
(CollectionName -> PrepArg) -> ToPrepArg CollectionName
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: CollectionName -> PrepArg
toPrepVal :: CollectionName -> PrepArg
PG.ToPrepArg,
      CollectionName -> Text
(CollectionName -> Text) -> ToTxt CollectionName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: CollectionName -> Text
toTxt :: CollectionName -> Text
ToTxt,
      (forall x. CollectionName -> Rep CollectionName x)
-> (forall x. Rep CollectionName x -> CollectionName)
-> Generic CollectionName
forall x. Rep CollectionName x -> CollectionName
forall x. CollectionName -> Rep CollectionName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CollectionName -> Rep CollectionName x
from :: forall x. CollectionName -> Rep CollectionName x
$cto :: forall x. Rep CollectionName x -> CollectionName
to :: forall x. Rep CollectionName x -> CollectionName
Generic
    )

instance HasCodec CollectionName where
  codec :: JSONCodec CollectionName
codec = (NonEmptyText -> CollectionName)
-> (CollectionName -> NonEmptyText)
-> Codec Value NonEmptyText NonEmptyText
-> JSONCodec CollectionName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec NonEmptyText -> CollectionName
CollectionName CollectionName -> NonEmptyText
unCollectionName Codec Value NonEmptyText NonEmptyText
forall value. HasCodec value => JSONCodec value
codec

newtype QueryName = QueryName {QueryName -> NonEmptyText
unQueryName :: NonEmptyText}
  deriving (Int -> QueryName -> ShowS
[QueryName] -> ShowS
QueryName -> String
(Int -> QueryName -> ShowS)
-> (QueryName -> String)
-> ([QueryName] -> ShowS)
-> Show QueryName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryName -> ShowS
showsPrec :: Int -> QueryName -> ShowS
$cshow :: QueryName -> String
show :: QueryName -> String
$cshowList :: [QueryName] -> ShowS
showList :: [QueryName] -> ShowS
Show, QueryName -> QueryName -> Bool
(QueryName -> QueryName -> Bool)
-> (QueryName -> QueryName -> Bool) -> Eq QueryName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryName -> QueryName -> Bool
== :: QueryName -> QueryName -> Bool
$c/= :: QueryName -> QueryName -> Bool
/= :: QueryName -> QueryName -> Bool
Eq, Eq QueryName
Eq QueryName
-> (QueryName -> QueryName -> Ordering)
-> (QueryName -> QueryName -> Bool)
-> (QueryName -> QueryName -> Bool)
-> (QueryName -> QueryName -> Bool)
-> (QueryName -> QueryName -> Bool)
-> (QueryName -> QueryName -> QueryName)
-> (QueryName -> QueryName -> QueryName)
-> Ord QueryName
QueryName -> QueryName -> Bool
QueryName -> QueryName -> Ordering
QueryName -> QueryName -> QueryName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QueryName -> QueryName -> Ordering
compare :: QueryName -> QueryName -> Ordering
$c< :: QueryName -> QueryName -> Bool
< :: QueryName -> QueryName -> Bool
$c<= :: QueryName -> QueryName -> Bool
<= :: QueryName -> QueryName -> Bool
$c> :: QueryName -> QueryName -> Bool
> :: QueryName -> QueryName -> Bool
$c>= :: QueryName -> QueryName -> Bool
>= :: QueryName -> QueryName -> Bool
$cmax :: QueryName -> QueryName -> QueryName
max :: QueryName -> QueryName -> QueryName
$cmin :: QueryName -> QueryName -> QueryName
min :: QueryName -> QueryName -> QueryName
Ord, QueryName -> ()
(QueryName -> ()) -> NFData QueryName
forall a. (a -> ()) -> NFData a
$crnf :: QueryName -> ()
rnf :: QueryName -> ()
NFData, Eq QueryName
Eq QueryName
-> (Int -> QueryName -> Int)
-> (QueryName -> Int)
-> Hashable QueryName
Int -> QueryName -> Int
QueryName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> QueryName -> Int
hashWithSalt :: Int -> QueryName -> Int
$chash :: QueryName -> Int
hash :: QueryName -> Int
Hashable, [QueryName] -> Value
[QueryName] -> Encoding
QueryName -> Value
QueryName -> Encoding
(QueryName -> Value)
-> (QueryName -> Encoding)
-> ([QueryName] -> Value)
-> ([QueryName] -> Encoding)
-> ToJSON QueryName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: QueryName -> Value
toJSON :: QueryName -> Value
$ctoEncoding :: QueryName -> Encoding
toEncoding :: QueryName -> Encoding
$ctoJSONList :: [QueryName] -> Value
toJSONList :: [QueryName] -> Value
$ctoEncodingList :: [QueryName] -> Encoding
toEncodingList :: [QueryName] -> Encoding
ToJSON, ToJSONKeyFunction [QueryName]
ToJSONKeyFunction QueryName
ToJSONKeyFunction QueryName
-> ToJSONKeyFunction [QueryName] -> ToJSONKey QueryName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction QueryName
toJSONKey :: ToJSONKeyFunction QueryName
$ctoJSONKeyList :: ToJSONKeyFunction [QueryName]
toJSONKeyList :: ToJSONKeyFunction [QueryName]
ToJSONKey, Value -> Parser [QueryName]
Value -> Parser QueryName
(Value -> Parser QueryName)
-> (Value -> Parser [QueryName]) -> FromJSON QueryName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser QueryName
parseJSON :: Value -> Parser QueryName
$cparseJSONList :: Value -> Parser [QueryName]
parseJSONList :: Value -> Parser [QueryName]
FromJSON, QueryName -> Text
(QueryName -> Text) -> ToTxt QueryName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: QueryName -> Text
toTxt :: QueryName -> Text
ToTxt, (forall x. QueryName -> Rep QueryName x)
-> (forall x. Rep QueryName x -> QueryName) -> Generic QueryName
forall x. Rep QueryName x -> QueryName
forall x. QueryName -> Rep QueryName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryName -> Rep QueryName x
from :: forall x. QueryName -> Rep QueryName x
$cto :: forall x. Rep QueryName x -> QueryName
to :: forall x. Rep QueryName x -> QueryName
Generic)

instance HasCodec QueryName where
  codec :: JSONCodec QueryName
codec = (NonEmptyText -> QueryName)
-> (QueryName -> NonEmptyText)
-> Codec Value NonEmptyText NonEmptyText
-> JSONCodec QueryName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec NonEmptyText -> QueryName
QueryName QueryName -> NonEmptyText
unQueryName Codec Value NonEmptyText NonEmptyText
forall value. HasCodec value => JSONCodec value
codec

newtype GQLQuery = GQLQuery {GQLQuery -> ExecutableDocument Name
unGQLQuery :: G.ExecutableDocument G.Name}
  deriving (Int -> GQLQuery -> ShowS
[GQLQuery] -> ShowS
GQLQuery -> String
(Int -> GQLQuery -> ShowS)
-> (GQLQuery -> String) -> ([GQLQuery] -> ShowS) -> Show GQLQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GQLQuery -> ShowS
showsPrec :: Int -> GQLQuery -> ShowS
$cshow :: GQLQuery -> String
show :: GQLQuery -> String
$cshowList :: [GQLQuery] -> ShowS
showList :: [GQLQuery] -> ShowS
Show, GQLQuery -> GQLQuery -> Bool
(GQLQuery -> GQLQuery -> Bool)
-> (GQLQuery -> GQLQuery -> Bool) -> Eq GQLQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GQLQuery -> GQLQuery -> Bool
== :: GQLQuery -> GQLQuery -> Bool
$c/= :: GQLQuery -> GQLQuery -> Bool
/= :: GQLQuery -> GQLQuery -> Bool
Eq, Eq GQLQuery
Eq GQLQuery
-> (GQLQuery -> GQLQuery -> Ordering)
-> (GQLQuery -> GQLQuery -> Bool)
-> (GQLQuery -> GQLQuery -> Bool)
-> (GQLQuery -> GQLQuery -> Bool)
-> (GQLQuery -> GQLQuery -> Bool)
-> (GQLQuery -> GQLQuery -> GQLQuery)
-> (GQLQuery -> GQLQuery -> GQLQuery)
-> Ord GQLQuery
GQLQuery -> GQLQuery -> Bool
GQLQuery -> GQLQuery -> Ordering
GQLQuery -> GQLQuery -> GQLQuery
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GQLQuery -> GQLQuery -> Ordering
compare :: GQLQuery -> GQLQuery -> Ordering
$c< :: GQLQuery -> GQLQuery -> Bool
< :: GQLQuery -> GQLQuery -> Bool
$c<= :: GQLQuery -> GQLQuery -> Bool
<= :: GQLQuery -> GQLQuery -> Bool
$c> :: GQLQuery -> GQLQuery -> Bool
> :: GQLQuery -> GQLQuery -> Bool
$c>= :: GQLQuery -> GQLQuery -> Bool
>= :: GQLQuery -> GQLQuery -> Bool
$cmax :: GQLQuery -> GQLQuery -> GQLQuery
max :: GQLQuery -> GQLQuery -> GQLQuery
$cmin :: GQLQuery -> GQLQuery -> GQLQuery
min :: GQLQuery -> GQLQuery -> GQLQuery
Ord, GQLQuery -> ()
(GQLQuery -> ()) -> NFData GQLQuery
forall a. (a -> ()) -> NFData a
$crnf :: GQLQuery -> ()
rnf :: GQLQuery -> ()
NFData, Eq GQLQuery
Eq GQLQuery
-> (Int -> GQLQuery -> Int)
-> (GQLQuery -> Int)
-> Hashable GQLQuery
Int -> GQLQuery -> Int
GQLQuery -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GQLQuery -> Int
hashWithSalt :: Int -> GQLQuery -> Int
$chash :: GQLQuery -> Int
hash :: GQLQuery -> Int
Hashable, [GQLQuery] -> Value
[GQLQuery] -> Encoding
GQLQuery -> Value
GQLQuery -> Encoding
(GQLQuery -> Value)
-> (GQLQuery -> Encoding)
-> ([GQLQuery] -> Value)
-> ([GQLQuery] -> Encoding)
-> ToJSON GQLQuery
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GQLQuery -> Value
toJSON :: GQLQuery -> Value
$ctoEncoding :: GQLQuery -> Encoding
toEncoding :: GQLQuery -> Encoding
$ctoJSONList :: [GQLQuery] -> Value
toJSONList :: [GQLQuery] -> Value
$ctoEncodingList :: [GQLQuery] -> Encoding
toEncodingList :: [GQLQuery] -> Encoding
ToJSON, Value -> Parser [GQLQuery]
Value -> Parser GQLQuery
(Value -> Parser GQLQuery)
-> (Value -> Parser [GQLQuery]) -> FromJSON GQLQuery
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GQLQuery
parseJSON :: Value -> Parser GQLQuery
$cparseJSONList :: Value -> Parser [GQLQuery]
parseJSONList :: Value -> Parser [GQLQuery]
FromJSON)

instance HasCodec GQLQuery where
  codec :: JSONCodec GQLQuery
codec = (ExecutableDocument Name -> GQLQuery)
-> (GQLQuery -> ExecutableDocument Name)
-> Codec Value (ExecutableDocument Name) (ExecutableDocument Name)
-> JSONCodec GQLQuery
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec ExecutableDocument Name -> GQLQuery
GQLQuery GQLQuery -> ExecutableDocument Name
unGQLQuery Codec Value (ExecutableDocument Name) (ExecutableDocument Name)
graphQLExecutableDocumentCodec

newtype GQLQueryWithText
  = GQLQueryWithText (Text, GQLQuery)
  deriving (Int -> GQLQueryWithText -> ShowS
[GQLQueryWithText] -> ShowS
GQLQueryWithText -> String
(Int -> GQLQueryWithText -> ShowS)
-> (GQLQueryWithText -> String)
-> ([GQLQueryWithText] -> ShowS)
-> Show GQLQueryWithText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GQLQueryWithText -> ShowS
showsPrec :: Int -> GQLQueryWithText -> ShowS
$cshow :: GQLQueryWithText -> String
show :: GQLQueryWithText -> String
$cshowList :: [GQLQueryWithText] -> ShowS
showList :: [GQLQueryWithText] -> ShowS
Show, GQLQueryWithText -> GQLQueryWithText -> Bool
(GQLQueryWithText -> GQLQueryWithText -> Bool)
-> (GQLQueryWithText -> GQLQueryWithText -> Bool)
-> Eq GQLQueryWithText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GQLQueryWithText -> GQLQueryWithText -> Bool
== :: GQLQueryWithText -> GQLQueryWithText -> Bool
$c/= :: GQLQueryWithText -> GQLQueryWithText -> Bool
/= :: GQLQueryWithText -> GQLQueryWithText -> Bool
Eq, Eq GQLQueryWithText
Eq GQLQueryWithText
-> (GQLQueryWithText -> GQLQueryWithText -> Ordering)
-> (GQLQueryWithText -> GQLQueryWithText -> Bool)
-> (GQLQueryWithText -> GQLQueryWithText -> Bool)
-> (GQLQueryWithText -> GQLQueryWithText -> Bool)
-> (GQLQueryWithText -> GQLQueryWithText -> Bool)
-> (GQLQueryWithText -> GQLQueryWithText -> GQLQueryWithText)
-> (GQLQueryWithText -> GQLQueryWithText -> GQLQueryWithText)
-> Ord GQLQueryWithText
GQLQueryWithText -> GQLQueryWithText -> Bool
GQLQueryWithText -> GQLQueryWithText -> Ordering
GQLQueryWithText -> GQLQueryWithText -> GQLQueryWithText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GQLQueryWithText -> GQLQueryWithText -> Ordering
compare :: GQLQueryWithText -> GQLQueryWithText -> Ordering
$c< :: GQLQueryWithText -> GQLQueryWithText -> Bool
< :: GQLQueryWithText -> GQLQueryWithText -> Bool
$c<= :: GQLQueryWithText -> GQLQueryWithText -> Bool
<= :: GQLQueryWithText -> GQLQueryWithText -> Bool
$c> :: GQLQueryWithText -> GQLQueryWithText -> Bool
> :: GQLQueryWithText -> GQLQueryWithText -> Bool
$c>= :: GQLQueryWithText -> GQLQueryWithText -> Bool
>= :: GQLQueryWithText -> GQLQueryWithText -> Bool
$cmax :: GQLQueryWithText -> GQLQueryWithText -> GQLQueryWithText
max :: GQLQueryWithText -> GQLQueryWithText -> GQLQueryWithText
$cmin :: GQLQueryWithText -> GQLQueryWithText -> GQLQueryWithText
min :: GQLQueryWithText -> GQLQueryWithText -> GQLQueryWithText
Ord, GQLQueryWithText -> ()
(GQLQueryWithText -> ()) -> NFData GQLQueryWithText
forall a. (a -> ()) -> NFData a
$crnf :: GQLQueryWithText -> ()
rnf :: GQLQueryWithText -> ()
NFData, (forall x. GQLQueryWithText -> Rep GQLQueryWithText x)
-> (forall x. Rep GQLQueryWithText x -> GQLQueryWithText)
-> Generic GQLQueryWithText
forall x. Rep GQLQueryWithText x -> GQLQueryWithText
forall x. GQLQueryWithText -> Rep GQLQueryWithText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GQLQueryWithText -> Rep GQLQueryWithText x
from :: forall x. GQLQueryWithText -> Rep GQLQueryWithText x
$cto :: forall x. Rep GQLQueryWithText x -> GQLQueryWithText
to :: forall x. Rep GQLQueryWithText x -> GQLQueryWithText
Generic, Eq GQLQueryWithText
Eq GQLQueryWithText
-> (Int -> GQLQueryWithText -> Int)
-> (GQLQueryWithText -> Int)
-> Hashable GQLQueryWithText
Int -> GQLQueryWithText -> Int
GQLQueryWithText -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GQLQueryWithText -> Int
hashWithSalt :: Int -> GQLQueryWithText -> Int
$chash :: GQLQueryWithText -> Int
hash :: GQLQueryWithText -> Int
Hashable)

instance HasCodec GQLQueryWithText where
  codec :: JSONCodec GQLQueryWithText
codec = (Text -> Either String GQLQueryWithText)
-> (GQLQueryWithText -> Text)
-> Codec Value Text Text
-> JSONCodec GQLQueryWithText
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Text -> Either String GQLQueryWithText
dec GQLQueryWithText -> Text
enc (Codec Value Text Text -> JSONCodec GQLQueryWithText)
-> Codec Value Text Text -> JSONCodec GQLQueryWithText
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @Text
    where
      dec :: Text -> Either String GQLQueryWithText
dec Text
t = (Text -> String)
-> Either Text GQLQueryWithText -> Either String GQLQueryWithText
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft Text -> String
T.unpack (Either Text GQLQueryWithText -> Either String GQLQueryWithText)
-> Either Text GQLQueryWithText -> Either String GQLQueryWithText
forall a b. (a -> b) -> a -> b
$ (Text, GQLQuery) -> GQLQueryWithText
GQLQueryWithText ((Text, GQLQuery) -> GQLQueryWithText)
-> (ExecutableDocument Name -> (Text, GQLQuery))
-> ExecutableDocument Name
-> GQLQueryWithText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
t,) (GQLQuery -> (Text, GQLQuery))
-> (ExecutableDocument Name -> GQLQuery)
-> ExecutableDocument Name
-> (Text, GQLQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutableDocument Name -> GQLQuery
GQLQuery (ExecutableDocument Name -> GQLQueryWithText)
-> Either Text (ExecutableDocument Name)
-> Either Text GQLQueryWithText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text (ExecutableDocument Name)
G.parseExecutableDoc Text
t
      enc :: GQLQueryWithText -> Text
enc (GQLQueryWithText (Text
t, GQLQuery
_)) = Text
t

instance FromJSON GQLQueryWithText where
  parseJSON :: Value -> Parser GQLQueryWithText
parseJSON v :: Value
v@(String Text
t) = (Text, GQLQuery) -> GQLQueryWithText
GQLQueryWithText ((Text, GQLQuery) -> GQLQueryWithText)
-> (GQLQuery -> (Text, GQLQuery)) -> GQLQuery -> GQLQueryWithText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
t,) (GQLQuery -> GQLQueryWithText)
-> Parser GQLQuery -> Parser GQLQueryWithText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GQLQuery
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON Value
_ = String -> Parser GQLQueryWithText
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting String for GraphQL query"

instance ToJSON GQLQueryWithText where
  toJSON :: GQLQueryWithText -> Value
toJSON (GQLQueryWithText (Text
t, GQLQuery
_)) = Text -> Value
String Text
t

getGQLQuery :: GQLQueryWithText -> GQLQuery
getGQLQuery :: GQLQueryWithText -> GQLQuery
getGQLQuery (GQLQueryWithText (Text, GQLQuery)
v) = (Text, GQLQuery) -> GQLQuery
forall a b. (a, b) -> b
snd (Text, GQLQuery)
v

getGQLQueryText :: GQLQueryWithText -> Text
getGQLQueryText :: GQLQueryWithText -> Text
getGQLQueryText (GQLQueryWithText (Text, GQLQuery)
v) = (Text, GQLQuery) -> Text
forall a b. (a, b) -> a
fst (Text, GQLQuery)
v

data ListedQuery = ListedQuery
  { ListedQuery -> QueryName
_lqName :: QueryName,
    ListedQuery -> GQLQueryWithText
_lqQuery :: GQLQueryWithText
  }
  deriving (Int -> ListedQuery -> ShowS
[ListedQuery] -> ShowS
ListedQuery -> String
(Int -> ListedQuery -> ShowS)
-> (ListedQuery -> String)
-> ([ListedQuery] -> ShowS)
-> Show ListedQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListedQuery -> ShowS
showsPrec :: Int -> ListedQuery -> ShowS
$cshow :: ListedQuery -> String
show :: ListedQuery -> String
$cshowList :: [ListedQuery] -> ShowS
showList :: [ListedQuery] -> ShowS
Show, ListedQuery -> ListedQuery -> Bool
(ListedQuery -> ListedQuery -> Bool)
-> (ListedQuery -> ListedQuery -> Bool) -> Eq ListedQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListedQuery -> ListedQuery -> Bool
== :: ListedQuery -> ListedQuery -> Bool
$c/= :: ListedQuery -> ListedQuery -> Bool
/= :: ListedQuery -> ListedQuery -> Bool
Eq, Eq ListedQuery
Eq ListedQuery
-> (ListedQuery -> ListedQuery -> Ordering)
-> (ListedQuery -> ListedQuery -> Bool)
-> (ListedQuery -> ListedQuery -> Bool)
-> (ListedQuery -> ListedQuery -> Bool)
-> (ListedQuery -> ListedQuery -> Bool)
-> (ListedQuery -> ListedQuery -> ListedQuery)
-> (ListedQuery -> ListedQuery -> ListedQuery)
-> Ord ListedQuery
ListedQuery -> ListedQuery -> Bool
ListedQuery -> ListedQuery -> Ordering
ListedQuery -> ListedQuery -> ListedQuery
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListedQuery -> ListedQuery -> Ordering
compare :: ListedQuery -> ListedQuery -> Ordering
$c< :: ListedQuery -> ListedQuery -> Bool
< :: ListedQuery -> ListedQuery -> Bool
$c<= :: ListedQuery -> ListedQuery -> Bool
<= :: ListedQuery -> ListedQuery -> Bool
$c> :: ListedQuery -> ListedQuery -> Bool
> :: ListedQuery -> ListedQuery -> Bool
$c>= :: ListedQuery -> ListedQuery -> Bool
>= :: ListedQuery -> ListedQuery -> Bool
$cmax :: ListedQuery -> ListedQuery -> ListedQuery
max :: ListedQuery -> ListedQuery -> ListedQuery
$cmin :: ListedQuery -> ListedQuery -> ListedQuery
min :: ListedQuery -> ListedQuery -> ListedQuery
Ord, (forall x. ListedQuery -> Rep ListedQuery x)
-> (forall x. Rep ListedQuery x -> ListedQuery)
-> Generic ListedQuery
forall x. Rep ListedQuery x -> ListedQuery
forall x. ListedQuery -> Rep ListedQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListedQuery -> Rep ListedQuery x
from :: forall x. ListedQuery -> Rep ListedQuery x
$cto :: forall x. Rep ListedQuery x -> ListedQuery
to :: forall x. Rep ListedQuery x -> ListedQuery
Generic)

instance NFData ListedQuery

instance Hashable ListedQuery

instance HasCodec ListedQuery where
  codec :: JSONCodec ListedQuery
codec =
    Text
-> ObjectCodec ListedQuery ListedQuery -> JSONCodec ListedQuery
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ListedQuery"
      (ObjectCodec ListedQuery ListedQuery -> JSONCodec ListedQuery)
-> ObjectCodec ListedQuery ListedQuery -> JSONCodec ListedQuery
forall a b. (a -> b) -> a -> b
$ QueryName -> GQLQueryWithText -> ListedQuery
ListedQuery
      (QueryName -> GQLQueryWithText -> ListedQuery)
-> Codec Object ListedQuery QueryName
-> Codec Object ListedQuery (GQLQueryWithText -> ListedQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec QueryName QueryName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec QueryName QueryName
-> (ListedQuery -> QueryName) -> Codec Object ListedQuery QueryName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ListedQuery -> QueryName
_lqName
        Codec Object ListedQuery (GQLQueryWithText -> ListedQuery)
-> Codec Object ListedQuery GQLQueryWithText
-> ObjectCodec ListedQuery ListedQuery
forall a b.
Codec Object ListedQuery (a -> b)
-> Codec Object ListedQuery a -> Codec Object ListedQuery b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec GQLQueryWithText GQLQueryWithText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"query"
      ObjectCodec GQLQueryWithText GQLQueryWithText
-> (ListedQuery -> GQLQueryWithText)
-> Codec Object ListedQuery GQLQueryWithText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ListedQuery -> GQLQueryWithText
_lqQuery

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

instance ToJSON ListedQuery where
  toJSON :: ListedQuery -> Value
toJSON = Options -> ListedQuery -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: ListedQuery -> Encoding
toEncoding = Options -> ListedQuery -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

newtype CollectionDef = CollectionDef
  {CollectionDef -> [ListedQuery]
_cdQueries :: [ListedQuery]}
  deriving (Int -> CollectionDef -> ShowS
[CollectionDef] -> ShowS
CollectionDef -> String
(Int -> CollectionDef -> ShowS)
-> (CollectionDef -> String)
-> ([CollectionDef] -> ShowS)
-> Show CollectionDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectionDef -> ShowS
showsPrec :: Int -> CollectionDef -> ShowS
$cshow :: CollectionDef -> String
show :: CollectionDef -> String
$cshowList :: [CollectionDef] -> ShowS
showList :: [CollectionDef] -> ShowS
Show, CollectionDef -> CollectionDef -> Bool
(CollectionDef -> CollectionDef -> Bool)
-> (CollectionDef -> CollectionDef -> Bool) -> Eq CollectionDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollectionDef -> CollectionDef -> Bool
== :: CollectionDef -> CollectionDef -> Bool
$c/= :: CollectionDef -> CollectionDef -> Bool
/= :: CollectionDef -> CollectionDef -> Bool
Eq, (forall x. CollectionDef -> Rep CollectionDef x)
-> (forall x. Rep CollectionDef x -> CollectionDef)
-> Generic CollectionDef
forall x. Rep CollectionDef x -> CollectionDef
forall x. CollectionDef -> Rep CollectionDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CollectionDef -> Rep CollectionDef x
from :: forall x. CollectionDef -> Rep CollectionDef x
$cto :: forall x. Rep CollectionDef x -> CollectionDef
to :: forall x. Rep CollectionDef x -> CollectionDef
Generic, CollectionDef -> ()
(CollectionDef -> ()) -> NFData CollectionDef
forall a. (a -> ()) -> NFData a
$crnf :: CollectionDef -> ()
rnf :: CollectionDef -> ()
NFData)

instance HasCodec CollectionDef where
  codec :: JSONCodec CollectionDef
codec =
    Text
-> ObjectCodec CollectionDef CollectionDef
-> JSONCodec CollectionDef
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"CollectionDef"
      (ObjectCodec CollectionDef CollectionDef
 -> JSONCodec CollectionDef)
-> ObjectCodec CollectionDef CollectionDef
-> JSONCodec CollectionDef
forall a b. (a -> b) -> a -> b
$ [ListedQuery] -> CollectionDef
CollectionDef
      ([ListedQuery] -> CollectionDef)
-> Codec Object CollectionDef [ListedQuery]
-> ObjectCodec CollectionDef CollectionDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec [ListedQuery] [ListedQuery]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"queries"
      ObjectCodec [ListedQuery] [ListedQuery]
-> (CollectionDef -> [ListedQuery])
-> Codec Object CollectionDef [ListedQuery]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CollectionDef -> [ListedQuery]
_cdQueries

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

instance ToJSON CollectionDef where
  toJSON :: CollectionDef -> Value
toJSON = Options -> CollectionDef -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: CollectionDef -> Encoding
toEncoding = Options -> CollectionDef -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

$(makeLenses ''CollectionDef)

data CreateCollection = CreateCollection
  { CreateCollection -> CollectionName
_ccName :: CollectionName,
    CreateCollection -> CollectionDef
_ccDefinition :: CollectionDef,
    CreateCollection -> Maybe Text
_ccComment :: Maybe Text
  }
  deriving (Int -> CreateCollection -> ShowS
[CreateCollection] -> ShowS
CreateCollection -> String
(Int -> CreateCollection -> ShowS)
-> (CreateCollection -> String)
-> ([CreateCollection] -> ShowS)
-> Show CreateCollection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCollection -> ShowS
showsPrec :: Int -> CreateCollection -> ShowS
$cshow :: CreateCollection -> String
show :: CreateCollection -> String
$cshowList :: [CreateCollection] -> ShowS
showList :: [CreateCollection] -> ShowS
Show, CreateCollection -> CreateCollection -> Bool
(CreateCollection -> CreateCollection -> Bool)
-> (CreateCollection -> CreateCollection -> Bool)
-> Eq CreateCollection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCollection -> CreateCollection -> Bool
== :: CreateCollection -> CreateCollection -> Bool
$c/= :: CreateCollection -> CreateCollection -> Bool
/= :: CreateCollection -> CreateCollection -> Bool
Eq, (forall x. CreateCollection -> Rep CreateCollection x)
-> (forall x. Rep CreateCollection x -> CreateCollection)
-> Generic CreateCollection
forall x. Rep CreateCollection x -> CreateCollection
forall x. CreateCollection -> Rep CreateCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateCollection -> Rep CreateCollection x
from :: forall x. CreateCollection -> Rep CreateCollection x
$cto :: forall x. Rep CreateCollection x -> CreateCollection
to :: forall x. Rep CreateCollection x -> CreateCollection
Generic)

instance HasCodec CreateCollection where
  codec :: JSONCodec CreateCollection
codec =
    Text
-> ObjectCodec CreateCollection CreateCollection
-> JSONCodec CreateCollection
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"CreateCollection"
      (ObjectCodec CreateCollection CreateCollection
 -> JSONCodec CreateCollection)
-> ObjectCodec CreateCollection CreateCollection
-> JSONCodec CreateCollection
forall a b. (a -> b) -> a -> b
$ CollectionName -> CollectionDef -> Maybe Text -> CreateCollection
CreateCollection
      (CollectionName -> CollectionDef -> Maybe Text -> CreateCollection)
-> Codec Object CreateCollection CollectionName
-> Codec
     Object
     CreateCollection
     (CollectionDef -> Maybe Text -> CreateCollection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec CollectionName CollectionName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec CollectionName CollectionName
-> (CreateCollection -> CollectionName)
-> Codec Object CreateCollection CollectionName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CreateCollection -> CollectionName
_ccName
        Codec
  Object
  CreateCollection
  (CollectionDef -> Maybe Text -> CreateCollection)
-> Codec Object CreateCollection CollectionDef
-> Codec Object CreateCollection (Maybe Text -> CreateCollection)
forall a b.
Codec Object CreateCollection (a -> b)
-> Codec Object CreateCollection a
-> Codec Object CreateCollection b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CollectionDef CollectionDef
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"definition"
      ObjectCodec CollectionDef CollectionDef
-> (CreateCollection -> CollectionDef)
-> Codec Object CreateCollection CollectionDef
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CreateCollection -> CollectionDef
_ccDefinition
        Codec Object CreateCollection (Maybe Text -> CreateCollection)
-> Codec Object CreateCollection (Maybe Text)
-> ObjectCodec CreateCollection CreateCollection
forall a b.
Codec Object CreateCollection (a -> b)
-> Codec Object CreateCollection a
-> Codec Object CreateCollection 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)
-> (CreateCollection -> Maybe Text)
-> Codec Object CreateCollection (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CreateCollection -> Maybe Text
_ccComment

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

instance ToJSON CreateCollection where
  toJSON :: CreateCollection -> Value
toJSON = Options -> CreateCollection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: CreateCollection -> Encoding
toEncoding = Options -> CreateCollection -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

$(makeLenses ''CreateCollection)

collectionQueries :: CreateCollection -> [G.ExecutableDocument G.Name]
collectionQueries :: CreateCollection -> [ExecutableDocument Name]
collectionQueries = (ListedQuery -> ExecutableDocument Name)
-> [ListedQuery] -> [ExecutableDocument Name]
forall a b. (a -> b) -> [a] -> [b]
map (GQLQuery -> ExecutableDocument Name
unGQLQuery (GQLQuery -> ExecutableDocument Name)
-> (ListedQuery -> GQLQuery)
-> ListedQuery
-> ExecutableDocument Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLQueryWithText -> GQLQuery
getGQLQuery (GQLQueryWithText -> GQLQuery)
-> (ListedQuery -> GQLQueryWithText) -> ListedQuery -> GQLQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListedQuery -> GQLQueryWithText
_lqQuery) ([ListedQuery] -> [ExecutableDocument Name])
-> (CreateCollection -> [ListedQuery])
-> CreateCollection
-> [ExecutableDocument Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollectionDef -> [ListedQuery]
_cdQueries (CollectionDef -> [ListedQuery])
-> (CreateCollection -> CollectionDef)
-> CreateCollection
-> [ListedQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateCollection -> CollectionDef
_ccDefinition

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

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

instance ToJSON RenameCollection where
  toJSON :: RenameCollection -> Value
toJSON = Options -> RenameCollection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: RenameCollection -> Encoding
toEncoding = Options -> RenameCollection -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

$(makeLenses ''RenameCollection)

data DropCollection = DropCollection
  { DropCollection -> CollectionName
_dcCollection :: CollectionName,
    DropCollection -> Bool
_dcCascade :: Bool
  }
  deriving stock (Int -> DropCollection -> ShowS
[DropCollection] -> ShowS
DropCollection -> String
(Int -> DropCollection -> ShowS)
-> (DropCollection -> String)
-> ([DropCollection] -> ShowS)
-> Show DropCollection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropCollection -> ShowS
showsPrec :: Int -> DropCollection -> ShowS
$cshow :: DropCollection -> String
show :: DropCollection -> String
$cshowList :: [DropCollection] -> ShowS
showList :: [DropCollection] -> ShowS
Show, DropCollection -> DropCollection -> Bool
(DropCollection -> DropCollection -> Bool)
-> (DropCollection -> DropCollection -> Bool) -> Eq DropCollection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropCollection -> DropCollection -> Bool
== :: DropCollection -> DropCollection -> Bool
$c/= :: DropCollection -> DropCollection -> Bool
/= :: DropCollection -> DropCollection -> Bool
Eq, (forall x. DropCollection -> Rep DropCollection x)
-> (forall x. Rep DropCollection x -> DropCollection)
-> Generic DropCollection
forall x. Rep DropCollection x -> DropCollection
forall x. DropCollection -> Rep DropCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DropCollection -> Rep DropCollection x
from :: forall x. DropCollection -> Rep DropCollection x
$cto :: forall x. Rep DropCollection x -> DropCollection
to :: forall x. Rep DropCollection x -> DropCollection
Generic)

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

instance ToJSON DropCollection where
  toJSON :: DropCollection -> Value
toJSON = Options -> DropCollection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: DropCollection -> Encoding
toEncoding = Options -> DropCollection -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data AddQueryToCollection = AddQueryToCollection
  { AddQueryToCollection -> CollectionName
_aqtcCollectionName :: CollectionName,
    AddQueryToCollection -> QueryName
_aqtcQueryName :: QueryName,
    AddQueryToCollection -> GQLQueryWithText
_aqtcQuery :: GQLQueryWithText
  }
  deriving stock (Int -> AddQueryToCollection -> ShowS
[AddQueryToCollection] -> ShowS
AddQueryToCollection -> String
(Int -> AddQueryToCollection -> ShowS)
-> (AddQueryToCollection -> String)
-> ([AddQueryToCollection] -> ShowS)
-> Show AddQueryToCollection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddQueryToCollection -> ShowS
showsPrec :: Int -> AddQueryToCollection -> ShowS
$cshow :: AddQueryToCollection -> String
show :: AddQueryToCollection -> String
$cshowList :: [AddQueryToCollection] -> ShowS
showList :: [AddQueryToCollection] -> ShowS
Show, AddQueryToCollection -> AddQueryToCollection -> Bool
(AddQueryToCollection -> AddQueryToCollection -> Bool)
-> (AddQueryToCollection -> AddQueryToCollection -> Bool)
-> Eq AddQueryToCollection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddQueryToCollection -> AddQueryToCollection -> Bool
== :: AddQueryToCollection -> AddQueryToCollection -> Bool
$c/= :: AddQueryToCollection -> AddQueryToCollection -> Bool
/= :: AddQueryToCollection -> AddQueryToCollection -> Bool
Eq, (forall x. AddQueryToCollection -> Rep AddQueryToCollection x)
-> (forall x. Rep AddQueryToCollection x -> AddQueryToCollection)
-> Generic AddQueryToCollection
forall x. Rep AddQueryToCollection x -> AddQueryToCollection
forall x. AddQueryToCollection -> Rep AddQueryToCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddQueryToCollection -> Rep AddQueryToCollection x
from :: forall x. AddQueryToCollection -> Rep AddQueryToCollection x
$cto :: forall x. Rep AddQueryToCollection x -> AddQueryToCollection
to :: forall x. Rep AddQueryToCollection x -> AddQueryToCollection
Generic)

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

instance ToJSON AddQueryToCollection where
  toJSON :: AddQueryToCollection -> Value
toJSON = Options -> AddQueryToCollection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: AddQueryToCollection -> Encoding
toEncoding = Options -> AddQueryToCollection -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data DropQueryFromCollection = DropQueryFromCollection
  { DropQueryFromCollection -> CollectionName
_dqfcCollectionName :: CollectionName,
    DropQueryFromCollection -> QueryName
_dqfcQueryName :: QueryName
  }
  deriving stock (Int -> DropQueryFromCollection -> ShowS
[DropQueryFromCollection] -> ShowS
DropQueryFromCollection -> String
(Int -> DropQueryFromCollection -> ShowS)
-> (DropQueryFromCollection -> String)
-> ([DropQueryFromCollection] -> ShowS)
-> Show DropQueryFromCollection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropQueryFromCollection -> ShowS
showsPrec :: Int -> DropQueryFromCollection -> ShowS
$cshow :: DropQueryFromCollection -> String
show :: DropQueryFromCollection -> String
$cshowList :: [DropQueryFromCollection] -> ShowS
showList :: [DropQueryFromCollection] -> ShowS
Show, DropQueryFromCollection -> DropQueryFromCollection -> Bool
(DropQueryFromCollection -> DropQueryFromCollection -> Bool)
-> (DropQueryFromCollection -> DropQueryFromCollection -> Bool)
-> Eq DropQueryFromCollection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropQueryFromCollection -> DropQueryFromCollection -> Bool
== :: DropQueryFromCollection -> DropQueryFromCollection -> Bool
$c/= :: DropQueryFromCollection -> DropQueryFromCollection -> Bool
/= :: DropQueryFromCollection -> DropQueryFromCollection -> Bool
Eq, (forall x.
 DropQueryFromCollection -> Rep DropQueryFromCollection x)
-> (forall x.
    Rep DropQueryFromCollection x -> DropQueryFromCollection)
-> Generic DropQueryFromCollection
forall x. Rep DropQueryFromCollection x -> DropQueryFromCollection
forall x. DropQueryFromCollection -> Rep DropQueryFromCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DropQueryFromCollection -> Rep DropQueryFromCollection x
from :: forall x. DropQueryFromCollection -> Rep DropQueryFromCollection x
$cto :: forall x. Rep DropQueryFromCollection x -> DropQueryFromCollection
to :: forall x. Rep DropQueryFromCollection x -> DropQueryFromCollection
Generic)

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

instance ToJSON DropQueryFromCollection where
  toJSON :: DropQueryFromCollection -> Value
toJSON = Options -> DropQueryFromCollection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: DropQueryFromCollection -> Encoding
toEncoding = Options -> DropQueryFromCollection -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

type QueryCollections = InsOrdHashMap CollectionName CreateCollection