{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.Endpoint
  ( EndpointName (..),
    EndpointMethod (..),
    EndpointUrl (),
    CreateEndpoint,
    EndpointDef (..),
    QueryReference (..),
    EndpointMetadata (..),
    DropEndpoint (..),
    module Trie,
    EndpointTrie,
    buildEndpointsTrie,
    qrCollectionName,
    qrQueryName,
    edQuery,
    ceComment,
    ceDefinition,
    ceMethods,
    ceName,
    ceUrl,
    deName,
    splitPath,
    mkEndpointUrl,
    unEndpointUrl,
  )
where

import Autodocodec (HasCodec (codec), dimapCodec, optionalField', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (boundedEnumCodec, typeableName)
import Control.Lens
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.HashMap.Strict.Multi qualified as MM
import Data.Text qualified as T
import Data.Text.Extended
import Data.Text.NonEmpty
import Data.Trie qualified as T
import Data.Typeable (Typeable)
import Hasura.Prelude
import Hasura.RQL.Types.Endpoint.Trie as Trie
import Hasura.RQL.Types.QueryCollection (CollectionName, QueryName)
import Web.HttpApiData (FromHttpApiData (..))

data EndpointMethod
  = GET
  | POST
  | PUT
  | DELETE
  | PATCH
  deriving
    (Int -> EndpointMethod -> ShowS
[EndpointMethod] -> ShowS
EndpointMethod -> String
(Int -> EndpointMethod -> ShowS)
-> (EndpointMethod -> String)
-> ([EndpointMethod] -> ShowS)
-> Show EndpointMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndpointMethod -> ShowS
showsPrec :: Int -> EndpointMethod -> ShowS
$cshow :: EndpointMethod -> String
show :: EndpointMethod -> String
$cshowList :: [EndpointMethod] -> ShowS
showList :: [EndpointMethod] -> ShowS
Show, EndpointMethod
EndpointMethod -> EndpointMethod -> Bounded EndpointMethod
forall a. a -> a -> Bounded a
$cminBound :: EndpointMethod
minBound :: EndpointMethod
$cmaxBound :: EndpointMethod
maxBound :: EndpointMethod
Bounded, Int -> EndpointMethod
EndpointMethod -> Int
EndpointMethod -> [EndpointMethod]
EndpointMethod -> EndpointMethod
EndpointMethod -> EndpointMethod -> [EndpointMethod]
EndpointMethod
-> EndpointMethod -> EndpointMethod -> [EndpointMethod]
(EndpointMethod -> EndpointMethod)
-> (EndpointMethod -> EndpointMethod)
-> (Int -> EndpointMethod)
-> (EndpointMethod -> Int)
-> (EndpointMethod -> [EndpointMethod])
-> (EndpointMethod -> EndpointMethod -> [EndpointMethod])
-> (EndpointMethod -> EndpointMethod -> [EndpointMethod])
-> (EndpointMethod
    -> EndpointMethod -> EndpointMethod -> [EndpointMethod])
-> Enum EndpointMethod
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EndpointMethod -> EndpointMethod
succ :: EndpointMethod -> EndpointMethod
$cpred :: EndpointMethod -> EndpointMethod
pred :: EndpointMethod -> EndpointMethod
$ctoEnum :: Int -> EndpointMethod
toEnum :: Int -> EndpointMethod
$cfromEnum :: EndpointMethod -> Int
fromEnum :: EndpointMethod -> Int
$cenumFrom :: EndpointMethod -> [EndpointMethod]
enumFrom :: EndpointMethod -> [EndpointMethod]
$cenumFromThen :: EndpointMethod -> EndpointMethod -> [EndpointMethod]
enumFromThen :: EndpointMethod -> EndpointMethod -> [EndpointMethod]
$cenumFromTo :: EndpointMethod -> EndpointMethod -> [EndpointMethod]
enumFromTo :: EndpointMethod -> EndpointMethod -> [EndpointMethod]
$cenumFromThenTo :: EndpointMethod
-> EndpointMethod -> EndpointMethod -> [EndpointMethod]
enumFromThenTo :: EndpointMethod
-> EndpointMethod -> EndpointMethod -> [EndpointMethod]
Enum, EndpointMethod -> EndpointMethod -> Bool
(EndpointMethod -> EndpointMethod -> Bool)
-> (EndpointMethod -> EndpointMethod -> Bool) -> Eq EndpointMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndpointMethod -> EndpointMethod -> Bool
== :: EndpointMethod -> EndpointMethod -> Bool
$c/= :: EndpointMethod -> EndpointMethod -> Bool
/= :: EndpointMethod -> EndpointMethod -> Bool
Eq, Eq EndpointMethod
Eq EndpointMethod
-> (EndpointMethod -> EndpointMethod -> Ordering)
-> (EndpointMethod -> EndpointMethod -> Bool)
-> (EndpointMethod -> EndpointMethod -> Bool)
-> (EndpointMethod -> EndpointMethod -> Bool)
-> (EndpointMethod -> EndpointMethod -> Bool)
-> (EndpointMethod -> EndpointMethod -> EndpointMethod)
-> (EndpointMethod -> EndpointMethod -> EndpointMethod)
-> Ord EndpointMethod
EndpointMethod -> EndpointMethod -> Bool
EndpointMethod -> EndpointMethod -> Ordering
EndpointMethod -> EndpointMethod -> EndpointMethod
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 :: EndpointMethod -> EndpointMethod -> Ordering
compare :: EndpointMethod -> EndpointMethod -> Ordering
$c< :: EndpointMethod -> EndpointMethod -> Bool
< :: EndpointMethod -> EndpointMethod -> Bool
$c<= :: EndpointMethod -> EndpointMethod -> Bool
<= :: EndpointMethod -> EndpointMethod -> Bool
$c> :: EndpointMethod -> EndpointMethod -> Bool
> :: EndpointMethod -> EndpointMethod -> Bool
$c>= :: EndpointMethod -> EndpointMethod -> Bool
>= :: EndpointMethod -> EndpointMethod -> Bool
$cmax :: EndpointMethod -> EndpointMethod -> EndpointMethod
max :: EndpointMethod -> EndpointMethod -> EndpointMethod
$cmin :: EndpointMethod -> EndpointMethod -> EndpointMethod
min :: EndpointMethod -> EndpointMethod -> EndpointMethod
Ord, Eq EndpointMethod
Eq EndpointMethod
-> (Int -> EndpointMethod -> Int)
-> (EndpointMethod -> Int)
-> Hashable EndpointMethod
Int -> EndpointMethod -> Int
EndpointMethod -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EndpointMethod -> Int
hashWithSalt :: Int -> EndpointMethod -> Int
$chash :: EndpointMethod -> Int
hash :: EndpointMethod -> Int
Hashable, Value -> Parser [EndpointMethod]
Value -> Parser EndpointMethod
(Value -> Parser EndpointMethod)
-> (Value -> Parser [EndpointMethod]) -> FromJSON EndpointMethod
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EndpointMethod
parseJSON :: Value -> Parser EndpointMethod
$cparseJSONList :: Value -> Parser [EndpointMethod]
parseJSONList :: Value -> Parser [EndpointMethod]
FromJSON, [EndpointMethod] -> Value
[EndpointMethod] -> Encoding
EndpointMethod -> Value
EndpointMethod -> Encoding
(EndpointMethod -> Value)
-> (EndpointMethod -> Encoding)
-> ([EndpointMethod] -> Value)
-> ([EndpointMethod] -> Encoding)
-> ToJSON EndpointMethod
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EndpointMethod -> Value
toJSON :: EndpointMethod -> Value
$ctoEncoding :: EndpointMethod -> Encoding
toEncoding :: EndpointMethod -> Encoding
$ctoJSONList :: [EndpointMethod] -> Value
toJSONList :: [EndpointMethod] -> Value
$ctoEncodingList :: [EndpointMethod] -> Encoding
toEncodingList :: [EndpointMethod] -> Encoding
ToJSON, ToJSONKeyFunction [EndpointMethod]
ToJSONKeyFunction EndpointMethod
ToJSONKeyFunction EndpointMethod
-> ToJSONKeyFunction [EndpointMethod] -> ToJSONKey EndpointMethod
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction EndpointMethod
toJSONKey :: ToJSONKeyFunction EndpointMethod
$ctoJSONKeyList :: ToJSONKeyFunction [EndpointMethod]
toJSONKeyList :: ToJSONKeyFunction [EndpointMethod]
ToJSONKey, (forall x. EndpointMethod -> Rep EndpointMethod x)
-> (forall x. Rep EndpointMethod x -> EndpointMethod)
-> Generic EndpointMethod
forall x. Rep EndpointMethod x -> EndpointMethod
forall x. EndpointMethod -> Rep EndpointMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EndpointMethod -> Rep EndpointMethod x
from :: forall x. EndpointMethod -> Rep EndpointMethod x
$cto :: forall x. Rep EndpointMethod x -> EndpointMethod
to :: forall x. Rep EndpointMethod x -> EndpointMethod
Generic)

-- | JSON representations for each 'EndpointMethod' value
endpointMethodJsonString :: EndpointMethod -> String
endpointMethodJsonString :: EndpointMethod -> String
endpointMethodJsonString = \case
  EndpointMethod
GET -> String
"GET"
  EndpointMethod
POST -> String
"POST"
  EndpointMethod
PUT -> String
"PUT"
  EndpointMethod
DELETE -> String
"DELETE"
  EndpointMethod
PATCH -> String
"PATCH"

instance HasCodec EndpointMethod where
  codec :: JSONCodec EndpointMethod
codec = (EndpointMethod -> String) -> JSONCodec EndpointMethod
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> String) -> JSONCodec enum
boundedEnumCodec EndpointMethod -> String
endpointMethodJsonString

instance ToTxt EndpointMethod where
  toTxt :: EndpointMethod -> Text
toTxt = EndpointMethod -> Text
forall a. Show a => a -> Text
tshow

newtype EndpointName = EndpointName {EndpointName -> NonEmptyText
unEndpointName :: NonEmptyText}
  deriving newtype
    ( Int -> EndpointName -> ShowS
[EndpointName] -> ShowS
EndpointName -> String
(Int -> EndpointName -> ShowS)
-> (EndpointName -> String)
-> ([EndpointName] -> ShowS)
-> Show EndpointName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndpointName -> ShowS
showsPrec :: Int -> EndpointName -> ShowS
$cshow :: EndpointName -> String
show :: EndpointName -> String
$cshowList :: [EndpointName] -> ShowS
showList :: [EndpointName] -> ShowS
Show,
      EndpointName -> EndpointName -> Bool
(EndpointName -> EndpointName -> Bool)
-> (EndpointName -> EndpointName -> Bool) -> Eq EndpointName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndpointName -> EndpointName -> Bool
== :: EndpointName -> EndpointName -> Bool
$c/= :: EndpointName -> EndpointName -> Bool
/= :: EndpointName -> EndpointName -> Bool
Eq,
      Eq EndpointName
Eq EndpointName
-> (EndpointName -> EndpointName -> Ordering)
-> (EndpointName -> EndpointName -> Bool)
-> (EndpointName -> EndpointName -> Bool)
-> (EndpointName -> EndpointName -> Bool)
-> (EndpointName -> EndpointName -> Bool)
-> (EndpointName -> EndpointName -> EndpointName)
-> (EndpointName -> EndpointName -> EndpointName)
-> Ord EndpointName
EndpointName -> EndpointName -> Bool
EndpointName -> EndpointName -> Ordering
EndpointName -> EndpointName -> EndpointName
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 :: EndpointName -> EndpointName -> Ordering
compare :: EndpointName -> EndpointName -> Ordering
$c< :: EndpointName -> EndpointName -> Bool
< :: EndpointName -> EndpointName -> Bool
$c<= :: EndpointName -> EndpointName -> Bool
<= :: EndpointName -> EndpointName -> Bool
$c> :: EndpointName -> EndpointName -> Bool
> :: EndpointName -> EndpointName -> Bool
$c>= :: EndpointName -> EndpointName -> Bool
>= :: EndpointName -> EndpointName -> Bool
$cmax :: EndpointName -> EndpointName -> EndpointName
max :: EndpointName -> EndpointName -> EndpointName
$cmin :: EndpointName -> EndpointName -> EndpointName
min :: EndpointName -> EndpointName -> EndpointName
Ord,
      EndpointName -> Text
(EndpointName -> Text) -> ToTxt EndpointName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: EndpointName -> Text
toTxt :: EndpointName -> Text
ToTxt,
      Eq EndpointName
Eq EndpointName
-> (Int -> EndpointName -> Int)
-> (EndpointName -> Int)
-> Hashable EndpointName
Int -> EndpointName -> Int
EndpointName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EndpointName -> Int
hashWithSalt :: Int -> EndpointName -> Int
$chash :: EndpointName -> Int
hash :: EndpointName -> Int
Hashable,
      [EndpointName] -> Value
[EndpointName] -> Encoding
EndpointName -> Value
EndpointName -> Encoding
(EndpointName -> Value)
-> (EndpointName -> Encoding)
-> ([EndpointName] -> Value)
-> ([EndpointName] -> Encoding)
-> ToJSON EndpointName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EndpointName -> Value
toJSON :: EndpointName -> Value
$ctoEncoding :: EndpointName -> Encoding
toEncoding :: EndpointName -> Encoding
$ctoJSONList :: [EndpointName] -> Value
toJSONList :: [EndpointName] -> Value
$ctoEncodingList :: [EndpointName] -> Encoding
toEncodingList :: [EndpointName] -> Encoding
ToJSON,
      Value -> Parser [EndpointName]
Value -> Parser EndpointName
(Value -> Parser EndpointName)
-> (Value -> Parser [EndpointName]) -> FromJSON EndpointName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EndpointName
parseJSON :: Value -> Parser EndpointName
$cparseJSONList :: Value -> Parser [EndpointName]
parseJSONList :: Value -> Parser [EndpointName]
FromJSON
    )

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

newtype EndpointUrl = EndpointUrl {EndpointUrl -> NonEmptyText
unEndpointUrl :: NonEmptyText}
  deriving newtype
    ( Int -> EndpointUrl -> ShowS
[EndpointUrl] -> ShowS
EndpointUrl -> String
(Int -> EndpointUrl -> ShowS)
-> (EndpointUrl -> String)
-> ([EndpointUrl] -> ShowS)
-> Show EndpointUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndpointUrl -> ShowS
showsPrec :: Int -> EndpointUrl -> ShowS
$cshow :: EndpointUrl -> String
show :: EndpointUrl -> String
$cshowList :: [EndpointUrl] -> ShowS
showList :: [EndpointUrl] -> ShowS
Show,
      EndpointUrl -> EndpointUrl -> Bool
(EndpointUrl -> EndpointUrl -> Bool)
-> (EndpointUrl -> EndpointUrl -> Bool) -> Eq EndpointUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndpointUrl -> EndpointUrl -> Bool
== :: EndpointUrl -> EndpointUrl -> Bool
$c/= :: EndpointUrl -> EndpointUrl -> Bool
/= :: EndpointUrl -> EndpointUrl -> Bool
Eq,
      Eq EndpointUrl
Eq EndpointUrl
-> (EndpointUrl -> EndpointUrl -> Ordering)
-> (EndpointUrl -> EndpointUrl -> Bool)
-> (EndpointUrl -> EndpointUrl -> Bool)
-> (EndpointUrl -> EndpointUrl -> Bool)
-> (EndpointUrl -> EndpointUrl -> Bool)
-> (EndpointUrl -> EndpointUrl -> EndpointUrl)
-> (EndpointUrl -> EndpointUrl -> EndpointUrl)
-> Ord EndpointUrl
EndpointUrl -> EndpointUrl -> Bool
EndpointUrl -> EndpointUrl -> Ordering
EndpointUrl -> EndpointUrl -> EndpointUrl
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 :: EndpointUrl -> EndpointUrl -> Ordering
compare :: EndpointUrl -> EndpointUrl -> Ordering
$c< :: EndpointUrl -> EndpointUrl -> Bool
< :: EndpointUrl -> EndpointUrl -> Bool
$c<= :: EndpointUrl -> EndpointUrl -> Bool
<= :: EndpointUrl -> EndpointUrl -> Bool
$c> :: EndpointUrl -> EndpointUrl -> Bool
> :: EndpointUrl -> EndpointUrl -> Bool
$c>= :: EndpointUrl -> EndpointUrl -> Bool
>= :: EndpointUrl -> EndpointUrl -> Bool
$cmax :: EndpointUrl -> EndpointUrl -> EndpointUrl
max :: EndpointUrl -> EndpointUrl -> EndpointUrl
$cmin :: EndpointUrl -> EndpointUrl -> EndpointUrl
min :: EndpointUrl -> EndpointUrl -> EndpointUrl
Ord,
      EndpointUrl -> Text
(EndpointUrl -> Text) -> ToTxt EndpointUrl
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: EndpointUrl -> Text
toTxt :: EndpointUrl -> Text
ToTxt,
      Eq EndpointUrl
Eq EndpointUrl
-> (Int -> EndpointUrl -> Int)
-> (EndpointUrl -> Int)
-> Hashable EndpointUrl
Int -> EndpointUrl -> Int
EndpointUrl -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EndpointUrl -> Int
hashWithSalt :: Int -> EndpointUrl -> Int
$chash :: EndpointUrl -> Int
hash :: EndpointUrl -> Int
Hashable,
      [EndpointUrl] -> Value
[EndpointUrl] -> Encoding
EndpointUrl -> Value
EndpointUrl -> Encoding
(EndpointUrl -> Value)
-> (EndpointUrl -> Encoding)
-> ([EndpointUrl] -> Value)
-> ([EndpointUrl] -> Encoding)
-> ToJSON EndpointUrl
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EndpointUrl -> Value
toJSON :: EndpointUrl -> Value
$ctoEncoding :: EndpointUrl -> Encoding
toEncoding :: EndpointUrl -> Encoding
$ctoJSONList :: [EndpointUrl] -> Value
toJSONList :: [EndpointUrl] -> Value
$ctoEncodingList :: [EndpointUrl] -> Encoding
toEncodingList :: [EndpointUrl] -> Encoding
ToJSON,
      Value -> Parser [EndpointUrl]
Value -> Parser EndpointUrl
(Value -> Parser EndpointUrl)
-> (Value -> Parser [EndpointUrl]) -> FromJSON EndpointUrl
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EndpointUrl
parseJSON :: Value -> Parser EndpointUrl
$cparseJSONList :: Value -> Parser [EndpointUrl]
parseJSONList :: Value -> Parser [EndpointUrl]
FromJSON
    )

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

mkEndpointUrl :: (ToTxt a) => a -> Maybe EndpointUrl
mkEndpointUrl :: forall a. ToTxt a => a -> Maybe EndpointUrl
mkEndpointUrl a
s = NonEmptyText -> EndpointUrl
EndpointUrl (NonEmptyText -> EndpointUrl)
-> Maybe NonEmptyText -> Maybe EndpointUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe NonEmptyText
mkNonEmptyText (a -> Text
forall a. ToTxt a => a -> Text
toTxt a
s)

instance FromHttpApiData EndpointUrl where
  parseQueryParam :: Text -> Either Text EndpointUrl
parseQueryParam Text
s =
    Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
s Either Text Text
-> (Text -> Either Text EndpointUrl) -> Either Text EndpointUrl
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t ->
      case Text -> Maybe NonEmptyText
mkNonEmptyText Text
t of
        Maybe NonEmptyText
Nothing -> Text -> Either Text EndpointUrl
forall a b. a -> Either a b
Left Text
"Endpoint url must be non-empty"
        Just NonEmptyText
net -> EndpointUrl -> Either Text EndpointUrl
forall a b. b -> Either a b
Right (NonEmptyText -> EndpointUrl
EndpointUrl NonEmptyText
net)

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

instance HasCodec QueryReference where
  codec :: JSONCodec QueryReference
codec =
    Text
-> ObjectCodec QueryReference QueryReference
-> JSONCodec QueryReference
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"QueryReference"
      (ObjectCodec QueryReference QueryReference
 -> JSONCodec QueryReference)
-> ObjectCodec QueryReference QueryReference
-> JSONCodec QueryReference
forall a b. (a -> b) -> a -> b
$ CollectionName -> QueryName -> QueryReference
QueryReference
      (CollectionName -> QueryName -> QueryReference)
-> Codec Object QueryReference CollectionName
-> Codec Object QueryReference (QueryName -> QueryReference)
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
"collection_name"
      ObjectCodec CollectionName CollectionName
-> (QueryReference -> CollectionName)
-> Codec Object QueryReference CollectionName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= QueryReference -> CollectionName
_qrCollectionName
        Codec Object QueryReference (QueryName -> QueryReference)
-> Codec Object QueryReference QueryName
-> ObjectCodec QueryReference QueryReference
forall a b.
Codec Object QueryReference (a -> b)
-> Codec Object QueryReference a -> Codec Object QueryReference b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec QueryName QueryName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"query_name"
      ObjectCodec QueryName QueryName
-> (QueryReference -> QueryName)
-> Codec Object QueryReference QueryName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= QueryReference -> QueryName
_qrQueryName

$(deriveJSON (aesonDrop 3 snakeCase) ''QueryReference)
$(makeLenses ''QueryReference)

data EndpointDef query = EndpointDef
  { forall query. EndpointDef query -> query
_edQuery :: query
  }
  deriving stock (Int -> EndpointDef query -> ShowS
[EndpointDef query] -> ShowS
EndpointDef query -> String
(Int -> EndpointDef query -> ShowS)
-> (EndpointDef query -> String)
-> ([EndpointDef query] -> ShowS)
-> Show (EndpointDef query)
forall query. Show query => Int -> EndpointDef query -> ShowS
forall query. Show query => [EndpointDef query] -> ShowS
forall query. Show query => EndpointDef query -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall query. Show query => Int -> EndpointDef query -> ShowS
showsPrec :: Int -> EndpointDef query -> ShowS
$cshow :: forall query. Show query => EndpointDef query -> String
show :: EndpointDef query -> String
$cshowList :: forall query. Show query => [EndpointDef query] -> ShowS
showList :: [EndpointDef query] -> ShowS
Show, EndpointDef query -> EndpointDef query -> Bool
(EndpointDef query -> EndpointDef query -> Bool)
-> (EndpointDef query -> EndpointDef query -> Bool)
-> Eq (EndpointDef query)
forall query.
Eq query =>
EndpointDef query -> EndpointDef query -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall query.
Eq query =>
EndpointDef query -> EndpointDef query -> Bool
== :: EndpointDef query -> EndpointDef query -> Bool
$c/= :: forall query.
Eq query =>
EndpointDef query -> EndpointDef query -> Bool
/= :: EndpointDef query -> EndpointDef query -> Bool
Eq, Eq (EndpointDef query)
Eq (EndpointDef query)
-> (EndpointDef query -> EndpointDef query -> Ordering)
-> (EndpointDef query -> EndpointDef query -> Bool)
-> (EndpointDef query -> EndpointDef query -> Bool)
-> (EndpointDef query -> EndpointDef query -> Bool)
-> (EndpointDef query -> EndpointDef query -> Bool)
-> (EndpointDef query -> EndpointDef query -> EndpointDef query)
-> (EndpointDef query -> EndpointDef query -> EndpointDef query)
-> Ord (EndpointDef query)
EndpointDef query -> EndpointDef query -> Bool
EndpointDef query -> EndpointDef query -> Ordering
EndpointDef query -> EndpointDef query -> EndpointDef query
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
forall {query}. Ord query => Eq (EndpointDef query)
forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> Bool
forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> Ordering
forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> EndpointDef query
$ccompare :: forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> Ordering
compare :: EndpointDef query -> EndpointDef query -> Ordering
$c< :: forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> Bool
< :: EndpointDef query -> EndpointDef query -> Bool
$c<= :: forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> Bool
<= :: EndpointDef query -> EndpointDef query -> Bool
$c> :: forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> Bool
> :: EndpointDef query -> EndpointDef query -> Bool
$c>= :: forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> Bool
>= :: EndpointDef query -> EndpointDef query -> Bool
$cmax :: forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> EndpointDef query
max :: EndpointDef query -> EndpointDef query -> EndpointDef query
$cmin :: forall query.
Ord query =>
EndpointDef query -> EndpointDef query -> EndpointDef query
min :: EndpointDef query -> EndpointDef query -> EndpointDef query
Ord, (forall x. EndpointDef query -> Rep (EndpointDef query) x)
-> (forall x. Rep (EndpointDef query) x -> EndpointDef query)
-> Generic (EndpointDef query)
forall x. Rep (EndpointDef query) x -> EndpointDef query
forall x. EndpointDef query -> Rep (EndpointDef query) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall query x. Rep (EndpointDef query) x -> EndpointDef query
forall query x. EndpointDef query -> Rep (EndpointDef query) x
$cfrom :: forall query x. EndpointDef query -> Rep (EndpointDef query) x
from :: forall x. EndpointDef query -> Rep (EndpointDef query) x
$cto :: forall query x. Rep (EndpointDef query) x -> EndpointDef query
to :: forall x. Rep (EndpointDef query) x -> EndpointDef query
Generic, (forall a b. (a -> b) -> EndpointDef a -> EndpointDef b)
-> (forall a b. a -> EndpointDef b -> EndpointDef a)
-> Functor EndpointDef
forall a b. a -> EndpointDef b -> EndpointDef a
forall a b. (a -> b) -> EndpointDef a -> EndpointDef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> EndpointDef a -> EndpointDef b
fmap :: forall a b. (a -> b) -> EndpointDef a -> EndpointDef b
$c<$ :: forall a b. a -> EndpointDef b -> EndpointDef a
<$ :: forall a b. a -> EndpointDef b -> EndpointDef a
Functor, (forall m. Monoid m => EndpointDef m -> m)
-> (forall m a. Monoid m => (a -> m) -> EndpointDef a -> m)
-> (forall m a. Monoid m => (a -> m) -> EndpointDef a -> m)
-> (forall a b. (a -> b -> b) -> b -> EndpointDef a -> b)
-> (forall a b. (a -> b -> b) -> b -> EndpointDef a -> b)
-> (forall b a. (b -> a -> b) -> b -> EndpointDef a -> b)
-> (forall b a. (b -> a -> b) -> b -> EndpointDef a -> b)
-> (forall a. (a -> a -> a) -> EndpointDef a -> a)
-> (forall a. (a -> a -> a) -> EndpointDef a -> a)
-> (forall a. EndpointDef a -> [a])
-> (forall a. EndpointDef a -> Bool)
-> (forall a. EndpointDef a -> Int)
-> (forall a. Eq a => a -> EndpointDef a -> Bool)
-> (forall a. Ord a => EndpointDef a -> a)
-> (forall a. Ord a => EndpointDef a -> a)
-> (forall a. Num a => EndpointDef a -> a)
-> (forall a. Num a => EndpointDef a -> a)
-> Foldable EndpointDef
forall a. Eq a => a -> EndpointDef a -> Bool
forall a. Num a => EndpointDef a -> a
forall a. Ord a => EndpointDef a -> a
forall m. Monoid m => EndpointDef m -> m
forall a. EndpointDef a -> Bool
forall a. EndpointDef a -> Int
forall a. EndpointDef a -> [a]
forall a. (a -> a -> a) -> EndpointDef a -> a
forall m a. Monoid m => (a -> m) -> EndpointDef a -> m
forall b a. (b -> a -> b) -> b -> EndpointDef a -> b
forall a b. (a -> b -> b) -> b -> EndpointDef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => EndpointDef m -> m
fold :: forall m. Monoid m => EndpointDef m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> EndpointDef a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> EndpointDef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> EndpointDef a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> EndpointDef a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> EndpointDef a -> b
foldr :: forall a b. (a -> b -> b) -> b -> EndpointDef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> EndpointDef a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> EndpointDef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> EndpointDef a -> b
foldl :: forall b a. (b -> a -> b) -> b -> EndpointDef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> EndpointDef a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> EndpointDef a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> EndpointDef a -> a
foldr1 :: forall a. (a -> a -> a) -> EndpointDef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> EndpointDef a -> a
foldl1 :: forall a. (a -> a -> a) -> EndpointDef a -> a
$ctoList :: forall a. EndpointDef a -> [a]
toList :: forall a. EndpointDef a -> [a]
$cnull :: forall a. EndpointDef a -> Bool
null :: forall a. EndpointDef a -> Bool
$clength :: forall a. EndpointDef a -> Int
length :: forall a. EndpointDef a -> Int
$celem :: forall a. Eq a => a -> EndpointDef a -> Bool
elem :: forall a. Eq a => a -> EndpointDef a -> Bool
$cmaximum :: forall a. Ord a => EndpointDef a -> a
maximum :: forall a. Ord a => EndpointDef a -> a
$cminimum :: forall a. Ord a => EndpointDef a -> a
minimum :: forall a. Ord a => EndpointDef a -> a
$csum :: forall a. Num a => EndpointDef a -> a
sum :: forall a. Num a => EndpointDef a -> a
$cproduct :: forall a. Num a => EndpointDef a -> a
product :: forall a. Num a => EndpointDef a -> a
Foldable, Functor EndpointDef
Foldable EndpointDef
Functor EndpointDef
-> Foldable EndpointDef
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> EndpointDef a -> f (EndpointDef b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    EndpointDef (f a) -> f (EndpointDef a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> EndpointDef a -> m (EndpointDef b))
-> (forall (m :: * -> *) a.
    Monad m =>
    EndpointDef (m a) -> m (EndpointDef a))
-> Traversable EndpointDef
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
EndpointDef (m a) -> m (EndpointDef a)
forall (f :: * -> *) a.
Applicative f =>
EndpointDef (f a) -> f (EndpointDef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndpointDef a -> m (EndpointDef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndpointDef a -> f (EndpointDef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndpointDef a -> f (EndpointDef b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndpointDef a -> f (EndpointDef b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
EndpointDef (f a) -> f (EndpointDef a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
EndpointDef (f a) -> f (EndpointDef a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndpointDef a -> m (EndpointDef b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndpointDef a -> m (EndpointDef b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
EndpointDef (m a) -> m (EndpointDef a)
sequence :: forall (m :: * -> *) a.
Monad m =>
EndpointDef (m a) -> m (EndpointDef a)
Traversable)

instance (HasCodec query, Typeable query) => HasCodec (EndpointDef query) where
  codec :: JSONCodec (EndpointDef query)
codec =
    Text
-> ObjectCodec (EndpointDef query) (EndpointDef query)
-> JSONCodec (EndpointDef query)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"EndpointDef_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @query)
      (ObjectCodec (EndpointDef query) (EndpointDef query)
 -> JSONCodec (EndpointDef query))
-> ObjectCodec (EndpointDef query) (EndpointDef query)
-> JSONCodec (EndpointDef query)
forall a b. (a -> b) -> a -> b
$ query -> EndpointDef query
forall query. query -> EndpointDef query
EndpointDef
      (query -> EndpointDef query)
-> Codec Object (EndpointDef query) query
-> ObjectCodec (EndpointDef query) (EndpointDef query)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec query query
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"query"
      ObjectCodec query query
-> (EndpointDef query -> query)
-> Codec Object (EndpointDef query) query
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EndpointDef query -> query
forall query. EndpointDef query -> query
_edQuery

$(deriveJSON (aesonDrop 3 snakeCase) ''EndpointDef)
$(makeLenses ''EndpointDef)

type EndpointTrie query = MultiMapPathTrie Text EndpointMethod (EndpointMetadata query)

buildEndpointsTrie :: (Ord query) => [EndpointMetadata query] -> EndpointTrie query
buildEndpointsTrie :: forall query.
Ord query =>
[EndpointMetadata query] -> EndpointTrie query
buildEndpointsTrie = (EndpointTrie query
 -> EndpointMetadata query -> EndpointTrie query)
-> EndpointTrie query
-> [EndpointMetadata query]
-> EndpointTrie query
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' EndpointTrie query -> EndpointMetadata query -> EndpointTrie query
forall {query}.
Ord query =>
Trie
  (PathComponent Text)
  (MultiMap EndpointMethod (EndpointMetadata query))
-> EndpointMetadata query
-> Trie
     (PathComponent Text)
     (MultiMap EndpointMethod (EndpointMetadata query))
insert EndpointTrie query
forall a. Monoid a => a
mempty
  where
    insert :: Trie
  (PathComponent Text)
  (MultiMap EndpointMethod (EndpointMetadata query))
-> EndpointMetadata query
-> Trie
     (PathComponent Text)
     (MultiMap EndpointMethod (EndpointMetadata query))
insert Trie
  (PathComponent Text)
  (MultiMap EndpointMethod (EndpointMetadata query))
t EndpointMetadata query
q =
      let endpointMap :: MultiMap EndpointMethod (EndpointMetadata query)
endpointMap = (EndpointMethod
 -> MultiMap EndpointMethod (EndpointMetadata query))
-> NonEmpty EndpointMethod
-> MultiMap EndpointMethod (EndpointMetadata query)
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (EndpointMethod
-> EndpointMetadata query
-> MultiMap EndpointMethod (EndpointMetadata query)
forall k v. Hashable k => k -> v -> MultiMap k v
`MM.singleton` EndpointMetadata query
q) (NonEmpty EndpointMethod
 -> MultiMap EndpointMethod (EndpointMetadata query))
-> NonEmpty EndpointMethod
-> MultiMap EndpointMethod (EndpointMetadata query)
forall a b. (a -> b) -> a -> b
$ EndpointMetadata query -> NonEmpty EndpointMethod
forall query. EndpointMetadata query -> NonEmpty EndpointMethod
_ceMethods EndpointMetadata query
q
       in (MultiMap EndpointMethod (EndpointMetadata query)
 -> MultiMap EndpointMethod (EndpointMetadata query)
 -> MultiMap EndpointMethod (EndpointMetadata query))
-> [PathComponent Text]
-> MultiMap EndpointMethod (EndpointMetadata query)
-> Trie
     (PathComponent Text)
     (MultiMap EndpointMethod (EndpointMetadata query))
-> Trie
     (PathComponent Text)
     (MultiMap EndpointMethod (EndpointMetadata query))
forall k v.
Hashable k =>
(v -> v -> v) -> [k] -> v -> Trie k v -> Trie k v
T.insertWith MultiMap EndpointMethod (EndpointMetadata query)
-> MultiMap EndpointMethod (EndpointMetadata query)
-> MultiMap EndpointMethod (EndpointMetadata query)
forall a. Semigroup a => a -> a -> a
(<>) ((Text -> PathComponent Text)
-> (Text -> PathComponent Text)
-> EndpointUrl
-> [PathComponent Text]
forall a. (Text -> a) -> (Text -> a) -> EndpointUrl -> [a]
splitPath (PathComponent Text -> Text -> PathComponent Text
forall a b. a -> b -> a
const PathComponent Text
forall a. PathComponent a
PathParam) Text -> PathComponent Text
forall a. a -> PathComponent a
PathLiteral (EndpointMetadata query -> EndpointUrl
forall query. EndpointMetadata query -> EndpointUrl
_ceUrl EndpointMetadata query
q)) MultiMap EndpointMethod (EndpointMetadata query)
endpointMap Trie
  (PathComponent Text)
  (MultiMap EndpointMethod (EndpointMetadata query))
t

-- | Split a path and construct PathSegments based on callbacks for variables and literals
--   Var callback is passed the ":" prefix as part of the text.
splitPath :: (T.Text -> a) -> (T.Text -> a) -> EndpointUrl -> [a]
splitPath :: forall a. (Text -> a) -> (Text -> a) -> EndpointUrl -> [a]
splitPath Text -> a
var Text -> a
lit = (Text -> a) -> [Text] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> a
toPathComponent ([Text] -> [a]) -> (EndpointUrl -> [Text]) -> EndpointUrl -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (Text -> [Text]) -> (EndpointUrl -> Text) -> EndpointUrl -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndpointUrl -> Text
forall a. ToTxt a => a -> Text
toTxt
  where
    toPathComponent :: Text -> a
toPathComponent Text
x
      | Text
":" Text -> Text -> Bool
`T.isPrefixOf` Text
x = Text -> a
var Text
x
      | Bool
otherwise = Text -> a
lit Text
x

type CreateEndpoint = EndpointMetadata QueryReference

data EndpointMetadata query = EndpointMetadata
  { forall query. EndpointMetadata query -> EndpointName
_ceName :: EndpointName,
    forall query. EndpointMetadata query -> EndpointUrl
_ceUrl :: EndpointUrl,
    forall query. EndpointMetadata query -> NonEmpty EndpointMethod
_ceMethods :: NonEmpty EndpointMethod, -- TODO: Use a set for this?
    forall query. EndpointMetadata query -> EndpointDef query
_ceDefinition :: EndpointDef query,
    forall query. EndpointMetadata query -> Maybe Text
_ceComment :: Maybe Text
  }
  deriving (Int -> EndpointMetadata query -> ShowS
[EndpointMetadata query] -> ShowS
EndpointMetadata query -> String
(Int -> EndpointMetadata query -> ShowS)
-> (EndpointMetadata query -> String)
-> ([EndpointMetadata query] -> ShowS)
-> Show (EndpointMetadata query)
forall query. Show query => Int -> EndpointMetadata query -> ShowS
forall query. Show query => [EndpointMetadata query] -> ShowS
forall query. Show query => EndpointMetadata query -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall query. Show query => Int -> EndpointMetadata query -> ShowS
showsPrec :: Int -> EndpointMetadata query -> ShowS
$cshow :: forall query. Show query => EndpointMetadata query -> String
show :: EndpointMetadata query -> String
$cshowList :: forall query. Show query => [EndpointMetadata query] -> ShowS
showList :: [EndpointMetadata query] -> ShowS
Show, EndpointMetadata query -> EndpointMetadata query -> Bool
(EndpointMetadata query -> EndpointMetadata query -> Bool)
-> (EndpointMetadata query -> EndpointMetadata query -> Bool)
-> Eq (EndpointMetadata query)
forall query.
Eq query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall query.
Eq query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
== :: EndpointMetadata query -> EndpointMetadata query -> Bool
$c/= :: forall query.
Eq query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
/= :: EndpointMetadata query -> EndpointMetadata query -> Bool
Eq, Eq (EndpointMetadata query)
Eq (EndpointMetadata query)
-> (EndpointMetadata query -> EndpointMetadata query -> Ordering)
-> (EndpointMetadata query -> EndpointMetadata query -> Bool)
-> (EndpointMetadata query -> EndpointMetadata query -> Bool)
-> (EndpointMetadata query -> EndpointMetadata query -> Bool)
-> (EndpointMetadata query -> EndpointMetadata query -> Bool)
-> (EndpointMetadata query
    -> EndpointMetadata query -> EndpointMetadata query)
-> (EndpointMetadata query
    -> EndpointMetadata query -> EndpointMetadata query)
-> Ord (EndpointMetadata query)
EndpointMetadata query -> EndpointMetadata query -> Bool
EndpointMetadata query -> EndpointMetadata query -> Ordering
EndpointMetadata query
-> EndpointMetadata query -> EndpointMetadata query
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
forall {query}. Ord query => Eq (EndpointMetadata query)
forall query.
Ord query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
forall query.
Ord query =>
EndpointMetadata query -> EndpointMetadata query -> Ordering
forall query.
Ord query =>
EndpointMetadata query
-> EndpointMetadata query -> EndpointMetadata query
$ccompare :: forall query.
Ord query =>
EndpointMetadata query -> EndpointMetadata query -> Ordering
compare :: EndpointMetadata query -> EndpointMetadata query -> Ordering
$c< :: forall query.
Ord query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
< :: EndpointMetadata query -> EndpointMetadata query -> Bool
$c<= :: forall query.
Ord query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
<= :: EndpointMetadata query -> EndpointMetadata query -> Bool
$c> :: forall query.
Ord query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
> :: EndpointMetadata query -> EndpointMetadata query -> Bool
$c>= :: forall query.
Ord query =>
EndpointMetadata query -> EndpointMetadata query -> Bool
>= :: EndpointMetadata query -> EndpointMetadata query -> Bool
$cmax :: forall query.
Ord query =>
EndpointMetadata query
-> EndpointMetadata query -> EndpointMetadata query
max :: EndpointMetadata query
-> EndpointMetadata query -> EndpointMetadata query
$cmin :: forall query.
Ord query =>
EndpointMetadata query
-> EndpointMetadata query -> EndpointMetadata query
min :: EndpointMetadata query
-> EndpointMetadata query -> EndpointMetadata query
Ord, (forall x.
 EndpointMetadata query -> Rep (EndpointMetadata query) x)
-> (forall x.
    Rep (EndpointMetadata query) x -> EndpointMetadata query)
-> Generic (EndpointMetadata query)
forall x. Rep (EndpointMetadata query) x -> EndpointMetadata query
forall x. EndpointMetadata query -> Rep (EndpointMetadata query) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall query x.
Rep (EndpointMetadata query) x -> EndpointMetadata query
forall query x.
EndpointMetadata query -> Rep (EndpointMetadata query) x
$cfrom :: forall query x.
EndpointMetadata query -> Rep (EndpointMetadata query) x
from :: forall x. EndpointMetadata query -> Rep (EndpointMetadata query) x
$cto :: forall query x.
Rep (EndpointMetadata query) x -> EndpointMetadata query
to :: forall x. Rep (EndpointMetadata query) x -> EndpointMetadata query
Generic, (forall a b. (a -> b) -> EndpointMetadata a -> EndpointMetadata b)
-> (forall a b. a -> EndpointMetadata b -> EndpointMetadata a)
-> Functor EndpointMetadata
forall a b. a -> EndpointMetadata b -> EndpointMetadata a
forall a b. (a -> b) -> EndpointMetadata a -> EndpointMetadata b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> EndpointMetadata a -> EndpointMetadata b
fmap :: forall a b. (a -> b) -> EndpointMetadata a -> EndpointMetadata b
$c<$ :: forall a b. a -> EndpointMetadata b -> EndpointMetadata a
<$ :: forall a b. a -> EndpointMetadata b -> EndpointMetadata a
Functor, (forall m. Monoid m => EndpointMetadata m -> m)
-> (forall m a. Monoid m => (a -> m) -> EndpointMetadata a -> m)
-> (forall m a. Monoid m => (a -> m) -> EndpointMetadata a -> m)
-> (forall a b. (a -> b -> b) -> b -> EndpointMetadata a -> b)
-> (forall a b. (a -> b -> b) -> b -> EndpointMetadata a -> b)
-> (forall b a. (b -> a -> b) -> b -> EndpointMetadata a -> b)
-> (forall b a. (b -> a -> b) -> b -> EndpointMetadata a -> b)
-> (forall a. (a -> a -> a) -> EndpointMetadata a -> a)
-> (forall a. (a -> a -> a) -> EndpointMetadata a -> a)
-> (forall a. EndpointMetadata a -> [a])
-> (forall a. EndpointMetadata a -> Bool)
-> (forall a. EndpointMetadata a -> Int)
-> (forall a. Eq a => a -> EndpointMetadata a -> Bool)
-> (forall a. Ord a => EndpointMetadata a -> a)
-> (forall a. Ord a => EndpointMetadata a -> a)
-> (forall a. Num a => EndpointMetadata a -> a)
-> (forall a. Num a => EndpointMetadata a -> a)
-> Foldable EndpointMetadata
forall a. Eq a => a -> EndpointMetadata a -> Bool
forall a. Num a => EndpointMetadata a -> a
forall a. Ord a => EndpointMetadata a -> a
forall m. Monoid m => EndpointMetadata m -> m
forall a. EndpointMetadata a -> Bool
forall a. EndpointMetadata a -> Int
forall a. EndpointMetadata a -> [a]
forall a. (a -> a -> a) -> EndpointMetadata a -> a
forall m a. Monoid m => (a -> m) -> EndpointMetadata a -> m
forall b a. (b -> a -> b) -> b -> EndpointMetadata a -> b
forall a b. (a -> b -> b) -> b -> EndpointMetadata a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => EndpointMetadata m -> m
fold :: forall m. Monoid m => EndpointMetadata m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> EndpointMetadata a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> EndpointMetadata a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> EndpointMetadata a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> EndpointMetadata a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> EndpointMetadata a -> b
foldr :: forall a b. (a -> b -> b) -> b -> EndpointMetadata a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> EndpointMetadata a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> EndpointMetadata a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> EndpointMetadata a -> b
foldl :: forall b a. (b -> a -> b) -> b -> EndpointMetadata a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> EndpointMetadata a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> EndpointMetadata a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> EndpointMetadata a -> a
foldr1 :: forall a. (a -> a -> a) -> EndpointMetadata a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> EndpointMetadata a -> a
foldl1 :: forall a. (a -> a -> a) -> EndpointMetadata a -> a
$ctoList :: forall a. EndpointMetadata a -> [a]
toList :: forall a. EndpointMetadata a -> [a]
$cnull :: forall a. EndpointMetadata a -> Bool
null :: forall a. EndpointMetadata a -> Bool
$clength :: forall a. EndpointMetadata a -> Int
length :: forall a. EndpointMetadata a -> Int
$celem :: forall a. Eq a => a -> EndpointMetadata a -> Bool
elem :: forall a. Eq a => a -> EndpointMetadata a -> Bool
$cmaximum :: forall a. Ord a => EndpointMetadata a -> a
maximum :: forall a. Ord a => EndpointMetadata a -> a
$cminimum :: forall a. Ord a => EndpointMetadata a -> a
minimum :: forall a. Ord a => EndpointMetadata a -> a
$csum :: forall a. Num a => EndpointMetadata a -> a
sum :: forall a. Num a => EndpointMetadata a -> a
$cproduct :: forall a. Num a => EndpointMetadata a -> a
product :: forall a. Num a => EndpointMetadata a -> a
Foldable, Functor EndpointMetadata
Foldable EndpointMetadata
Functor EndpointMetadata
-> Foldable EndpointMetadata
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> EndpointMetadata a -> f (EndpointMetadata b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    EndpointMetadata (f a) -> f (EndpointMetadata a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> EndpointMetadata a -> m (EndpointMetadata b))
-> (forall (m :: * -> *) a.
    Monad m =>
    EndpointMetadata (m a) -> m (EndpointMetadata a))
-> Traversable EndpointMetadata
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
EndpointMetadata (m a) -> m (EndpointMetadata a)
forall (f :: * -> *) a.
Applicative f =>
EndpointMetadata (f a) -> f (EndpointMetadata a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndpointMetadata a -> m (EndpointMetadata b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndpointMetadata a -> f (EndpointMetadata b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndpointMetadata a -> f (EndpointMetadata b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndpointMetadata a -> f (EndpointMetadata b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
EndpointMetadata (f a) -> f (EndpointMetadata a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
EndpointMetadata (f a) -> f (EndpointMetadata a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndpointMetadata a -> m (EndpointMetadata b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndpointMetadata a -> m (EndpointMetadata b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
EndpointMetadata (m a) -> m (EndpointMetadata a)
sequence :: forall (m :: * -> *) a.
Monad m =>
EndpointMetadata (m a) -> m (EndpointMetadata a)
Traversable)

instance (HasCodec query, Typeable query) => HasCodec (EndpointMetadata query) where
  codec :: JSONCodec (EndpointMetadata query)
codec =
    Text
-> ObjectCodec (EndpointMetadata query) (EndpointMetadata query)
-> JSONCodec (EndpointMetadata query)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"EndpointMetadata_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @query)
      (ObjectCodec (EndpointMetadata query) (EndpointMetadata query)
 -> JSONCodec (EndpointMetadata query))
-> ObjectCodec (EndpointMetadata query) (EndpointMetadata query)
-> JSONCodec (EndpointMetadata query)
forall a b. (a -> b) -> a -> b
$ EndpointName
-> EndpointUrl
-> NonEmpty EndpointMethod
-> EndpointDef query
-> Maybe Text
-> EndpointMetadata query
forall query.
EndpointName
-> EndpointUrl
-> NonEmpty EndpointMethod
-> EndpointDef query
-> Maybe Text
-> EndpointMetadata query
EndpointMetadata
      (EndpointName
 -> EndpointUrl
 -> NonEmpty EndpointMethod
 -> EndpointDef query
 -> Maybe Text
 -> EndpointMetadata query)
-> Codec Object (EndpointMetadata query) EndpointName
-> Codec
     Object
     (EndpointMetadata query)
     (EndpointUrl
      -> NonEmpty EndpointMethod
      -> EndpointDef query
      -> Maybe Text
      -> EndpointMetadata query)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec EndpointName EndpointName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec EndpointName EndpointName
-> (EndpointMetadata query -> EndpointName)
-> Codec Object (EndpointMetadata query) EndpointName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EndpointMetadata query -> EndpointName
forall query. EndpointMetadata query -> EndpointName
_ceName
        Codec
  Object
  (EndpointMetadata query)
  (EndpointUrl
   -> NonEmpty EndpointMethod
   -> EndpointDef query
   -> Maybe Text
   -> EndpointMetadata query)
-> Codec Object (EndpointMetadata query) EndpointUrl
-> Codec
     Object
     (EndpointMetadata query)
     (NonEmpty EndpointMethod
      -> EndpointDef query -> Maybe Text -> EndpointMetadata query)
forall a b.
Codec Object (EndpointMetadata query) (a -> b)
-> Codec Object (EndpointMetadata query) a
-> Codec Object (EndpointMetadata query) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec EndpointUrl EndpointUrl
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"url"
      ObjectCodec EndpointUrl EndpointUrl
-> (EndpointMetadata query -> EndpointUrl)
-> Codec Object (EndpointMetadata query) EndpointUrl
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EndpointMetadata query -> EndpointUrl
forall query. EndpointMetadata query -> EndpointUrl
_ceUrl
        Codec
  Object
  (EndpointMetadata query)
  (NonEmpty EndpointMethod
   -> EndpointDef query -> Maybe Text -> EndpointMetadata query)
-> Codec Object (EndpointMetadata query) (NonEmpty EndpointMethod)
-> Codec
     Object
     (EndpointMetadata query)
     (EndpointDef query -> Maybe Text -> EndpointMetadata query)
forall a b.
Codec Object (EndpointMetadata query) (a -> b)
-> Codec Object (EndpointMetadata query) a
-> Codec Object (EndpointMetadata query) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec (NonEmpty EndpointMethod) (NonEmpty EndpointMethod)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"methods"
      ObjectCodec (NonEmpty EndpointMethod) (NonEmpty EndpointMethod)
-> (EndpointMetadata query -> NonEmpty EndpointMethod)
-> Codec Object (EndpointMetadata query) (NonEmpty EndpointMethod)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EndpointMetadata query -> NonEmpty EndpointMethod
forall query. EndpointMetadata query -> NonEmpty EndpointMethod
_ceMethods
        Codec
  Object
  (EndpointMetadata query)
  (EndpointDef query -> Maybe Text -> EndpointMetadata query)
-> Codec Object (EndpointMetadata query) (EndpointDef query)
-> Codec
     Object
     (EndpointMetadata query)
     (Maybe Text -> EndpointMetadata query)
forall a b.
Codec Object (EndpointMetadata query) (a -> b)
-> Codec Object (EndpointMetadata query) a
-> Codec Object (EndpointMetadata query) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (EndpointDef query) (EndpointDef query)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"definition"
      ObjectCodec (EndpointDef query) (EndpointDef query)
-> (EndpointMetadata query -> EndpointDef query)
-> Codec Object (EndpointMetadata query) (EndpointDef query)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EndpointMetadata query -> EndpointDef query
forall query. EndpointMetadata query -> EndpointDef query
_ceDefinition
        Codec
  Object
  (EndpointMetadata query)
  (Maybe Text -> EndpointMetadata query)
-> Codec Object (EndpointMetadata query) (Maybe Text)
-> ObjectCodec (EndpointMetadata query) (EndpointMetadata query)
forall a b.
Codec Object (EndpointMetadata query) (a -> b)
-> Codec Object (EndpointMetadata query) a
-> Codec Object (EndpointMetadata query) 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)
-> (EndpointMetadata query -> Maybe Text)
-> Codec Object (EndpointMetadata query) (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EndpointMetadata query -> Maybe Text
forall query. EndpointMetadata query -> Maybe Text
_ceComment

$(deriveJSON (aesonDrop 3 snakeCase) ''EndpointMetadata)
$(makeLenses ''EndpointMetadata)

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

$(deriveJSON (aesonDrop 3 snakeCase) ''DropEndpoint)
$(makeLenses ''DropEndpoint)