module Mensam.API.Route.Api.Reservation where

import Mensam.API.Aeson
import Mensam.API.Aeson.StaticText
import Mensam.API.Data.Desk
import Mensam.API.Data.Reservation
import Mensam.API.Data.Space
import Mensam.API.Data.Space.Permission
import Mensam.API.Data.User

import Data.Aeson qualified as A
import Data.Kind
import Data.Time qualified as T
import Deriving.Aeson qualified as A
import GHC.Generics
import Servant.API hiding (BasicAuth)
import Servant.Auth
import Servant.Auth.JWT.WithSession

type Routes :: Type -> Type
data Routes route = Routes
  { forall route.
Routes route
-> route
   :- (Summary "Create Reservation"
       :> (Description
             "Request a desk reservation.\nA desk can only be reserved by one user at any time.\n"
           :> ("create"
               :> (Auth '[JWTWithSession] UserAuthenticated
                   :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationCreate
                       :> UVerb
                            'PUT
                            '[JSON]
                            '[WithStatus 201 ResponseReservationCreate,
                              WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                              WithStatus
                                403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
                              WithStatus
                                409
                                (StaticText "Desk is not available within the given time window."),
                              WithStatus 500 ()])))))
routeReservationCreate ::
      route
        :- Summary "Create Reservation"
          :> Description
              "Request a desk reservation.\n\
              \A desk can only be reserved by one user at any time.\n"
          :> "create"
          :> Auth '[JWTWithSession] UserAuthenticated
          :> ReqBody' '[Lenient, Required] '[JSON] RequestReservationCreate
          :> UVerb
              PUT
              '[JSON]
              [ WithStatus 201 ResponseReservationCreate
              , WithStatus 400 ErrorParseBodyJson
              , WithStatus 401 ErrorBearerAuth
              , WithStatus 403 (ErrorInsufficientPermission MkPermissionCreateReservation)
              , WithStatus 409 (StaticText "Desk is not available within the given time window.")
              , WithStatus 500 ()
              ]
  , forall route.
Routes route
-> route
   :- (Summary "Cancel Reservation"
       :> (Description "Cancel a desk reservation.\n"
           :> ("cancel"
               :> (Auth '[JWTWithSession] UserAuthenticated
                   :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationCancel
                       :> UVerb
                            'POST
                            '[JSON]
                            '[WithStatus 200 ResponseReservationCancel,
                              WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                              WithStatus
                                403 (ErrorInsufficientPermission 'MkPermissionCancelReservation),
                              WithStatus 409 (StaticText "Already cancelled."),
                              WithStatus 410 (StaticText "Already happened."),
                              WithStatus 500 ()])))))
routeReservationCancel ::
      route
        :- Summary "Cancel Reservation"
          :> Description
              "Cancel a desk reservation.\n"
          :> "cancel"
          :> Auth '[JWTWithSession] UserAuthenticated
          :> ReqBody' '[Lenient, Required] '[JSON] RequestReservationCancel
          :> UVerb
              POST
              '[JSON]
              [ WithStatus 200 ResponseReservationCancel
              , WithStatus 400 ErrorParseBodyJson
              , WithStatus 401 ErrorBearerAuth
              , WithStatus 403 (ErrorInsufficientPermission MkPermissionCancelReservation)
              , WithStatus 409 (StaticText "Already cancelled.")
              , WithStatus 410 (StaticText "Already happened.")
              , WithStatus 500 ()
              ]
  , forall route.
Routes route
-> route
   :- (Summary "List Reservations"
       :> (Description
             "View all of your desk reservations.\nUse the time-window to restrict the result to overlapping reservations.\n"
           :> ("list"
               :> (Auth '[JWTWithSession] UserAuthenticated
                   :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationList
                       :> UVerb
                            'POST
                            '[JSON]
                            '[WithStatus 200 ResponseReservationList,
                              WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                              WithStatus 500 ()])))))
routeReservationList ::
      route
        :- Summary "List Reservations"
          :> Description
              "View all of your desk reservations.\n\
              \Use the time-window to restrict the result to overlapping reservations.\n"
          :> "list"
          :> Auth '[JWTWithSession] UserAuthenticated
          :> ReqBody' '[Lenient, Required] '[JSON] RequestReservationList
          :> UVerb
              POST
              '[JSON]
              [ WithStatus 200 ResponseReservationList
              , WithStatus 400 ErrorParseBodyJson
              , WithStatus 401 ErrorBearerAuth
              , WithStatus 500 ()
              ]
  }
  deriving stock ((forall x. Routes route -> Rep (Routes route) x)
-> (forall x. Rep (Routes route) x -> Routes route)
-> Generic (Routes route)
forall x. Rep (Routes route) x -> Routes route
forall x. Routes route -> Rep (Routes route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x. Rep (Routes route) x -> Routes route
forall route x. Routes route -> Rep (Routes route) x
$cfrom :: forall route x. Routes route -> Rep (Routes route) x
from :: forall x. Routes route -> Rep (Routes route) x
$cto :: forall route x. Rep (Routes route) x -> Routes route
to :: forall x. Rep (Routes route) x -> Routes route
Generic)

type RequestReservationCreate :: Type
data RequestReservationCreate = MkRequestReservationCreate
  { RequestReservationCreate
-> NameOrIdentifier DeskNameWithContext IdentifierDesk
requestReservationCreateDesk :: NameOrIdentifier DeskNameWithContext IdentifierDesk
  , RequestReservationCreate -> IntervalNonDegenerate UTCTime
requestReservationCreateTimeWindow :: IntervalNonDegenerate T.UTCTime
  }
  deriving stock (RequestReservationCreate -> RequestReservationCreate -> Bool
(RequestReservationCreate -> RequestReservationCreate -> Bool)
-> (RequestReservationCreate -> RequestReservationCreate -> Bool)
-> Eq RequestReservationCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestReservationCreate -> RequestReservationCreate -> Bool
== :: RequestReservationCreate -> RequestReservationCreate -> Bool
$c/= :: RequestReservationCreate -> RequestReservationCreate -> Bool
/= :: RequestReservationCreate -> RequestReservationCreate -> Bool
Eq, (forall x.
 RequestReservationCreate -> Rep RequestReservationCreate x)
-> (forall x.
    Rep RequestReservationCreate x -> RequestReservationCreate)
-> Generic RequestReservationCreate
forall x.
Rep RequestReservationCreate x -> RequestReservationCreate
forall x.
RequestReservationCreate -> Rep RequestReservationCreate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RequestReservationCreate -> Rep RequestReservationCreate x
from :: forall x.
RequestReservationCreate -> Rep RequestReservationCreate x
$cto :: forall x.
Rep RequestReservationCreate x -> RequestReservationCreate
to :: forall x.
Rep RequestReservationCreate x -> RequestReservationCreate
Generic, Eq RequestReservationCreate
Eq RequestReservationCreate =>
(RequestReservationCreate -> RequestReservationCreate -> Ordering)
-> (RequestReservationCreate -> RequestReservationCreate -> Bool)
-> (RequestReservationCreate -> RequestReservationCreate -> Bool)
-> (RequestReservationCreate -> RequestReservationCreate -> Bool)
-> (RequestReservationCreate -> RequestReservationCreate -> Bool)
-> (RequestReservationCreate
    -> RequestReservationCreate -> RequestReservationCreate)
-> (RequestReservationCreate
    -> RequestReservationCreate -> RequestReservationCreate)
-> Ord RequestReservationCreate
RequestReservationCreate -> RequestReservationCreate -> Bool
RequestReservationCreate -> RequestReservationCreate -> Ordering
RequestReservationCreate
-> RequestReservationCreate -> RequestReservationCreate
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 :: RequestReservationCreate -> RequestReservationCreate -> Ordering
compare :: RequestReservationCreate -> RequestReservationCreate -> Ordering
$c< :: RequestReservationCreate -> RequestReservationCreate -> Bool
< :: RequestReservationCreate -> RequestReservationCreate -> Bool
$c<= :: RequestReservationCreate -> RequestReservationCreate -> Bool
<= :: RequestReservationCreate -> RequestReservationCreate -> Bool
$c> :: RequestReservationCreate -> RequestReservationCreate -> Bool
> :: RequestReservationCreate -> RequestReservationCreate -> Bool
$c>= :: RequestReservationCreate -> RequestReservationCreate -> Bool
>= :: RequestReservationCreate -> RequestReservationCreate -> Bool
$cmax :: RequestReservationCreate
-> RequestReservationCreate -> RequestReservationCreate
max :: RequestReservationCreate
-> RequestReservationCreate -> RequestReservationCreate
$cmin :: RequestReservationCreate
-> RequestReservationCreate -> RequestReservationCreate
min :: RequestReservationCreate
-> RequestReservationCreate -> RequestReservationCreate
Ord, ReadPrec [RequestReservationCreate]
ReadPrec RequestReservationCreate
Int -> ReadS RequestReservationCreate
ReadS [RequestReservationCreate]
(Int -> ReadS RequestReservationCreate)
-> ReadS [RequestReservationCreate]
-> ReadPrec RequestReservationCreate
-> ReadPrec [RequestReservationCreate]
-> Read RequestReservationCreate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RequestReservationCreate
readsPrec :: Int -> ReadS RequestReservationCreate
$creadList :: ReadS [RequestReservationCreate]
readList :: ReadS [RequestReservationCreate]
$creadPrec :: ReadPrec RequestReservationCreate
readPrec :: ReadPrec RequestReservationCreate
$creadListPrec :: ReadPrec [RequestReservationCreate]
readListPrec :: ReadPrec [RequestReservationCreate]
Read, Int -> RequestReservationCreate -> ShowS
[RequestReservationCreate] -> ShowS
RequestReservationCreate -> String
(Int -> RequestReservationCreate -> ShowS)
-> (RequestReservationCreate -> String)
-> ([RequestReservationCreate] -> ShowS)
-> Show RequestReservationCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestReservationCreate -> ShowS
showsPrec :: Int -> RequestReservationCreate -> ShowS
$cshow :: RequestReservationCreate -> String
show :: RequestReservationCreate -> String
$cshowList :: [RequestReservationCreate] -> ShowS
showList :: [RequestReservationCreate] -> ShowS
Show)
  deriving
    (Value -> Parser [RequestReservationCreate]
Value -> Parser RequestReservationCreate
(Value -> Parser RequestReservationCreate)
-> (Value -> Parser [RequestReservationCreate])
-> FromJSON RequestReservationCreate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RequestReservationCreate
parseJSON :: Value -> Parser RequestReservationCreate
$cparseJSONList :: Value -> Parser [RequestReservationCreate]
parseJSONList :: Value -> Parser [RequestReservationCreate]
A.FromJSON, [RequestReservationCreate] -> Value
[RequestReservationCreate] -> Encoding
RequestReservationCreate -> Value
RequestReservationCreate -> Encoding
(RequestReservationCreate -> Value)
-> (RequestReservationCreate -> Encoding)
-> ([RequestReservationCreate] -> Value)
-> ([RequestReservationCreate] -> Encoding)
-> ToJSON RequestReservationCreate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RequestReservationCreate -> Value
toJSON :: RequestReservationCreate -> Value
$ctoEncoding :: RequestReservationCreate -> Encoding
toEncoding :: RequestReservationCreate -> Encoding
$ctoJSONList :: [RequestReservationCreate] -> Value
toJSONList :: [RequestReservationCreate] -> Value
$ctoEncodingList :: [RequestReservationCreate] -> Encoding
toEncodingList :: [RequestReservationCreate] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkRequest" "requestReservationCreate") RequestReservationCreate

type ResponseReservationCreate :: Type
data ResponseReservationCreate = MkResponseReservationCreate
  { ResponseReservationCreate -> IdentifierReservation
responseReservationCreateId :: IdentifierReservation
  , ResponseReservationCreate -> Maybe Bool
responseReservationCreateEmailSent :: Maybe Bool
  }
  deriving stock (ResponseReservationCreate -> ResponseReservationCreate -> Bool
(ResponseReservationCreate -> ResponseReservationCreate -> Bool)
-> (ResponseReservationCreate -> ResponseReservationCreate -> Bool)
-> Eq ResponseReservationCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
== :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
$c/= :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
/= :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
Eq, (forall x.
 ResponseReservationCreate -> Rep ResponseReservationCreate x)
-> (forall x.
    Rep ResponseReservationCreate x -> ResponseReservationCreate)
-> Generic ResponseReservationCreate
forall x.
Rep ResponseReservationCreate x -> ResponseReservationCreate
forall x.
ResponseReservationCreate -> Rep ResponseReservationCreate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ResponseReservationCreate -> Rep ResponseReservationCreate x
from :: forall x.
ResponseReservationCreate -> Rep ResponseReservationCreate x
$cto :: forall x.
Rep ResponseReservationCreate x -> ResponseReservationCreate
to :: forall x.
Rep ResponseReservationCreate x -> ResponseReservationCreate
Generic, Eq ResponseReservationCreate
Eq ResponseReservationCreate =>
(ResponseReservationCreate
 -> ResponseReservationCreate -> Ordering)
-> (ResponseReservationCreate -> ResponseReservationCreate -> Bool)
-> (ResponseReservationCreate -> ResponseReservationCreate -> Bool)
-> (ResponseReservationCreate -> ResponseReservationCreate -> Bool)
-> (ResponseReservationCreate -> ResponseReservationCreate -> Bool)
-> (ResponseReservationCreate
    -> ResponseReservationCreate -> ResponseReservationCreate)
-> (ResponseReservationCreate
    -> ResponseReservationCreate -> ResponseReservationCreate)
-> Ord ResponseReservationCreate
ResponseReservationCreate -> ResponseReservationCreate -> Bool
ResponseReservationCreate -> ResponseReservationCreate -> Ordering
ResponseReservationCreate
-> ResponseReservationCreate -> ResponseReservationCreate
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 :: ResponseReservationCreate -> ResponseReservationCreate -> Ordering
compare :: ResponseReservationCreate -> ResponseReservationCreate -> Ordering
$c< :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
< :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
$c<= :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
<= :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
$c> :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
> :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
$c>= :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
>= :: ResponseReservationCreate -> ResponseReservationCreate -> Bool
$cmax :: ResponseReservationCreate
-> ResponseReservationCreate -> ResponseReservationCreate
max :: ResponseReservationCreate
-> ResponseReservationCreate -> ResponseReservationCreate
$cmin :: ResponseReservationCreate
-> ResponseReservationCreate -> ResponseReservationCreate
min :: ResponseReservationCreate
-> ResponseReservationCreate -> ResponseReservationCreate
Ord, ReadPrec [ResponseReservationCreate]
ReadPrec ResponseReservationCreate
Int -> ReadS ResponseReservationCreate
ReadS [ResponseReservationCreate]
(Int -> ReadS ResponseReservationCreate)
-> ReadS [ResponseReservationCreate]
-> ReadPrec ResponseReservationCreate
-> ReadPrec [ResponseReservationCreate]
-> Read ResponseReservationCreate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ResponseReservationCreate
readsPrec :: Int -> ReadS ResponseReservationCreate
$creadList :: ReadS [ResponseReservationCreate]
readList :: ReadS [ResponseReservationCreate]
$creadPrec :: ReadPrec ResponseReservationCreate
readPrec :: ReadPrec ResponseReservationCreate
$creadListPrec :: ReadPrec [ResponseReservationCreate]
readListPrec :: ReadPrec [ResponseReservationCreate]
Read, Int -> ResponseReservationCreate -> ShowS
[ResponseReservationCreate] -> ShowS
ResponseReservationCreate -> String
(Int -> ResponseReservationCreate -> ShowS)
-> (ResponseReservationCreate -> String)
-> ([ResponseReservationCreate] -> ShowS)
-> Show ResponseReservationCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseReservationCreate -> ShowS
showsPrec :: Int -> ResponseReservationCreate -> ShowS
$cshow :: ResponseReservationCreate -> String
show :: ResponseReservationCreate -> String
$cshowList :: [ResponseReservationCreate] -> ShowS
showList :: [ResponseReservationCreate] -> ShowS
Show)
  deriving
    (Value -> Parser [ResponseReservationCreate]
Value -> Parser ResponseReservationCreate
(Value -> Parser ResponseReservationCreate)
-> (Value -> Parser [ResponseReservationCreate])
-> FromJSON ResponseReservationCreate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ResponseReservationCreate
parseJSON :: Value -> Parser ResponseReservationCreate
$cparseJSONList :: Value -> Parser [ResponseReservationCreate]
parseJSONList :: Value -> Parser [ResponseReservationCreate]
A.FromJSON, [ResponseReservationCreate] -> Value
[ResponseReservationCreate] -> Encoding
ResponseReservationCreate -> Value
ResponseReservationCreate -> Encoding
(ResponseReservationCreate -> Value)
-> (ResponseReservationCreate -> Encoding)
-> ([ResponseReservationCreate] -> Value)
-> ([ResponseReservationCreate] -> Encoding)
-> ToJSON ResponseReservationCreate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ResponseReservationCreate -> Value
toJSON :: ResponseReservationCreate -> Value
$ctoEncoding :: ResponseReservationCreate -> Encoding
toEncoding :: ResponseReservationCreate -> Encoding
$ctoJSONList :: [ResponseReservationCreate] -> Value
toJSONList :: [ResponseReservationCreate] -> Value
$ctoEncodingList :: [ResponseReservationCreate] -> Encoding
toEncodingList :: [ResponseReservationCreate] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkResponse" "responseReservationCreate") ResponseReservationCreate

type RequestReservationCancel :: Type
newtype RequestReservationCancel = MkRequestReservationCancel
  { RequestReservationCancel -> IdentifierReservation
requestReservationCancelId :: IdentifierReservation
  }
  deriving stock (RequestReservationCancel -> RequestReservationCancel -> Bool
(RequestReservationCancel -> RequestReservationCancel -> Bool)
-> (RequestReservationCancel -> RequestReservationCancel -> Bool)
-> Eq RequestReservationCancel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestReservationCancel -> RequestReservationCancel -> Bool
== :: RequestReservationCancel -> RequestReservationCancel -> Bool
$c/= :: RequestReservationCancel -> RequestReservationCancel -> Bool
/= :: RequestReservationCancel -> RequestReservationCancel -> Bool
Eq, (forall x.
 RequestReservationCancel -> Rep RequestReservationCancel x)
-> (forall x.
    Rep RequestReservationCancel x -> RequestReservationCancel)
-> Generic RequestReservationCancel
forall x.
Rep RequestReservationCancel x -> RequestReservationCancel
forall x.
RequestReservationCancel -> Rep RequestReservationCancel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RequestReservationCancel -> Rep RequestReservationCancel x
from :: forall x.
RequestReservationCancel -> Rep RequestReservationCancel x
$cto :: forall x.
Rep RequestReservationCancel x -> RequestReservationCancel
to :: forall x.
Rep RequestReservationCancel x -> RequestReservationCancel
Generic, Eq RequestReservationCancel
Eq RequestReservationCancel =>
(RequestReservationCancel -> RequestReservationCancel -> Ordering)
-> (RequestReservationCancel -> RequestReservationCancel -> Bool)
-> (RequestReservationCancel -> RequestReservationCancel -> Bool)
-> (RequestReservationCancel -> RequestReservationCancel -> Bool)
-> (RequestReservationCancel -> RequestReservationCancel -> Bool)
-> (RequestReservationCancel
    -> RequestReservationCancel -> RequestReservationCancel)
-> (RequestReservationCancel
    -> RequestReservationCancel -> RequestReservationCancel)
-> Ord RequestReservationCancel
RequestReservationCancel -> RequestReservationCancel -> Bool
RequestReservationCancel -> RequestReservationCancel -> Ordering
RequestReservationCancel
-> RequestReservationCancel -> RequestReservationCancel
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 :: RequestReservationCancel -> RequestReservationCancel -> Ordering
compare :: RequestReservationCancel -> RequestReservationCancel -> Ordering
$c< :: RequestReservationCancel -> RequestReservationCancel -> Bool
< :: RequestReservationCancel -> RequestReservationCancel -> Bool
$c<= :: RequestReservationCancel -> RequestReservationCancel -> Bool
<= :: RequestReservationCancel -> RequestReservationCancel -> Bool
$c> :: RequestReservationCancel -> RequestReservationCancel -> Bool
> :: RequestReservationCancel -> RequestReservationCancel -> Bool
$c>= :: RequestReservationCancel -> RequestReservationCancel -> Bool
>= :: RequestReservationCancel -> RequestReservationCancel -> Bool
$cmax :: RequestReservationCancel
-> RequestReservationCancel -> RequestReservationCancel
max :: RequestReservationCancel
-> RequestReservationCancel -> RequestReservationCancel
$cmin :: RequestReservationCancel
-> RequestReservationCancel -> RequestReservationCancel
min :: RequestReservationCancel
-> RequestReservationCancel -> RequestReservationCancel
Ord, ReadPrec [RequestReservationCancel]
ReadPrec RequestReservationCancel
Int -> ReadS RequestReservationCancel
ReadS [RequestReservationCancel]
(Int -> ReadS RequestReservationCancel)
-> ReadS [RequestReservationCancel]
-> ReadPrec RequestReservationCancel
-> ReadPrec [RequestReservationCancel]
-> Read RequestReservationCancel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RequestReservationCancel
readsPrec :: Int -> ReadS RequestReservationCancel
$creadList :: ReadS [RequestReservationCancel]
readList :: ReadS [RequestReservationCancel]
$creadPrec :: ReadPrec RequestReservationCancel
readPrec :: ReadPrec RequestReservationCancel
$creadListPrec :: ReadPrec [RequestReservationCancel]
readListPrec :: ReadPrec [RequestReservationCancel]
Read, Int -> RequestReservationCancel -> ShowS
[RequestReservationCancel] -> ShowS
RequestReservationCancel -> String
(Int -> RequestReservationCancel -> ShowS)
-> (RequestReservationCancel -> String)
-> ([RequestReservationCancel] -> ShowS)
-> Show RequestReservationCancel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestReservationCancel -> ShowS
showsPrec :: Int -> RequestReservationCancel -> ShowS
$cshow :: RequestReservationCancel -> String
show :: RequestReservationCancel -> String
$cshowList :: [RequestReservationCancel] -> ShowS
showList :: [RequestReservationCancel] -> ShowS
Show)
  deriving
    (Value -> Parser [RequestReservationCancel]
Value -> Parser RequestReservationCancel
(Value -> Parser RequestReservationCancel)
-> (Value -> Parser [RequestReservationCancel])
-> FromJSON RequestReservationCancel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RequestReservationCancel
parseJSON :: Value -> Parser RequestReservationCancel
$cparseJSONList :: Value -> Parser [RequestReservationCancel]
parseJSONList :: Value -> Parser [RequestReservationCancel]
A.FromJSON, [RequestReservationCancel] -> Value
[RequestReservationCancel] -> Encoding
RequestReservationCancel -> Value
RequestReservationCancel -> Encoding
(RequestReservationCancel -> Value)
-> (RequestReservationCancel -> Encoding)
-> ([RequestReservationCancel] -> Value)
-> ([RequestReservationCancel] -> Encoding)
-> ToJSON RequestReservationCancel
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RequestReservationCancel -> Value
toJSON :: RequestReservationCancel -> Value
$ctoEncoding :: RequestReservationCancel -> Encoding
toEncoding :: RequestReservationCancel -> Encoding
$ctoJSONList :: [RequestReservationCancel] -> Value
toJSONList :: [RequestReservationCancel] -> Value
$ctoEncodingList :: [RequestReservationCancel] -> Encoding
toEncodingList :: [RequestReservationCancel] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkRequest" "requestReservationCancel") RequestReservationCancel

type ResponseReservationCancel :: Type
newtype ResponseReservationCancel = MkResponseReservationCancel
  { ResponseReservationCancel -> ()
responseReservationCancelUnit :: ()
  }
  deriving stock (ResponseReservationCancel -> ResponseReservationCancel -> Bool
(ResponseReservationCancel -> ResponseReservationCancel -> Bool)
-> (ResponseReservationCancel -> ResponseReservationCancel -> Bool)
-> Eq ResponseReservationCancel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
== :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
$c/= :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
/= :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
Eq, (forall x.
 ResponseReservationCancel -> Rep ResponseReservationCancel x)
-> (forall x.
    Rep ResponseReservationCancel x -> ResponseReservationCancel)
-> Generic ResponseReservationCancel
forall x.
Rep ResponseReservationCancel x -> ResponseReservationCancel
forall x.
ResponseReservationCancel -> Rep ResponseReservationCancel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ResponseReservationCancel -> Rep ResponseReservationCancel x
from :: forall x.
ResponseReservationCancel -> Rep ResponseReservationCancel x
$cto :: forall x.
Rep ResponseReservationCancel x -> ResponseReservationCancel
to :: forall x.
Rep ResponseReservationCancel x -> ResponseReservationCancel
Generic, Eq ResponseReservationCancel
Eq ResponseReservationCancel =>
(ResponseReservationCancel
 -> ResponseReservationCancel -> Ordering)
-> (ResponseReservationCancel -> ResponseReservationCancel -> Bool)
-> (ResponseReservationCancel -> ResponseReservationCancel -> Bool)
-> (ResponseReservationCancel -> ResponseReservationCancel -> Bool)
-> (ResponseReservationCancel -> ResponseReservationCancel -> Bool)
-> (ResponseReservationCancel
    -> ResponseReservationCancel -> ResponseReservationCancel)
-> (ResponseReservationCancel
    -> ResponseReservationCancel -> ResponseReservationCancel)
-> Ord ResponseReservationCancel
ResponseReservationCancel -> ResponseReservationCancel -> Bool
ResponseReservationCancel -> ResponseReservationCancel -> Ordering
ResponseReservationCancel
-> ResponseReservationCancel -> ResponseReservationCancel
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 :: ResponseReservationCancel -> ResponseReservationCancel -> Ordering
compare :: ResponseReservationCancel -> ResponseReservationCancel -> Ordering
$c< :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
< :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
$c<= :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
<= :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
$c> :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
> :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
$c>= :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
>= :: ResponseReservationCancel -> ResponseReservationCancel -> Bool
$cmax :: ResponseReservationCancel
-> ResponseReservationCancel -> ResponseReservationCancel
max :: ResponseReservationCancel
-> ResponseReservationCancel -> ResponseReservationCancel
$cmin :: ResponseReservationCancel
-> ResponseReservationCancel -> ResponseReservationCancel
min :: ResponseReservationCancel
-> ResponseReservationCancel -> ResponseReservationCancel
Ord, ReadPrec [ResponseReservationCancel]
ReadPrec ResponseReservationCancel
Int -> ReadS ResponseReservationCancel
ReadS [ResponseReservationCancel]
(Int -> ReadS ResponseReservationCancel)
-> ReadS [ResponseReservationCancel]
-> ReadPrec ResponseReservationCancel
-> ReadPrec [ResponseReservationCancel]
-> Read ResponseReservationCancel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ResponseReservationCancel
readsPrec :: Int -> ReadS ResponseReservationCancel
$creadList :: ReadS [ResponseReservationCancel]
readList :: ReadS [ResponseReservationCancel]
$creadPrec :: ReadPrec ResponseReservationCancel
readPrec :: ReadPrec ResponseReservationCancel
$creadListPrec :: ReadPrec [ResponseReservationCancel]
readListPrec :: ReadPrec [ResponseReservationCancel]
Read, Int -> ResponseReservationCancel -> ShowS
[ResponseReservationCancel] -> ShowS
ResponseReservationCancel -> String
(Int -> ResponseReservationCancel -> ShowS)
-> (ResponseReservationCancel -> String)
-> ([ResponseReservationCancel] -> ShowS)
-> Show ResponseReservationCancel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseReservationCancel -> ShowS
showsPrec :: Int -> ResponseReservationCancel -> ShowS
$cshow :: ResponseReservationCancel -> String
show :: ResponseReservationCancel -> String
$cshowList :: [ResponseReservationCancel] -> ShowS
showList :: [ResponseReservationCancel] -> ShowS
Show)
  deriving
    (Value -> Parser [ResponseReservationCancel]
Value -> Parser ResponseReservationCancel
(Value -> Parser ResponseReservationCancel)
-> (Value -> Parser [ResponseReservationCancel])
-> FromJSON ResponseReservationCancel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ResponseReservationCancel
parseJSON :: Value -> Parser ResponseReservationCancel
$cparseJSONList :: Value -> Parser [ResponseReservationCancel]
parseJSONList :: Value -> Parser [ResponseReservationCancel]
A.FromJSON, [ResponseReservationCancel] -> Value
[ResponseReservationCancel] -> Encoding
ResponseReservationCancel -> Value
ResponseReservationCancel -> Encoding
(ResponseReservationCancel -> Value)
-> (ResponseReservationCancel -> Encoding)
-> ([ResponseReservationCancel] -> Value)
-> ([ResponseReservationCancel] -> Encoding)
-> ToJSON ResponseReservationCancel
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ResponseReservationCancel -> Value
toJSON :: ResponseReservationCancel -> Value
$ctoEncoding :: ResponseReservationCancel -> Encoding
toEncoding :: ResponseReservationCancel -> Encoding
$ctoJSONList :: [ResponseReservationCancel] -> Value
toJSONList :: [ResponseReservationCancel] -> Value
$ctoEncodingList :: [ResponseReservationCancel] -> Encoding
toEncodingList :: [ResponseReservationCancel] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkResponse" "responseReservationCancel") ResponseReservationCancel

type RequestReservationList :: Type
newtype RequestReservationList = MkRequestReservationList
  { RequestReservationList -> IntervalUnbounded UTCTime
requestReservationListTimeWindow :: IntervalUnbounded T.UTCTime
  }
  deriving stock (RequestReservationList -> RequestReservationList -> Bool
(RequestReservationList -> RequestReservationList -> Bool)
-> (RequestReservationList -> RequestReservationList -> Bool)
-> Eq RequestReservationList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestReservationList -> RequestReservationList -> Bool
== :: RequestReservationList -> RequestReservationList -> Bool
$c/= :: RequestReservationList -> RequestReservationList -> Bool
/= :: RequestReservationList -> RequestReservationList -> Bool
Eq, (forall x. RequestReservationList -> Rep RequestReservationList x)
-> (forall x.
    Rep RequestReservationList x -> RequestReservationList)
-> Generic RequestReservationList
forall x. Rep RequestReservationList x -> RequestReservationList
forall x. RequestReservationList -> Rep RequestReservationList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestReservationList -> Rep RequestReservationList x
from :: forall x. RequestReservationList -> Rep RequestReservationList x
$cto :: forall x. Rep RequestReservationList x -> RequestReservationList
to :: forall x. Rep RequestReservationList x -> RequestReservationList
Generic, Eq RequestReservationList
Eq RequestReservationList =>
(RequestReservationList -> RequestReservationList -> Ordering)
-> (RequestReservationList -> RequestReservationList -> Bool)
-> (RequestReservationList -> RequestReservationList -> Bool)
-> (RequestReservationList -> RequestReservationList -> Bool)
-> (RequestReservationList -> RequestReservationList -> Bool)
-> (RequestReservationList
    -> RequestReservationList -> RequestReservationList)
-> (RequestReservationList
    -> RequestReservationList -> RequestReservationList)
-> Ord RequestReservationList
RequestReservationList -> RequestReservationList -> Bool
RequestReservationList -> RequestReservationList -> Ordering
RequestReservationList
-> RequestReservationList -> RequestReservationList
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 :: RequestReservationList -> RequestReservationList -> Ordering
compare :: RequestReservationList -> RequestReservationList -> Ordering
$c< :: RequestReservationList -> RequestReservationList -> Bool
< :: RequestReservationList -> RequestReservationList -> Bool
$c<= :: RequestReservationList -> RequestReservationList -> Bool
<= :: RequestReservationList -> RequestReservationList -> Bool
$c> :: RequestReservationList -> RequestReservationList -> Bool
> :: RequestReservationList -> RequestReservationList -> Bool
$c>= :: RequestReservationList -> RequestReservationList -> Bool
>= :: RequestReservationList -> RequestReservationList -> Bool
$cmax :: RequestReservationList
-> RequestReservationList -> RequestReservationList
max :: RequestReservationList
-> RequestReservationList -> RequestReservationList
$cmin :: RequestReservationList
-> RequestReservationList -> RequestReservationList
min :: RequestReservationList
-> RequestReservationList -> RequestReservationList
Ord, ReadPrec [RequestReservationList]
ReadPrec RequestReservationList
Int -> ReadS RequestReservationList
ReadS [RequestReservationList]
(Int -> ReadS RequestReservationList)
-> ReadS [RequestReservationList]
-> ReadPrec RequestReservationList
-> ReadPrec [RequestReservationList]
-> Read RequestReservationList
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RequestReservationList
readsPrec :: Int -> ReadS RequestReservationList
$creadList :: ReadS [RequestReservationList]
readList :: ReadS [RequestReservationList]
$creadPrec :: ReadPrec RequestReservationList
readPrec :: ReadPrec RequestReservationList
$creadListPrec :: ReadPrec [RequestReservationList]
readListPrec :: ReadPrec [RequestReservationList]
Read, Int -> RequestReservationList -> ShowS
[RequestReservationList] -> ShowS
RequestReservationList -> String
(Int -> RequestReservationList -> ShowS)
-> (RequestReservationList -> String)
-> ([RequestReservationList] -> ShowS)
-> Show RequestReservationList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestReservationList -> ShowS
showsPrec :: Int -> RequestReservationList -> ShowS
$cshow :: RequestReservationList -> String
show :: RequestReservationList -> String
$cshowList :: [RequestReservationList] -> ShowS
showList :: [RequestReservationList] -> ShowS
Show)
  deriving
    (Value -> Parser [RequestReservationList]
Value -> Parser RequestReservationList
(Value -> Parser RequestReservationList)
-> (Value -> Parser [RequestReservationList])
-> FromJSON RequestReservationList
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RequestReservationList
parseJSON :: Value -> Parser RequestReservationList
$cparseJSONList :: Value -> Parser [RequestReservationList]
parseJSONList :: Value -> Parser [RequestReservationList]
A.FromJSON, [RequestReservationList] -> Value
[RequestReservationList] -> Encoding
RequestReservationList -> Value
RequestReservationList -> Encoding
(RequestReservationList -> Value)
-> (RequestReservationList -> Encoding)
-> ([RequestReservationList] -> Value)
-> ([RequestReservationList] -> Encoding)
-> ToJSON RequestReservationList
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RequestReservationList -> Value
toJSON :: RequestReservationList -> Value
$ctoEncoding :: RequestReservationList -> Encoding
toEncoding :: RequestReservationList -> Encoding
$ctoJSONList :: [RequestReservationList] -> Value
toJSONList :: [RequestReservationList] -> Value
$ctoEncodingList :: [RequestReservationList] -> Encoding
toEncodingList :: [RequestReservationList] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkRequest" "requestReservationList") RequestReservationList

type ReservationWithInfo :: Type
data ReservationWithInfo = MkReservationWithInfo
  { ReservationWithInfo -> Reservation
reservationWithInfoReservation :: Reservation
  , ReservationWithInfo -> Desk
reservationWithInfoDesk :: Desk
  , ReservationWithInfo -> Space
reservationWithInfoSpace :: Space
  }
  deriving stock (ReservationWithInfo -> ReservationWithInfo -> Bool
(ReservationWithInfo -> ReservationWithInfo -> Bool)
-> (ReservationWithInfo -> ReservationWithInfo -> Bool)
-> Eq ReservationWithInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReservationWithInfo -> ReservationWithInfo -> Bool
== :: ReservationWithInfo -> ReservationWithInfo -> Bool
$c/= :: ReservationWithInfo -> ReservationWithInfo -> Bool
/= :: ReservationWithInfo -> ReservationWithInfo -> Bool
Eq, (forall x. ReservationWithInfo -> Rep ReservationWithInfo x)
-> (forall x. Rep ReservationWithInfo x -> ReservationWithInfo)
-> Generic ReservationWithInfo
forall x. Rep ReservationWithInfo x -> ReservationWithInfo
forall x. ReservationWithInfo -> Rep ReservationWithInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReservationWithInfo -> Rep ReservationWithInfo x
from :: forall x. ReservationWithInfo -> Rep ReservationWithInfo x
$cto :: forall x. Rep ReservationWithInfo x -> ReservationWithInfo
to :: forall x. Rep ReservationWithInfo x -> ReservationWithInfo
Generic, Eq ReservationWithInfo
Eq ReservationWithInfo =>
(ReservationWithInfo -> ReservationWithInfo -> Ordering)
-> (ReservationWithInfo -> ReservationWithInfo -> Bool)
-> (ReservationWithInfo -> ReservationWithInfo -> Bool)
-> (ReservationWithInfo -> ReservationWithInfo -> Bool)
-> (ReservationWithInfo -> ReservationWithInfo -> Bool)
-> (ReservationWithInfo
    -> ReservationWithInfo -> ReservationWithInfo)
-> (ReservationWithInfo
    -> ReservationWithInfo -> ReservationWithInfo)
-> Ord ReservationWithInfo
ReservationWithInfo -> ReservationWithInfo -> Bool
ReservationWithInfo -> ReservationWithInfo -> Ordering
ReservationWithInfo -> ReservationWithInfo -> ReservationWithInfo
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 :: ReservationWithInfo -> ReservationWithInfo -> Ordering
compare :: ReservationWithInfo -> ReservationWithInfo -> Ordering
$c< :: ReservationWithInfo -> ReservationWithInfo -> Bool
< :: ReservationWithInfo -> ReservationWithInfo -> Bool
$c<= :: ReservationWithInfo -> ReservationWithInfo -> Bool
<= :: ReservationWithInfo -> ReservationWithInfo -> Bool
$c> :: ReservationWithInfo -> ReservationWithInfo -> Bool
> :: ReservationWithInfo -> ReservationWithInfo -> Bool
$c>= :: ReservationWithInfo -> ReservationWithInfo -> Bool
>= :: ReservationWithInfo -> ReservationWithInfo -> Bool
$cmax :: ReservationWithInfo -> ReservationWithInfo -> ReservationWithInfo
max :: ReservationWithInfo -> ReservationWithInfo -> ReservationWithInfo
$cmin :: ReservationWithInfo -> ReservationWithInfo -> ReservationWithInfo
min :: ReservationWithInfo -> ReservationWithInfo -> ReservationWithInfo
Ord, ReadPrec [ReservationWithInfo]
ReadPrec ReservationWithInfo
Int -> ReadS ReservationWithInfo
ReadS [ReservationWithInfo]
(Int -> ReadS ReservationWithInfo)
-> ReadS [ReservationWithInfo]
-> ReadPrec ReservationWithInfo
-> ReadPrec [ReservationWithInfo]
-> Read ReservationWithInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ReservationWithInfo
readsPrec :: Int -> ReadS ReservationWithInfo
$creadList :: ReadS [ReservationWithInfo]
readList :: ReadS [ReservationWithInfo]
$creadPrec :: ReadPrec ReservationWithInfo
readPrec :: ReadPrec ReservationWithInfo
$creadListPrec :: ReadPrec [ReservationWithInfo]
readListPrec :: ReadPrec [ReservationWithInfo]
Read, Int -> ReservationWithInfo -> ShowS
[ReservationWithInfo] -> ShowS
ReservationWithInfo -> String
(Int -> ReservationWithInfo -> ShowS)
-> (ReservationWithInfo -> String)
-> ([ReservationWithInfo] -> ShowS)
-> Show ReservationWithInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReservationWithInfo -> ShowS
showsPrec :: Int -> ReservationWithInfo -> ShowS
$cshow :: ReservationWithInfo -> String
show :: ReservationWithInfo -> String
$cshowList :: [ReservationWithInfo] -> ShowS
showList :: [ReservationWithInfo] -> ShowS
Show)
  deriving
    (Value -> Parser [ReservationWithInfo]
Value -> Parser ReservationWithInfo
(Value -> Parser ReservationWithInfo)
-> (Value -> Parser [ReservationWithInfo])
-> FromJSON ReservationWithInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ReservationWithInfo
parseJSON :: Value -> Parser ReservationWithInfo
$cparseJSONList :: Value -> Parser [ReservationWithInfo]
parseJSONList :: Value -> Parser [ReservationWithInfo]
A.FromJSON, [ReservationWithInfo] -> Value
[ReservationWithInfo] -> Encoding
ReservationWithInfo -> Value
ReservationWithInfo -> Encoding
(ReservationWithInfo -> Value)
-> (ReservationWithInfo -> Encoding)
-> ([ReservationWithInfo] -> Value)
-> ([ReservationWithInfo] -> Encoding)
-> ToJSON ReservationWithInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ReservationWithInfo -> Value
toJSON :: ReservationWithInfo -> Value
$ctoEncoding :: ReservationWithInfo -> Encoding
toEncoding :: ReservationWithInfo -> Encoding
$ctoJSONList :: [ReservationWithInfo] -> Value
toJSONList :: [ReservationWithInfo] -> Value
$ctoEncodingList :: [ReservationWithInfo] -> Encoding
toEncodingList :: [ReservationWithInfo] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "reservationWithInfo") ReservationWithInfo

type ResponseReservationList :: Type
newtype ResponseReservationList = MkResponseReservationList
  { ResponseReservationList -> [ReservationWithInfo]
responseReservationListReservations :: [ReservationWithInfo]
  }
  deriving stock (ResponseReservationList -> ResponseReservationList -> Bool
(ResponseReservationList -> ResponseReservationList -> Bool)
-> (ResponseReservationList -> ResponseReservationList -> Bool)
-> Eq ResponseReservationList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseReservationList -> ResponseReservationList -> Bool
== :: ResponseReservationList -> ResponseReservationList -> Bool
$c/= :: ResponseReservationList -> ResponseReservationList -> Bool
/= :: ResponseReservationList -> ResponseReservationList -> Bool
Eq, (forall x.
 ResponseReservationList -> Rep ResponseReservationList x)
-> (forall x.
    Rep ResponseReservationList x -> ResponseReservationList)
-> Generic ResponseReservationList
forall x. Rep ResponseReservationList x -> ResponseReservationList
forall x. ResponseReservationList -> Rep ResponseReservationList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseReservationList -> Rep ResponseReservationList x
from :: forall x. ResponseReservationList -> Rep ResponseReservationList x
$cto :: forall x. Rep ResponseReservationList x -> ResponseReservationList
to :: forall x. Rep ResponseReservationList x -> ResponseReservationList
Generic, Eq ResponseReservationList
Eq ResponseReservationList =>
(ResponseReservationList -> ResponseReservationList -> Ordering)
-> (ResponseReservationList -> ResponseReservationList -> Bool)
-> (ResponseReservationList -> ResponseReservationList -> Bool)
-> (ResponseReservationList -> ResponseReservationList -> Bool)
-> (ResponseReservationList -> ResponseReservationList -> Bool)
-> (ResponseReservationList
    -> ResponseReservationList -> ResponseReservationList)
-> (ResponseReservationList
    -> ResponseReservationList -> ResponseReservationList)
-> Ord ResponseReservationList
ResponseReservationList -> ResponseReservationList -> Bool
ResponseReservationList -> ResponseReservationList -> Ordering
ResponseReservationList
-> ResponseReservationList -> ResponseReservationList
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 :: ResponseReservationList -> ResponseReservationList -> Ordering
compare :: ResponseReservationList -> ResponseReservationList -> Ordering
$c< :: ResponseReservationList -> ResponseReservationList -> Bool
< :: ResponseReservationList -> ResponseReservationList -> Bool
$c<= :: ResponseReservationList -> ResponseReservationList -> Bool
<= :: ResponseReservationList -> ResponseReservationList -> Bool
$c> :: ResponseReservationList -> ResponseReservationList -> Bool
> :: ResponseReservationList -> ResponseReservationList -> Bool
$c>= :: ResponseReservationList -> ResponseReservationList -> Bool
>= :: ResponseReservationList -> ResponseReservationList -> Bool
$cmax :: ResponseReservationList
-> ResponseReservationList -> ResponseReservationList
max :: ResponseReservationList
-> ResponseReservationList -> ResponseReservationList
$cmin :: ResponseReservationList
-> ResponseReservationList -> ResponseReservationList
min :: ResponseReservationList
-> ResponseReservationList -> ResponseReservationList
Ord, ReadPrec [ResponseReservationList]
ReadPrec ResponseReservationList
Int -> ReadS ResponseReservationList
ReadS [ResponseReservationList]
(Int -> ReadS ResponseReservationList)
-> ReadS [ResponseReservationList]
-> ReadPrec ResponseReservationList
-> ReadPrec [ResponseReservationList]
-> Read ResponseReservationList
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ResponseReservationList
readsPrec :: Int -> ReadS ResponseReservationList
$creadList :: ReadS [ResponseReservationList]
readList :: ReadS [ResponseReservationList]
$creadPrec :: ReadPrec ResponseReservationList
readPrec :: ReadPrec ResponseReservationList
$creadListPrec :: ReadPrec [ResponseReservationList]
readListPrec :: ReadPrec [ResponseReservationList]
Read, Int -> ResponseReservationList -> ShowS
[ResponseReservationList] -> ShowS
ResponseReservationList -> String
(Int -> ResponseReservationList -> ShowS)
-> (ResponseReservationList -> String)
-> ([ResponseReservationList] -> ShowS)
-> Show ResponseReservationList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseReservationList -> ShowS
showsPrec :: Int -> ResponseReservationList -> ShowS
$cshow :: ResponseReservationList -> String
show :: ResponseReservationList -> String
$cshowList :: [ResponseReservationList] -> ShowS
showList :: [ResponseReservationList] -> ShowS
Show)
  deriving
    (Value -> Parser [ResponseReservationList]
Value -> Parser ResponseReservationList
(Value -> Parser ResponseReservationList)
-> (Value -> Parser [ResponseReservationList])
-> FromJSON ResponseReservationList
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ResponseReservationList
parseJSON :: Value -> Parser ResponseReservationList
$cparseJSONList :: Value -> Parser [ResponseReservationList]
parseJSONList :: Value -> Parser [ResponseReservationList]
A.FromJSON, [ResponseReservationList] -> Value
[ResponseReservationList] -> Encoding
ResponseReservationList -> Value
ResponseReservationList -> Encoding
(ResponseReservationList -> Value)
-> (ResponseReservationList -> Encoding)
-> ([ResponseReservationList] -> Value)
-> ([ResponseReservationList] -> Encoding)
-> ToJSON ResponseReservationList
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ResponseReservationList -> Value
toJSON :: ResponseReservationList -> Value
$ctoEncoding :: ResponseReservationList -> Encoding
toEncoding :: ResponseReservationList -> Encoding
$ctoJSONList :: [ResponseReservationList] -> Value
toJSONList :: [ResponseReservationList] -> Value
$ctoEncodingList :: [ResponseReservationList] -> Encoding
toEncodingList :: [ResponseReservationList] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkResponse" "responseReservationList") ResponseReservationList