{-
   Vikunja API

   # Pagination Every endpoint capable of pagination will return two headers: * `x-pagination-total-pages`: The total number of available pages for this request * `x-pagination-result-count`: The number of items returned for this request. # Rights All endpoints which return a single item (project, task, etc.) - no array - will also return a `x-max-right` header with the max right the user has on this item as an int where `0` is `Read Only`, `1` is `Read & Write` and `2` is `Admin`. This can be used to show or hide ui elements based on the rights the user has. # Errors All errors have an error code and a human-readable error message in addition to the http status code. You should always check for the status code in the response, not only the http status code. Due to limitations in the swagger library we're using for this document, only one error per http status code is documented here. Make sure to check the [error docs](https://vikunja.io/docs/errors/) in Vikunja's documentation for a full list of available error codes. # Authorization **JWT-Auth:** Main authorization method, used for most of the requests. Needs `Authorization: Bearer <jwt-token>`-header to authenticate successfully.  **API Token:** You can create scoped API tokens for your user and use the token to make authenticated requests in the context of that user. The token must be provided via an `Authorization: Bearer <token>` header, similar to jwt auth. See the documentation for the `api` group to manage token creation and revocation.  **BasicAuth:** Only used when requesting tasks via CalDAV. <!-- ReDoc-Inject: <security-definitions> -->

   OpenAPI Version: 3.0.1
   Vikunja API API version: 0.24.6
   Contact: hello@vikunja.io
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Vikunja.Model
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}

module Vikunja.Model where

import Vikunja.Core
import Vikunja.MimeTypes

import Data.Aeson ((.:),(.:!),(.:?),(.=))

import qualified Control.Arrow as P (left)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)
import qualified Data.Foldable as P
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time as TI
import qualified Lens.Micro as L
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH

import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import Prelude (($),(/=),(.),(<$>),(<*>),(>>=),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)

import qualified Prelude as P



-- * Parameter newtypes


-- ** AttachmentId
newtype AttachmentId = AttachmentId { AttachmentId -> Int
unAttachmentId :: Int } deriving (AttachmentId -> AttachmentId -> Bool
(AttachmentId -> AttachmentId -> Bool)
-> (AttachmentId -> AttachmentId -> Bool) -> Eq AttachmentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachmentId -> AttachmentId -> Bool
$c/= :: AttachmentId -> AttachmentId -> Bool
== :: AttachmentId -> AttachmentId -> Bool
$c== :: AttachmentId -> AttachmentId -> Bool
P.Eq, Int -> AttachmentId -> ShowS
[AttachmentId] -> ShowS
AttachmentId -> String
(Int -> AttachmentId -> ShowS)
-> (AttachmentId -> String)
-> ([AttachmentId] -> ShowS)
-> Show AttachmentId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachmentId] -> ShowS
$cshowList :: [AttachmentId] -> ShowS
show :: AttachmentId -> String
$cshow :: AttachmentId -> String
showsPrec :: Int -> AttachmentId -> ShowS
$cshowsPrec :: Int -> AttachmentId -> ShowS
P.Show)

-- ** Avatar
newtype Avatar = Avatar { Avatar -> Text
unAvatar :: Text } deriving (Avatar -> Avatar -> Bool
(Avatar -> Avatar -> Bool)
-> (Avatar -> Avatar -> Bool) -> Eq Avatar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Avatar -> Avatar -> Bool
$c/= :: Avatar -> Avatar -> Bool
== :: Avatar -> Avatar -> Bool
$c== :: Avatar -> Avatar -> Bool
P.Eq, Int -> Avatar -> ShowS
[Avatar] -> ShowS
Avatar -> String
(Int -> Avatar -> ShowS)
-> (Avatar -> String) -> ([Avatar] -> ShowS) -> Show Avatar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Avatar] -> ShowS
$cshowList :: [Avatar] -> ShowS
show :: Avatar -> String
$cshow :: Avatar -> String
showsPrec :: Int -> Avatar -> ShowS
$cshowsPrec :: Int -> Avatar -> ShowS
P.Show)

-- ** Background
newtype Background = Background { Background -> Text
unBackground :: Text } deriving (Background -> Background -> Bool
(Background -> Background -> Bool)
-> (Background -> Background -> Bool) -> Eq Background
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Background -> Background -> Bool
$c/= :: Background -> Background -> Bool
== :: Background -> Background -> Bool
$c== :: Background -> Background -> Bool
P.Eq, Int -> Background -> ShowS
[Background] -> ShowS
Background -> String
(Int -> Background -> ShowS)
-> (Background -> String)
-> ([Background] -> ShowS)
-> Show Background
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Background] -> ShowS
$cshowList :: [Background] -> ShowS
show :: Background -> String
$cshow :: Background -> String
showsPrec :: Int -> Background -> ShowS
$cshowsPrec :: Int -> Background -> ShowS
P.Show)

-- ** Bucket
newtype Bucket = Bucket { Bucket -> Int
unBucket :: Int } deriving (Bucket -> Bucket -> Bool
(Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool) -> Eq Bucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bucket -> Bucket -> Bool
$c/= :: Bucket -> Bucket -> Bool
== :: Bucket -> Bucket -> Bool
$c== :: Bucket -> Bucket -> Bool
P.Eq, Int -> Bucket -> ShowS
[Bucket] -> ShowS
Bucket -> String
(Int -> Bucket -> ShowS)
-> (Bucket -> String) -> ([Bucket] -> ShowS) -> Show Bucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bucket] -> ShowS
$cshowList :: [Bucket] -> ShowS
show :: Bucket -> String
$cshow :: Bucket -> String
showsPrec :: Int -> Bucket -> ShowS
$cshowsPrec :: Int -> Bucket -> ShowS
P.Show)

-- ** BucketId
newtype BucketId = BucketId { BucketId -> Int
unBucketId :: Int } deriving (BucketId -> BucketId -> Bool
(BucketId -> BucketId -> Bool)
-> (BucketId -> BucketId -> Bool) -> Eq BucketId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BucketId -> BucketId -> Bool
$c/= :: BucketId -> BucketId -> Bool
== :: BucketId -> BucketId -> Bool
$c== :: BucketId -> BucketId -> Bool
P.Eq, Int -> BucketId -> ShowS
[BucketId] -> ShowS
BucketId -> String
(Int -> BucketId -> ShowS)
-> (BucketId -> String) -> ([BucketId] -> ShowS) -> Show BucketId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BucketId] -> ShowS
$cshowList :: [BucketId] -> ShowS
show :: BucketId -> String
$cshow :: BucketId -> String
showsPrec :: Int -> BucketId -> ShowS
$cshowsPrec :: Int -> BucketId -> ShowS
P.Show)

-- ** CommentId
newtype CommentId = CommentId { CommentId -> Int
unCommentId :: Int } deriving (CommentId -> CommentId -> Bool
(CommentId -> CommentId -> Bool)
-> (CommentId -> CommentId -> Bool) -> Eq CommentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentId -> CommentId -> Bool
$c/= :: CommentId -> CommentId -> Bool
== :: CommentId -> CommentId -> Bool
$c== :: CommentId -> CommentId -> Bool
P.Eq, Int -> CommentId -> ShowS
[CommentId] -> ShowS
CommentId -> String
(Int -> CommentId -> ShowS)
-> (CommentId -> String)
-> ([CommentId] -> ShowS)
-> Show CommentId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentId] -> ShowS
$cshowList :: [CommentId] -> ShowS
show :: CommentId -> String
$cshow :: CommentId -> String
showsPrec :: Int -> CommentId -> ShowS
$cshowsPrec :: Int -> CommentId -> ShowS
P.Show)

-- ** Entity
newtype Entity = Entity { Entity -> Text
unEntity :: Text } deriving (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
P.Eq, Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
(Int -> Entity -> ShowS)
-> (Entity -> String) -> ([Entity] -> ShowS) -> Show Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entity] -> ShowS
$cshowList :: [Entity] -> ShowS
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> ShowS
$cshowsPrec :: Int -> Entity -> ShowS
P.Show)

-- ** EntityId
newtype EntityId = EntityId { EntityId -> Text
unEntityId :: Text } deriving (EntityId -> EntityId -> Bool
(EntityId -> EntityId -> Bool)
-> (EntityId -> EntityId -> Bool) -> Eq EntityId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityId -> EntityId -> Bool
$c/= :: EntityId -> EntityId -> Bool
== :: EntityId -> EntityId -> Bool
$c== :: EntityId -> EntityId -> Bool
P.Eq, Int -> EntityId -> ShowS
[EntityId] -> ShowS
EntityId -> String
(Int -> EntityId -> ShowS)
-> (EntityId -> String) -> ([EntityId] -> ShowS) -> Show EntityId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityId] -> ShowS
$cshowList :: [EntityId] -> ShowS
show :: EntityId -> String
$cshow :: EntityId -> String
showsPrec :: Int -> EntityId -> ShowS
$cshowsPrec :: Int -> EntityId -> ShowS
P.Show)

-- ** Expand
newtype Expand = Expand { Expand -> Text
unExpand :: Text } deriving (Expand -> Expand -> Bool
(Expand -> Expand -> Bool)
-> (Expand -> Expand -> Bool) -> Eq Expand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expand -> Expand -> Bool
$c/= :: Expand -> Expand -> Bool
== :: Expand -> Expand -> Bool
$c== :: Expand -> Expand -> Bool
P.Eq, Int -> Expand -> ShowS
[Expand] -> ShowS
Expand -> String
(Int -> Expand -> ShowS)
-> (Expand -> String) -> ([Expand] -> ShowS) -> Show Expand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expand] -> ShowS
$cshowList :: [Expand] -> ShowS
show :: Expand -> String
$cshow :: Expand -> String
showsPrec :: Int -> Expand -> ShowS
$cshowsPrec :: Int -> Expand -> ShowS
P.Show)

-- ** Files
newtype Files = Files { Files -> Text
unFiles :: Text } deriving (Files -> Files -> Bool
(Files -> Files -> Bool) -> (Files -> Files -> Bool) -> Eq Files
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Files -> Files -> Bool
$c/= :: Files -> Files -> Bool
== :: Files -> Files -> Bool
$c== :: Files -> Files -> Bool
P.Eq, Int -> Files -> ShowS
[Files] -> ShowS
Files -> String
(Int -> Files -> ShowS)
-> (Files -> String) -> ([Files] -> ShowS) -> Show Files
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Files] -> ShowS
$cshowList :: [Files] -> ShowS
show :: Files -> String
$cshow :: Files -> String
showsPrec :: Int -> Files -> ShowS
$cshowsPrec :: Int -> Files -> ShowS
P.Show)

-- ** Filter
newtype Filter = Filter { Filter -> Text
unFilter :: Text } deriving (Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
P.Eq, Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
P.Show)

-- ** FilterIncludeNulls
newtype FilterIncludeNulls = FilterIncludeNulls { FilterIncludeNulls -> Text
unFilterIncludeNulls :: Text } deriving (FilterIncludeNulls -> FilterIncludeNulls -> Bool
(FilterIncludeNulls -> FilterIncludeNulls -> Bool)
-> (FilterIncludeNulls -> FilterIncludeNulls -> Bool)
-> Eq FilterIncludeNulls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterIncludeNulls -> FilterIncludeNulls -> Bool
$c/= :: FilterIncludeNulls -> FilterIncludeNulls -> Bool
== :: FilterIncludeNulls -> FilterIncludeNulls -> Bool
$c== :: FilterIncludeNulls -> FilterIncludeNulls -> Bool
P.Eq, Int -> FilterIncludeNulls -> ShowS
[FilterIncludeNulls] -> ShowS
FilterIncludeNulls -> String
(Int -> FilterIncludeNulls -> ShowS)
-> (FilterIncludeNulls -> String)
-> ([FilterIncludeNulls] -> ShowS)
-> Show FilterIncludeNulls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterIncludeNulls] -> ShowS
$cshowList :: [FilterIncludeNulls] -> ShowS
show :: FilterIncludeNulls -> String
$cshow :: FilterIncludeNulls -> String
showsPrec :: Int -> FilterIncludeNulls -> ShowS
$cshowsPrec :: Int -> FilterIncludeNulls -> ShowS
P.Show)

-- ** FilterTimezone
newtype FilterTimezone = FilterTimezone { FilterTimezone -> Text
unFilterTimezone :: Text } deriving (FilterTimezone -> FilterTimezone -> Bool
(FilterTimezone -> FilterTimezone -> Bool)
-> (FilterTimezone -> FilterTimezone -> Bool) -> Eq FilterTimezone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterTimezone -> FilterTimezone -> Bool
$c/= :: FilterTimezone -> FilterTimezone -> Bool
== :: FilterTimezone -> FilterTimezone -> Bool
$c== :: FilterTimezone -> FilterTimezone -> Bool
P.Eq, Int -> FilterTimezone -> ShowS
[FilterTimezone] -> ShowS
FilterTimezone -> String
(Int -> FilterTimezone -> ShowS)
-> (FilterTimezone -> String)
-> ([FilterTimezone] -> ShowS)
-> Show FilterTimezone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterTimezone] -> ShowS
$cshowList :: [FilterTimezone] -> ShowS
show :: FilterTimezone -> String
$cshow :: FilterTimezone -> String
showsPrec :: Int -> FilterTimezone -> ShowS
$cshowsPrec :: Int -> FilterTimezone -> ShowS
P.Show)

-- ** Id
newtype Id = Id { Id -> Int
unId :: Int } deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
P.Eq, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
P.Show)

-- ** Image
newtype Image = Image { Image -> Int
unImage :: Int } deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
P.Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
P.Show)

-- ** IsArchived
newtype IsArchived = IsArchived { IsArchived -> Bool
unIsArchived :: Bool } deriving (IsArchived -> IsArchived -> Bool
(IsArchived -> IsArchived -> Bool)
-> (IsArchived -> IsArchived -> Bool) -> Eq IsArchived
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsArchived -> IsArchived -> Bool
$c/= :: IsArchived -> IsArchived -> Bool
== :: IsArchived -> IsArchived -> Bool
$c== :: IsArchived -> IsArchived -> Bool
P.Eq, Int -> IsArchived -> ShowS
[IsArchived] -> ShowS
IsArchived -> String
(Int -> IsArchived -> ShowS)
-> (IsArchived -> String)
-> ([IsArchived] -> ShowS)
-> Show IsArchived
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsArchived] -> ShowS
$cshowList :: [IsArchived] -> ShowS
show :: IsArchived -> String
$cshow :: IsArchived -> String
showsPrec :: Int -> IsArchived -> ShowS
$cshowsPrec :: Int -> IsArchived -> ShowS
P.Show)

-- ** Kind
newtype Kind = Kind { Kind -> Int
unKind :: Int } deriving (Kind -> Kind -> Bool
(Kind -> Kind -> Bool) -> (Kind -> Kind -> Bool) -> Eq Kind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kind -> Kind -> Bool
$c/= :: Kind -> Kind -> Bool
== :: Kind -> Kind -> Bool
$c== :: Kind -> Kind -> Bool
P.Eq, Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kind] -> ShowS
$cshowList :: [Kind] -> ShowS
show :: Kind -> String
$cshow :: Kind -> String
showsPrec :: Int -> Kind -> ShowS
$cshowsPrec :: Int -> Kind -> ShowS
P.Show)

-- ** Label
newtype Label = Label { Label -> Int
unLabel :: Int } deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
P.Eq, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
P.Show)

-- ** OrderBy
newtype OrderBy = OrderBy { OrderBy -> Text
unOrderBy :: Text } deriving (OrderBy -> OrderBy -> Bool
(OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool) -> Eq OrderBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderBy -> OrderBy -> Bool
$c/= :: OrderBy -> OrderBy -> Bool
== :: OrderBy -> OrderBy -> Bool
$c== :: OrderBy -> OrderBy -> Bool
P.Eq, Int -> OrderBy -> ShowS
[OrderBy] -> ShowS
OrderBy -> String
(Int -> OrderBy -> ShowS)
-> (OrderBy -> String) -> ([OrderBy] -> ShowS) -> Show OrderBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderBy] -> ShowS
$cshowList :: [OrderBy] -> ShowS
show :: OrderBy -> String
$cshow :: OrderBy -> String
showsPrec :: Int -> OrderBy -> ShowS
$cshowsPrec :: Int -> OrderBy -> ShowS
P.Show)

-- ** OtherTaskId
newtype OtherTaskId = OtherTaskId { OtherTaskId -> Int
unOtherTaskId :: Int } deriving (OtherTaskId -> OtherTaskId -> Bool
(OtherTaskId -> OtherTaskId -> Bool)
-> (OtherTaskId -> OtherTaskId -> Bool) -> Eq OtherTaskId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherTaskId -> OtherTaskId -> Bool
$c/= :: OtherTaskId -> OtherTaskId -> Bool
== :: OtherTaskId -> OtherTaskId -> Bool
$c== :: OtherTaskId -> OtherTaskId -> Bool
P.Eq, Int -> OtherTaskId -> ShowS
[OtherTaskId] -> ShowS
OtherTaskId -> String
(Int -> OtherTaskId -> ShowS)
-> (OtherTaskId -> String)
-> ([OtherTaskId] -> ShowS)
-> Show OtherTaskId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherTaskId] -> ShowS
$cshowList :: [OtherTaskId] -> ShowS
show :: OtherTaskId -> String
$cshow :: OtherTaskId -> String
showsPrec :: Int -> OtherTaskId -> ShowS
$cshowsPrec :: Int -> OtherTaskId -> ShowS
P.Show)

-- ** P
newtype P = P { P -> Int
unP :: Int } deriving (P -> P -> Bool
(P -> P -> Bool) -> (P -> P -> Bool) -> Eq P
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: P -> P -> Bool
$c/= :: P -> P -> Bool
== :: P -> P -> Bool
$c== :: P -> P -> Bool
P.Eq, Int -> P -> ShowS
[P] -> ShowS
P -> String
(Int -> P -> ShowS) -> (P -> String) -> ([P] -> ShowS) -> Show P
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [P] -> ShowS
$cshowList :: [P] -> ShowS
show :: P -> String
$cshow :: P -> String
showsPrec :: Int -> P -> ShowS
$cshowsPrec :: Int -> P -> ShowS
P.Show)

-- ** Page
newtype Page = Page { Page -> Int
unPage :: Int } deriving (Page -> Page -> Bool
(Page -> Page -> Bool) -> (Page -> Page -> Bool) -> Eq Page
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Page -> Page -> Bool
$c/= :: Page -> Page -> Bool
== :: Page -> Page -> Bool
$c== :: Page -> Page -> Bool
P.Eq, Int -> Page -> ShowS
[Page] -> ShowS
Page -> String
(Int -> Page -> ShowS)
-> (Page -> String) -> ([Page] -> ShowS) -> Show Page
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Page] -> ShowS
$cshowList :: [Page] -> ShowS
show :: Page -> String
$cshow :: Page -> String
showsPrec :: Int -> Page -> ShowS
$cshowsPrec :: Int -> Page -> ShowS
P.Show)

-- ** ParamImport
newtype ParamImport = ParamImport { ParamImport -> Text
unParamImport :: Text } deriving (ParamImport -> ParamImport -> Bool
(ParamImport -> ParamImport -> Bool)
-> (ParamImport -> ParamImport -> Bool) -> Eq ParamImport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamImport -> ParamImport -> Bool
$c/= :: ParamImport -> ParamImport -> Bool
== :: ParamImport -> ParamImport -> Bool
$c== :: ParamImport -> ParamImport -> Bool
P.Eq, Int -> ParamImport -> ShowS
[ParamImport] -> ShowS
ParamImport -> String
(Int -> ParamImport -> ShowS)
-> (ParamImport -> String)
-> ([ParamImport] -> ShowS)
-> Show ParamImport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamImport] -> ShowS
$cshowList :: [ParamImport] -> ShowS
show :: ParamImport -> String
$cshow :: ParamImport -> String
showsPrec :: Int -> ParamImport -> ShowS
$cshowsPrec :: Int -> ParamImport -> ShowS
P.Show)

-- ** PerPage
newtype PerPage = PerPage { PerPage -> Int
unPerPage :: Int } deriving (PerPage -> PerPage -> Bool
(PerPage -> PerPage -> Bool)
-> (PerPage -> PerPage -> Bool) -> Eq PerPage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerPage -> PerPage -> Bool
$c/= :: PerPage -> PerPage -> Bool
== :: PerPage -> PerPage -> Bool
$c== :: PerPage -> PerPage -> Bool
P.Eq, Int -> PerPage -> ShowS
[PerPage] -> ShowS
PerPage -> String
(Int -> PerPage -> ShowS)
-> (PerPage -> String) -> ([PerPage] -> ShowS) -> Show PerPage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerPage] -> ShowS
$cshowList :: [PerPage] -> ShowS
show :: PerPage -> String
$cshow :: PerPage -> String
showsPrec :: Int -> PerPage -> ShowS
$cshowsPrec :: Int -> PerPage -> ShowS
P.Show)

-- ** PreviewSize
newtype PreviewSize = PreviewSize { PreviewSize -> Text
unPreviewSize :: Text } deriving (PreviewSize -> PreviewSize -> Bool
(PreviewSize -> PreviewSize -> Bool)
-> (PreviewSize -> PreviewSize -> Bool) -> Eq PreviewSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreviewSize -> PreviewSize -> Bool
$c/= :: PreviewSize -> PreviewSize -> Bool
== :: PreviewSize -> PreviewSize -> Bool
$c== :: PreviewSize -> PreviewSize -> Bool
P.Eq, Int -> PreviewSize -> ShowS
[PreviewSize] -> ShowS
PreviewSize -> String
(Int -> PreviewSize -> ShowS)
-> (PreviewSize -> String)
-> ([PreviewSize] -> ShowS)
-> Show PreviewSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreviewSize] -> ShowS
$cshowList :: [PreviewSize] -> ShowS
show :: PreviewSize -> String
$cshow :: PreviewSize -> String
showsPrec :: Int -> PreviewSize -> ShowS
$cshowsPrec :: Int -> PreviewSize -> ShowS
P.Show)

-- ** Project
newtype Project = Project { Project -> Int
unProject :: Int } deriving (Project -> Project -> Bool
(Project -> Project -> Bool)
-> (Project -> Project -> Bool) -> Eq Project
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Project -> Project -> Bool
$c/= :: Project -> Project -> Bool
== :: Project -> Project -> Bool
$c== :: Project -> Project -> Bool
P.Eq, Int -> Project -> ShowS
[Project] -> ShowS
Project -> String
(Int -> Project -> ShowS)
-> (Project -> String) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Project] -> ShowS
$cshowList :: [Project] -> ShowS
show :: Project -> String
$cshow :: Project -> String
showsPrec :: Int -> Project -> ShowS
$cshowsPrec :: Int -> Project -> ShowS
P.Show)

-- ** ProjectId
newtype ProjectId = ProjectId { ProjectId -> Int
unProjectId :: Int } deriving (ProjectId -> ProjectId -> Bool
(ProjectId -> ProjectId -> Bool)
-> (ProjectId -> ProjectId -> Bool) -> Eq ProjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectId -> ProjectId -> Bool
$c/= :: ProjectId -> ProjectId -> Bool
== :: ProjectId -> ProjectId -> Bool
$c== :: ProjectId -> ProjectId -> Bool
P.Eq, Int -> ProjectId -> ShowS
[ProjectId] -> ShowS
ProjectId -> String
(Int -> ProjectId -> ShowS)
-> (ProjectId -> String)
-> ([ProjectId] -> ShowS)
-> Show ProjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectId] -> ShowS
$cshowList :: [ProjectId] -> ShowS
show :: ProjectId -> String
$cshow :: ProjectId -> String
showsPrec :: Int -> ProjectId -> ShowS
$cshowsPrec :: Int -> ProjectId -> ShowS
P.Show)

-- ** Provider
newtype Provider = Provider { Provider -> Int
unProvider :: Int } deriving (Provider -> Provider -> Bool
(Provider -> Provider -> Bool)
-> (Provider -> Provider -> Bool) -> Eq Provider
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Provider -> Provider -> Bool
$c/= :: Provider -> Provider -> Bool
== :: Provider -> Provider -> Bool
$c== :: Provider -> Provider -> Bool
P.Eq, Int -> Provider -> ShowS
[Provider] -> ShowS
Provider -> String
(Int -> Provider -> ShowS)
-> (Provider -> String) -> ([Provider] -> ShowS) -> Show Provider
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Provider] -> ShowS
$cshowList :: [Provider] -> ShowS
show :: Provider -> String
$cshow :: Provider -> String
showsPrec :: Int -> Provider -> ShowS
$cshowsPrec :: Int -> Provider -> ShowS
P.Show)

-- ** RelationKind
newtype RelationKind = RelationKind { RelationKind -> Text
unRelationKind :: Text } deriving (RelationKind -> RelationKind -> Bool
(RelationKind -> RelationKind -> Bool)
-> (RelationKind -> RelationKind -> Bool) -> Eq RelationKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelationKind -> RelationKind -> Bool
$c/= :: RelationKind -> RelationKind -> Bool
== :: RelationKind -> RelationKind -> Bool
$c== :: RelationKind -> RelationKind -> Bool
P.Eq, Int -> RelationKind -> ShowS
[RelationKind] -> ShowS
RelationKind -> String
(Int -> RelationKind -> ShowS)
-> (RelationKind -> String)
-> ([RelationKind] -> ShowS)
-> Show RelationKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelationKind] -> ShowS
$cshowList :: [RelationKind] -> ShowS
show :: RelationKind -> String
$cshow :: RelationKind -> String
showsPrec :: Int -> RelationKind -> ShowS
$cshowsPrec :: Int -> RelationKind -> ShowS
P.Show)

-- ** S
newtype S = S { S -> Text
unS :: Text } deriving (S -> S -> Bool
(S -> S -> Bool) -> (S -> S -> Bool) -> Eq S
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S -> S -> Bool
$c/= :: S -> S -> Bool
== :: S -> S -> Bool
$c== :: S -> S -> Bool
P.Eq, Int -> S -> ShowS
[S] -> ShowS
S -> String
(Int -> S -> ShowS) -> (S -> String) -> ([S] -> ShowS) -> Show S
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S] -> ShowS
$cshowList :: [S] -> ShowS
show :: S -> String
$cshow :: S -> String
showsPrec :: Int -> S -> ShowS
$cshowsPrec :: Int -> S -> ShowS
P.Show)

-- ** Share
newtype Share = Share { Share -> Int
unShare :: Int } deriving (Share -> Share -> Bool
(Share -> Share -> Bool) -> (Share -> Share -> Bool) -> Eq Share
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Share -> Share -> Bool
$c/= :: Share -> Share -> Bool
== :: Share -> Share -> Bool
$c== :: Share -> Share -> Bool
P.Eq, Int -> Share -> ShowS
[Share] -> ShowS
Share -> String
(Int -> Share -> ShowS)
-> (Share -> String) -> ([Share] -> ShowS) -> Show Share
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Share] -> ShowS
$cshowList :: [Share] -> ShowS
show :: Share -> String
$cshow :: Share -> String
showsPrec :: Int -> Share -> ShowS
$cshowsPrec :: Int -> Share -> ShowS
P.Show)

-- ** ShareText
newtype ShareText = ShareText { ShareText -> Text
unShareText :: Text } deriving (ShareText -> ShareText -> Bool
(ShareText -> ShareText -> Bool)
-> (ShareText -> ShareText -> Bool) -> Eq ShareText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShareText -> ShareText -> Bool
$c/= :: ShareText -> ShareText -> Bool
== :: ShareText -> ShareText -> Bool
$c== :: ShareText -> ShareText -> Bool
P.Eq, Int -> ShareText -> ShowS
[ShareText] -> ShowS
ShareText -> String
(Int -> ShareText -> ShowS)
-> (ShareText -> String)
-> ([ShareText] -> ShowS)
-> Show ShareText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShareText] -> ShowS
$cshowList :: [ShareText] -> ShowS
show :: ShareText -> String
$cshow :: ShareText -> String
showsPrec :: Int -> ShareText -> ShowS
$cshowsPrec :: Int -> ShareText -> ShowS
P.Show)

-- ** Size
newtype Size = Size { Size -> Int
unSize :: Int } deriving (Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
P.Eq, Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
P.Show)

-- ** SortBy
newtype SortBy = SortBy { SortBy -> Text
unSortBy :: Text } deriving (SortBy -> SortBy -> Bool
(SortBy -> SortBy -> Bool)
-> (SortBy -> SortBy -> Bool) -> Eq SortBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortBy -> SortBy -> Bool
$c/= :: SortBy -> SortBy -> Bool
== :: SortBy -> SortBy -> Bool
$c== :: SortBy -> SortBy -> Bool
P.Eq, Int -> SortBy -> ShowS
[SortBy] -> ShowS
SortBy -> String
(Int -> SortBy -> ShowS)
-> (SortBy -> String) -> ([SortBy] -> ShowS) -> Show SortBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortBy] -> ShowS
$cshowList :: [SortBy] -> ShowS
show :: SortBy -> String
$cshow :: SortBy -> String
showsPrec :: Int -> SortBy -> ShowS
$cshowsPrec :: Int -> SortBy -> ShowS
P.Show)

-- ** Table
newtype Table = Table { Table -> Text
unTable :: Text } deriving (Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
P.Eq, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
P.Show)

-- ** Task
newtype Task = Task { Task -> Int
unTask :: Int } deriving (Task -> Task -> Bool
(Task -> Task -> Bool) -> (Task -> Task -> Bool) -> Eq Task
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c== :: Task -> Task -> Bool
P.Eq, Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
(Int -> Task -> ShowS)
-> (Task -> String) -> ([Task] -> ShowS) -> Show Task
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
P.Show)

-- ** TaskId
newtype TaskId = TaskId { TaskId -> Int
unTaskId :: Int } deriving (TaskId -> TaskId -> Bool
(TaskId -> TaskId -> Bool)
-> (TaskId -> TaskId -> Bool) -> Eq TaskId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TaskId -> TaskId -> Bool
$c/= :: TaskId -> TaskId -> Bool
== :: TaskId -> TaskId -> Bool
$c== :: TaskId -> TaskId -> Bool
P.Eq, Int -> TaskId -> ShowS
[TaskId] -> ShowS
TaskId -> String
(Int -> TaskId -> ShowS)
-> (TaskId -> String) -> ([TaskId] -> ShowS) -> Show TaskId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaskId] -> ShowS
$cshowList :: [TaskId] -> ShowS
show :: TaskId -> String
$cshow :: TaskId -> String
showsPrec :: Int -> TaskId -> ShowS
$cshowsPrec :: Int -> TaskId -> ShowS
P.Show)

-- ** TeamId
newtype TeamId = TeamId { TeamId -> Int
unTeamId :: Int } deriving (TeamId -> TeamId -> Bool
(TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool) -> Eq TeamId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamId -> TeamId -> Bool
$c/= :: TeamId -> TeamId -> Bool
== :: TeamId -> TeamId -> Bool
$c== :: TeamId -> TeamId -> Bool
P.Eq, Int -> TeamId -> ShowS
[TeamId] -> ShowS
TeamId -> String
(Int -> TeamId -> ShowS)
-> (TeamId -> String) -> ([TeamId] -> ShowS) -> Show TeamId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamId] -> ShowS
$cshowList :: [TeamId] -> ShowS
show :: TeamId -> String
$cshow :: TeamId -> String
showsPrec :: Int -> TeamId -> ShowS
$cshowsPrec :: Int -> TeamId -> ShowS
P.Show)

-- ** TokenId
newtype TokenId = TokenId { TokenId -> Int
unTokenId :: Int } deriving (TokenId -> TokenId -> Bool
(TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool) -> Eq TokenId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenId -> TokenId -> Bool
$c/= :: TokenId -> TokenId -> Bool
== :: TokenId -> TokenId -> Bool
$c== :: TokenId -> TokenId -> Bool
P.Eq, Int -> TokenId -> ShowS
[TokenId] -> ShowS
TokenId -> String
(Int -> TokenId -> ShowS)
-> (TokenId -> String) -> ([TokenId] -> ShowS) -> Show TokenId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenId] -> ShowS
$cshowList :: [TokenId] -> ShowS
show :: TokenId -> String
$cshow :: TokenId -> String
showsPrec :: Int -> TokenId -> ShowS
$cshowsPrec :: Int -> TokenId -> ShowS
P.Show)

-- ** UserId
newtype UserId = UserId { UserId -> Int
unUserId :: Int } deriving (UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
P.Eq, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> String
$cshow :: UserId -> String
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
P.Show)

-- ** Username
newtype Username = Username { Username -> Text
unUsername :: Text } deriving (Username -> Username -> Bool
(Username -> Username -> Bool)
-> (Username -> Username -> Bool) -> Eq Username
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Username -> Username -> Bool
$c/= :: Username -> Username -> Bool
== :: Username -> Username -> Bool
$c== :: Username -> Username -> Bool
P.Eq, Int -> Username -> ShowS
[Username] -> ShowS
Username -> String
(Int -> Username -> ShowS)
-> (Username -> String) -> ([Username] -> ShowS) -> Show Username
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Username] -> ShowS
$cshowList :: [Username] -> ShowS
show :: Username -> String
$cshow :: Username -> String
showsPrec :: Int -> Username -> ShowS
$cshowsPrec :: Int -> Username -> ShowS
P.Show)

-- ** View
newtype View = View { View -> Int
unView :: Int } deriving (View -> View -> Bool
(View -> View -> Bool) -> (View -> View -> Bool) -> Eq View
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: View -> View -> Bool
$c/= :: View -> View -> Bool
== :: View -> View -> Bool
$c== :: View -> View -> Bool
P.Eq, Int -> View -> ShowS
[View] -> ShowS
View -> String
(Int -> View -> ShowS)
-> (View -> String) -> ([View] -> ShowS) -> Show View
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [View] -> ShowS
$cshowList :: [View] -> ShowS
show :: View -> String
$cshow :: View -> String
showsPrec :: Int -> View -> ShowS
$cshowsPrec :: Int -> View -> ShowS
P.Show)

-- ** WebhookId
newtype WebhookId = WebhookId { WebhookId -> Int
unWebhookId :: Int } deriving (WebhookId -> WebhookId -> Bool
(WebhookId -> WebhookId -> Bool)
-> (WebhookId -> WebhookId -> Bool) -> Eq WebhookId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebhookId -> WebhookId -> Bool
$c/= :: WebhookId -> WebhookId -> Bool
== :: WebhookId -> WebhookId -> Bool
$c== :: WebhookId -> WebhookId -> Bool
P.Eq, Int -> WebhookId -> ShowS
[WebhookId] -> ShowS
WebhookId -> String
(Int -> WebhookId -> ShowS)
-> (WebhookId -> String)
-> ([WebhookId] -> ShowS)
-> Show WebhookId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebhookId] -> ShowS
$cshowList :: [WebhookId] -> ShowS
show :: WebhookId -> String
$cshow :: WebhookId -> String
showsPrec :: Int -> WebhookId -> ShowS
$cshowsPrec :: Int -> WebhookId -> ShowS
P.Show)

-- * Models


-- ** AuthToken
-- | AuthToken
data AuthToken = AuthToken
  { AuthToken -> Maybe Text
authTokenToken :: !(Maybe Text) -- ^ "token"
  } deriving (Int -> AuthToken -> ShowS
[AuthToken] -> ShowS
AuthToken -> String
(Int -> AuthToken -> ShowS)
-> (AuthToken -> String)
-> ([AuthToken] -> ShowS)
-> Show AuthToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthToken] -> ShowS
$cshowList :: [AuthToken] -> ShowS
show :: AuthToken -> String
$cshow :: AuthToken -> String
showsPrec :: Int -> AuthToken -> ShowS
$cshowsPrec :: Int -> AuthToken -> ShowS
P.Show, AuthToken -> AuthToken -> Bool
(AuthToken -> AuthToken -> Bool)
-> (AuthToken -> AuthToken -> Bool) -> Eq AuthToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthToken -> AuthToken -> Bool
$c/= :: AuthToken -> AuthToken -> Bool
== :: AuthToken -> AuthToken -> Bool
$c== :: AuthToken -> AuthToken -> Bool
P.Eq, P.Typeable)

-- | FromJSON AuthToken
instance A.FromJSON AuthToken where
  parseJSON :: Value -> Parser AuthToken
parseJSON = String -> (Object -> Parser AuthToken) -> Value -> Parser AuthToken
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AuthToken" ((Object -> Parser AuthToken) -> Value -> Parser AuthToken)
-> (Object -> Parser AuthToken) -> Value -> Parser AuthToken
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> AuthToken
AuthToken
      (Maybe Text -> AuthToken)
-> Parser (Maybe Text) -> Parser AuthToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token")

-- | ToJSON AuthToken
instance A.ToJSON AuthToken where
  toJSON :: AuthToken -> Value
toJSON AuthToken {Maybe Text
authTokenToken :: Maybe Text
$sel:authTokenToken:AuthToken :: AuthToken -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
authTokenToken
      ]


-- | Construct a value of type 'AuthToken' (by applying it's required fields, if any)
mkAuthToken
  :: AuthToken
mkAuthToken :: AuthToken
mkAuthToken =
  AuthToken :: Maybe Text -> AuthToken
AuthToken
  { $sel:authTokenToken:AuthToken :: Maybe Text
authTokenToken = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** BackgroundImage
-- | BackgroundImage
data BackgroundImage = BackgroundImage
  { BackgroundImage -> Maybe Text
backgroundImageBlurHash :: !(Maybe Text) -- ^ "blur_hash"
  , BackgroundImage -> Maybe Text
backgroundImageId :: !(Maybe Text) -- ^ "id"
  , BackgroundImage -> Maybe Value
backgroundImageInfo :: !(Maybe A.Value) -- ^ "info" - This can be used to supply extra information from an image provider to clients
  , BackgroundImage -> Maybe Text
backgroundImageThumb :: !(Maybe Text) -- ^ "thumb"
  , BackgroundImage -> Maybe Text
backgroundImageUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> BackgroundImage -> ShowS
[BackgroundImage] -> ShowS
BackgroundImage -> String
(Int -> BackgroundImage -> ShowS)
-> (BackgroundImage -> String)
-> ([BackgroundImage] -> ShowS)
-> Show BackgroundImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundImage] -> ShowS
$cshowList :: [BackgroundImage] -> ShowS
show :: BackgroundImage -> String
$cshow :: BackgroundImage -> String
showsPrec :: Int -> BackgroundImage -> ShowS
$cshowsPrec :: Int -> BackgroundImage -> ShowS
P.Show, BackgroundImage -> BackgroundImage -> Bool
(BackgroundImage -> BackgroundImage -> Bool)
-> (BackgroundImage -> BackgroundImage -> Bool)
-> Eq BackgroundImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundImage -> BackgroundImage -> Bool
$c/= :: BackgroundImage -> BackgroundImage -> Bool
== :: BackgroundImage -> BackgroundImage -> Bool
$c== :: BackgroundImage -> BackgroundImage -> Bool
P.Eq, P.Typeable)

-- | FromJSON BackgroundImage
instance A.FromJSON BackgroundImage where
  parseJSON :: Value -> Parser BackgroundImage
parseJSON = String
-> (Object -> Parser BackgroundImage)
-> Value
-> Parser BackgroundImage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BackgroundImage" ((Object -> Parser BackgroundImage)
 -> Value -> Parser BackgroundImage)
-> (Object -> Parser BackgroundImage)
-> Value
-> Parser BackgroundImage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> BackgroundImage
BackgroundImage
      (Maybe Text
 -> Maybe Text
 -> Maybe Value
 -> Maybe Text
 -> Maybe Text
 -> BackgroundImage)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Value -> Maybe Text -> Maybe Text -> BackgroundImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"blur_hash")
      Parser
  (Maybe Text
   -> Maybe Value -> Maybe Text -> Maybe Text -> BackgroundImage)
-> Parser (Maybe Text)
-> Parser
     (Maybe Value -> Maybe Text -> Maybe Text -> BackgroundImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Value -> Maybe Text -> Maybe Text -> BackgroundImage)
-> Parser (Maybe Value)
-> Parser (Maybe Text -> Maybe Text -> BackgroundImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"info")
      Parser (Maybe Text -> Maybe Text -> BackgroundImage)
-> Parser (Maybe Text) -> Parser (Maybe Text -> BackgroundImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"thumb")
      Parser (Maybe Text -> BackgroundImage)
-> Parser (Maybe Text) -> Parser BackgroundImage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON BackgroundImage
instance A.ToJSON BackgroundImage where
  toJSON :: BackgroundImage -> Value
toJSON BackgroundImage {Maybe Text
Maybe Value
backgroundImageUrl :: Maybe Text
backgroundImageThumb :: Maybe Text
backgroundImageInfo :: Maybe Value
backgroundImageId :: Maybe Text
backgroundImageBlurHash :: Maybe Text
$sel:backgroundImageUrl:BackgroundImage :: BackgroundImage -> Maybe Text
$sel:backgroundImageThumb:BackgroundImage :: BackgroundImage -> Maybe Text
$sel:backgroundImageInfo:BackgroundImage :: BackgroundImage -> Maybe Value
$sel:backgroundImageId:BackgroundImage :: BackgroundImage -> Maybe Text
$sel:backgroundImageBlurHash:BackgroundImage :: BackgroundImage -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"blur_hash" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
backgroundImageBlurHash
      , Key
"id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
backgroundImageId
      , Key
"info" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
backgroundImageInfo
      , Key
"thumb" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
backgroundImageThumb
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
backgroundImageUrl
      ]


-- | Construct a value of type 'BackgroundImage' (by applying it's required fields, if any)
mkBackgroundImage
  :: BackgroundImage
mkBackgroundImage :: BackgroundImage
mkBackgroundImage =
  BackgroundImage :: Maybe Text
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> BackgroundImage
BackgroundImage
  { $sel:backgroundImageBlurHash:BackgroundImage :: Maybe Text
backgroundImageBlurHash = Maybe Text
forall a. Maybe a
Nothing
  , $sel:backgroundImageId:BackgroundImage :: Maybe Text
backgroundImageId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:backgroundImageInfo:BackgroundImage :: Maybe Value
backgroundImageInfo = Maybe Value
forall a. Maybe a
Nothing
  , $sel:backgroundImageThumb:BackgroundImage :: Maybe Text
backgroundImageThumb = Maybe Text
forall a. Maybe a
Nothing
  , $sel:backgroundImageUrl:BackgroundImage :: Maybe Text
backgroundImageUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** FilesFile
-- | FilesFile
data FilesFile = FilesFile
  { FilesFile -> Maybe Text
filesFileCreated :: !(Maybe Text) -- ^ "created"
  , FilesFile -> Maybe Int
filesFileId :: !(Maybe Int) -- ^ "id"
  , FilesFile -> Maybe Text
filesFileMime :: !(Maybe Text) -- ^ "mime"
  , FilesFile -> Maybe Text
filesFileName :: !(Maybe Text) -- ^ "name"
  , FilesFile -> Maybe Int
filesFileSize :: !(Maybe Int) -- ^ "size"
  } deriving (Int -> FilesFile -> ShowS
[FilesFile] -> ShowS
FilesFile -> String
(Int -> FilesFile -> ShowS)
-> (FilesFile -> String)
-> ([FilesFile] -> ShowS)
-> Show FilesFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilesFile] -> ShowS
$cshowList :: [FilesFile] -> ShowS
show :: FilesFile -> String
$cshow :: FilesFile -> String
showsPrec :: Int -> FilesFile -> ShowS
$cshowsPrec :: Int -> FilesFile -> ShowS
P.Show, FilesFile -> FilesFile -> Bool
(FilesFile -> FilesFile -> Bool)
-> (FilesFile -> FilesFile -> Bool) -> Eq FilesFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilesFile -> FilesFile -> Bool
$c/= :: FilesFile -> FilesFile -> Bool
== :: FilesFile -> FilesFile -> Bool
$c== :: FilesFile -> FilesFile -> Bool
P.Eq, P.Typeable)

-- | FromJSON FilesFile
instance A.FromJSON FilesFile where
  parseJSON :: Value -> Parser FilesFile
parseJSON = String -> (Object -> Parser FilesFile) -> Value -> Parser FilesFile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FilesFile" ((Object -> Parser FilesFile) -> Value -> Parser FilesFile)
-> (Object -> Parser FilesFile) -> Value -> Parser FilesFile
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int -> Maybe Text -> Maybe Text -> Maybe Int -> FilesFile
FilesFile
      (Maybe Text
 -> Maybe Int -> Maybe Text -> Maybe Text -> Maybe Int -> FilesFile)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int -> Maybe Text -> Maybe Text -> Maybe Int -> FilesFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Int -> Maybe Text -> Maybe Text -> Maybe Int -> FilesFile)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> Maybe Text -> Maybe Int -> FilesFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> Maybe Int -> FilesFile)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Int -> FilesFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mime")
      Parser (Maybe Text -> Maybe Int -> FilesFile)
-> Parser (Maybe Text) -> Parser (Maybe Int -> FilesFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Int -> FilesFile)
-> Parser (Maybe Int) -> Parser FilesFile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size")

-- | ToJSON FilesFile
instance A.ToJSON FilesFile where
  toJSON :: FilesFile -> Value
toJSON FilesFile {Maybe Int
Maybe Text
filesFileSize :: Maybe Int
filesFileName :: Maybe Text
filesFileMime :: Maybe Text
filesFileId :: Maybe Int
filesFileCreated :: Maybe Text
$sel:filesFileSize:FilesFile :: FilesFile -> Maybe Int
$sel:filesFileName:FilesFile :: FilesFile -> Maybe Text
$sel:filesFileMime:FilesFile :: FilesFile -> Maybe Text
$sel:filesFileId:FilesFile :: FilesFile -> Maybe Int
$sel:filesFileCreated:FilesFile :: FilesFile -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
filesFileCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
filesFileId
      , Key
"mime" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
filesFileMime
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
filesFileName
      , Key
"size" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
filesFileSize
      ]


-- | Construct a value of type 'FilesFile' (by applying it's required fields, if any)
mkFilesFile
  :: FilesFile
mkFilesFile :: FilesFile
mkFilesFile =
  FilesFile :: Maybe Text
-> Maybe Int -> Maybe Text -> Maybe Text -> Maybe Int -> FilesFile
FilesFile
  { $sel:filesFileCreated:FilesFile :: Maybe Text
filesFileCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:filesFileId:FilesFile :: Maybe Int
filesFileId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:filesFileMime:FilesFile :: Maybe Text
filesFileMime = Maybe Text
forall a. Maybe a
Nothing
  , $sel:filesFileName:FilesFile :: Maybe Text
filesFileName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:filesFileSize:FilesFile :: Maybe Int
filesFileSize = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** HandlerAuthURL
-- | HandlerAuthURL
data HandlerAuthURL = HandlerAuthURL
  { HandlerAuthURL -> Maybe Text
handlerAuthURLUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> HandlerAuthURL -> ShowS
[HandlerAuthURL] -> ShowS
HandlerAuthURL -> String
(Int -> HandlerAuthURL -> ShowS)
-> (HandlerAuthURL -> String)
-> ([HandlerAuthURL] -> ShowS)
-> Show HandlerAuthURL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandlerAuthURL] -> ShowS
$cshowList :: [HandlerAuthURL] -> ShowS
show :: HandlerAuthURL -> String
$cshow :: HandlerAuthURL -> String
showsPrec :: Int -> HandlerAuthURL -> ShowS
$cshowsPrec :: Int -> HandlerAuthURL -> ShowS
P.Show, HandlerAuthURL -> HandlerAuthURL -> Bool
(HandlerAuthURL -> HandlerAuthURL -> Bool)
-> (HandlerAuthURL -> HandlerAuthURL -> Bool) -> Eq HandlerAuthURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandlerAuthURL -> HandlerAuthURL -> Bool
$c/= :: HandlerAuthURL -> HandlerAuthURL -> Bool
== :: HandlerAuthURL -> HandlerAuthURL -> Bool
$c== :: HandlerAuthURL -> HandlerAuthURL -> Bool
P.Eq, P.Typeable)

-- | FromJSON HandlerAuthURL
instance A.FromJSON HandlerAuthURL where
  parseJSON :: Value -> Parser HandlerAuthURL
parseJSON = String
-> (Object -> Parser HandlerAuthURL)
-> Value
-> Parser HandlerAuthURL
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HandlerAuthURL" ((Object -> Parser HandlerAuthURL)
 -> Value -> Parser HandlerAuthURL)
-> (Object -> Parser HandlerAuthURL)
-> Value
-> Parser HandlerAuthURL
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> HandlerAuthURL
HandlerAuthURL
      (Maybe Text -> HandlerAuthURL)
-> Parser (Maybe Text) -> Parser HandlerAuthURL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON HandlerAuthURL
instance A.ToJSON HandlerAuthURL where
  toJSON :: HandlerAuthURL -> Value
toJSON HandlerAuthURL {Maybe Text
handlerAuthURLUrl :: Maybe Text
$sel:handlerAuthURLUrl:HandlerAuthURL :: HandlerAuthURL -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
handlerAuthURLUrl
      ]


-- | Construct a value of type 'HandlerAuthURL' (by applying it's required fields, if any)
mkHandlerAuthURL
  :: HandlerAuthURL
mkHandlerAuthURL :: HandlerAuthURL
mkHandlerAuthURL =
  HandlerAuthURL :: Maybe Text -> HandlerAuthURL
HandlerAuthURL
  { $sel:handlerAuthURLUrl:HandlerAuthURL :: Maybe Text
handlerAuthURLUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** MicrosofttodoMigration
-- | MicrosofttodoMigration
data MicrosofttodoMigration = MicrosofttodoMigration
  { MicrosofttodoMigration -> Maybe Text
microsofttodoMigrationCode :: !(Maybe Text) -- ^ "code"
  } deriving (Int -> MicrosofttodoMigration -> ShowS
[MicrosofttodoMigration] -> ShowS
MicrosofttodoMigration -> String
(Int -> MicrosofttodoMigration -> ShowS)
-> (MicrosofttodoMigration -> String)
-> ([MicrosofttodoMigration] -> ShowS)
-> Show MicrosofttodoMigration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MicrosofttodoMigration] -> ShowS
$cshowList :: [MicrosofttodoMigration] -> ShowS
show :: MicrosofttodoMigration -> String
$cshow :: MicrosofttodoMigration -> String
showsPrec :: Int -> MicrosofttodoMigration -> ShowS
$cshowsPrec :: Int -> MicrosofttodoMigration -> ShowS
P.Show, MicrosofttodoMigration -> MicrosofttodoMigration -> Bool
(MicrosofttodoMigration -> MicrosofttodoMigration -> Bool)
-> (MicrosofttodoMigration -> MicrosofttodoMigration -> Bool)
-> Eq MicrosofttodoMigration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MicrosofttodoMigration -> MicrosofttodoMigration -> Bool
$c/= :: MicrosofttodoMigration -> MicrosofttodoMigration -> Bool
== :: MicrosofttodoMigration -> MicrosofttodoMigration -> Bool
$c== :: MicrosofttodoMigration -> MicrosofttodoMigration -> Bool
P.Eq, P.Typeable)

-- | FromJSON MicrosofttodoMigration
instance A.FromJSON MicrosofttodoMigration where
  parseJSON :: Value -> Parser MicrosofttodoMigration
parseJSON = String
-> (Object -> Parser MicrosofttodoMigration)
-> Value
-> Parser MicrosofttodoMigration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"MicrosofttodoMigration" ((Object -> Parser MicrosofttodoMigration)
 -> Value -> Parser MicrosofttodoMigration)
-> (Object -> Parser MicrosofttodoMigration)
-> Value
-> Parser MicrosofttodoMigration
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> MicrosofttodoMigration
MicrosofttodoMigration
      (Maybe Text -> MicrosofttodoMigration)
-> Parser (Maybe Text) -> Parser MicrosofttodoMigration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code")

-- | ToJSON MicrosofttodoMigration
instance A.ToJSON MicrosofttodoMigration where
  toJSON :: MicrosofttodoMigration -> Value
toJSON MicrosofttodoMigration {Maybe Text
microsofttodoMigrationCode :: Maybe Text
$sel:microsofttodoMigrationCode:MicrosofttodoMigration :: MicrosofttodoMigration -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"code" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
microsofttodoMigrationCode
      ]


-- | Construct a value of type 'MicrosofttodoMigration' (by applying it's required fields, if any)
mkMicrosofttodoMigration
  :: MicrosofttodoMigration
mkMicrosofttodoMigration :: MicrosofttodoMigration
mkMicrosofttodoMigration =
  MicrosofttodoMigration :: Maybe Text -> MicrosofttodoMigration
MicrosofttodoMigration
  { $sel:microsofttodoMigrationCode:MicrosofttodoMigration :: Maybe Text
microsofttodoMigrationCode = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** MigrationStatus
-- | MigrationStatus
data MigrationStatus = MigrationStatus
  { MigrationStatus -> Maybe Text
migrationStatusFinishedAt :: !(Maybe Text) -- ^ "finished_at"
  , MigrationStatus -> Maybe Int
migrationStatusId :: !(Maybe Int) -- ^ "id"
  , MigrationStatus -> Maybe Text
migrationStatusMigratorName :: !(Maybe Text) -- ^ "migrator_name"
  , MigrationStatus -> Maybe Text
migrationStatusStartedAt :: !(Maybe Text) -- ^ "started_at"
  } deriving (Int -> MigrationStatus -> ShowS
[MigrationStatus] -> ShowS
MigrationStatus -> String
(Int -> MigrationStatus -> ShowS)
-> (MigrationStatus -> String)
-> ([MigrationStatus] -> ShowS)
-> Show MigrationStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationStatus] -> ShowS
$cshowList :: [MigrationStatus] -> ShowS
show :: MigrationStatus -> String
$cshow :: MigrationStatus -> String
showsPrec :: Int -> MigrationStatus -> ShowS
$cshowsPrec :: Int -> MigrationStatus -> ShowS
P.Show, MigrationStatus -> MigrationStatus -> Bool
(MigrationStatus -> MigrationStatus -> Bool)
-> (MigrationStatus -> MigrationStatus -> Bool)
-> Eq MigrationStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrationStatus -> MigrationStatus -> Bool
$c/= :: MigrationStatus -> MigrationStatus -> Bool
== :: MigrationStatus -> MigrationStatus -> Bool
$c== :: MigrationStatus -> MigrationStatus -> Bool
P.Eq, P.Typeable)

-- | FromJSON MigrationStatus
instance A.FromJSON MigrationStatus where
  parseJSON :: Value -> Parser MigrationStatus
parseJSON = String
-> (Object -> Parser MigrationStatus)
-> Value
-> Parser MigrationStatus
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"MigrationStatus" ((Object -> Parser MigrationStatus)
 -> Value -> Parser MigrationStatus)
-> (Object -> Parser MigrationStatus)
-> Value
-> Parser MigrationStatus
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int -> Maybe Text -> Maybe Text -> MigrationStatus
MigrationStatus
      (Maybe Text
 -> Maybe Int -> Maybe Text -> Maybe Text -> MigrationStatus)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int -> Maybe Text -> Maybe Text -> MigrationStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"finished_at")
      Parser (Maybe Int -> Maybe Text -> Maybe Text -> MigrationStatus)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> Maybe Text -> MigrationStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> MigrationStatus)
-> Parser (Maybe Text) -> Parser (Maybe Text -> MigrationStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"migrator_name")
      Parser (Maybe Text -> MigrationStatus)
-> Parser (Maybe Text) -> Parser MigrationStatus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"started_at")

-- | ToJSON MigrationStatus
instance A.ToJSON MigrationStatus where
  toJSON :: MigrationStatus -> Value
toJSON MigrationStatus {Maybe Int
Maybe Text
migrationStatusStartedAt :: Maybe Text
migrationStatusMigratorName :: Maybe Text
migrationStatusId :: Maybe Int
migrationStatusFinishedAt :: Maybe Text
$sel:migrationStatusStartedAt:MigrationStatus :: MigrationStatus -> Maybe Text
$sel:migrationStatusMigratorName:MigrationStatus :: MigrationStatus -> Maybe Text
$sel:migrationStatusId:MigrationStatus :: MigrationStatus -> Maybe Int
$sel:migrationStatusFinishedAt:MigrationStatus :: MigrationStatus -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"finished_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
migrationStatusFinishedAt
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
migrationStatusId
      , Key
"migrator_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
migrationStatusMigratorName
      , Key
"started_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
migrationStatusStartedAt
      ]


-- | Construct a value of type 'MigrationStatus' (by applying it's required fields, if any)
mkMigrationStatus
  :: MigrationStatus
mkMigrationStatus :: MigrationStatus
mkMigrationStatus =
  MigrationStatus :: Maybe Text
-> Maybe Int -> Maybe Text -> Maybe Text -> MigrationStatus
MigrationStatus
  { $sel:migrationStatusFinishedAt:MigrationStatus :: Maybe Text
migrationStatusFinishedAt = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrationStatusId:MigrationStatus :: Maybe Int
migrationStatusId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:migrationStatusMigratorName:MigrationStatus :: Maybe Text
migrationStatusMigratorName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrationStatusStartedAt:MigrationStatus :: Maybe Text
migrationStatusStartedAt = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsAPIToken
-- | ModelsAPIToken
data ModelsAPIToken = ModelsAPIToken
  { ModelsAPIToken -> Maybe Text
modelsAPITokenCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this api key was created. You cannot change this value.
  , ModelsAPIToken -> Maybe Text
modelsAPITokenExpiresAt :: !(Maybe Text) -- ^ "expires_at" - The date when this key expires.
  , ModelsAPIToken -> Maybe Int
modelsAPITokenId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this api key.
  , ModelsAPIToken -> Maybe (Map String [Text])
modelsAPITokenPermissions :: !(Maybe (Map.Map String [Text])) -- ^ "permissions" - The permissions this token has. Possible values are available via the /routes endpoint and consist of the keys of the list from that endpoint. For example, if the token should be able to read all tasks as well as update existing tasks, you should add &#x60;{\&quot;tasks\&quot;:[\&quot;read_all\&quot;,\&quot;update\&quot;]}&#x60;.
  , ModelsAPIToken -> Maybe Text
modelsAPITokenTitle :: !(Maybe Text) -- ^ "title" - A human-readable name for this token
  , ModelsAPIToken -> Maybe Text
modelsAPITokenToken :: !(Maybe Text) -- ^ "token" - The actual api key. Only visible after creation.
  } deriving (Int -> ModelsAPIToken -> ShowS
[ModelsAPIToken] -> ShowS
ModelsAPIToken -> String
(Int -> ModelsAPIToken -> ShowS)
-> (ModelsAPIToken -> String)
-> ([ModelsAPIToken] -> ShowS)
-> Show ModelsAPIToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsAPIToken] -> ShowS
$cshowList :: [ModelsAPIToken] -> ShowS
show :: ModelsAPIToken -> String
$cshow :: ModelsAPIToken -> String
showsPrec :: Int -> ModelsAPIToken -> ShowS
$cshowsPrec :: Int -> ModelsAPIToken -> ShowS
P.Show, ModelsAPIToken -> ModelsAPIToken -> Bool
(ModelsAPIToken -> ModelsAPIToken -> Bool)
-> (ModelsAPIToken -> ModelsAPIToken -> Bool) -> Eq ModelsAPIToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsAPIToken -> ModelsAPIToken -> Bool
$c/= :: ModelsAPIToken -> ModelsAPIToken -> Bool
== :: ModelsAPIToken -> ModelsAPIToken -> Bool
$c== :: ModelsAPIToken -> ModelsAPIToken -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsAPIToken
instance A.FromJSON ModelsAPIToken where
  parseJSON :: Value -> Parser ModelsAPIToken
parseJSON = String
-> (Object -> Parser ModelsAPIToken)
-> Value
-> Parser ModelsAPIToken
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsAPIToken" ((Object -> Parser ModelsAPIToken)
 -> Value -> Parser ModelsAPIToken)
-> (Object -> Parser ModelsAPIToken)
-> Value
-> Parser ModelsAPIToken
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe (Map String [Text])
-> Maybe Text
-> Maybe Text
-> ModelsAPIToken
ModelsAPIToken
      (Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe (Map String [Text])
 -> Maybe Text
 -> Maybe Text
 -> ModelsAPIToken)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe (Map String [Text])
      -> Maybe Text
      -> Maybe Text
      -> ModelsAPIToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe (Map String [Text])
   -> Maybe Text
   -> Maybe Text
   -> ModelsAPIToken)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe (Map String [Text])
      -> Maybe Text
      -> Maybe Text
      -> ModelsAPIToken)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_at")
      Parser
  (Maybe Int
   -> Maybe (Map String [Text])
   -> Maybe Text
   -> Maybe Text
   -> ModelsAPIToken)
-> Parser (Maybe Int)
-> Parser
     (Maybe (Map String [Text])
      -> Maybe Text -> Maybe Text -> ModelsAPIToken)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe (Map String [Text])
   -> Maybe Text -> Maybe Text -> ModelsAPIToken)
-> Parser (Maybe (Map String [Text]))
-> Parser (Maybe Text -> Maybe Text -> ModelsAPIToken)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map String [Text]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions")
      Parser (Maybe Text -> Maybe Text -> ModelsAPIToken)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsAPIToken)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> ModelsAPIToken)
-> Parser (Maybe Text) -> Parser ModelsAPIToken
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token")

-- | ToJSON ModelsAPIToken
instance A.ToJSON ModelsAPIToken where
  toJSON :: ModelsAPIToken -> Value
toJSON ModelsAPIToken {Maybe Int
Maybe Text
Maybe (Map String [Text])
modelsAPITokenToken :: Maybe Text
modelsAPITokenTitle :: Maybe Text
modelsAPITokenPermissions :: Maybe (Map String [Text])
modelsAPITokenId :: Maybe Int
modelsAPITokenExpiresAt :: Maybe Text
modelsAPITokenCreated :: Maybe Text
$sel:modelsAPITokenToken:ModelsAPIToken :: ModelsAPIToken -> Maybe Text
$sel:modelsAPITokenTitle:ModelsAPIToken :: ModelsAPIToken -> Maybe Text
$sel:modelsAPITokenPermissions:ModelsAPIToken :: ModelsAPIToken -> Maybe (Map String [Text])
$sel:modelsAPITokenId:ModelsAPIToken :: ModelsAPIToken -> Maybe Int
$sel:modelsAPITokenExpiresAt:ModelsAPIToken :: ModelsAPIToken -> Maybe Text
$sel:modelsAPITokenCreated:ModelsAPIToken :: ModelsAPIToken -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsAPITokenCreated
      , Key
"expires_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsAPITokenExpiresAt
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsAPITokenId
      , Key
"permissions" Key -> Maybe (Map String [Text]) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String [Text])
modelsAPITokenPermissions
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsAPITokenTitle
      , Key
"token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsAPITokenToken
      ]


-- | Construct a value of type 'ModelsAPIToken' (by applying it's required fields, if any)
mkModelsAPIToken
  :: ModelsAPIToken
mkModelsAPIToken :: ModelsAPIToken
mkModelsAPIToken =
  ModelsAPIToken :: Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe (Map String [Text])
-> Maybe Text
-> Maybe Text
-> ModelsAPIToken
ModelsAPIToken
  { $sel:modelsAPITokenCreated:ModelsAPIToken :: Maybe Text
modelsAPITokenCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsAPITokenExpiresAt:ModelsAPIToken :: Maybe Text
modelsAPITokenExpiresAt = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsAPITokenId:ModelsAPIToken :: Maybe Int
modelsAPITokenId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsAPITokenPermissions:ModelsAPIToken :: Maybe (Map String [Text])
modelsAPITokenPermissions = Maybe (Map String [Text])
forall a. Maybe a
Nothing
  , $sel:modelsAPITokenTitle:ModelsAPIToken :: Maybe Text
modelsAPITokenTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsAPITokenToken:ModelsAPIToken :: Maybe Text
modelsAPITokenToken = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsBucket
-- | ModelsBucket
data ModelsBucket = ModelsBucket
  { ModelsBucket -> Maybe Int
modelsBucketCount :: !(Maybe Int) -- ^ "count" - The number of tasks currently in this bucket
  , ModelsBucket -> Maybe Text
modelsBucketCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this bucket was created. You cannot change this value.
  , ModelsBucket -> Maybe UserUser
modelsBucketCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who initially created the bucket.
  , ModelsBucket -> Maybe Int
modelsBucketId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this bucket.
  , ModelsBucket -> Maybe Int
modelsBucketLimit :: !(Maybe Int) -- ^ "limit" - How many tasks can be at the same time on this board max
  , ModelsBucket -> Maybe Double
modelsBucketPosition :: !(Maybe Double) -- ^ "position" - The position this bucket has when querying all buckets. See the tasks.position property on how to use this.
  , ModelsBucket -> Maybe Int
modelsBucketProjectViewId :: !(Maybe Int) -- ^ "project_view_id" - The project view this bucket belongs to.
  , ModelsBucket -> Maybe [ModelsTask]
modelsBucketTasks :: !(Maybe [ModelsTask]) -- ^ "tasks" - All tasks which belong to this bucket.
  , ModelsBucket -> Maybe Text
modelsBucketTitle :: !(Maybe Text) -- ^ "title" - The title of this bucket.
  , ModelsBucket -> Maybe Text
modelsBucketUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this bucket was last updated. You cannot change this value.
  } deriving (Int -> ModelsBucket -> ShowS
[ModelsBucket] -> ShowS
ModelsBucket -> String
(Int -> ModelsBucket -> ShowS)
-> (ModelsBucket -> String)
-> ([ModelsBucket] -> ShowS)
-> Show ModelsBucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsBucket] -> ShowS
$cshowList :: [ModelsBucket] -> ShowS
show :: ModelsBucket -> String
$cshow :: ModelsBucket -> String
showsPrec :: Int -> ModelsBucket -> ShowS
$cshowsPrec :: Int -> ModelsBucket -> ShowS
P.Show, ModelsBucket -> ModelsBucket -> Bool
(ModelsBucket -> ModelsBucket -> Bool)
-> (ModelsBucket -> ModelsBucket -> Bool) -> Eq ModelsBucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsBucket -> ModelsBucket -> Bool
$c/= :: ModelsBucket -> ModelsBucket -> Bool
== :: ModelsBucket -> ModelsBucket -> Bool
$c== :: ModelsBucket -> ModelsBucket -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsBucket
instance A.FromJSON ModelsBucket where
  parseJSON :: Value -> Parser ModelsBucket
parseJSON = String
-> (Object -> Parser ModelsBucket) -> Value -> Parser ModelsBucket
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsBucket" ((Object -> Parser ModelsBucket) -> Value -> Parser ModelsBucket)
-> (Object -> Parser ModelsBucket) -> Value -> Parser ModelsBucket
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int
-> Maybe Text
-> Maybe UserUser
-> Maybe Int
-> Maybe Int
-> Maybe Double
-> Maybe Int
-> Maybe [ModelsTask]
-> Maybe Text
-> Maybe Text
-> ModelsBucket
ModelsBucket
      (Maybe Int
 -> Maybe Text
 -> Maybe UserUser
 -> Maybe Int
 -> Maybe Int
 -> Maybe Double
 -> Maybe Int
 -> Maybe [ModelsTask]
 -> Maybe Text
 -> Maybe Text
 -> ModelsBucket)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe [ModelsTask]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"count")
      Parser
  (Maybe Text
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe [ModelsTask]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBucket)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe Int
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe [ModelsTask]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe Int
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe [ModelsTask]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBucket)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe [ModelsTask]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe [ModelsTask]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBucket)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe [ModelsTask]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe [ModelsTask]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBucket)
-> Parser (Maybe Int)
-> Parser
     (Maybe Double
      -> Maybe Int
      -> Maybe [ModelsTask]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"limit")
      Parser
  (Maybe Double
   -> Maybe Int
   -> Maybe [ModelsTask]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBucket)
-> Parser (Maybe Double)
-> Parser
     (Maybe Int
      -> Maybe [ModelsTask] -> Maybe Text -> Maybe Text -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position")
      Parser
  (Maybe Int
   -> Maybe [ModelsTask] -> Maybe Text -> Maybe Text -> ModelsBucket)
-> Parser (Maybe Int)
-> Parser
     (Maybe [ModelsTask] -> Maybe Text -> Maybe Text -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_view_id")
      Parser
  (Maybe [ModelsTask] -> Maybe Text -> Maybe Text -> ModelsBucket)
-> Parser (Maybe [ModelsTask])
-> Parser (Maybe Text -> Maybe Text -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsTask])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tasks")
      Parser (Maybe Text -> Maybe Text -> ModelsBucket)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> ModelsBucket)
-> Parser (Maybe Text) -> Parser ModelsBucket
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsBucket
instance A.ToJSON ModelsBucket where
  toJSON :: ModelsBucket -> Value
toJSON ModelsBucket {Maybe Double
Maybe Int
Maybe [ModelsTask]
Maybe Text
Maybe UserUser
modelsBucketUpdated :: Maybe Text
modelsBucketTitle :: Maybe Text
modelsBucketTasks :: Maybe [ModelsTask]
modelsBucketProjectViewId :: Maybe Int
modelsBucketPosition :: Maybe Double
modelsBucketLimit :: Maybe Int
modelsBucketId :: Maybe Int
modelsBucketCreatedBy :: Maybe UserUser
modelsBucketCreated :: Maybe Text
modelsBucketCount :: Maybe Int
$sel:modelsBucketUpdated:ModelsBucket :: ModelsBucket -> Maybe Text
$sel:modelsBucketTitle:ModelsBucket :: ModelsBucket -> Maybe Text
$sel:modelsBucketTasks:ModelsBucket :: ModelsBucket -> Maybe [ModelsTask]
$sel:modelsBucketProjectViewId:ModelsBucket :: ModelsBucket -> Maybe Int
$sel:modelsBucketPosition:ModelsBucket :: ModelsBucket -> Maybe Double
$sel:modelsBucketLimit:ModelsBucket :: ModelsBucket -> Maybe Int
$sel:modelsBucketId:ModelsBucket :: ModelsBucket -> Maybe Int
$sel:modelsBucketCreatedBy:ModelsBucket :: ModelsBucket -> Maybe UserUser
$sel:modelsBucketCreated:ModelsBucket :: ModelsBucket -> Maybe Text
$sel:modelsBucketCount:ModelsBucket :: ModelsBucket -> Maybe Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"count" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBucketCount
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBucketCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsBucketCreatedBy
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBucketId
      , Key
"limit" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBucketLimit
      , Key
"position" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsBucketPosition
      , Key
"project_view_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBucketProjectViewId
      , Key
"tasks" Key -> Maybe [ModelsTask] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsTask]
modelsBucketTasks
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBucketTitle
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBucketUpdated
      ]


-- | Construct a value of type 'ModelsBucket' (by applying it's required fields, if any)
mkModelsBucket
  :: ModelsBucket
mkModelsBucket :: ModelsBucket
mkModelsBucket =
  ModelsBucket :: Maybe Int
-> Maybe Text
-> Maybe UserUser
-> Maybe Int
-> Maybe Int
-> Maybe Double
-> Maybe Int
-> Maybe [ModelsTask]
-> Maybe Text
-> Maybe Text
-> ModelsBucket
ModelsBucket
  { $sel:modelsBucketCount:ModelsBucket :: Maybe Int
modelsBucketCount = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBucketCreated:ModelsBucket :: Maybe Text
modelsBucketCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBucketCreatedBy:ModelsBucket :: Maybe UserUser
modelsBucketCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsBucketId:ModelsBucket :: Maybe Int
modelsBucketId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBucketLimit:ModelsBucket :: Maybe Int
modelsBucketLimit = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBucketPosition:ModelsBucket :: Maybe Double
modelsBucketPosition = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsBucketProjectViewId:ModelsBucket :: Maybe Int
modelsBucketProjectViewId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBucketTasks:ModelsBucket :: Maybe [ModelsTask]
modelsBucketTasks = Maybe [ModelsTask]
forall a. Maybe a
Nothing
  , $sel:modelsBucketTitle:ModelsBucket :: Maybe Text
modelsBucketTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBucketUpdated:ModelsBucket :: Maybe Text
modelsBucketUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsBulkAssignees
-- | ModelsBulkAssignees
data ModelsBulkAssignees = ModelsBulkAssignees
  { ModelsBulkAssignees -> Maybe [UserUser]
modelsBulkAssigneesAssignees :: !(Maybe [UserUser]) -- ^ "assignees" - A project with all assignees
  } deriving (Int -> ModelsBulkAssignees -> ShowS
[ModelsBulkAssignees] -> ShowS
ModelsBulkAssignees -> String
(Int -> ModelsBulkAssignees -> ShowS)
-> (ModelsBulkAssignees -> String)
-> ([ModelsBulkAssignees] -> ShowS)
-> Show ModelsBulkAssignees
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsBulkAssignees] -> ShowS
$cshowList :: [ModelsBulkAssignees] -> ShowS
show :: ModelsBulkAssignees -> String
$cshow :: ModelsBulkAssignees -> String
showsPrec :: Int -> ModelsBulkAssignees -> ShowS
$cshowsPrec :: Int -> ModelsBulkAssignees -> ShowS
P.Show, ModelsBulkAssignees -> ModelsBulkAssignees -> Bool
(ModelsBulkAssignees -> ModelsBulkAssignees -> Bool)
-> (ModelsBulkAssignees -> ModelsBulkAssignees -> Bool)
-> Eq ModelsBulkAssignees
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsBulkAssignees -> ModelsBulkAssignees -> Bool
$c/= :: ModelsBulkAssignees -> ModelsBulkAssignees -> Bool
== :: ModelsBulkAssignees -> ModelsBulkAssignees -> Bool
$c== :: ModelsBulkAssignees -> ModelsBulkAssignees -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsBulkAssignees
instance A.FromJSON ModelsBulkAssignees where
  parseJSON :: Value -> Parser ModelsBulkAssignees
parseJSON = String
-> (Object -> Parser ModelsBulkAssignees)
-> Value
-> Parser ModelsBulkAssignees
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsBulkAssignees" ((Object -> Parser ModelsBulkAssignees)
 -> Value -> Parser ModelsBulkAssignees)
-> (Object -> Parser ModelsBulkAssignees)
-> Value
-> Parser ModelsBulkAssignees
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [UserUser] -> ModelsBulkAssignees
ModelsBulkAssignees
      (Maybe [UserUser] -> ModelsBulkAssignees)
-> Parser (Maybe [UserUser]) -> Parser ModelsBulkAssignees
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [UserUser])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")

-- | ToJSON ModelsBulkAssignees
instance A.ToJSON ModelsBulkAssignees where
  toJSON :: ModelsBulkAssignees -> Value
toJSON ModelsBulkAssignees {Maybe [UserUser]
modelsBulkAssigneesAssignees :: Maybe [UserUser]
$sel:modelsBulkAssigneesAssignees:ModelsBulkAssignees :: ModelsBulkAssignees -> Maybe [UserUser]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assignees" Key -> Maybe [UserUser] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [UserUser]
modelsBulkAssigneesAssignees
      ]


-- | Construct a value of type 'ModelsBulkAssignees' (by applying it's required fields, if any)
mkModelsBulkAssignees
  :: ModelsBulkAssignees
mkModelsBulkAssignees :: ModelsBulkAssignees
mkModelsBulkAssignees =
  ModelsBulkAssignees :: Maybe [UserUser] -> ModelsBulkAssignees
ModelsBulkAssignees
  { $sel:modelsBulkAssigneesAssignees:ModelsBulkAssignees :: Maybe [UserUser]
modelsBulkAssigneesAssignees = Maybe [UserUser]
forall a. Maybe a
Nothing
  }

-- ** ModelsBulkTask
-- | ModelsBulkTask
data ModelsBulkTask = ModelsBulkTask
  { ModelsBulkTask -> Maybe [UserUser]
modelsBulkTaskAssignees :: !(Maybe [UserUser]) -- ^ "assignees" - An array of users who are assigned to this task
  , ModelsBulkTask -> Maybe [ModelsTaskAttachment]
modelsBulkTaskAttachments :: !(Maybe [ModelsTaskAttachment]) -- ^ "attachments" - All attachments this task has. This property is read-onlym, you must use the separate endpoint to add attachments to a task.
  , ModelsBulkTask -> Maybe Int
modelsBulkTaskBucketId :: !(Maybe Int) -- ^ "bucket_id" - The bucket id. Will only be populated when the task is accessed via a view with buckets. Can be used to move a task between buckets. In that case, the new bucket must be in the same view as the old one.
  , ModelsBulkTask -> Maybe Int
modelsBulkTaskCoverImageAttachmentId :: !(Maybe Int) -- ^ "cover_image_attachment_id" - If this task has a cover image, the field will return the id of the attachment that is the cover image.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this task was created. You cannot change this value.
  , ModelsBulkTask -> Maybe UserUser
modelsBulkTaskCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who initially created the task.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskDescription :: !(Maybe Text) -- ^ "description" - The task description.
  , ModelsBulkTask -> Maybe Bool
modelsBulkTaskDone :: !(Maybe Bool) -- ^ "done" - Whether a task is done or not.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskDoneAt :: !(Maybe Text) -- ^ "done_at" - The time when a task was marked as done.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskDueDate :: !(Maybe Text) -- ^ "due_date" - The time when the task is due.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskEndDate :: !(Maybe Text) -- ^ "end_date" - When this task ends.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskHexColor :: !(Maybe Text) -- ^ "hex_color" - The task color in hex
  , ModelsBulkTask -> Maybe Int
modelsBulkTaskId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this task.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskIdentifier :: !(Maybe Text) -- ^ "identifier" - The task identifier, based on the project identifier and the task&#39;s index
  , ModelsBulkTask -> Maybe Int
modelsBulkTaskIndex :: !(Maybe Int) -- ^ "index" - The task index, calculated per project
  , ModelsBulkTask -> Maybe Bool
modelsBulkTaskIsFavorite :: !(Maybe Bool) -- ^ "is_favorite" - True if a task is a favorite task. Favorite tasks show up in a separate \&quot;Important\&quot; project. This value depends on the user making the call to the api.
  , ModelsBulkTask -> Maybe [ModelsLabel]
modelsBulkTaskLabels :: !(Maybe [ModelsLabel]) -- ^ "labels" - An array of labels which are associated with this task. This property is read-only, you must use the separate endpoint to add labels to a task.
  , ModelsBulkTask -> Maybe Double
modelsBulkTaskPercentDone :: !(Maybe Double) -- ^ "percent_done" - Determines how far a task is left from being done
  , ModelsBulkTask -> Maybe Double
modelsBulkTaskPosition :: !(Maybe Double) -- ^ "position" - The position of the task - any task project can be sorted as usual by this parameter. When accessing tasks via views with buckets, this is primarily used to sort them based on a range. Positions are always saved per view. They will automatically be set if you request the tasks through a view endpoint, otherwise they will always be 0. To update them, take a look at the Task Position endpoint.
  , ModelsBulkTask -> Maybe Int
modelsBulkTaskPriority :: !(Maybe Int) -- ^ "priority" - The task priority. Can be anything you want, it is possible to sort by this later.
  , ModelsBulkTask -> Maybe Int
modelsBulkTaskProjectId :: !(Maybe Int) -- ^ "project_id" - The project this task belongs to.
  , ModelsBulkTask -> Maybe (Map String [UserUser])
modelsBulkTaskReactions :: !(Maybe (Map.Map String [UserUser])) -- ^ "reactions" - Reactions on that task.
  , ModelsBulkTask -> Maybe (Map String [ModelsTask])
modelsBulkTaskRelatedTasks :: !(Maybe (Map.Map String [ModelsTask])) -- ^ "related_tasks" - All related tasks, grouped by their relation kind
  , ModelsBulkTask -> Maybe [ModelsTaskReminder]
modelsBulkTaskReminders :: !(Maybe [ModelsTaskReminder]) -- ^ "reminders" - An array of reminders that are associated with this task.
  , ModelsBulkTask -> Maybe Int
modelsBulkTaskRepeatAfter :: !(Maybe Int) -- ^ "repeat_after" - An amount in seconds this task repeats itself. If this is set, when marking the task as done, it will mark itself as \&quot;undone\&quot; and then increase all remindes and the due date by its amount.
  , ModelsBulkTask -> Maybe ModelsTaskRepeatMode
modelsBulkTaskRepeatMode :: !(Maybe ModelsTaskRepeatMode) -- ^ "repeat_mode" - Can have three possible values which will trigger when the task is marked as done: 0 &#x3D; repeats after the amount specified in repeat_after, 1 &#x3D; repeats all dates each months (ignoring repeat_after), 3 &#x3D; repeats from the current date rather than the last set date.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskStartDate :: !(Maybe Text) -- ^ "start_date" - When this task starts.
  , ModelsBulkTask -> Maybe ModelsSubscription
modelsBulkTaskSubscription :: !(Maybe ModelsSubscription) -- ^ "subscription" - The subscription status for the user reading this task. You can only read this property, use the subscription endpoints to modify it. Will only returned when retrieving one task.
  , ModelsBulkTask -> Maybe [Int]
modelsBulkTaskTaskIds :: !(Maybe [Int]) -- ^ "task_ids" - A project of task ids to update
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskTitle :: !(Maybe Text) -- ^ "title" - The task text. This is what you&#39;ll see in the project.
  , ModelsBulkTask -> Maybe Text
modelsBulkTaskUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this task was last updated. You cannot change this value.
  } deriving (Int -> ModelsBulkTask -> ShowS
[ModelsBulkTask] -> ShowS
ModelsBulkTask -> String
(Int -> ModelsBulkTask -> ShowS)
-> (ModelsBulkTask -> String)
-> ([ModelsBulkTask] -> ShowS)
-> Show ModelsBulkTask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsBulkTask] -> ShowS
$cshowList :: [ModelsBulkTask] -> ShowS
show :: ModelsBulkTask -> String
$cshow :: ModelsBulkTask -> String
showsPrec :: Int -> ModelsBulkTask -> ShowS
$cshowsPrec :: Int -> ModelsBulkTask -> ShowS
P.Show, ModelsBulkTask -> ModelsBulkTask -> Bool
(ModelsBulkTask -> ModelsBulkTask -> Bool)
-> (ModelsBulkTask -> ModelsBulkTask -> Bool) -> Eq ModelsBulkTask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsBulkTask -> ModelsBulkTask -> Bool
$c/= :: ModelsBulkTask -> ModelsBulkTask -> Bool
== :: ModelsBulkTask -> ModelsBulkTask -> Bool
$c== :: ModelsBulkTask -> ModelsBulkTask -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsBulkTask
instance A.FromJSON ModelsBulkTask where
  parseJSON :: Value -> Parser ModelsBulkTask
parseJSON = String
-> (Object -> Parser ModelsBulkTask)
-> Value
-> Parser ModelsBulkTask
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsBulkTask" ((Object -> Parser ModelsBulkTask)
 -> Value -> Parser ModelsBulkTask)
-> (Object -> Parser ModelsBulkTask)
-> Value
-> Parser ModelsBulkTask
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [UserUser]
-> Maybe [ModelsTaskAttachment]
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe [ModelsLabel]
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe (Map String [UserUser])
-> Maybe (Map String [ModelsTask])
-> Maybe [ModelsTaskReminder]
-> Maybe Int
-> Maybe ModelsTaskRepeatMode
-> Maybe Text
-> Maybe ModelsSubscription
-> Maybe [Int]
-> Maybe Text
-> Maybe Text
-> ModelsBulkTask
ModelsBulkTask
      (Maybe [UserUser]
 -> Maybe [ModelsTaskAttachment]
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe UserUser
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Int
 -> Maybe Bool
 -> Maybe [ModelsLabel]
 -> Maybe Double
 -> Maybe Double
 -> Maybe Int
 -> Maybe Int
 -> Maybe (Map String [UserUser])
 -> Maybe (Map String [ModelsTask])
 -> Maybe [ModelsTaskReminder]
 -> Maybe Int
 -> Maybe ModelsTaskRepeatMode
 -> Maybe Text
 -> Maybe ModelsSubscription
 -> Maybe [Int]
 -> Maybe Text
 -> Maybe Text
 -> ModelsBulkTask)
-> Parser (Maybe [UserUser])
-> Parser
     (Maybe [ModelsTaskAttachment]
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [UserUser])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe [ModelsTaskAttachment]
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe [ModelsTaskAttachment])
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsTaskAttachment])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attachments")
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bucket_id")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cover_image_attachment_id")
      Parser
  (Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"done")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"done_at")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"end_date")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hex_color")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"identifier")
      Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"index")
      Parser
  (Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_favorite")
      Parser
  (Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe [ModelsLabel])
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsLabel])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"percent_done")
      Parser
  (Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Double)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position")
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priority")
      Parser
  (Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_id")
      Parser
  (Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe (Map String [UserUser]))
-> Parser
     (Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map String [UserUser]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reactions")
      Parser
  (Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe (Map String [ModelsTask]))
-> Parser
     (Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map String [ModelsTask]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"related_tasks")
      Parser
  (Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe [ModelsTaskReminder])
-> Parser
     (Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsTaskReminder])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reminders")
      Parser
  (Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repeat_after")
      Parser
  (Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe ModelsTaskRepeatMode)
-> Parser
     (Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe Text
      -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsTaskRepeatMode)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repeat_mode")
      Parser
  (Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe Text
   -> ModelsBulkTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe ModelsSubscription
      -> Maybe [Int] -> Maybe Text -> Maybe Text -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"start_date")
      Parser
  (Maybe ModelsSubscription
   -> Maybe [Int] -> Maybe Text -> Maybe Text -> ModelsBulkTask)
-> Parser (Maybe ModelsSubscription)
-> Parser
     (Maybe [Int] -> Maybe Text -> Maybe Text -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsSubscription)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subscription")
      Parser (Maybe [Int] -> Maybe Text -> Maybe Text -> ModelsBulkTask)
-> Parser (Maybe [Int])
-> Parser (Maybe Text -> Maybe Text -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_ids")
      Parser (Maybe Text -> Maybe Text -> ModelsBulkTask)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsBulkTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> ModelsBulkTask)
-> Parser (Maybe Text) -> Parser ModelsBulkTask
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsBulkTask
instance A.ToJSON ModelsBulkTask where
  toJSON :: ModelsBulkTask -> Value
toJSON ModelsBulkTask {Maybe Bool
Maybe Double
Maybe Int
Maybe [Int]
Maybe [UserUser]
Maybe [ModelsTaskReminder]
Maybe [ModelsTaskAttachment]
Maybe [ModelsLabel]
Maybe Text
Maybe (Map String [UserUser])
Maybe (Map String [ModelsTask])
Maybe ModelsTaskRepeatMode
Maybe UserUser
Maybe ModelsSubscription
modelsBulkTaskUpdated :: Maybe Text
modelsBulkTaskTitle :: Maybe Text
modelsBulkTaskTaskIds :: Maybe [Int]
modelsBulkTaskSubscription :: Maybe ModelsSubscription
modelsBulkTaskStartDate :: Maybe Text
modelsBulkTaskRepeatMode :: Maybe ModelsTaskRepeatMode
modelsBulkTaskRepeatAfter :: Maybe Int
modelsBulkTaskReminders :: Maybe [ModelsTaskReminder]
modelsBulkTaskRelatedTasks :: Maybe (Map String [ModelsTask])
modelsBulkTaskReactions :: Maybe (Map String [UserUser])
modelsBulkTaskProjectId :: Maybe Int
modelsBulkTaskPriority :: Maybe Int
modelsBulkTaskPosition :: Maybe Double
modelsBulkTaskPercentDone :: Maybe Double
modelsBulkTaskLabels :: Maybe [ModelsLabel]
modelsBulkTaskIsFavorite :: Maybe Bool
modelsBulkTaskIndex :: Maybe Int
modelsBulkTaskIdentifier :: Maybe Text
modelsBulkTaskId :: Maybe Int
modelsBulkTaskHexColor :: Maybe Text
modelsBulkTaskEndDate :: Maybe Text
modelsBulkTaskDueDate :: Maybe Text
modelsBulkTaskDoneAt :: Maybe Text
modelsBulkTaskDone :: Maybe Bool
modelsBulkTaskDescription :: Maybe Text
modelsBulkTaskCreatedBy :: Maybe UserUser
modelsBulkTaskCreated :: Maybe Text
modelsBulkTaskCoverImageAttachmentId :: Maybe Int
modelsBulkTaskBucketId :: Maybe Int
modelsBulkTaskAttachments :: Maybe [ModelsTaskAttachment]
modelsBulkTaskAssignees :: Maybe [UserUser]
$sel:modelsBulkTaskUpdated:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskTitle:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskTaskIds:ModelsBulkTask :: ModelsBulkTask -> Maybe [Int]
$sel:modelsBulkTaskSubscription:ModelsBulkTask :: ModelsBulkTask -> Maybe ModelsSubscription
$sel:modelsBulkTaskStartDate:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskRepeatMode:ModelsBulkTask :: ModelsBulkTask -> Maybe ModelsTaskRepeatMode
$sel:modelsBulkTaskRepeatAfter:ModelsBulkTask :: ModelsBulkTask -> Maybe Int
$sel:modelsBulkTaskReminders:ModelsBulkTask :: ModelsBulkTask -> Maybe [ModelsTaskReminder]
$sel:modelsBulkTaskRelatedTasks:ModelsBulkTask :: ModelsBulkTask -> Maybe (Map String [ModelsTask])
$sel:modelsBulkTaskReactions:ModelsBulkTask :: ModelsBulkTask -> Maybe (Map String [UserUser])
$sel:modelsBulkTaskProjectId:ModelsBulkTask :: ModelsBulkTask -> Maybe Int
$sel:modelsBulkTaskPriority:ModelsBulkTask :: ModelsBulkTask -> Maybe Int
$sel:modelsBulkTaskPosition:ModelsBulkTask :: ModelsBulkTask -> Maybe Double
$sel:modelsBulkTaskPercentDone:ModelsBulkTask :: ModelsBulkTask -> Maybe Double
$sel:modelsBulkTaskLabels:ModelsBulkTask :: ModelsBulkTask -> Maybe [ModelsLabel]
$sel:modelsBulkTaskIsFavorite:ModelsBulkTask :: ModelsBulkTask -> Maybe Bool
$sel:modelsBulkTaskIndex:ModelsBulkTask :: ModelsBulkTask -> Maybe Int
$sel:modelsBulkTaskIdentifier:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskId:ModelsBulkTask :: ModelsBulkTask -> Maybe Int
$sel:modelsBulkTaskHexColor:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskEndDate:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskDueDate:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskDoneAt:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskDone:ModelsBulkTask :: ModelsBulkTask -> Maybe Bool
$sel:modelsBulkTaskDescription:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskCreatedBy:ModelsBulkTask :: ModelsBulkTask -> Maybe UserUser
$sel:modelsBulkTaskCreated:ModelsBulkTask :: ModelsBulkTask -> Maybe Text
$sel:modelsBulkTaskCoverImageAttachmentId:ModelsBulkTask :: ModelsBulkTask -> Maybe Int
$sel:modelsBulkTaskBucketId:ModelsBulkTask :: ModelsBulkTask -> Maybe Int
$sel:modelsBulkTaskAttachments:ModelsBulkTask :: ModelsBulkTask -> Maybe [ModelsTaskAttachment]
$sel:modelsBulkTaskAssignees:ModelsBulkTask :: ModelsBulkTask -> Maybe [UserUser]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assignees" Key -> Maybe [UserUser] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [UserUser]
modelsBulkTaskAssignees
      , Key
"attachments" Key -> Maybe [ModelsTaskAttachment] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsTaskAttachment]
modelsBulkTaskAttachments
      , Key
"bucket_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBulkTaskBucketId
      , Key
"cover_image_attachment_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBulkTaskCoverImageAttachmentId
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsBulkTaskCreatedBy
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskDescription
      , Key
"done" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsBulkTaskDone
      , Key
"done_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskDoneAt
      , Key
"due_date" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskDueDate
      , Key
"end_date" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskEndDate
      , Key
"hex_color" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskHexColor
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBulkTaskId
      , Key
"identifier" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskIdentifier
      , Key
"index" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBulkTaskIndex
      , Key
"is_favorite" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsBulkTaskIsFavorite
      , Key
"labels" Key -> Maybe [ModelsLabel] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsLabel]
modelsBulkTaskLabels
      , Key
"percent_done" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsBulkTaskPercentDone
      , Key
"position" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsBulkTaskPosition
      , Key
"priority" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBulkTaskPriority
      , Key
"project_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBulkTaskProjectId
      , Key
"reactions" Key -> Maybe (Map String [UserUser]) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String [UserUser])
modelsBulkTaskReactions
      , Key
"related_tasks" Key -> Maybe (Map String [ModelsTask]) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String [ModelsTask])
modelsBulkTaskRelatedTasks
      , Key
"reminders" Key -> Maybe [ModelsTaskReminder] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsTaskReminder]
modelsBulkTaskReminders
      , Key
"repeat_after" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsBulkTaskRepeatAfter
      , Key
"repeat_mode" Key -> Maybe ModelsTaskRepeatMode -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsTaskRepeatMode
modelsBulkTaskRepeatMode
      , Key
"start_date" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskStartDate
      , Key
"subscription" Key -> Maybe ModelsSubscription -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsSubscription
modelsBulkTaskSubscription
      , Key
"task_ids" Key -> Maybe [Int] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Int]
modelsBulkTaskTaskIds
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskTitle
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsBulkTaskUpdated
      ]


-- | Construct a value of type 'ModelsBulkTask' (by applying it's required fields, if any)
mkModelsBulkTask
  :: ModelsBulkTask
mkModelsBulkTask :: ModelsBulkTask
mkModelsBulkTask =
  ModelsBulkTask :: Maybe [UserUser]
-> Maybe [ModelsTaskAttachment]
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe [ModelsLabel]
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe (Map String [UserUser])
-> Maybe (Map String [ModelsTask])
-> Maybe [ModelsTaskReminder]
-> Maybe Int
-> Maybe ModelsTaskRepeatMode
-> Maybe Text
-> Maybe ModelsSubscription
-> Maybe [Int]
-> Maybe Text
-> Maybe Text
-> ModelsBulkTask
ModelsBulkTask
  { $sel:modelsBulkTaskAssignees:ModelsBulkTask :: Maybe [UserUser]
modelsBulkTaskAssignees = Maybe [UserUser]
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskAttachments:ModelsBulkTask :: Maybe [ModelsTaskAttachment]
modelsBulkTaskAttachments = Maybe [ModelsTaskAttachment]
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskBucketId:ModelsBulkTask :: Maybe Int
modelsBulkTaskBucketId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskCoverImageAttachmentId:ModelsBulkTask :: Maybe Int
modelsBulkTaskCoverImageAttachmentId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskCreated:ModelsBulkTask :: Maybe Text
modelsBulkTaskCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskCreatedBy:ModelsBulkTask :: Maybe UserUser
modelsBulkTaskCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskDescription:ModelsBulkTask :: Maybe Text
modelsBulkTaskDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskDone:ModelsBulkTask :: Maybe Bool
modelsBulkTaskDone = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskDoneAt:ModelsBulkTask :: Maybe Text
modelsBulkTaskDoneAt = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskDueDate:ModelsBulkTask :: Maybe Text
modelsBulkTaskDueDate = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskEndDate:ModelsBulkTask :: Maybe Text
modelsBulkTaskEndDate = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskHexColor:ModelsBulkTask :: Maybe Text
modelsBulkTaskHexColor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskId:ModelsBulkTask :: Maybe Int
modelsBulkTaskId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskIdentifier:ModelsBulkTask :: Maybe Text
modelsBulkTaskIdentifier = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskIndex:ModelsBulkTask :: Maybe Int
modelsBulkTaskIndex = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskIsFavorite:ModelsBulkTask :: Maybe Bool
modelsBulkTaskIsFavorite = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskLabels:ModelsBulkTask :: Maybe [ModelsLabel]
modelsBulkTaskLabels = Maybe [ModelsLabel]
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskPercentDone:ModelsBulkTask :: Maybe Double
modelsBulkTaskPercentDone = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskPosition:ModelsBulkTask :: Maybe Double
modelsBulkTaskPosition = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskPriority:ModelsBulkTask :: Maybe Int
modelsBulkTaskPriority = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskProjectId:ModelsBulkTask :: Maybe Int
modelsBulkTaskProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskReactions:ModelsBulkTask :: Maybe (Map String [UserUser])
modelsBulkTaskReactions = Maybe (Map String [UserUser])
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskRelatedTasks:ModelsBulkTask :: Maybe (Map String [ModelsTask])
modelsBulkTaskRelatedTasks = Maybe (Map String [ModelsTask])
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskReminders:ModelsBulkTask :: Maybe [ModelsTaskReminder]
modelsBulkTaskReminders = Maybe [ModelsTaskReminder]
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskRepeatAfter:ModelsBulkTask :: Maybe Int
modelsBulkTaskRepeatAfter = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskRepeatMode:ModelsBulkTask :: Maybe ModelsTaskRepeatMode
modelsBulkTaskRepeatMode = Maybe ModelsTaskRepeatMode
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskStartDate:ModelsBulkTask :: Maybe Text
modelsBulkTaskStartDate = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskSubscription:ModelsBulkTask :: Maybe ModelsSubscription
modelsBulkTaskSubscription = Maybe ModelsSubscription
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskTaskIds:ModelsBulkTask :: Maybe [Int]
modelsBulkTaskTaskIds = Maybe [Int]
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskTitle:ModelsBulkTask :: Maybe Text
modelsBulkTaskTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsBulkTaskUpdated:ModelsBulkTask :: Maybe Text
modelsBulkTaskUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsDatabaseNotifications
-- | ModelsDatabaseNotifications
data ModelsDatabaseNotifications = ModelsDatabaseNotifications
  { ModelsDatabaseNotifications -> Maybe Text
modelsDatabaseNotificationsCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this notification was created. You cannot change this value.
  , ModelsDatabaseNotifications -> Maybe Int
modelsDatabaseNotificationsId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this notification.
  , ModelsDatabaseNotifications -> Maybe Text
modelsDatabaseNotificationsName :: !(Maybe Text) -- ^ "name" - The name of the notification
  , ModelsDatabaseNotifications -> Maybe Value
modelsDatabaseNotificationsNotification :: !(Maybe A.Value) -- ^ "notification" - The actual content of the notification.
  , ModelsDatabaseNotifications -> Maybe Bool
modelsDatabaseNotificationsRead :: !(Maybe Bool) -- ^ "read" - Whether or not to mark this notification as read or unread. True is read, false is unread.
  , ModelsDatabaseNotifications -> Maybe Text
modelsDatabaseNotificationsReadAt :: !(Maybe Text) -- ^ "read_at" - When this notification is marked as read, this will be updated with the current timestamp.
  } deriving (Int -> ModelsDatabaseNotifications -> ShowS
[ModelsDatabaseNotifications] -> ShowS
ModelsDatabaseNotifications -> String
(Int -> ModelsDatabaseNotifications -> ShowS)
-> (ModelsDatabaseNotifications -> String)
-> ([ModelsDatabaseNotifications] -> ShowS)
-> Show ModelsDatabaseNotifications
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsDatabaseNotifications] -> ShowS
$cshowList :: [ModelsDatabaseNotifications] -> ShowS
show :: ModelsDatabaseNotifications -> String
$cshow :: ModelsDatabaseNotifications -> String
showsPrec :: Int -> ModelsDatabaseNotifications -> ShowS
$cshowsPrec :: Int -> ModelsDatabaseNotifications -> ShowS
P.Show, ModelsDatabaseNotifications -> ModelsDatabaseNotifications -> Bool
(ModelsDatabaseNotifications
 -> ModelsDatabaseNotifications -> Bool)
-> (ModelsDatabaseNotifications
    -> ModelsDatabaseNotifications -> Bool)
-> Eq ModelsDatabaseNotifications
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsDatabaseNotifications -> ModelsDatabaseNotifications -> Bool
$c/= :: ModelsDatabaseNotifications -> ModelsDatabaseNotifications -> Bool
== :: ModelsDatabaseNotifications -> ModelsDatabaseNotifications -> Bool
$c== :: ModelsDatabaseNotifications -> ModelsDatabaseNotifications -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsDatabaseNotifications
instance A.FromJSON ModelsDatabaseNotifications where
  parseJSON :: Value -> Parser ModelsDatabaseNotifications
parseJSON = String
-> (Object -> Parser ModelsDatabaseNotifications)
-> Value
-> Parser ModelsDatabaseNotifications
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsDatabaseNotifications" ((Object -> Parser ModelsDatabaseNotifications)
 -> Value -> Parser ModelsDatabaseNotifications)
-> (Object -> Parser ModelsDatabaseNotifications)
-> Value
-> Parser ModelsDatabaseNotifications
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Value
-> Maybe Bool
-> Maybe Text
-> ModelsDatabaseNotifications
ModelsDatabaseNotifications
      (Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Value
 -> Maybe Bool
 -> Maybe Text
 -> ModelsDatabaseNotifications)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Value
      -> Maybe Bool
      -> Maybe Text
      -> ModelsDatabaseNotifications)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Value
   -> Maybe Bool
   -> Maybe Text
   -> ModelsDatabaseNotifications)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Value
      -> Maybe Bool
      -> Maybe Text
      -> ModelsDatabaseNotifications)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Value
   -> Maybe Bool
   -> Maybe Text
   -> ModelsDatabaseNotifications)
-> Parser (Maybe Text)
-> Parser
     (Maybe Value
      -> Maybe Bool -> Maybe Text -> ModelsDatabaseNotifications)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Value
   -> Maybe Bool -> Maybe Text -> ModelsDatabaseNotifications)
-> Parser (Maybe Value)
-> Parser (Maybe Bool -> Maybe Text -> ModelsDatabaseNotifications)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"notification")
      Parser (Maybe Bool -> Maybe Text -> ModelsDatabaseNotifications)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> ModelsDatabaseNotifications)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read")
      Parser (Maybe Text -> ModelsDatabaseNotifications)
-> Parser (Maybe Text) -> Parser ModelsDatabaseNotifications
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read_at")

-- | ToJSON ModelsDatabaseNotifications
instance A.ToJSON ModelsDatabaseNotifications where
  toJSON :: ModelsDatabaseNotifications -> Value
toJSON ModelsDatabaseNotifications {Maybe Bool
Maybe Int
Maybe Text
Maybe Value
modelsDatabaseNotificationsReadAt :: Maybe Text
modelsDatabaseNotificationsRead :: Maybe Bool
modelsDatabaseNotificationsNotification :: Maybe Value
modelsDatabaseNotificationsName :: Maybe Text
modelsDatabaseNotificationsId :: Maybe Int
modelsDatabaseNotificationsCreated :: Maybe Text
$sel:modelsDatabaseNotificationsReadAt:ModelsDatabaseNotifications :: ModelsDatabaseNotifications -> Maybe Text
$sel:modelsDatabaseNotificationsRead:ModelsDatabaseNotifications :: ModelsDatabaseNotifications -> Maybe Bool
$sel:modelsDatabaseNotificationsNotification:ModelsDatabaseNotifications :: ModelsDatabaseNotifications -> Maybe Value
$sel:modelsDatabaseNotificationsName:ModelsDatabaseNotifications :: ModelsDatabaseNotifications -> Maybe Text
$sel:modelsDatabaseNotificationsId:ModelsDatabaseNotifications :: ModelsDatabaseNotifications -> Maybe Int
$sel:modelsDatabaseNotificationsCreated:ModelsDatabaseNotifications :: ModelsDatabaseNotifications -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsDatabaseNotificationsCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsDatabaseNotificationsId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsDatabaseNotificationsName
      , Key
"notification" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
modelsDatabaseNotificationsNotification
      , Key
"read" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsDatabaseNotificationsRead
      , Key
"read_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsDatabaseNotificationsReadAt
      ]


-- | Construct a value of type 'ModelsDatabaseNotifications' (by applying it's required fields, if any)
mkModelsDatabaseNotifications
  :: ModelsDatabaseNotifications
mkModelsDatabaseNotifications :: ModelsDatabaseNotifications
mkModelsDatabaseNotifications =
  ModelsDatabaseNotifications :: Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Value
-> Maybe Bool
-> Maybe Text
-> ModelsDatabaseNotifications
ModelsDatabaseNotifications
  { $sel:modelsDatabaseNotificationsCreated:ModelsDatabaseNotifications :: Maybe Text
modelsDatabaseNotificationsCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsDatabaseNotificationsId:ModelsDatabaseNotifications :: Maybe Int
modelsDatabaseNotificationsId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsDatabaseNotificationsName:ModelsDatabaseNotifications :: Maybe Text
modelsDatabaseNotificationsName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsDatabaseNotificationsNotification:ModelsDatabaseNotifications :: Maybe Value
modelsDatabaseNotificationsNotification = Maybe Value
forall a. Maybe a
Nothing
  , $sel:modelsDatabaseNotificationsRead:ModelsDatabaseNotifications :: Maybe Bool
modelsDatabaseNotificationsRead = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsDatabaseNotificationsReadAt:ModelsDatabaseNotifications :: Maybe Text
modelsDatabaseNotificationsReadAt = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsLabel
-- | ModelsLabel
data ModelsLabel = ModelsLabel
  { ModelsLabel -> Maybe Text
modelsLabelCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this label was created. You cannot change this value.
  , ModelsLabel -> Maybe UserUser
modelsLabelCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who created this label
  , ModelsLabel -> Maybe Text
modelsLabelDescription :: !(Maybe Text) -- ^ "description" - The label description.
  , ModelsLabel -> Maybe Text
modelsLabelHexColor :: !(Maybe Text) -- ^ "hex_color" - The color this label has in hex format.
  , ModelsLabel -> Maybe Int
modelsLabelId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this label.
  , ModelsLabel -> Maybe Text
modelsLabelTitle :: !(Maybe Text) -- ^ "title" - The title of the lable. You&#39;ll see this one on tasks associated with it.
  , ModelsLabel -> Maybe Text
modelsLabelUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this label was last updated. You cannot change this value.
  } deriving (Int -> ModelsLabel -> ShowS
[ModelsLabel] -> ShowS
ModelsLabel -> String
(Int -> ModelsLabel -> ShowS)
-> (ModelsLabel -> String)
-> ([ModelsLabel] -> ShowS)
-> Show ModelsLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsLabel] -> ShowS
$cshowList :: [ModelsLabel] -> ShowS
show :: ModelsLabel -> String
$cshow :: ModelsLabel -> String
showsPrec :: Int -> ModelsLabel -> ShowS
$cshowsPrec :: Int -> ModelsLabel -> ShowS
P.Show, ModelsLabel -> ModelsLabel -> Bool
(ModelsLabel -> ModelsLabel -> Bool)
-> (ModelsLabel -> ModelsLabel -> Bool) -> Eq ModelsLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsLabel -> ModelsLabel -> Bool
$c/= :: ModelsLabel -> ModelsLabel -> Bool
== :: ModelsLabel -> ModelsLabel -> Bool
$c== :: ModelsLabel -> ModelsLabel -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsLabel
instance A.FromJSON ModelsLabel where
  parseJSON :: Value -> Parser ModelsLabel
parseJSON = String
-> (Object -> Parser ModelsLabel) -> Value -> Parser ModelsLabel
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsLabel" ((Object -> Parser ModelsLabel) -> Value -> Parser ModelsLabel)
-> (Object -> Parser ModelsLabel) -> Value -> Parser ModelsLabel
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> ModelsLabel
ModelsLabel
      (Maybe Text
 -> Maybe UserUser
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> ModelsLabel)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> ModelsLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> ModelsLabel)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> ModelsLabel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> ModelsLabel)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int -> Maybe Text -> Maybe Text -> ModelsLabel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Int -> Maybe Text -> Maybe Text -> ModelsLabel)
-> Parser (Maybe Text)
-> Parser (Maybe Int -> Maybe Text -> Maybe Text -> ModelsLabel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hex_color")
      Parser (Maybe Int -> Maybe Text -> Maybe Text -> ModelsLabel)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> Maybe Text -> ModelsLabel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> ModelsLabel)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsLabel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> ModelsLabel)
-> Parser (Maybe Text) -> Parser ModelsLabel
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsLabel
instance A.ToJSON ModelsLabel where
  toJSON :: ModelsLabel -> Value
toJSON ModelsLabel {Maybe Int
Maybe Text
Maybe UserUser
modelsLabelUpdated :: Maybe Text
modelsLabelTitle :: Maybe Text
modelsLabelId :: Maybe Int
modelsLabelHexColor :: Maybe Text
modelsLabelDescription :: Maybe Text
modelsLabelCreatedBy :: Maybe UserUser
modelsLabelCreated :: Maybe Text
$sel:modelsLabelUpdated:ModelsLabel :: ModelsLabel -> Maybe Text
$sel:modelsLabelTitle:ModelsLabel :: ModelsLabel -> Maybe Text
$sel:modelsLabelId:ModelsLabel :: ModelsLabel -> Maybe Int
$sel:modelsLabelHexColor:ModelsLabel :: ModelsLabel -> Maybe Text
$sel:modelsLabelDescription:ModelsLabel :: ModelsLabel -> Maybe Text
$sel:modelsLabelCreatedBy:ModelsLabel :: ModelsLabel -> Maybe UserUser
$sel:modelsLabelCreated:ModelsLabel :: ModelsLabel -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLabelCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsLabelCreatedBy
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLabelDescription
      , Key
"hex_color" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLabelHexColor
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsLabelId
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLabelTitle
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLabelUpdated
      ]


-- | Construct a value of type 'ModelsLabel' (by applying it's required fields, if any)
mkModelsLabel
  :: ModelsLabel
mkModelsLabel :: ModelsLabel
mkModelsLabel =
  ModelsLabel :: Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> ModelsLabel
ModelsLabel
  { $sel:modelsLabelCreated:ModelsLabel :: Maybe Text
modelsLabelCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLabelCreatedBy:ModelsLabel :: Maybe UserUser
modelsLabelCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsLabelDescription:ModelsLabel :: Maybe Text
modelsLabelDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLabelHexColor:ModelsLabel :: Maybe Text
modelsLabelHexColor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLabelId:ModelsLabel :: Maybe Int
modelsLabelId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsLabelTitle:ModelsLabel :: Maybe Text
modelsLabelTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLabelUpdated:ModelsLabel :: Maybe Text
modelsLabelUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsLabelTask
-- | ModelsLabelTask
data ModelsLabelTask = ModelsLabelTask
  { ModelsLabelTask -> Maybe Text
modelsLabelTaskCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this task was created. You cannot change this value.
  , ModelsLabelTask -> Maybe Int
modelsLabelTaskLabelId :: !(Maybe Int) -- ^ "label_id" - The label id you want to associate with a task.
  } deriving (Int -> ModelsLabelTask -> ShowS
[ModelsLabelTask] -> ShowS
ModelsLabelTask -> String
(Int -> ModelsLabelTask -> ShowS)
-> (ModelsLabelTask -> String)
-> ([ModelsLabelTask] -> ShowS)
-> Show ModelsLabelTask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsLabelTask] -> ShowS
$cshowList :: [ModelsLabelTask] -> ShowS
show :: ModelsLabelTask -> String
$cshow :: ModelsLabelTask -> String
showsPrec :: Int -> ModelsLabelTask -> ShowS
$cshowsPrec :: Int -> ModelsLabelTask -> ShowS
P.Show, ModelsLabelTask -> ModelsLabelTask -> Bool
(ModelsLabelTask -> ModelsLabelTask -> Bool)
-> (ModelsLabelTask -> ModelsLabelTask -> Bool)
-> Eq ModelsLabelTask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsLabelTask -> ModelsLabelTask -> Bool
$c/= :: ModelsLabelTask -> ModelsLabelTask -> Bool
== :: ModelsLabelTask -> ModelsLabelTask -> Bool
$c== :: ModelsLabelTask -> ModelsLabelTask -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsLabelTask
instance A.FromJSON ModelsLabelTask where
  parseJSON :: Value -> Parser ModelsLabelTask
parseJSON = String
-> (Object -> Parser ModelsLabelTask)
-> Value
-> Parser ModelsLabelTask
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsLabelTask" ((Object -> Parser ModelsLabelTask)
 -> Value -> Parser ModelsLabelTask)
-> (Object -> Parser ModelsLabelTask)
-> Value
-> Parser ModelsLabelTask
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Int -> ModelsLabelTask
ModelsLabelTask
      (Maybe Text -> Maybe Int -> ModelsLabelTask)
-> Parser (Maybe Text) -> Parser (Maybe Int -> ModelsLabelTask)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Maybe Int -> ModelsLabelTask)
-> Parser (Maybe Int) -> Parser ModelsLabelTask
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label_id")

-- | ToJSON ModelsLabelTask
instance A.ToJSON ModelsLabelTask where
  toJSON :: ModelsLabelTask -> Value
toJSON ModelsLabelTask {Maybe Int
Maybe Text
modelsLabelTaskLabelId :: Maybe Int
modelsLabelTaskCreated :: Maybe Text
$sel:modelsLabelTaskLabelId:ModelsLabelTask :: ModelsLabelTask -> Maybe Int
$sel:modelsLabelTaskCreated:ModelsLabelTask :: ModelsLabelTask -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLabelTaskCreated
      , Key
"label_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsLabelTaskLabelId
      ]


-- | Construct a value of type 'ModelsLabelTask' (by applying it's required fields, if any)
mkModelsLabelTask
  :: ModelsLabelTask
mkModelsLabelTask :: ModelsLabelTask
mkModelsLabelTask =
  ModelsLabelTask :: Maybe Text -> Maybe Int -> ModelsLabelTask
ModelsLabelTask
  { $sel:modelsLabelTaskCreated:ModelsLabelTask :: Maybe Text
modelsLabelTaskCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLabelTaskLabelId:ModelsLabelTask :: Maybe Int
modelsLabelTaskLabelId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsLabelTaskBulk
-- | ModelsLabelTaskBulk
data ModelsLabelTaskBulk = ModelsLabelTaskBulk
  { ModelsLabelTaskBulk -> Maybe [ModelsLabel]
modelsLabelTaskBulkLabels :: !(Maybe [ModelsLabel]) -- ^ "labels" - All labels you want to update at once.
  } deriving (Int -> ModelsLabelTaskBulk -> ShowS
[ModelsLabelTaskBulk] -> ShowS
ModelsLabelTaskBulk -> String
(Int -> ModelsLabelTaskBulk -> ShowS)
-> (ModelsLabelTaskBulk -> String)
-> ([ModelsLabelTaskBulk] -> ShowS)
-> Show ModelsLabelTaskBulk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsLabelTaskBulk] -> ShowS
$cshowList :: [ModelsLabelTaskBulk] -> ShowS
show :: ModelsLabelTaskBulk -> String
$cshow :: ModelsLabelTaskBulk -> String
showsPrec :: Int -> ModelsLabelTaskBulk -> ShowS
$cshowsPrec :: Int -> ModelsLabelTaskBulk -> ShowS
P.Show, ModelsLabelTaskBulk -> ModelsLabelTaskBulk -> Bool
(ModelsLabelTaskBulk -> ModelsLabelTaskBulk -> Bool)
-> (ModelsLabelTaskBulk -> ModelsLabelTaskBulk -> Bool)
-> Eq ModelsLabelTaskBulk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsLabelTaskBulk -> ModelsLabelTaskBulk -> Bool
$c/= :: ModelsLabelTaskBulk -> ModelsLabelTaskBulk -> Bool
== :: ModelsLabelTaskBulk -> ModelsLabelTaskBulk -> Bool
$c== :: ModelsLabelTaskBulk -> ModelsLabelTaskBulk -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsLabelTaskBulk
instance A.FromJSON ModelsLabelTaskBulk where
  parseJSON :: Value -> Parser ModelsLabelTaskBulk
parseJSON = String
-> (Object -> Parser ModelsLabelTaskBulk)
-> Value
-> Parser ModelsLabelTaskBulk
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsLabelTaskBulk" ((Object -> Parser ModelsLabelTaskBulk)
 -> Value -> Parser ModelsLabelTaskBulk)
-> (Object -> Parser ModelsLabelTaskBulk)
-> Value
-> Parser ModelsLabelTaskBulk
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [ModelsLabel] -> ModelsLabelTaskBulk
ModelsLabelTaskBulk
      (Maybe [ModelsLabel] -> ModelsLabelTaskBulk)
-> Parser (Maybe [ModelsLabel]) -> Parser ModelsLabelTaskBulk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [ModelsLabel])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")

-- | ToJSON ModelsLabelTaskBulk
instance A.ToJSON ModelsLabelTaskBulk where
  toJSON :: ModelsLabelTaskBulk -> Value
toJSON ModelsLabelTaskBulk {Maybe [ModelsLabel]
modelsLabelTaskBulkLabels :: Maybe [ModelsLabel]
$sel:modelsLabelTaskBulkLabels:ModelsLabelTaskBulk :: ModelsLabelTaskBulk -> Maybe [ModelsLabel]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"labels" Key -> Maybe [ModelsLabel] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsLabel]
modelsLabelTaskBulkLabels
      ]


-- | Construct a value of type 'ModelsLabelTaskBulk' (by applying it's required fields, if any)
mkModelsLabelTaskBulk
  :: ModelsLabelTaskBulk
mkModelsLabelTaskBulk :: ModelsLabelTaskBulk
mkModelsLabelTaskBulk =
  ModelsLabelTaskBulk :: Maybe [ModelsLabel] -> ModelsLabelTaskBulk
ModelsLabelTaskBulk
  { $sel:modelsLabelTaskBulkLabels:ModelsLabelTaskBulk :: Maybe [ModelsLabel]
modelsLabelTaskBulkLabels = Maybe [ModelsLabel]
forall a. Maybe a
Nothing
  }

-- ** ModelsLinkSharing
-- | ModelsLinkSharing
data ModelsLinkSharing = ModelsLinkSharing
  { ModelsLinkSharing -> Maybe Text
modelsLinkSharingCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this project was shared. You cannot change this value.
  , ModelsLinkSharing -> Maybe Text
modelsLinkSharingHash :: !(Maybe Text) -- ^ "hash" - The public id to get this shared project
  , ModelsLinkSharing -> Maybe Int
modelsLinkSharingId :: !(Maybe Int) -- ^ "id" - The ID of the shared thing
  , ModelsLinkSharing -> Maybe Text
modelsLinkSharingName :: !(Maybe Text) -- ^ "name" - The name of this link share. All actions someone takes while being authenticated with that link will appear with that name.
  , ModelsLinkSharing -> Maybe Text
modelsLinkSharingPassword :: !(Maybe Text) -- ^ "password" - The password of this link share. You can only set it, not retrieve it after the link share has been created.
  , ModelsLinkSharing -> Maybe ModelsRight
modelsLinkSharingRight :: !(Maybe ModelsRight) -- ^ "right" - The right this project is shared with. 0 &#x3D; Read only, 1 &#x3D; Read &amp; Write, 2 &#x3D; Admin. See the docs for more details.
  , ModelsLinkSharing -> Maybe UserUser
modelsLinkSharingSharedBy :: !(Maybe UserUser) -- ^ "shared_by" - The user who shared this project
  , ModelsLinkSharing -> Maybe ModelsSharingType
modelsLinkSharingSharingType :: !(Maybe ModelsSharingType) -- ^ "sharing_type" - The kind of this link. 0 &#x3D; undefined, 1 &#x3D; without password, 2 &#x3D; with password.
  , ModelsLinkSharing -> Maybe Text
modelsLinkSharingUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this share was last updated. You cannot change this value.
  } deriving (Int -> ModelsLinkSharing -> ShowS
[ModelsLinkSharing] -> ShowS
ModelsLinkSharing -> String
(Int -> ModelsLinkSharing -> ShowS)
-> (ModelsLinkSharing -> String)
-> ([ModelsLinkSharing] -> ShowS)
-> Show ModelsLinkSharing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsLinkSharing] -> ShowS
$cshowList :: [ModelsLinkSharing] -> ShowS
show :: ModelsLinkSharing -> String
$cshow :: ModelsLinkSharing -> String
showsPrec :: Int -> ModelsLinkSharing -> ShowS
$cshowsPrec :: Int -> ModelsLinkSharing -> ShowS
P.Show, ModelsLinkSharing -> ModelsLinkSharing -> Bool
(ModelsLinkSharing -> ModelsLinkSharing -> Bool)
-> (ModelsLinkSharing -> ModelsLinkSharing -> Bool)
-> Eq ModelsLinkSharing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsLinkSharing -> ModelsLinkSharing -> Bool
$c/= :: ModelsLinkSharing -> ModelsLinkSharing -> Bool
== :: ModelsLinkSharing -> ModelsLinkSharing -> Bool
$c== :: ModelsLinkSharing -> ModelsLinkSharing -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsLinkSharing
instance A.FromJSON ModelsLinkSharing where
  parseJSON :: Value -> Parser ModelsLinkSharing
parseJSON = String
-> (Object -> Parser ModelsLinkSharing)
-> Value
-> Parser ModelsLinkSharing
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsLinkSharing" ((Object -> Parser ModelsLinkSharing)
 -> Value -> Parser ModelsLinkSharing)
-> (Object -> Parser ModelsLinkSharing)
-> Value
-> Parser ModelsLinkSharing
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe ModelsRight
-> Maybe UserUser
-> Maybe ModelsSharingType
-> Maybe Text
-> ModelsLinkSharing
ModelsLinkSharing
      (Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe ModelsRight
 -> Maybe UserUser
 -> Maybe ModelsSharingType
 -> Maybe Text
 -> ModelsLinkSharing)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe UserUser
      -> Maybe ModelsSharingType
      -> Maybe Text
      -> ModelsLinkSharing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe UserUser
   -> Maybe ModelsSharingType
   -> Maybe Text
   -> ModelsLinkSharing)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe UserUser
      -> Maybe ModelsSharingType
      -> Maybe Text
      -> ModelsLinkSharing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hash")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe UserUser
   -> Maybe ModelsSharingType
   -> Maybe Text
   -> ModelsLinkSharing)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe UserUser
      -> Maybe ModelsSharingType
      -> Maybe Text
      -> ModelsLinkSharing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe UserUser
   -> Maybe ModelsSharingType
   -> Maybe Text
   -> ModelsLinkSharing)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ModelsRight
      -> Maybe UserUser
      -> Maybe ModelsSharingType
      -> Maybe Text
      -> ModelsLinkSharing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Text
   -> Maybe ModelsRight
   -> Maybe UserUser
   -> Maybe ModelsSharingType
   -> Maybe Text
   -> ModelsLinkSharing)
-> Parser (Maybe Text)
-> Parser
     (Maybe ModelsRight
      -> Maybe UserUser
      -> Maybe ModelsSharingType
      -> Maybe Text
      -> ModelsLinkSharing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")
      Parser
  (Maybe ModelsRight
   -> Maybe UserUser
   -> Maybe ModelsSharingType
   -> Maybe Text
   -> ModelsLinkSharing)
-> Parser (Maybe ModelsRight)
-> Parser
     (Maybe UserUser
      -> Maybe ModelsSharingType -> Maybe Text -> ModelsLinkSharing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsRight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"right")
      Parser
  (Maybe UserUser
   -> Maybe ModelsSharingType -> Maybe Text -> ModelsLinkSharing)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe ModelsSharingType -> Maybe Text -> ModelsLinkSharing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"shared_by")
      Parser (Maybe ModelsSharingType -> Maybe Text -> ModelsLinkSharing)
-> Parser (Maybe ModelsSharingType)
-> Parser (Maybe Text -> ModelsLinkSharing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsSharingType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sharing_type")
      Parser (Maybe Text -> ModelsLinkSharing)
-> Parser (Maybe Text) -> Parser ModelsLinkSharing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsLinkSharing
instance A.ToJSON ModelsLinkSharing where
  toJSON :: ModelsLinkSharing -> Value
toJSON ModelsLinkSharing {Maybe Int
Maybe Text
Maybe ModelsSharingType
Maybe ModelsRight
Maybe UserUser
modelsLinkSharingUpdated :: Maybe Text
modelsLinkSharingSharingType :: Maybe ModelsSharingType
modelsLinkSharingSharedBy :: Maybe UserUser
modelsLinkSharingRight :: Maybe ModelsRight
modelsLinkSharingPassword :: Maybe Text
modelsLinkSharingName :: Maybe Text
modelsLinkSharingId :: Maybe Int
modelsLinkSharingHash :: Maybe Text
modelsLinkSharingCreated :: Maybe Text
$sel:modelsLinkSharingUpdated:ModelsLinkSharing :: ModelsLinkSharing -> Maybe Text
$sel:modelsLinkSharingSharingType:ModelsLinkSharing :: ModelsLinkSharing -> Maybe ModelsSharingType
$sel:modelsLinkSharingSharedBy:ModelsLinkSharing :: ModelsLinkSharing -> Maybe UserUser
$sel:modelsLinkSharingRight:ModelsLinkSharing :: ModelsLinkSharing -> Maybe ModelsRight
$sel:modelsLinkSharingPassword:ModelsLinkSharing :: ModelsLinkSharing -> Maybe Text
$sel:modelsLinkSharingName:ModelsLinkSharing :: ModelsLinkSharing -> Maybe Text
$sel:modelsLinkSharingId:ModelsLinkSharing :: ModelsLinkSharing -> Maybe Int
$sel:modelsLinkSharingHash:ModelsLinkSharing :: ModelsLinkSharing -> Maybe Text
$sel:modelsLinkSharingCreated:ModelsLinkSharing :: ModelsLinkSharing -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLinkSharingCreated
      , Key
"hash" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLinkSharingHash
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsLinkSharingId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLinkSharingName
      , Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLinkSharingPassword
      , Key
"right" Key -> Maybe ModelsRight -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsRight
modelsLinkSharingRight
      , Key
"shared_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsLinkSharingSharedBy
      , Key
"sharing_type" Key -> Maybe ModelsSharingType -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsSharingType
modelsLinkSharingSharingType
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsLinkSharingUpdated
      ]


-- | Construct a value of type 'ModelsLinkSharing' (by applying it's required fields, if any)
mkModelsLinkSharing
  :: ModelsLinkSharing
mkModelsLinkSharing :: ModelsLinkSharing
mkModelsLinkSharing =
  ModelsLinkSharing :: Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe ModelsRight
-> Maybe UserUser
-> Maybe ModelsSharingType
-> Maybe Text
-> ModelsLinkSharing
ModelsLinkSharing
  { $sel:modelsLinkSharingCreated:ModelsLinkSharing :: Maybe Text
modelsLinkSharingCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingHash:ModelsLinkSharing :: Maybe Text
modelsLinkSharingHash = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingId:ModelsLinkSharing :: Maybe Int
modelsLinkSharingId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingName:ModelsLinkSharing :: Maybe Text
modelsLinkSharingName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingPassword:ModelsLinkSharing :: Maybe Text
modelsLinkSharingPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingRight:ModelsLinkSharing :: Maybe ModelsRight
modelsLinkSharingRight = Maybe ModelsRight
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingSharedBy:ModelsLinkSharing :: Maybe UserUser
modelsLinkSharingSharedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingSharingType:ModelsLinkSharing :: Maybe ModelsSharingType
modelsLinkSharingSharingType = Maybe ModelsSharingType
forall a. Maybe a
Nothing
  , $sel:modelsLinkSharingUpdated:ModelsLinkSharing :: Maybe Text
modelsLinkSharingUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsMessage
-- | ModelsMessage
data ModelsMessage = ModelsMessage
  { ModelsMessage -> Maybe Text
modelsMessageMessage :: !(Maybe Text) -- ^ "message" - A standard message.
  } deriving (Int -> ModelsMessage -> ShowS
[ModelsMessage] -> ShowS
ModelsMessage -> String
(Int -> ModelsMessage -> ShowS)
-> (ModelsMessage -> String)
-> ([ModelsMessage] -> ShowS)
-> Show ModelsMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsMessage] -> ShowS
$cshowList :: [ModelsMessage] -> ShowS
show :: ModelsMessage -> String
$cshow :: ModelsMessage -> String
showsPrec :: Int -> ModelsMessage -> ShowS
$cshowsPrec :: Int -> ModelsMessage -> ShowS
P.Show, ModelsMessage -> ModelsMessage -> Bool
(ModelsMessage -> ModelsMessage -> Bool)
-> (ModelsMessage -> ModelsMessage -> Bool) -> Eq ModelsMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsMessage -> ModelsMessage -> Bool
$c/= :: ModelsMessage -> ModelsMessage -> Bool
== :: ModelsMessage -> ModelsMessage -> Bool
$c== :: ModelsMessage -> ModelsMessage -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsMessage
instance A.FromJSON ModelsMessage where
  parseJSON :: Value -> Parser ModelsMessage
parseJSON = String
-> (Object -> Parser ModelsMessage)
-> Value
-> Parser ModelsMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsMessage" ((Object -> Parser ModelsMessage) -> Value -> Parser ModelsMessage)
-> (Object -> Parser ModelsMessage)
-> Value
-> Parser ModelsMessage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> ModelsMessage
ModelsMessage
      (Maybe Text -> ModelsMessage)
-> Parser (Maybe Text) -> Parser ModelsMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")

-- | ToJSON ModelsMessage
instance A.ToJSON ModelsMessage where
  toJSON :: ModelsMessage -> Value
toJSON ModelsMessage {Maybe Text
modelsMessageMessage :: Maybe Text
$sel:modelsMessageMessage:ModelsMessage :: ModelsMessage -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsMessageMessage
      ]


-- | Construct a value of type 'ModelsMessage' (by applying it's required fields, if any)
mkModelsMessage
  :: ModelsMessage
mkModelsMessage :: ModelsMessage
mkModelsMessage =
  ModelsMessage :: Maybe Text -> ModelsMessage
ModelsMessage
  { $sel:modelsMessageMessage:ModelsMessage :: Maybe Text
modelsMessageMessage = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsProject
-- | ModelsProject
data ModelsProject = ModelsProject
  { ModelsProject -> Maybe Text
modelsProjectBackgroundBlurHash :: !(Maybe Text) -- ^ "background_blur_hash" - Contains a very small version of the project background to use as a blurry preview until the actual background is loaded. Check out https://blurha.sh/ to learn how it works.
  , ModelsProject -> Maybe Value
modelsProjectBackgroundInformation :: !(Maybe A.Value) -- ^ "background_information" - Holds extra information about the background set since some background providers require attribution or similar. If not null, the background can be accessed at /projects/{projectID}/background
  , ModelsProject -> Maybe Text
modelsProjectCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this project was created. You cannot change this value.
  , ModelsProject -> Maybe Text
modelsProjectDescription :: !(Maybe Text) -- ^ "description" - The description of the project.
  , ModelsProject -> Maybe Text
modelsProjectHexColor :: !(Maybe Text) -- ^ "hex_color" - The hex color of this project
  , ModelsProject -> Maybe Int
modelsProjectId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this project.
  , ModelsProject -> Maybe Text
modelsProjectIdentifier :: !(Maybe Text) -- ^ "identifier" - The unique project short identifier. Used to build task identifiers.
  , ModelsProject -> Maybe Bool
modelsProjectIsArchived :: !(Maybe Bool) -- ^ "is_archived" - Whether a project is archived.
  , ModelsProject -> Maybe Bool
modelsProjectIsFavorite :: !(Maybe Bool) -- ^ "is_favorite" - True if a project is a favorite. Favorite projects show up in a separate parent project. This value depends on the user making the call to the api.
  , ModelsProject -> Maybe UserUser
modelsProjectOwner :: !(Maybe UserUser) -- ^ "owner" - The user who created this project.
  , ModelsProject -> Maybe Int
modelsProjectParentProjectId :: !(Maybe Int) -- ^ "parent_project_id"
  , ModelsProject -> Maybe Double
modelsProjectPosition :: !(Maybe Double) -- ^ "position" - The position this project has when querying all projects. See the tasks.position property on how to use this.
  , ModelsProject -> Maybe ModelsSubscription
modelsProjectSubscription :: !(Maybe ModelsSubscription) -- ^ "subscription" - The subscription status for the user reading this project. You can only read this property, use the subscription endpoints to modify it. Will only returned when retreiving one project.
  , ModelsProject -> Maybe Text
modelsProjectTitle :: !(Maybe Text) -- ^ "title" - The title of the project. You&#39;ll see this in the overview.
  , ModelsProject -> Maybe Text
modelsProjectUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this project was last updated. You cannot change this value.
  , ModelsProject -> Maybe [ModelsProjectView]
modelsProjectViews :: !(Maybe [ModelsProjectView]) -- ^ "views"
  } deriving (Int -> ModelsProject -> ShowS
[ModelsProject] -> ShowS
ModelsProject -> String
(Int -> ModelsProject -> ShowS)
-> (ModelsProject -> String)
-> ([ModelsProject] -> ShowS)
-> Show ModelsProject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsProject] -> ShowS
$cshowList :: [ModelsProject] -> ShowS
show :: ModelsProject -> String
$cshow :: ModelsProject -> String
showsPrec :: Int -> ModelsProject -> ShowS
$cshowsPrec :: Int -> ModelsProject -> ShowS
P.Show, ModelsProject -> ModelsProject -> Bool
(ModelsProject -> ModelsProject -> Bool)
-> (ModelsProject -> ModelsProject -> Bool) -> Eq ModelsProject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsProject -> ModelsProject -> Bool
$c/= :: ModelsProject -> ModelsProject -> Bool
== :: ModelsProject -> ModelsProject -> Bool
$c== :: ModelsProject -> ModelsProject -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsProject
instance A.FromJSON ModelsProject where
  parseJSON :: Value -> Parser ModelsProject
parseJSON = String
-> (Object -> Parser ModelsProject)
-> Value
-> Parser ModelsProject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsProject" ((Object -> Parser ModelsProject) -> Value -> Parser ModelsProject)
-> (Object -> Parser ModelsProject)
-> Value
-> Parser ModelsProject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe UserUser
-> Maybe Int
-> Maybe Double
-> Maybe ModelsSubscription
-> Maybe Text
-> Maybe Text
-> Maybe [ModelsProjectView]
-> ModelsProject
ModelsProject
      (Maybe Text
 -> Maybe Value
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe UserUser
 -> Maybe Int
 -> Maybe Double
 -> Maybe ModelsSubscription
 -> Maybe Text
 -> Maybe Text
 -> Maybe [ModelsProjectView]
 -> ModelsProject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"background_blur_hash")
      Parser
  (Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Value)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"background_information")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hex_color")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"identifier")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_archived")
      Parser
  (Maybe Bool
   -> Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Bool)
-> Parser
     (Maybe UserUser
      -> Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_favorite")
      Parser
  (Maybe UserUser
   -> Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Int
      -> Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")
      Parser
  (Maybe Int
   -> Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Int)
-> Parser
     (Maybe Double
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parent_project_id")
      Parser
  (Maybe Double
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe Double)
-> Parser
     (Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> Maybe [ModelsProjectView]
      -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position")
      Parser
  (Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> Maybe [ModelsProjectView]
   -> ModelsProject)
-> Parser (Maybe ModelsSubscription)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe [ModelsProjectView] -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsSubscription)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subscription")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe [ModelsProjectView] -> ModelsProject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe [ModelsProjectView] -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> Maybe [ModelsProjectView] -> ModelsProject)
-> Parser (Maybe Text)
-> Parser (Maybe [ModelsProjectView] -> ModelsProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")
      Parser (Maybe [ModelsProjectView] -> ModelsProject)
-> Parser (Maybe [ModelsProjectView]) -> Parser ModelsProject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsProjectView])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"views")

-- | ToJSON ModelsProject
instance A.ToJSON ModelsProject where
  toJSON :: ModelsProject -> Value
toJSON ModelsProject {Maybe Bool
Maybe Double
Maybe Int
Maybe [ModelsProjectView]
Maybe Text
Maybe Value
Maybe UserUser
Maybe ModelsSubscription
modelsProjectViews :: Maybe [ModelsProjectView]
modelsProjectUpdated :: Maybe Text
modelsProjectTitle :: Maybe Text
modelsProjectSubscription :: Maybe ModelsSubscription
modelsProjectPosition :: Maybe Double
modelsProjectParentProjectId :: Maybe Int
modelsProjectOwner :: Maybe UserUser
modelsProjectIsFavorite :: Maybe Bool
modelsProjectIsArchived :: Maybe Bool
modelsProjectIdentifier :: Maybe Text
modelsProjectId :: Maybe Int
modelsProjectHexColor :: Maybe Text
modelsProjectDescription :: Maybe Text
modelsProjectCreated :: Maybe Text
modelsProjectBackgroundInformation :: Maybe Value
modelsProjectBackgroundBlurHash :: Maybe Text
$sel:modelsProjectViews:ModelsProject :: ModelsProject -> Maybe [ModelsProjectView]
$sel:modelsProjectUpdated:ModelsProject :: ModelsProject -> Maybe Text
$sel:modelsProjectTitle:ModelsProject :: ModelsProject -> Maybe Text
$sel:modelsProjectSubscription:ModelsProject :: ModelsProject -> Maybe ModelsSubscription
$sel:modelsProjectPosition:ModelsProject :: ModelsProject -> Maybe Double
$sel:modelsProjectParentProjectId:ModelsProject :: ModelsProject -> Maybe Int
$sel:modelsProjectOwner:ModelsProject :: ModelsProject -> Maybe UserUser
$sel:modelsProjectIsFavorite:ModelsProject :: ModelsProject -> Maybe Bool
$sel:modelsProjectIsArchived:ModelsProject :: ModelsProject -> Maybe Bool
$sel:modelsProjectIdentifier:ModelsProject :: ModelsProject -> Maybe Text
$sel:modelsProjectId:ModelsProject :: ModelsProject -> Maybe Int
$sel:modelsProjectHexColor:ModelsProject :: ModelsProject -> Maybe Text
$sel:modelsProjectDescription:ModelsProject :: ModelsProject -> Maybe Text
$sel:modelsProjectCreated:ModelsProject :: ModelsProject -> Maybe Text
$sel:modelsProjectBackgroundInformation:ModelsProject :: ModelsProject -> Maybe Value
$sel:modelsProjectBackgroundBlurHash:ModelsProject :: ModelsProject -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"background_blur_hash" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectBackgroundBlurHash
      , Key
"background_information" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
modelsProjectBackgroundInformation
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectCreated
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectDescription
      , Key
"hex_color" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectHexColor
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectId
      , Key
"identifier" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectIdentifier
      , Key
"is_archived" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsProjectIsArchived
      , Key
"is_favorite" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsProjectIsFavorite
      , Key
"owner" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsProjectOwner
      , Key
"parent_project_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectParentProjectId
      , Key
"position" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsProjectPosition
      , Key
"subscription" Key -> Maybe ModelsSubscription -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsSubscription
modelsProjectSubscription
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectTitle
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectUpdated
      , Key
"views" Key -> Maybe [ModelsProjectView] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsProjectView]
modelsProjectViews
      ]


-- | Construct a value of type 'ModelsProject' (by applying it's required fields, if any)
mkModelsProject
  :: ModelsProject
mkModelsProject :: ModelsProject
mkModelsProject =
  ModelsProject :: Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe UserUser
-> Maybe Int
-> Maybe Double
-> Maybe ModelsSubscription
-> Maybe Text
-> Maybe Text
-> Maybe [ModelsProjectView]
-> ModelsProject
ModelsProject
  { $sel:modelsProjectBackgroundBlurHash:ModelsProject :: Maybe Text
modelsProjectBackgroundBlurHash = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectBackgroundInformation:ModelsProject :: Maybe Value
modelsProjectBackgroundInformation = Maybe Value
forall a. Maybe a
Nothing
  , $sel:modelsProjectCreated:ModelsProject :: Maybe Text
modelsProjectCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectDescription:ModelsProject :: Maybe Text
modelsProjectDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectHexColor:ModelsProject :: Maybe Text
modelsProjectHexColor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectId:ModelsProject :: Maybe Int
modelsProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsProjectIdentifier:ModelsProject :: Maybe Text
modelsProjectIdentifier = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectIsArchived:ModelsProject :: Maybe Bool
modelsProjectIsArchived = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsProjectIsFavorite:ModelsProject :: Maybe Bool
modelsProjectIsFavorite = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsProjectOwner:ModelsProject :: Maybe UserUser
modelsProjectOwner = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsProjectParentProjectId:ModelsProject :: Maybe Int
modelsProjectParentProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsProjectPosition:ModelsProject :: Maybe Double
modelsProjectPosition = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsProjectSubscription:ModelsProject :: Maybe ModelsSubscription
modelsProjectSubscription = Maybe ModelsSubscription
forall a. Maybe a
Nothing
  , $sel:modelsProjectTitle:ModelsProject :: Maybe Text
modelsProjectTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectUpdated:ModelsProject :: Maybe Text
modelsProjectUpdated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectViews:ModelsProject :: Maybe [ModelsProjectView]
modelsProjectViews = Maybe [ModelsProjectView]
forall a. Maybe a
Nothing
  }

-- ** ModelsProjectDuplicate
-- | ModelsProjectDuplicate
data ModelsProjectDuplicate = ModelsProjectDuplicate
  { ModelsProjectDuplicate -> Maybe ModelsProject
modelsProjectDuplicateDuplicatedProject :: !(Maybe ModelsProject) -- ^ "duplicated_project" - The copied project
  , ModelsProjectDuplicate -> Maybe Int
modelsProjectDuplicateParentProjectId :: !(Maybe Int) -- ^ "parent_project_id" - The target parent project
  } deriving (Int -> ModelsProjectDuplicate -> ShowS
[ModelsProjectDuplicate] -> ShowS
ModelsProjectDuplicate -> String
(Int -> ModelsProjectDuplicate -> ShowS)
-> (ModelsProjectDuplicate -> String)
-> ([ModelsProjectDuplicate] -> ShowS)
-> Show ModelsProjectDuplicate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsProjectDuplicate] -> ShowS
$cshowList :: [ModelsProjectDuplicate] -> ShowS
show :: ModelsProjectDuplicate -> String
$cshow :: ModelsProjectDuplicate -> String
showsPrec :: Int -> ModelsProjectDuplicate -> ShowS
$cshowsPrec :: Int -> ModelsProjectDuplicate -> ShowS
P.Show, ModelsProjectDuplicate -> ModelsProjectDuplicate -> Bool
(ModelsProjectDuplicate -> ModelsProjectDuplicate -> Bool)
-> (ModelsProjectDuplicate -> ModelsProjectDuplicate -> Bool)
-> Eq ModelsProjectDuplicate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsProjectDuplicate -> ModelsProjectDuplicate -> Bool
$c/= :: ModelsProjectDuplicate -> ModelsProjectDuplicate -> Bool
== :: ModelsProjectDuplicate -> ModelsProjectDuplicate -> Bool
$c== :: ModelsProjectDuplicate -> ModelsProjectDuplicate -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsProjectDuplicate
instance A.FromJSON ModelsProjectDuplicate where
  parseJSON :: Value -> Parser ModelsProjectDuplicate
parseJSON = String
-> (Object -> Parser ModelsProjectDuplicate)
-> Value
-> Parser ModelsProjectDuplicate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsProjectDuplicate" ((Object -> Parser ModelsProjectDuplicate)
 -> Value -> Parser ModelsProjectDuplicate)
-> (Object -> Parser ModelsProjectDuplicate)
-> Value
-> Parser ModelsProjectDuplicate
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe ModelsProject -> Maybe Int -> ModelsProjectDuplicate
ModelsProjectDuplicate
      (Maybe ModelsProject -> Maybe Int -> ModelsProjectDuplicate)
-> Parser (Maybe ModelsProject)
-> Parser (Maybe Int -> ModelsProjectDuplicate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe ModelsProject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"duplicated_project")
      Parser (Maybe Int -> ModelsProjectDuplicate)
-> Parser (Maybe Int) -> Parser ModelsProjectDuplicate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parent_project_id")

-- | ToJSON ModelsProjectDuplicate
instance A.ToJSON ModelsProjectDuplicate where
  toJSON :: ModelsProjectDuplicate -> Value
toJSON ModelsProjectDuplicate {Maybe Int
Maybe ModelsProject
modelsProjectDuplicateParentProjectId :: Maybe Int
modelsProjectDuplicateDuplicatedProject :: Maybe ModelsProject
$sel:modelsProjectDuplicateParentProjectId:ModelsProjectDuplicate :: ModelsProjectDuplicate -> Maybe Int
$sel:modelsProjectDuplicateDuplicatedProject:ModelsProjectDuplicate :: ModelsProjectDuplicate -> Maybe ModelsProject
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"duplicated_project" Key -> Maybe ModelsProject -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsProject
modelsProjectDuplicateDuplicatedProject
      , Key
"parent_project_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectDuplicateParentProjectId
      ]


-- | Construct a value of type 'ModelsProjectDuplicate' (by applying it's required fields, if any)
mkModelsProjectDuplicate
  :: ModelsProjectDuplicate
mkModelsProjectDuplicate :: ModelsProjectDuplicate
mkModelsProjectDuplicate =
  ModelsProjectDuplicate :: Maybe ModelsProject -> Maybe Int -> ModelsProjectDuplicate
ModelsProjectDuplicate
  { $sel:modelsProjectDuplicateDuplicatedProject:ModelsProjectDuplicate :: Maybe ModelsProject
modelsProjectDuplicateDuplicatedProject = Maybe ModelsProject
forall a. Maybe a
Nothing
  , $sel:modelsProjectDuplicateParentProjectId:ModelsProjectDuplicate :: Maybe Int
modelsProjectDuplicateParentProjectId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsProjectUser
-- | ModelsProjectUser
data ModelsProjectUser = ModelsProjectUser
  { ModelsProjectUser -> Maybe Text
modelsProjectUserCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this relation was created. You cannot change this value.
  , ModelsProjectUser -> Maybe Int
modelsProjectUserId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this project &lt;-&gt; user relation.
  , ModelsProjectUser -> Maybe ModelsRight
modelsProjectUserRight :: !(Maybe ModelsRight) -- ^ "right" - The right this user has. 0 &#x3D; Read only, 1 &#x3D; Read &amp; Write, 2 &#x3D; Admin. See the docs for more details.
  , ModelsProjectUser -> Maybe Text
modelsProjectUserUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this relation was last updated. You cannot change this value.
  , ModelsProjectUser -> Maybe Text
modelsProjectUserUserId :: !(Maybe Text) -- ^ "user_id" - The username.
  } deriving (Int -> ModelsProjectUser -> ShowS
[ModelsProjectUser] -> ShowS
ModelsProjectUser -> String
(Int -> ModelsProjectUser -> ShowS)
-> (ModelsProjectUser -> String)
-> ([ModelsProjectUser] -> ShowS)
-> Show ModelsProjectUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsProjectUser] -> ShowS
$cshowList :: [ModelsProjectUser] -> ShowS
show :: ModelsProjectUser -> String
$cshow :: ModelsProjectUser -> String
showsPrec :: Int -> ModelsProjectUser -> ShowS
$cshowsPrec :: Int -> ModelsProjectUser -> ShowS
P.Show, ModelsProjectUser -> ModelsProjectUser -> Bool
(ModelsProjectUser -> ModelsProjectUser -> Bool)
-> (ModelsProjectUser -> ModelsProjectUser -> Bool)
-> Eq ModelsProjectUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsProjectUser -> ModelsProjectUser -> Bool
$c/= :: ModelsProjectUser -> ModelsProjectUser -> Bool
== :: ModelsProjectUser -> ModelsProjectUser -> Bool
$c== :: ModelsProjectUser -> ModelsProjectUser -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsProjectUser
instance A.FromJSON ModelsProjectUser where
  parseJSON :: Value -> Parser ModelsProjectUser
parseJSON = String
-> (Object -> Parser ModelsProjectUser)
-> Value
-> Parser ModelsProjectUser
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsProjectUser" ((Object -> Parser ModelsProjectUser)
 -> Value -> Parser ModelsProjectUser)
-> (Object -> Parser ModelsProjectUser)
-> Value
-> Parser ModelsProjectUser
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int
-> Maybe ModelsRight
-> Maybe Text
-> Maybe Text
-> ModelsProjectUser
ModelsProjectUser
      (Maybe Text
 -> Maybe Int
 -> Maybe ModelsRight
 -> Maybe Text
 -> Maybe Text
 -> ModelsProjectUser)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe ModelsRight
      -> Maybe Text
      -> Maybe Text
      -> ModelsProjectUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Int
   -> Maybe ModelsRight
   -> Maybe Text
   -> Maybe Text
   -> ModelsProjectUser)
-> Parser (Maybe Int)
-> Parser
     (Maybe ModelsRight
      -> Maybe Text -> Maybe Text -> ModelsProjectUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe ModelsRight
   -> Maybe Text -> Maybe Text -> ModelsProjectUser)
-> Parser (Maybe ModelsRight)
-> Parser (Maybe Text -> Maybe Text -> ModelsProjectUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsRight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"right")
      Parser (Maybe Text -> Maybe Text -> ModelsProjectUser)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsProjectUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")
      Parser (Maybe Text -> ModelsProjectUser)
-> Parser (Maybe Text) -> Parser ModelsProjectUser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_id")

-- | ToJSON ModelsProjectUser
instance A.ToJSON ModelsProjectUser where
  toJSON :: ModelsProjectUser -> Value
toJSON ModelsProjectUser {Maybe Int
Maybe Text
Maybe ModelsRight
modelsProjectUserUserId :: Maybe Text
modelsProjectUserUpdated :: Maybe Text
modelsProjectUserRight :: Maybe ModelsRight
modelsProjectUserId :: Maybe Int
modelsProjectUserCreated :: Maybe Text
$sel:modelsProjectUserUserId:ModelsProjectUser :: ModelsProjectUser -> Maybe Text
$sel:modelsProjectUserUpdated:ModelsProjectUser :: ModelsProjectUser -> Maybe Text
$sel:modelsProjectUserRight:ModelsProjectUser :: ModelsProjectUser -> Maybe ModelsRight
$sel:modelsProjectUserId:ModelsProjectUser :: ModelsProjectUser -> Maybe Int
$sel:modelsProjectUserCreated:ModelsProjectUser :: ModelsProjectUser -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectUserCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectUserId
      , Key
"right" Key -> Maybe ModelsRight -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsRight
modelsProjectUserRight
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectUserUpdated
      , Key
"user_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectUserUserId
      ]


-- | Construct a value of type 'ModelsProjectUser' (by applying it's required fields, if any)
mkModelsProjectUser
  :: ModelsProjectUser
mkModelsProjectUser :: ModelsProjectUser
mkModelsProjectUser =
  ModelsProjectUser :: Maybe Text
-> Maybe Int
-> Maybe ModelsRight
-> Maybe Text
-> Maybe Text
-> ModelsProjectUser
ModelsProjectUser
  { $sel:modelsProjectUserCreated:ModelsProjectUser :: Maybe Text
modelsProjectUserCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectUserId:ModelsProjectUser :: Maybe Int
modelsProjectUserId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsProjectUserRight:ModelsProjectUser :: Maybe ModelsRight
modelsProjectUserRight = Maybe ModelsRight
forall a. Maybe a
Nothing
  , $sel:modelsProjectUserUpdated:ModelsProjectUser :: Maybe Text
modelsProjectUserUpdated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectUserUserId:ModelsProjectUser :: Maybe Text
modelsProjectUserUserId = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsProjectView
-- | ModelsProjectView
data ModelsProjectView = ModelsProjectView
  { ModelsProjectView -> Maybe [ModelsProjectViewBucketConfiguration]
modelsProjectViewBucketConfiguration :: !(Maybe [ModelsProjectViewBucketConfiguration]) -- ^ "bucket_configuration" - When the bucket configuration mode is not &#x60;manual&#x60;, this field holds the options of that configuration.
  , ModelsProjectView -> Maybe ModelsBucketConfigurationModeKind
modelsProjectViewBucketConfigurationMode :: !(Maybe ModelsBucketConfigurationModeKind) -- ^ "bucket_configuration_mode" - The bucket configuration mode. Can be &#x60;none&#x60;, &#x60;manual&#x60; or &#x60;filter&#x60;. &#x60;manual&#x60; allows to move tasks between buckets as you normally would. &#x60;filter&#x60; creates buckets based on a filter for each bucket.
  , ModelsProjectView -> Maybe Text
modelsProjectViewCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this reaction was created. You cannot change this value.
  , ModelsProjectView -> Maybe Int
modelsProjectViewDefaultBucketId :: !(Maybe Int) -- ^ "default_bucket_id" - The ID of the bucket where new tasks without a bucket are added to. By default, this is the leftmost bucket in a view.
  , ModelsProjectView -> Maybe Int
modelsProjectViewDoneBucketId :: !(Maybe Int) -- ^ "done_bucket_id" - If tasks are moved to the done bucket, they are marked as done. If they are marked as done individually, they are moved into the done bucket.
  , ModelsProjectView -> Maybe Text
modelsProjectViewFilter :: !(Maybe Text) -- ^ "filter" - The filter query to match tasks by. Check out https://vikunja.io/docs/filters for a full explanation.
  , ModelsProjectView -> Maybe Int
modelsProjectViewId :: !(Maybe Int) -- ^ "id" - The unique numeric id of this view
  , ModelsProjectView -> Maybe Double
modelsProjectViewPosition :: !(Maybe Double) -- ^ "position" - The position of this view in the list. The list of all views will be sorted by this parameter.
  , ModelsProjectView -> Maybe Int
modelsProjectViewProjectId :: !(Maybe Int) -- ^ "project_id" - The project this view belongs to
  , ModelsProjectView -> Maybe Text
modelsProjectViewTitle :: !(Maybe Text) -- ^ "title" - The title of this view
  , ModelsProjectView -> Maybe Text
modelsProjectViewUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this view was updated. You cannot change this value.
  , ModelsProjectView -> Maybe ModelsProjectViewKind
modelsProjectViewViewKind :: !(Maybe ModelsProjectViewKind) -- ^ "view_kind" - The kind of this view. Can be &#x60;list&#x60;, &#x60;gantt&#x60;, &#x60;table&#x60; or &#x60;kanban&#x60;.
  } deriving (Int -> ModelsProjectView -> ShowS
[ModelsProjectView] -> ShowS
ModelsProjectView -> String
(Int -> ModelsProjectView -> ShowS)
-> (ModelsProjectView -> String)
-> ([ModelsProjectView] -> ShowS)
-> Show ModelsProjectView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsProjectView] -> ShowS
$cshowList :: [ModelsProjectView] -> ShowS
show :: ModelsProjectView -> String
$cshow :: ModelsProjectView -> String
showsPrec :: Int -> ModelsProjectView -> ShowS
$cshowsPrec :: Int -> ModelsProjectView -> ShowS
P.Show, ModelsProjectView -> ModelsProjectView -> Bool
(ModelsProjectView -> ModelsProjectView -> Bool)
-> (ModelsProjectView -> ModelsProjectView -> Bool)
-> Eq ModelsProjectView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsProjectView -> ModelsProjectView -> Bool
$c/= :: ModelsProjectView -> ModelsProjectView -> Bool
== :: ModelsProjectView -> ModelsProjectView -> Bool
$c== :: ModelsProjectView -> ModelsProjectView -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsProjectView
instance A.FromJSON ModelsProjectView where
  parseJSON :: Value -> Parser ModelsProjectView
parseJSON = String
-> (Object -> Parser ModelsProjectView)
-> Value
-> Parser ModelsProjectView
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsProjectView" ((Object -> Parser ModelsProjectView)
 -> Value -> Parser ModelsProjectView)
-> (Object -> Parser ModelsProjectView)
-> Value
-> Parser ModelsProjectView
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [ModelsProjectViewBucketConfiguration]
-> Maybe ModelsBucketConfigurationModeKind
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Double
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe ModelsProjectViewKind
-> ModelsProjectView
ModelsProjectView
      (Maybe [ModelsProjectViewBucketConfiguration]
 -> Maybe ModelsBucketConfigurationModeKind
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe Int
 -> Maybe Double
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe ModelsProjectViewKind
 -> ModelsProjectView)
-> Parser (Maybe [ModelsProjectViewBucketConfiguration])
-> Parser
     (Maybe ModelsBucketConfigurationModeKind
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Key -> Parser (Maybe [ModelsProjectViewBucketConfiguration])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bucket_configuration")
      Parser
  (Maybe ModelsBucketConfigurationModeKind
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe ModelsBucketConfigurationModeKind)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsBucketConfigurationModeKind)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bucket_configuration_mode")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_bucket_id")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"done_bucket_id")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Double
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter")
      Parser
  (Maybe Int
   -> Maybe Double
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe Int)
-> Parser
     (Maybe Double
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Double
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe Double)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsProjectViewKind
      -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsProjectViewKind
   -> ModelsProjectView)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe ModelsProjectViewKind -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_id")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe ModelsProjectViewKind -> ModelsProjectView)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe ModelsProjectViewKind -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser
  (Maybe Text -> Maybe ModelsProjectViewKind -> ModelsProjectView)
-> Parser (Maybe Text)
-> Parser (Maybe ModelsProjectViewKind -> ModelsProjectView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")
      Parser (Maybe ModelsProjectViewKind -> ModelsProjectView)
-> Parser (Maybe ModelsProjectViewKind) -> Parser ModelsProjectView
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsProjectViewKind)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"view_kind")

-- | ToJSON ModelsProjectView
instance A.ToJSON ModelsProjectView where
  toJSON :: ModelsProjectView -> Value
toJSON ModelsProjectView {Maybe Double
Maybe Int
Maybe [ModelsProjectViewBucketConfiguration]
Maybe Text
Maybe ModelsProjectViewKind
Maybe ModelsBucketConfigurationModeKind
modelsProjectViewViewKind :: Maybe ModelsProjectViewKind
modelsProjectViewUpdated :: Maybe Text
modelsProjectViewTitle :: Maybe Text
modelsProjectViewProjectId :: Maybe Int
modelsProjectViewPosition :: Maybe Double
modelsProjectViewId :: Maybe Int
modelsProjectViewFilter :: Maybe Text
modelsProjectViewDoneBucketId :: Maybe Int
modelsProjectViewDefaultBucketId :: Maybe Int
modelsProjectViewCreated :: Maybe Text
modelsProjectViewBucketConfigurationMode :: Maybe ModelsBucketConfigurationModeKind
modelsProjectViewBucketConfiguration :: Maybe [ModelsProjectViewBucketConfiguration]
$sel:modelsProjectViewViewKind:ModelsProjectView :: ModelsProjectView -> Maybe ModelsProjectViewKind
$sel:modelsProjectViewUpdated:ModelsProjectView :: ModelsProjectView -> Maybe Text
$sel:modelsProjectViewTitle:ModelsProjectView :: ModelsProjectView -> Maybe Text
$sel:modelsProjectViewProjectId:ModelsProjectView :: ModelsProjectView -> Maybe Int
$sel:modelsProjectViewPosition:ModelsProjectView :: ModelsProjectView -> Maybe Double
$sel:modelsProjectViewId:ModelsProjectView :: ModelsProjectView -> Maybe Int
$sel:modelsProjectViewFilter:ModelsProjectView :: ModelsProjectView -> Maybe Text
$sel:modelsProjectViewDoneBucketId:ModelsProjectView :: ModelsProjectView -> Maybe Int
$sel:modelsProjectViewDefaultBucketId:ModelsProjectView :: ModelsProjectView -> Maybe Int
$sel:modelsProjectViewCreated:ModelsProjectView :: ModelsProjectView -> Maybe Text
$sel:modelsProjectViewBucketConfigurationMode:ModelsProjectView :: ModelsProjectView -> Maybe ModelsBucketConfigurationModeKind
$sel:modelsProjectViewBucketConfiguration:ModelsProjectView :: ModelsProjectView -> Maybe [ModelsProjectViewBucketConfiguration]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"bucket_configuration" Key -> Maybe [ModelsProjectViewBucketConfiguration] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsProjectViewBucketConfiguration]
modelsProjectViewBucketConfiguration
      , Key
"bucket_configuration_mode" Key -> Maybe ModelsBucketConfigurationModeKind -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsBucketConfigurationModeKind
modelsProjectViewBucketConfigurationMode
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectViewCreated
      , Key
"default_bucket_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectViewDefaultBucketId
      , Key
"done_bucket_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectViewDoneBucketId
      , Key
"filter" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectViewFilter
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectViewId
      , Key
"position" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsProjectViewPosition
      , Key
"project_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsProjectViewProjectId
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectViewTitle
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectViewUpdated
      , Key
"view_kind" Key -> Maybe ModelsProjectViewKind -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsProjectViewKind
modelsProjectViewViewKind
      ]


-- | Construct a value of type 'ModelsProjectView' (by applying it's required fields, if any)
mkModelsProjectView
  :: ModelsProjectView
mkModelsProjectView :: ModelsProjectView
mkModelsProjectView =
  ModelsProjectView :: Maybe [ModelsProjectViewBucketConfiguration]
-> Maybe ModelsBucketConfigurationModeKind
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Double
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe ModelsProjectViewKind
-> ModelsProjectView
ModelsProjectView
  { $sel:modelsProjectViewBucketConfiguration:ModelsProjectView :: Maybe [ModelsProjectViewBucketConfiguration]
modelsProjectViewBucketConfiguration = Maybe [ModelsProjectViewBucketConfiguration]
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewBucketConfigurationMode:ModelsProjectView :: Maybe ModelsBucketConfigurationModeKind
modelsProjectViewBucketConfigurationMode = Maybe ModelsBucketConfigurationModeKind
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewCreated:ModelsProjectView :: Maybe Text
modelsProjectViewCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewDefaultBucketId:ModelsProjectView :: Maybe Int
modelsProjectViewDefaultBucketId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewDoneBucketId:ModelsProjectView :: Maybe Int
modelsProjectViewDoneBucketId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewFilter:ModelsProjectView :: Maybe Text
modelsProjectViewFilter = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewId:ModelsProjectView :: Maybe Int
modelsProjectViewId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewPosition:ModelsProjectView :: Maybe Double
modelsProjectViewPosition = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewProjectId:ModelsProjectView :: Maybe Int
modelsProjectViewProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewTitle:ModelsProjectView :: Maybe Text
modelsProjectViewTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewUpdated:ModelsProjectView :: Maybe Text
modelsProjectViewUpdated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewViewKind:ModelsProjectView :: Maybe ModelsProjectViewKind
modelsProjectViewViewKind = Maybe ModelsProjectViewKind
forall a. Maybe a
Nothing
  }

-- ** ModelsProjectViewBucketConfiguration
-- | ModelsProjectViewBucketConfiguration
data ModelsProjectViewBucketConfiguration = ModelsProjectViewBucketConfiguration
  { ModelsProjectViewBucketConfiguration -> Maybe Text
modelsProjectViewBucketConfigurationFilter :: !(Maybe Text) -- ^ "filter"
  , ModelsProjectViewBucketConfiguration -> Maybe Text
modelsProjectViewBucketConfigurationTitle :: !(Maybe Text) -- ^ "title"
  } deriving (Int -> ModelsProjectViewBucketConfiguration -> ShowS
[ModelsProjectViewBucketConfiguration] -> ShowS
ModelsProjectViewBucketConfiguration -> String
(Int -> ModelsProjectViewBucketConfiguration -> ShowS)
-> (ModelsProjectViewBucketConfiguration -> String)
-> ([ModelsProjectViewBucketConfiguration] -> ShowS)
-> Show ModelsProjectViewBucketConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsProjectViewBucketConfiguration] -> ShowS
$cshowList :: [ModelsProjectViewBucketConfiguration] -> ShowS
show :: ModelsProjectViewBucketConfiguration -> String
$cshow :: ModelsProjectViewBucketConfiguration -> String
showsPrec :: Int -> ModelsProjectViewBucketConfiguration -> ShowS
$cshowsPrec :: Int -> ModelsProjectViewBucketConfiguration -> ShowS
P.Show, ModelsProjectViewBucketConfiguration
-> ModelsProjectViewBucketConfiguration -> Bool
(ModelsProjectViewBucketConfiguration
 -> ModelsProjectViewBucketConfiguration -> Bool)
-> (ModelsProjectViewBucketConfiguration
    -> ModelsProjectViewBucketConfiguration -> Bool)
-> Eq ModelsProjectViewBucketConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsProjectViewBucketConfiguration
-> ModelsProjectViewBucketConfiguration -> Bool
$c/= :: ModelsProjectViewBucketConfiguration
-> ModelsProjectViewBucketConfiguration -> Bool
== :: ModelsProjectViewBucketConfiguration
-> ModelsProjectViewBucketConfiguration -> Bool
$c== :: ModelsProjectViewBucketConfiguration
-> ModelsProjectViewBucketConfiguration -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsProjectViewBucketConfiguration
instance A.FromJSON ModelsProjectViewBucketConfiguration where
  parseJSON :: Value -> Parser ModelsProjectViewBucketConfiguration
parseJSON = String
-> (Object -> Parser ModelsProjectViewBucketConfiguration)
-> Value
-> Parser ModelsProjectViewBucketConfiguration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsProjectViewBucketConfiguration" ((Object -> Parser ModelsProjectViewBucketConfiguration)
 -> Value -> Parser ModelsProjectViewBucketConfiguration)
-> (Object -> Parser ModelsProjectViewBucketConfiguration)
-> Value
-> Parser ModelsProjectViewBucketConfiguration
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> ModelsProjectViewBucketConfiguration
ModelsProjectViewBucketConfiguration
      (Maybe Text -> Maybe Text -> ModelsProjectViewBucketConfiguration)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> ModelsProjectViewBucketConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter")
      Parser (Maybe Text -> ModelsProjectViewBucketConfiguration)
-> Parser (Maybe Text)
-> Parser ModelsProjectViewBucketConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON ModelsProjectViewBucketConfiguration
instance A.ToJSON ModelsProjectViewBucketConfiguration where
  toJSON :: ModelsProjectViewBucketConfiguration -> Value
toJSON ModelsProjectViewBucketConfiguration {Maybe Text
modelsProjectViewBucketConfigurationTitle :: Maybe Text
modelsProjectViewBucketConfigurationFilter :: Maybe Text
$sel:modelsProjectViewBucketConfigurationTitle:ModelsProjectViewBucketConfiguration :: ModelsProjectViewBucketConfiguration -> Maybe Text
$sel:modelsProjectViewBucketConfigurationFilter:ModelsProjectViewBucketConfiguration :: ModelsProjectViewBucketConfiguration -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"filter" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectViewBucketConfigurationFilter
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsProjectViewBucketConfigurationTitle
      ]


-- | Construct a value of type 'ModelsProjectViewBucketConfiguration' (by applying it's required fields, if any)
mkModelsProjectViewBucketConfiguration
  :: ModelsProjectViewBucketConfiguration
mkModelsProjectViewBucketConfiguration :: ModelsProjectViewBucketConfiguration
mkModelsProjectViewBucketConfiguration =
  ModelsProjectViewBucketConfiguration :: Maybe Text -> Maybe Text -> ModelsProjectViewBucketConfiguration
ModelsProjectViewBucketConfiguration
  { $sel:modelsProjectViewBucketConfigurationFilter:ModelsProjectViewBucketConfiguration :: Maybe Text
modelsProjectViewBucketConfigurationFilter = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsProjectViewBucketConfigurationTitle:ModelsProjectViewBucketConfiguration :: Maybe Text
modelsProjectViewBucketConfigurationTitle = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsReaction
-- | ModelsReaction
data ModelsReaction = ModelsReaction
  { ModelsReaction -> Maybe Text
modelsReactionCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this reaction was created. You cannot change this value.
  , ModelsReaction -> Maybe UserUser
modelsReactionUser :: !(Maybe UserUser) -- ^ "user" - The user who reacted
  , ModelsReaction -> Maybe Text
modelsReactionValue :: !(Maybe Text) -- ^ "value" - The actual reaction. This can be any valid utf character or text, up to a length of 20.
  } deriving (Int -> ModelsReaction -> ShowS
[ModelsReaction] -> ShowS
ModelsReaction -> String
(Int -> ModelsReaction -> ShowS)
-> (ModelsReaction -> String)
-> ([ModelsReaction] -> ShowS)
-> Show ModelsReaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsReaction] -> ShowS
$cshowList :: [ModelsReaction] -> ShowS
show :: ModelsReaction -> String
$cshow :: ModelsReaction -> String
showsPrec :: Int -> ModelsReaction -> ShowS
$cshowsPrec :: Int -> ModelsReaction -> ShowS
P.Show, ModelsReaction -> ModelsReaction -> Bool
(ModelsReaction -> ModelsReaction -> Bool)
-> (ModelsReaction -> ModelsReaction -> Bool) -> Eq ModelsReaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsReaction -> ModelsReaction -> Bool
$c/= :: ModelsReaction -> ModelsReaction -> Bool
== :: ModelsReaction -> ModelsReaction -> Bool
$c== :: ModelsReaction -> ModelsReaction -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsReaction
instance A.FromJSON ModelsReaction where
  parseJSON :: Value -> Parser ModelsReaction
parseJSON = String
-> (Object -> Parser ModelsReaction)
-> Value
-> Parser ModelsReaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsReaction" ((Object -> Parser ModelsReaction)
 -> Value -> Parser ModelsReaction)
-> (Object -> Parser ModelsReaction)
-> Value
-> Parser ModelsReaction
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe UserUser -> Maybe Text -> ModelsReaction
ModelsReaction
      (Maybe Text -> Maybe UserUser -> Maybe Text -> ModelsReaction)
-> Parser (Maybe Text)
-> Parser (Maybe UserUser -> Maybe Text -> ModelsReaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Maybe UserUser -> Maybe Text -> ModelsReaction)
-> Parser (Maybe UserUser) -> Parser (Maybe Text -> ModelsReaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")
      Parser (Maybe Text -> ModelsReaction)
-> Parser (Maybe Text) -> Parser ModelsReaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value")

-- | ToJSON ModelsReaction
instance A.ToJSON ModelsReaction where
  toJSON :: ModelsReaction -> Value
toJSON ModelsReaction {Maybe Text
Maybe UserUser
modelsReactionValue :: Maybe Text
modelsReactionUser :: Maybe UserUser
modelsReactionCreated :: Maybe Text
$sel:modelsReactionValue:ModelsReaction :: ModelsReaction -> Maybe Text
$sel:modelsReactionUser:ModelsReaction :: ModelsReaction -> Maybe UserUser
$sel:modelsReactionCreated:ModelsReaction :: ModelsReaction -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsReactionCreated
      , Key
"user" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsReactionUser
      , Key
"value" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsReactionValue
      ]


-- | Construct a value of type 'ModelsReaction' (by applying it's required fields, if any)
mkModelsReaction
  :: ModelsReaction
mkModelsReaction :: ModelsReaction
mkModelsReaction =
  ModelsReaction :: Maybe Text -> Maybe UserUser -> Maybe Text -> ModelsReaction
ModelsReaction
  { $sel:modelsReactionCreated:ModelsReaction :: Maybe Text
modelsReactionCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsReactionUser:ModelsReaction :: Maybe UserUser
modelsReactionUser = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsReactionValue:ModelsReaction :: Maybe Text
modelsReactionValue = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsRouteDetail
-- | ModelsRouteDetail
data ModelsRouteDetail = ModelsRouteDetail
  { ModelsRouteDetail -> Maybe Text
modelsRouteDetailMethod :: !(Maybe Text) -- ^ "method"
  , ModelsRouteDetail -> Maybe Text
modelsRouteDetailPath :: !(Maybe Text) -- ^ "path"
  } deriving (Int -> ModelsRouteDetail -> ShowS
[ModelsRouteDetail] -> ShowS
ModelsRouteDetail -> String
(Int -> ModelsRouteDetail -> ShowS)
-> (ModelsRouteDetail -> String)
-> ([ModelsRouteDetail] -> ShowS)
-> Show ModelsRouteDetail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsRouteDetail] -> ShowS
$cshowList :: [ModelsRouteDetail] -> ShowS
show :: ModelsRouteDetail -> String
$cshow :: ModelsRouteDetail -> String
showsPrec :: Int -> ModelsRouteDetail -> ShowS
$cshowsPrec :: Int -> ModelsRouteDetail -> ShowS
P.Show, ModelsRouteDetail -> ModelsRouteDetail -> Bool
(ModelsRouteDetail -> ModelsRouteDetail -> Bool)
-> (ModelsRouteDetail -> ModelsRouteDetail -> Bool)
-> Eq ModelsRouteDetail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsRouteDetail -> ModelsRouteDetail -> Bool
$c/= :: ModelsRouteDetail -> ModelsRouteDetail -> Bool
== :: ModelsRouteDetail -> ModelsRouteDetail -> Bool
$c== :: ModelsRouteDetail -> ModelsRouteDetail -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsRouteDetail
instance A.FromJSON ModelsRouteDetail where
  parseJSON :: Value -> Parser ModelsRouteDetail
parseJSON = String
-> (Object -> Parser ModelsRouteDetail)
-> Value
-> Parser ModelsRouteDetail
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsRouteDetail" ((Object -> Parser ModelsRouteDetail)
 -> Value -> Parser ModelsRouteDetail)
-> (Object -> Parser ModelsRouteDetail)
-> Value
-> Parser ModelsRouteDetail
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> ModelsRouteDetail
ModelsRouteDetail
      (Maybe Text -> Maybe Text -> ModelsRouteDetail)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsRouteDetail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"method")
      Parser (Maybe Text -> ModelsRouteDetail)
-> Parser (Maybe Text) -> Parser ModelsRouteDetail
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path")

-- | ToJSON ModelsRouteDetail
instance A.ToJSON ModelsRouteDetail where
  toJSON :: ModelsRouteDetail -> Value
toJSON ModelsRouteDetail {Maybe Text
modelsRouteDetailPath :: Maybe Text
modelsRouteDetailMethod :: Maybe Text
$sel:modelsRouteDetailPath:ModelsRouteDetail :: ModelsRouteDetail -> Maybe Text
$sel:modelsRouteDetailMethod:ModelsRouteDetail :: ModelsRouteDetail -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"method" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsRouteDetailMethod
      , Key
"path" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsRouteDetailPath
      ]


-- | Construct a value of type 'ModelsRouteDetail' (by applying it's required fields, if any)
mkModelsRouteDetail
  :: ModelsRouteDetail
mkModelsRouteDetail :: ModelsRouteDetail
mkModelsRouteDetail =
  ModelsRouteDetail :: Maybe Text -> Maybe Text -> ModelsRouteDetail
ModelsRouteDetail
  { $sel:modelsRouteDetailMethod:ModelsRouteDetail :: Maybe Text
modelsRouteDetailMethod = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsRouteDetailPath:ModelsRouteDetail :: Maybe Text
modelsRouteDetailPath = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsSavedFilter
-- | ModelsSavedFilter
data ModelsSavedFilter = ModelsSavedFilter
  { ModelsSavedFilter -> Maybe Text
modelsSavedFilterCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this filter was created. You cannot change this value.
  , ModelsSavedFilter -> Maybe Text
modelsSavedFilterDescription :: !(Maybe Text) -- ^ "description" - The description of the filter
  , ModelsSavedFilter -> Maybe ModelsTaskCollection
modelsSavedFilterFilters :: !(Maybe ModelsTaskCollection) -- ^ "filters" - The actual filters this filter contains
  , ModelsSavedFilter -> Maybe Int
modelsSavedFilterId :: !(Maybe Int) -- ^ "id" - The unique numeric id of this saved filter
  , ModelsSavedFilter -> Maybe Bool
modelsSavedFilterIsFavorite :: !(Maybe Bool) -- ^ "is_favorite" - True if the filter is a favorite. Favorite filters show up in a separate parent project together with favorite projects.
  , ModelsSavedFilter -> Maybe UserUser
modelsSavedFilterOwner :: !(Maybe UserUser) -- ^ "owner" - The user who owns this filter
  , ModelsSavedFilter -> Maybe Text
modelsSavedFilterTitle :: !(Maybe Text) -- ^ "title" - The title of the filter.
  , ModelsSavedFilter -> Maybe Text
modelsSavedFilterUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this filter was last updated. You cannot change this value.
  } deriving (Int -> ModelsSavedFilter -> ShowS
[ModelsSavedFilter] -> ShowS
ModelsSavedFilter -> String
(Int -> ModelsSavedFilter -> ShowS)
-> (ModelsSavedFilter -> String)
-> ([ModelsSavedFilter] -> ShowS)
-> Show ModelsSavedFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsSavedFilter] -> ShowS
$cshowList :: [ModelsSavedFilter] -> ShowS
show :: ModelsSavedFilter -> String
$cshow :: ModelsSavedFilter -> String
showsPrec :: Int -> ModelsSavedFilter -> ShowS
$cshowsPrec :: Int -> ModelsSavedFilter -> ShowS
P.Show, ModelsSavedFilter -> ModelsSavedFilter -> Bool
(ModelsSavedFilter -> ModelsSavedFilter -> Bool)
-> (ModelsSavedFilter -> ModelsSavedFilter -> Bool)
-> Eq ModelsSavedFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsSavedFilter -> ModelsSavedFilter -> Bool
$c/= :: ModelsSavedFilter -> ModelsSavedFilter -> Bool
== :: ModelsSavedFilter -> ModelsSavedFilter -> Bool
$c== :: ModelsSavedFilter -> ModelsSavedFilter -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsSavedFilter
instance A.FromJSON ModelsSavedFilter where
  parseJSON :: Value -> Parser ModelsSavedFilter
parseJSON = String
-> (Object -> Parser ModelsSavedFilter)
-> Value
-> Parser ModelsSavedFilter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsSavedFilter" ((Object -> Parser ModelsSavedFilter)
 -> Value -> Parser ModelsSavedFilter)
-> (Object -> Parser ModelsSavedFilter)
-> Value
-> Parser ModelsSavedFilter
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe ModelsTaskCollection
-> Maybe Int
-> Maybe Bool
-> Maybe UserUser
-> Maybe Text
-> Maybe Text
-> ModelsSavedFilter
ModelsSavedFilter
      (Maybe Text
 -> Maybe Text
 -> Maybe ModelsTaskCollection
 -> Maybe Int
 -> Maybe Bool
 -> Maybe UserUser
 -> Maybe Text
 -> Maybe Text
 -> ModelsSavedFilter)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ModelsTaskCollection
      -> Maybe Int
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Text
      -> ModelsSavedFilter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe ModelsTaskCollection
   -> Maybe Int
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Text
   -> ModelsSavedFilter)
-> Parser (Maybe Text)
-> Parser
     (Maybe ModelsTaskCollection
      -> Maybe Int
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Text
      -> ModelsSavedFilter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe ModelsTaskCollection
   -> Maybe Int
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Text
   -> ModelsSavedFilter)
-> Parser (Maybe ModelsTaskCollection)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Text
      -> ModelsSavedFilter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsTaskCollection)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filters")
      Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Text
   -> ModelsSavedFilter)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe UserUser -> Maybe Text -> Maybe Text -> ModelsSavedFilter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe UserUser -> Maybe Text -> Maybe Text -> ModelsSavedFilter)
-> Parser (Maybe Bool)
-> Parser
     (Maybe UserUser -> Maybe Text -> Maybe Text -> ModelsSavedFilter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_favorite")
      Parser
  (Maybe UserUser -> Maybe Text -> Maybe Text -> ModelsSavedFilter)
-> Parser (Maybe UserUser)
-> Parser (Maybe Text -> Maybe Text -> ModelsSavedFilter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")
      Parser (Maybe Text -> Maybe Text -> ModelsSavedFilter)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsSavedFilter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> ModelsSavedFilter)
-> Parser (Maybe Text) -> Parser ModelsSavedFilter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsSavedFilter
instance A.ToJSON ModelsSavedFilter where
  toJSON :: ModelsSavedFilter -> Value
toJSON ModelsSavedFilter {Maybe Bool
Maybe Int
Maybe Text
Maybe UserUser
Maybe ModelsTaskCollection
modelsSavedFilterUpdated :: Maybe Text
modelsSavedFilterTitle :: Maybe Text
modelsSavedFilterOwner :: Maybe UserUser
modelsSavedFilterIsFavorite :: Maybe Bool
modelsSavedFilterId :: Maybe Int
modelsSavedFilterFilters :: Maybe ModelsTaskCollection
modelsSavedFilterDescription :: Maybe Text
modelsSavedFilterCreated :: Maybe Text
$sel:modelsSavedFilterUpdated:ModelsSavedFilter :: ModelsSavedFilter -> Maybe Text
$sel:modelsSavedFilterTitle:ModelsSavedFilter :: ModelsSavedFilter -> Maybe Text
$sel:modelsSavedFilterOwner:ModelsSavedFilter :: ModelsSavedFilter -> Maybe UserUser
$sel:modelsSavedFilterIsFavorite:ModelsSavedFilter :: ModelsSavedFilter -> Maybe Bool
$sel:modelsSavedFilterId:ModelsSavedFilter :: ModelsSavedFilter -> Maybe Int
$sel:modelsSavedFilterFilters:ModelsSavedFilter :: ModelsSavedFilter -> Maybe ModelsTaskCollection
$sel:modelsSavedFilterDescription:ModelsSavedFilter :: ModelsSavedFilter -> Maybe Text
$sel:modelsSavedFilterCreated:ModelsSavedFilter :: ModelsSavedFilter -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsSavedFilterCreated
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsSavedFilterDescription
      , Key
"filters" Key -> Maybe ModelsTaskCollection -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsTaskCollection
modelsSavedFilterFilters
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsSavedFilterId
      , Key
"is_favorite" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsSavedFilterIsFavorite
      , Key
"owner" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsSavedFilterOwner
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsSavedFilterTitle
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsSavedFilterUpdated
      ]


-- | Construct a value of type 'ModelsSavedFilter' (by applying it's required fields, if any)
mkModelsSavedFilter
  :: ModelsSavedFilter
mkModelsSavedFilter :: ModelsSavedFilter
mkModelsSavedFilter =
  ModelsSavedFilter :: Maybe Text
-> Maybe Text
-> Maybe ModelsTaskCollection
-> Maybe Int
-> Maybe Bool
-> Maybe UserUser
-> Maybe Text
-> Maybe Text
-> ModelsSavedFilter
ModelsSavedFilter
  { $sel:modelsSavedFilterCreated:ModelsSavedFilter :: Maybe Text
modelsSavedFilterCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsSavedFilterDescription:ModelsSavedFilter :: Maybe Text
modelsSavedFilterDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsSavedFilterFilters:ModelsSavedFilter :: Maybe ModelsTaskCollection
modelsSavedFilterFilters = Maybe ModelsTaskCollection
forall a. Maybe a
Nothing
  , $sel:modelsSavedFilterId:ModelsSavedFilter :: Maybe Int
modelsSavedFilterId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsSavedFilterIsFavorite:ModelsSavedFilter :: Maybe Bool
modelsSavedFilterIsFavorite = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsSavedFilterOwner:ModelsSavedFilter :: Maybe UserUser
modelsSavedFilterOwner = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsSavedFilterTitle:ModelsSavedFilter :: Maybe Text
modelsSavedFilterTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsSavedFilterUpdated:ModelsSavedFilter :: Maybe Text
modelsSavedFilterUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsSubscription
-- | ModelsSubscription
data ModelsSubscription = ModelsSubscription
  { ModelsSubscription -> Maybe Text
modelsSubscriptionCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this subscription was created. You cannot change this value.
  , ModelsSubscription -> Maybe Int
modelsSubscriptionEntity :: !(Maybe Int) -- ^ "entity"
  , ModelsSubscription -> Maybe Int
modelsSubscriptionEntityId :: !(Maybe Int) -- ^ "entity_id" - The id of the entity to subscribe to.
  , ModelsSubscription -> Maybe Int
modelsSubscriptionId :: !(Maybe Int) -- ^ "id" - The numeric ID of the subscription
  } deriving (Int -> ModelsSubscription -> ShowS
[ModelsSubscription] -> ShowS
ModelsSubscription -> String
(Int -> ModelsSubscription -> ShowS)
-> (ModelsSubscription -> String)
-> ([ModelsSubscription] -> ShowS)
-> Show ModelsSubscription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsSubscription] -> ShowS
$cshowList :: [ModelsSubscription] -> ShowS
show :: ModelsSubscription -> String
$cshow :: ModelsSubscription -> String
showsPrec :: Int -> ModelsSubscription -> ShowS
$cshowsPrec :: Int -> ModelsSubscription -> ShowS
P.Show, ModelsSubscription -> ModelsSubscription -> Bool
(ModelsSubscription -> ModelsSubscription -> Bool)
-> (ModelsSubscription -> ModelsSubscription -> Bool)
-> Eq ModelsSubscription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsSubscription -> ModelsSubscription -> Bool
$c/= :: ModelsSubscription -> ModelsSubscription -> Bool
== :: ModelsSubscription -> ModelsSubscription -> Bool
$c== :: ModelsSubscription -> ModelsSubscription -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsSubscription
instance A.FromJSON ModelsSubscription where
  parseJSON :: Value -> Parser ModelsSubscription
parseJSON = String
-> (Object -> Parser ModelsSubscription)
-> Value
-> Parser ModelsSubscription
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsSubscription" ((Object -> Parser ModelsSubscription)
 -> Value -> Parser ModelsSubscription)
-> (Object -> Parser ModelsSubscription)
-> Value
-> Parser ModelsSubscription
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int -> Maybe Int -> Maybe Int -> ModelsSubscription
ModelsSubscription
      (Maybe Text
 -> Maybe Int -> Maybe Int -> Maybe Int -> ModelsSubscription)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int -> Maybe Int -> Maybe Int -> ModelsSubscription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Maybe Int -> Maybe Int -> Maybe Int -> ModelsSubscription)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> ModelsSubscription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"entity")
      Parser (Maybe Int -> Maybe Int -> ModelsSubscription)
-> Parser (Maybe Int) -> Parser (Maybe Int -> ModelsSubscription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"entity_id")
      Parser (Maybe Int -> ModelsSubscription)
-> Parser (Maybe Int) -> Parser ModelsSubscription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")

-- | ToJSON ModelsSubscription
instance A.ToJSON ModelsSubscription where
  toJSON :: ModelsSubscription -> Value
toJSON ModelsSubscription {Maybe Int
Maybe Text
modelsSubscriptionId :: Maybe Int
modelsSubscriptionEntityId :: Maybe Int
modelsSubscriptionEntity :: Maybe Int
modelsSubscriptionCreated :: Maybe Text
$sel:modelsSubscriptionId:ModelsSubscription :: ModelsSubscription -> Maybe Int
$sel:modelsSubscriptionEntityId:ModelsSubscription :: ModelsSubscription -> Maybe Int
$sel:modelsSubscriptionEntity:ModelsSubscription :: ModelsSubscription -> Maybe Int
$sel:modelsSubscriptionCreated:ModelsSubscription :: ModelsSubscription -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsSubscriptionCreated
      , Key
"entity" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsSubscriptionEntity
      , Key
"entity_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsSubscriptionEntityId
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsSubscriptionId
      ]


-- | Construct a value of type 'ModelsSubscription' (by applying it's required fields, if any)
mkModelsSubscription
  :: ModelsSubscription
mkModelsSubscription :: ModelsSubscription
mkModelsSubscription =
  ModelsSubscription :: Maybe Text
-> Maybe Int -> Maybe Int -> Maybe Int -> ModelsSubscription
ModelsSubscription
  { $sel:modelsSubscriptionCreated:ModelsSubscription :: Maybe Text
modelsSubscriptionCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsSubscriptionEntity:ModelsSubscription :: Maybe Int
modelsSubscriptionEntity = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsSubscriptionEntityId:ModelsSubscription :: Maybe Int
modelsSubscriptionEntityId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsSubscriptionId:ModelsSubscription :: Maybe Int
modelsSubscriptionId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsTask
-- | ModelsTask
data ModelsTask = ModelsTask
  { ModelsTask -> Maybe [UserUser]
modelsTaskAssignees :: !(Maybe [UserUser]) -- ^ "assignees" - An array of users who are assigned to this task
  , ModelsTask -> Maybe [ModelsTaskAttachment]
modelsTaskAttachments :: !(Maybe [ModelsTaskAttachment]) -- ^ "attachments" - All attachments this task has. This property is read-onlym, you must use the separate endpoint to add attachments to a task.
  , ModelsTask -> Maybe Int
modelsTaskBucketId :: !(Maybe Int) -- ^ "bucket_id" - The bucket id. Will only be populated when the task is accessed via a view with buckets. Can be used to move a task between buckets. In that case, the new bucket must be in the same view as the old one.
  , ModelsTask -> Maybe Int
modelsTaskCoverImageAttachmentId :: !(Maybe Int) -- ^ "cover_image_attachment_id" - If this task has a cover image, the field will return the id of the attachment that is the cover image.
  , ModelsTask -> Maybe Text
modelsTaskCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this task was created. You cannot change this value.
  , ModelsTask -> Maybe UserUser
modelsTaskCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who initially created the task.
  , ModelsTask -> Maybe Text
modelsTaskDescription :: !(Maybe Text) -- ^ "description" - The task description.
  , ModelsTask -> Maybe Bool
modelsTaskDone :: !(Maybe Bool) -- ^ "done" - Whether a task is done or not.
  , ModelsTask -> Maybe Text
modelsTaskDoneAt :: !(Maybe Text) -- ^ "done_at" - The time when a task was marked as done.
  , ModelsTask -> Maybe Text
modelsTaskDueDate :: !(Maybe Text) -- ^ "due_date" - The time when the task is due.
  , ModelsTask -> Maybe Text
modelsTaskEndDate :: !(Maybe Text) -- ^ "end_date" - When this task ends.
  , ModelsTask -> Maybe Text
modelsTaskHexColor :: !(Maybe Text) -- ^ "hex_color" - The task color in hex
  , ModelsTask -> Maybe Int
modelsTaskId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this task.
  , ModelsTask -> Maybe Text
modelsTaskIdentifier :: !(Maybe Text) -- ^ "identifier" - The task identifier, based on the project identifier and the task&#39;s index
  , ModelsTask -> Maybe Int
modelsTaskIndex :: !(Maybe Int) -- ^ "index" - The task index, calculated per project
  , ModelsTask -> Maybe Bool
modelsTaskIsFavorite :: !(Maybe Bool) -- ^ "is_favorite" - True if a task is a favorite task. Favorite tasks show up in a separate \&quot;Important\&quot; project. This value depends on the user making the call to the api.
  , ModelsTask -> Maybe [ModelsLabel]
modelsTaskLabels :: !(Maybe [ModelsLabel]) -- ^ "labels" - An array of labels which are associated with this task. This property is read-only, you must use the separate endpoint to add labels to a task.
  , ModelsTask -> Maybe Double
modelsTaskPercentDone :: !(Maybe Double) -- ^ "percent_done" - Determines how far a task is left from being done
  , ModelsTask -> Maybe Double
modelsTaskPosition :: !(Maybe Double) -- ^ "position" - The position of the task - any task project can be sorted as usual by this parameter. When accessing tasks via views with buckets, this is primarily used to sort them based on a range. Positions are always saved per view. They will automatically be set if you request the tasks through a view endpoint, otherwise they will always be 0. To update them, take a look at the Task Position endpoint.
  , ModelsTask -> Maybe Int
modelsTaskPriority :: !(Maybe Int) -- ^ "priority" - The task priority. Can be anything you want, it is possible to sort by this later.
  , ModelsTask -> Maybe Int
modelsTaskProjectId :: !(Maybe Int) -- ^ "project_id" - The project this task belongs to.
  , ModelsTask -> Maybe (Map String [UserUser])
modelsTaskReactions :: !(Maybe (Map.Map String [UserUser])) -- ^ "reactions" - Reactions on that task.
  , ModelsTask -> Maybe (Map String [ModelsTask])
modelsTaskRelatedTasks :: !(Maybe (Map.Map String [ModelsTask])) -- ^ "related_tasks" - All related tasks, grouped by their relation kind
  , ModelsTask -> Maybe [ModelsTaskReminder]
modelsTaskReminders :: !(Maybe [ModelsTaskReminder]) -- ^ "reminders" - An array of reminders that are associated with this task.
  , ModelsTask -> Maybe Int
modelsTaskRepeatAfter :: !(Maybe Int) -- ^ "repeat_after" - An amount in seconds this task repeats itself. If this is set, when marking the task as done, it will mark itself as \&quot;undone\&quot; and then increase all remindes and the due date by its amount.
  , ModelsTask -> Maybe ModelsTaskRepeatMode
modelsTaskRepeatMode :: !(Maybe ModelsTaskRepeatMode) -- ^ "repeat_mode" - Can have three possible values which will trigger when the task is marked as done: 0 &#x3D; repeats after the amount specified in repeat_after, 1 &#x3D; repeats all dates each months (ignoring repeat_after), 3 &#x3D; repeats from the current date rather than the last set date.
  , ModelsTask -> Maybe Text
modelsTaskStartDate :: !(Maybe Text) -- ^ "start_date" - When this task starts.
  , ModelsTask -> Maybe ModelsSubscription
modelsTaskSubscription :: !(Maybe ModelsSubscription) -- ^ "subscription" - The subscription status for the user reading this task. You can only read this property, use the subscription endpoints to modify it. Will only returned when retrieving one task.
  , ModelsTask -> Maybe Text
modelsTaskTitle :: !(Maybe Text) -- ^ "title" - The task text. This is what you&#39;ll see in the project.
  , ModelsTask -> Maybe Text
modelsTaskUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this task was last updated. You cannot change this value.
  } deriving (Int -> ModelsTask -> ShowS
[ModelsTask] -> ShowS
ModelsTask -> String
(Int -> ModelsTask -> ShowS)
-> (ModelsTask -> String)
-> ([ModelsTask] -> ShowS)
-> Show ModelsTask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTask] -> ShowS
$cshowList :: [ModelsTask] -> ShowS
show :: ModelsTask -> String
$cshow :: ModelsTask -> String
showsPrec :: Int -> ModelsTask -> ShowS
$cshowsPrec :: Int -> ModelsTask -> ShowS
P.Show, ModelsTask -> ModelsTask -> Bool
(ModelsTask -> ModelsTask -> Bool)
-> (ModelsTask -> ModelsTask -> Bool) -> Eq ModelsTask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTask -> ModelsTask -> Bool
$c/= :: ModelsTask -> ModelsTask -> Bool
== :: ModelsTask -> ModelsTask -> Bool
$c== :: ModelsTask -> ModelsTask -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTask
instance A.FromJSON ModelsTask where
  parseJSON :: Value -> Parser ModelsTask
parseJSON = String
-> (Object -> Parser ModelsTask) -> Value -> Parser ModelsTask
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTask" ((Object -> Parser ModelsTask) -> Value -> Parser ModelsTask)
-> (Object -> Parser ModelsTask) -> Value -> Parser ModelsTask
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [UserUser]
-> Maybe [ModelsTaskAttachment]
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe [ModelsLabel]
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe (Map String [UserUser])
-> Maybe (Map String [ModelsTask])
-> Maybe [ModelsTaskReminder]
-> Maybe Int
-> Maybe ModelsTaskRepeatMode
-> Maybe Text
-> Maybe ModelsSubscription
-> Maybe Text
-> Maybe Text
-> ModelsTask
ModelsTask
      (Maybe [UserUser]
 -> Maybe [ModelsTaskAttachment]
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe UserUser
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Int
 -> Maybe Bool
 -> Maybe [ModelsLabel]
 -> Maybe Double
 -> Maybe Double
 -> Maybe Int
 -> Maybe Int
 -> Maybe (Map String [UserUser])
 -> Maybe (Map String [ModelsTask])
 -> Maybe [ModelsTaskReminder]
 -> Maybe Int
 -> Maybe ModelsTaskRepeatMode
 -> Maybe Text
 -> Maybe ModelsSubscription
 -> Maybe Text
 -> Maybe Text
 -> ModelsTask)
-> Parser (Maybe [UserUser])
-> Parser
     (Maybe [ModelsTaskAttachment]
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [UserUser])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe [ModelsTaskAttachment]
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe [ModelsTaskAttachment])
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsTaskAttachment])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attachments")
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bucket_id")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cover_image_attachment_id")
      Parser
  (Maybe Text
   -> Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"done")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"done_at")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"end_date")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hex_color")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"identifier")
      Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"index")
      Parser
  (Maybe Bool
   -> Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [ModelsLabel]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_favorite")
      Parser
  (Maybe [ModelsLabel]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe [ModelsLabel])
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsLabel])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"percent_done")
      Parser
  (Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Double)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position")
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priority")
      Parser
  (Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe (Map String [UserUser])
      -> Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_id")
      Parser
  (Maybe (Map String [UserUser])
   -> Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe (Map String [UserUser]))
-> Parser
     (Maybe (Map String [ModelsTask])
      -> Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map String [UserUser]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reactions")
      Parser
  (Maybe (Map String [ModelsTask])
   -> Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe (Map String [ModelsTask]))
-> Parser
     (Maybe [ModelsTaskReminder]
      -> Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map String [ModelsTask]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"related_tasks")
      Parser
  (Maybe [ModelsTaskReminder]
   -> Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe [ModelsTaskReminder])
-> Parser
     (Maybe Int
      -> Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsTaskReminder])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reminders")
      Parser
  (Maybe Int
   -> Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Int)
-> Parser
     (Maybe ModelsTaskRepeatMode
      -> Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repeat_after")
      Parser
  (Maybe ModelsTaskRepeatMode
   -> Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe ModelsTaskRepeatMode)
-> Parser
     (Maybe Text
      -> Maybe ModelsSubscription
      -> Maybe Text
      -> Maybe Text
      -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsTaskRepeatMode)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repeat_mode")
      Parser
  (Maybe Text
   -> Maybe ModelsSubscription
   -> Maybe Text
   -> Maybe Text
   -> ModelsTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe ModelsSubscription
      -> Maybe Text -> Maybe Text -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"start_date")
      Parser
  (Maybe ModelsSubscription
   -> Maybe Text -> Maybe Text -> ModelsTask)
-> Parser (Maybe ModelsSubscription)
-> Parser (Maybe Text -> Maybe Text -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsSubscription)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subscription")
      Parser (Maybe Text -> Maybe Text -> ModelsTask)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsTask)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> ModelsTask)
-> Parser (Maybe Text) -> Parser ModelsTask
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsTask
instance A.ToJSON ModelsTask where
  toJSON :: ModelsTask -> Value
toJSON ModelsTask {Maybe Bool
Maybe Double
Maybe Int
Maybe [UserUser]
Maybe [ModelsTaskReminder]
Maybe [ModelsTaskAttachment]
Maybe [ModelsLabel]
Maybe Text
Maybe (Map String [UserUser])
Maybe (Map String [ModelsTask])
Maybe ModelsTaskRepeatMode
Maybe UserUser
Maybe ModelsSubscription
modelsTaskUpdated :: Maybe Text
modelsTaskTitle :: Maybe Text
modelsTaskSubscription :: Maybe ModelsSubscription
modelsTaskStartDate :: Maybe Text
modelsTaskRepeatMode :: Maybe ModelsTaskRepeatMode
modelsTaskRepeatAfter :: Maybe Int
modelsTaskReminders :: Maybe [ModelsTaskReminder]
modelsTaskRelatedTasks :: Maybe (Map String [ModelsTask])
modelsTaskReactions :: Maybe (Map String [UserUser])
modelsTaskProjectId :: Maybe Int
modelsTaskPriority :: Maybe Int
modelsTaskPosition :: Maybe Double
modelsTaskPercentDone :: Maybe Double
modelsTaskLabels :: Maybe [ModelsLabel]
modelsTaskIsFavorite :: Maybe Bool
modelsTaskIndex :: Maybe Int
modelsTaskIdentifier :: Maybe Text
modelsTaskId :: Maybe Int
modelsTaskHexColor :: Maybe Text
modelsTaskEndDate :: Maybe Text
modelsTaskDueDate :: Maybe Text
modelsTaskDoneAt :: Maybe Text
modelsTaskDone :: Maybe Bool
modelsTaskDescription :: Maybe Text
modelsTaskCreatedBy :: Maybe UserUser
modelsTaskCreated :: Maybe Text
modelsTaskCoverImageAttachmentId :: Maybe Int
modelsTaskBucketId :: Maybe Int
modelsTaskAttachments :: Maybe [ModelsTaskAttachment]
modelsTaskAssignees :: Maybe [UserUser]
$sel:modelsTaskUpdated:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskTitle:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskSubscription:ModelsTask :: ModelsTask -> Maybe ModelsSubscription
$sel:modelsTaskStartDate:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskRepeatMode:ModelsTask :: ModelsTask -> Maybe ModelsTaskRepeatMode
$sel:modelsTaskRepeatAfter:ModelsTask :: ModelsTask -> Maybe Int
$sel:modelsTaskReminders:ModelsTask :: ModelsTask -> Maybe [ModelsTaskReminder]
$sel:modelsTaskRelatedTasks:ModelsTask :: ModelsTask -> Maybe (Map String [ModelsTask])
$sel:modelsTaskReactions:ModelsTask :: ModelsTask -> Maybe (Map String [UserUser])
$sel:modelsTaskProjectId:ModelsTask :: ModelsTask -> Maybe Int
$sel:modelsTaskPriority:ModelsTask :: ModelsTask -> Maybe Int
$sel:modelsTaskPosition:ModelsTask :: ModelsTask -> Maybe Double
$sel:modelsTaskPercentDone:ModelsTask :: ModelsTask -> Maybe Double
$sel:modelsTaskLabels:ModelsTask :: ModelsTask -> Maybe [ModelsLabel]
$sel:modelsTaskIsFavorite:ModelsTask :: ModelsTask -> Maybe Bool
$sel:modelsTaskIndex:ModelsTask :: ModelsTask -> Maybe Int
$sel:modelsTaskIdentifier:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskId:ModelsTask :: ModelsTask -> Maybe Int
$sel:modelsTaskHexColor:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskEndDate:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskDueDate:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskDoneAt:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskDone:ModelsTask :: ModelsTask -> Maybe Bool
$sel:modelsTaskDescription:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskCreatedBy:ModelsTask :: ModelsTask -> Maybe UserUser
$sel:modelsTaskCreated:ModelsTask :: ModelsTask -> Maybe Text
$sel:modelsTaskCoverImageAttachmentId:ModelsTask :: ModelsTask -> Maybe Int
$sel:modelsTaskBucketId:ModelsTask :: ModelsTask -> Maybe Int
$sel:modelsTaskAttachments:ModelsTask :: ModelsTask -> Maybe [ModelsTaskAttachment]
$sel:modelsTaskAssignees:ModelsTask :: ModelsTask -> Maybe [UserUser]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assignees" Key -> Maybe [UserUser] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [UserUser]
modelsTaskAssignees
      , Key
"attachments" Key -> Maybe [ModelsTaskAttachment] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsTaskAttachment]
modelsTaskAttachments
      , Key
"bucket_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskBucketId
      , Key
"cover_image_attachment_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskCoverImageAttachmentId
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsTaskCreatedBy
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskDescription
      , Key
"done" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTaskDone
      , Key
"done_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskDoneAt
      , Key
"due_date" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskDueDate
      , Key
"end_date" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskEndDate
      , Key
"hex_color" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskHexColor
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskId
      , Key
"identifier" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskIdentifier
      , Key
"index" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskIndex
      , Key
"is_favorite" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTaskIsFavorite
      , Key
"labels" Key -> Maybe [ModelsLabel] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsLabel]
modelsTaskLabels
      , Key
"percent_done" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsTaskPercentDone
      , Key
"position" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsTaskPosition
      , Key
"priority" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskPriority
      , Key
"project_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskProjectId
      , Key
"reactions" Key -> Maybe (Map String [UserUser]) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String [UserUser])
modelsTaskReactions
      , Key
"related_tasks" Key -> Maybe (Map String [ModelsTask]) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String [ModelsTask])
modelsTaskRelatedTasks
      , Key
"reminders" Key -> Maybe [ModelsTaskReminder] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsTaskReminder]
modelsTaskReminders
      , Key
"repeat_after" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskRepeatAfter
      , Key
"repeat_mode" Key -> Maybe ModelsTaskRepeatMode -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsTaskRepeatMode
modelsTaskRepeatMode
      , Key
"start_date" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskStartDate
      , Key
"subscription" Key -> Maybe ModelsSubscription -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsSubscription
modelsTaskSubscription
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskTitle
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskUpdated
      ]


-- | Construct a value of type 'ModelsTask' (by applying it's required fields, if any)
mkModelsTask
  :: ModelsTask
mkModelsTask :: ModelsTask
mkModelsTask =
  ModelsTask :: Maybe [UserUser]
-> Maybe [ModelsTaskAttachment]
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe [ModelsLabel]
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe (Map String [UserUser])
-> Maybe (Map String [ModelsTask])
-> Maybe [ModelsTaskReminder]
-> Maybe Int
-> Maybe ModelsTaskRepeatMode
-> Maybe Text
-> Maybe ModelsSubscription
-> Maybe Text
-> Maybe Text
-> ModelsTask
ModelsTask
  { $sel:modelsTaskAssignees:ModelsTask :: Maybe [UserUser]
modelsTaskAssignees = Maybe [UserUser]
forall a. Maybe a
Nothing
  , $sel:modelsTaskAttachments:ModelsTask :: Maybe [ModelsTaskAttachment]
modelsTaskAttachments = Maybe [ModelsTaskAttachment]
forall a. Maybe a
Nothing
  , $sel:modelsTaskBucketId:ModelsTask :: Maybe Int
modelsTaskBucketId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskCoverImageAttachmentId:ModelsTask :: Maybe Int
modelsTaskCoverImageAttachmentId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskCreated:ModelsTask :: Maybe Text
modelsTaskCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskCreatedBy:ModelsTask :: Maybe UserUser
modelsTaskCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsTaskDescription:ModelsTask :: Maybe Text
modelsTaskDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskDone:ModelsTask :: Maybe Bool
modelsTaskDone = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTaskDoneAt:ModelsTask :: Maybe Text
modelsTaskDoneAt = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskDueDate:ModelsTask :: Maybe Text
modelsTaskDueDate = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskEndDate:ModelsTask :: Maybe Text
modelsTaskEndDate = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskHexColor:ModelsTask :: Maybe Text
modelsTaskHexColor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskId:ModelsTask :: Maybe Int
modelsTaskId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskIdentifier:ModelsTask :: Maybe Text
modelsTaskIdentifier = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskIndex:ModelsTask :: Maybe Int
modelsTaskIndex = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskIsFavorite:ModelsTask :: Maybe Bool
modelsTaskIsFavorite = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTaskLabels:ModelsTask :: Maybe [ModelsLabel]
modelsTaskLabels = Maybe [ModelsLabel]
forall a. Maybe a
Nothing
  , $sel:modelsTaskPercentDone:ModelsTask :: Maybe Double
modelsTaskPercentDone = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsTaskPosition:ModelsTask :: Maybe Double
modelsTaskPosition = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsTaskPriority:ModelsTask :: Maybe Int
modelsTaskPriority = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskProjectId:ModelsTask :: Maybe Int
modelsTaskProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskReactions:ModelsTask :: Maybe (Map String [UserUser])
modelsTaskReactions = Maybe (Map String [UserUser])
forall a. Maybe a
Nothing
  , $sel:modelsTaskRelatedTasks:ModelsTask :: Maybe (Map String [ModelsTask])
modelsTaskRelatedTasks = Maybe (Map String [ModelsTask])
forall a. Maybe a
Nothing
  , $sel:modelsTaskReminders:ModelsTask :: Maybe [ModelsTaskReminder]
modelsTaskReminders = Maybe [ModelsTaskReminder]
forall a. Maybe a
Nothing
  , $sel:modelsTaskRepeatAfter:ModelsTask :: Maybe Int
modelsTaskRepeatAfter = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskRepeatMode:ModelsTask :: Maybe ModelsTaskRepeatMode
modelsTaskRepeatMode = Maybe ModelsTaskRepeatMode
forall a. Maybe a
Nothing
  , $sel:modelsTaskStartDate:ModelsTask :: Maybe Text
modelsTaskStartDate = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskSubscription:ModelsTask :: Maybe ModelsSubscription
modelsTaskSubscription = Maybe ModelsSubscription
forall a. Maybe a
Nothing
  , $sel:modelsTaskTitle:ModelsTask :: Maybe Text
modelsTaskTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskUpdated:ModelsTask :: Maybe Text
modelsTaskUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskAssginee
-- | ModelsTaskAssginee
data ModelsTaskAssginee = ModelsTaskAssginee
  { ModelsTaskAssginee -> Maybe Text
modelsTaskAssgineeCreated :: !(Maybe Text) -- ^ "created"
  , ModelsTaskAssginee -> Maybe Int
modelsTaskAssgineeUserId :: !(Maybe Int) -- ^ "user_id"
  } deriving (Int -> ModelsTaskAssginee -> ShowS
[ModelsTaskAssginee] -> ShowS
ModelsTaskAssginee -> String
(Int -> ModelsTaskAssginee -> ShowS)
-> (ModelsTaskAssginee -> String)
-> ([ModelsTaskAssginee] -> ShowS)
-> Show ModelsTaskAssginee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskAssginee] -> ShowS
$cshowList :: [ModelsTaskAssginee] -> ShowS
show :: ModelsTaskAssginee -> String
$cshow :: ModelsTaskAssginee -> String
showsPrec :: Int -> ModelsTaskAssginee -> ShowS
$cshowsPrec :: Int -> ModelsTaskAssginee -> ShowS
P.Show, ModelsTaskAssginee -> ModelsTaskAssginee -> Bool
(ModelsTaskAssginee -> ModelsTaskAssginee -> Bool)
-> (ModelsTaskAssginee -> ModelsTaskAssginee -> Bool)
-> Eq ModelsTaskAssginee
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskAssginee -> ModelsTaskAssginee -> Bool
$c/= :: ModelsTaskAssginee -> ModelsTaskAssginee -> Bool
== :: ModelsTaskAssginee -> ModelsTaskAssginee -> Bool
$c== :: ModelsTaskAssginee -> ModelsTaskAssginee -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskAssginee
instance A.FromJSON ModelsTaskAssginee where
  parseJSON :: Value -> Parser ModelsTaskAssginee
parseJSON = String
-> (Object -> Parser ModelsTaskAssginee)
-> Value
-> Parser ModelsTaskAssginee
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskAssginee" ((Object -> Parser ModelsTaskAssginee)
 -> Value -> Parser ModelsTaskAssginee)
-> (Object -> Parser ModelsTaskAssginee)
-> Value
-> Parser ModelsTaskAssginee
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Int -> ModelsTaskAssginee
ModelsTaskAssginee
      (Maybe Text -> Maybe Int -> ModelsTaskAssginee)
-> Parser (Maybe Text) -> Parser (Maybe Int -> ModelsTaskAssginee)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Maybe Int -> ModelsTaskAssginee)
-> Parser (Maybe Int) -> Parser ModelsTaskAssginee
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_id")

-- | ToJSON ModelsTaskAssginee
instance A.ToJSON ModelsTaskAssginee where
  toJSON :: ModelsTaskAssginee -> Value
toJSON ModelsTaskAssginee {Maybe Int
Maybe Text
modelsTaskAssgineeUserId :: Maybe Int
modelsTaskAssgineeCreated :: Maybe Text
$sel:modelsTaskAssgineeUserId:ModelsTaskAssginee :: ModelsTaskAssginee -> Maybe Int
$sel:modelsTaskAssgineeCreated:ModelsTaskAssginee :: ModelsTaskAssginee -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskAssgineeCreated
      , Key
"user_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskAssgineeUserId
      ]


-- | Construct a value of type 'ModelsTaskAssginee' (by applying it's required fields, if any)
mkModelsTaskAssginee
  :: ModelsTaskAssginee
mkModelsTaskAssginee :: ModelsTaskAssginee
mkModelsTaskAssginee =
  ModelsTaskAssginee :: Maybe Text -> Maybe Int -> ModelsTaskAssginee
ModelsTaskAssginee
  { $sel:modelsTaskAssgineeCreated:ModelsTaskAssginee :: Maybe Text
modelsTaskAssgineeCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskAssgineeUserId:ModelsTaskAssginee :: Maybe Int
modelsTaskAssgineeUserId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskAttachment
-- | ModelsTaskAttachment
data ModelsTaskAttachment = ModelsTaskAttachment
  { ModelsTaskAttachment -> Maybe Text
modelsTaskAttachmentCreated :: !(Maybe Text) -- ^ "created"
  , ModelsTaskAttachment -> Maybe UserUser
modelsTaskAttachmentCreatedBy :: !(Maybe UserUser) -- ^ "created_by"
  , ModelsTaskAttachment -> Maybe FilesFile
modelsTaskAttachmentFile :: !(Maybe FilesFile) -- ^ "file"
  , ModelsTaskAttachment -> Maybe Int
modelsTaskAttachmentId :: !(Maybe Int) -- ^ "id"
  , ModelsTaskAttachment -> Maybe Int
modelsTaskAttachmentTaskId :: !(Maybe Int) -- ^ "task_id"
  } deriving (Int -> ModelsTaskAttachment -> ShowS
[ModelsTaskAttachment] -> ShowS
ModelsTaskAttachment -> String
(Int -> ModelsTaskAttachment -> ShowS)
-> (ModelsTaskAttachment -> String)
-> ([ModelsTaskAttachment] -> ShowS)
-> Show ModelsTaskAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskAttachment] -> ShowS
$cshowList :: [ModelsTaskAttachment] -> ShowS
show :: ModelsTaskAttachment -> String
$cshow :: ModelsTaskAttachment -> String
showsPrec :: Int -> ModelsTaskAttachment -> ShowS
$cshowsPrec :: Int -> ModelsTaskAttachment -> ShowS
P.Show, ModelsTaskAttachment -> ModelsTaskAttachment -> Bool
(ModelsTaskAttachment -> ModelsTaskAttachment -> Bool)
-> (ModelsTaskAttachment -> ModelsTaskAttachment -> Bool)
-> Eq ModelsTaskAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskAttachment -> ModelsTaskAttachment -> Bool
$c/= :: ModelsTaskAttachment -> ModelsTaskAttachment -> Bool
== :: ModelsTaskAttachment -> ModelsTaskAttachment -> Bool
$c== :: ModelsTaskAttachment -> ModelsTaskAttachment -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskAttachment
instance A.FromJSON ModelsTaskAttachment where
  parseJSON :: Value -> Parser ModelsTaskAttachment
parseJSON = String
-> (Object -> Parser ModelsTaskAttachment)
-> Value
-> Parser ModelsTaskAttachment
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskAttachment" ((Object -> Parser ModelsTaskAttachment)
 -> Value -> Parser ModelsTaskAttachment)
-> (Object -> Parser ModelsTaskAttachment)
-> Value
-> Parser ModelsTaskAttachment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe UserUser
-> Maybe FilesFile
-> Maybe Int
-> Maybe Int
-> ModelsTaskAttachment
ModelsTaskAttachment
      (Maybe Text
 -> Maybe UserUser
 -> Maybe FilesFile
 -> Maybe Int
 -> Maybe Int
 -> ModelsTaskAttachment)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe FilesFile
      -> Maybe Int
      -> Maybe Int
      -> ModelsTaskAttachment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe FilesFile
   -> Maybe Int
   -> Maybe Int
   -> ModelsTaskAttachment)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe FilesFile -> Maybe Int -> Maybe Int -> ModelsTaskAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe FilesFile -> Maybe Int -> Maybe Int -> ModelsTaskAttachment)
-> Parser (Maybe FilesFile)
-> Parser (Maybe Int -> Maybe Int -> ModelsTaskAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe FilesFile)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"file")
      Parser (Maybe Int -> Maybe Int -> ModelsTaskAttachment)
-> Parser (Maybe Int) -> Parser (Maybe Int -> ModelsTaskAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Int -> ModelsTaskAttachment)
-> Parser (Maybe Int) -> Parser ModelsTaskAttachment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_id")

-- | ToJSON ModelsTaskAttachment
instance A.ToJSON ModelsTaskAttachment where
  toJSON :: ModelsTaskAttachment -> Value
toJSON ModelsTaskAttachment {Maybe Int
Maybe Text
Maybe UserUser
Maybe FilesFile
modelsTaskAttachmentTaskId :: Maybe Int
modelsTaskAttachmentId :: Maybe Int
modelsTaskAttachmentFile :: Maybe FilesFile
modelsTaskAttachmentCreatedBy :: Maybe UserUser
modelsTaskAttachmentCreated :: Maybe Text
$sel:modelsTaskAttachmentTaskId:ModelsTaskAttachment :: ModelsTaskAttachment -> Maybe Int
$sel:modelsTaskAttachmentId:ModelsTaskAttachment :: ModelsTaskAttachment -> Maybe Int
$sel:modelsTaskAttachmentFile:ModelsTaskAttachment :: ModelsTaskAttachment -> Maybe FilesFile
$sel:modelsTaskAttachmentCreatedBy:ModelsTaskAttachment :: ModelsTaskAttachment -> Maybe UserUser
$sel:modelsTaskAttachmentCreated:ModelsTaskAttachment :: ModelsTaskAttachment -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskAttachmentCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsTaskAttachmentCreatedBy
      , Key
"file" Key -> Maybe FilesFile -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe FilesFile
modelsTaskAttachmentFile
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskAttachmentId
      , Key
"task_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskAttachmentTaskId
      ]


-- | Construct a value of type 'ModelsTaskAttachment' (by applying it's required fields, if any)
mkModelsTaskAttachment
  :: ModelsTaskAttachment
mkModelsTaskAttachment :: ModelsTaskAttachment
mkModelsTaskAttachment =
  ModelsTaskAttachment :: Maybe Text
-> Maybe UserUser
-> Maybe FilesFile
-> Maybe Int
-> Maybe Int
-> ModelsTaskAttachment
ModelsTaskAttachment
  { $sel:modelsTaskAttachmentCreated:ModelsTaskAttachment :: Maybe Text
modelsTaskAttachmentCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskAttachmentCreatedBy:ModelsTaskAttachment :: Maybe UserUser
modelsTaskAttachmentCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsTaskAttachmentFile:ModelsTaskAttachment :: Maybe FilesFile
modelsTaskAttachmentFile = Maybe FilesFile
forall a. Maybe a
Nothing
  , $sel:modelsTaskAttachmentId:ModelsTaskAttachment :: Maybe Int
modelsTaskAttachmentId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskAttachmentTaskId:ModelsTaskAttachment :: Maybe Int
modelsTaskAttachmentTaskId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskBucket
-- | ModelsTaskBucket
data ModelsTaskBucket = ModelsTaskBucket
  { ModelsTaskBucket -> Maybe Int
modelsTaskBucketBucketId :: !(Maybe Int) -- ^ "bucket_id"
  , ModelsTaskBucket -> Maybe Int
modelsTaskBucketProjectViewId :: !(Maybe Int) -- ^ "project_view_id"
  , ModelsTaskBucket -> Maybe Bool
modelsTaskBucketTaskDone :: !(Maybe Bool) -- ^ "task_done"
  , ModelsTaskBucket -> Maybe Int
modelsTaskBucketTaskId :: !(Maybe Int) -- ^ "task_id"
  } deriving (Int -> ModelsTaskBucket -> ShowS
[ModelsTaskBucket] -> ShowS
ModelsTaskBucket -> String
(Int -> ModelsTaskBucket -> ShowS)
-> (ModelsTaskBucket -> String)
-> ([ModelsTaskBucket] -> ShowS)
-> Show ModelsTaskBucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskBucket] -> ShowS
$cshowList :: [ModelsTaskBucket] -> ShowS
show :: ModelsTaskBucket -> String
$cshow :: ModelsTaskBucket -> String
showsPrec :: Int -> ModelsTaskBucket -> ShowS
$cshowsPrec :: Int -> ModelsTaskBucket -> ShowS
P.Show, ModelsTaskBucket -> ModelsTaskBucket -> Bool
(ModelsTaskBucket -> ModelsTaskBucket -> Bool)
-> (ModelsTaskBucket -> ModelsTaskBucket -> Bool)
-> Eq ModelsTaskBucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskBucket -> ModelsTaskBucket -> Bool
$c/= :: ModelsTaskBucket -> ModelsTaskBucket -> Bool
== :: ModelsTaskBucket -> ModelsTaskBucket -> Bool
$c== :: ModelsTaskBucket -> ModelsTaskBucket -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskBucket
instance A.FromJSON ModelsTaskBucket where
  parseJSON :: Value -> Parser ModelsTaskBucket
parseJSON = String
-> (Object -> Parser ModelsTaskBucket)
-> Value
-> Parser ModelsTaskBucket
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskBucket" ((Object -> Parser ModelsTaskBucket)
 -> Value -> Parser ModelsTaskBucket)
-> (Object -> Parser ModelsTaskBucket)
-> Value
-> Parser ModelsTaskBucket
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int
-> Maybe Int -> Maybe Bool -> Maybe Int -> ModelsTaskBucket
ModelsTaskBucket
      (Maybe Int
 -> Maybe Int -> Maybe Bool -> Maybe Int -> ModelsTaskBucket)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int -> Maybe Bool -> Maybe Int -> ModelsTaskBucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bucket_id")
      Parser (Maybe Int -> Maybe Bool -> Maybe Int -> ModelsTaskBucket)
-> Parser (Maybe Int)
-> Parser (Maybe Bool -> Maybe Int -> ModelsTaskBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_view_id")
      Parser (Maybe Bool -> Maybe Int -> ModelsTaskBucket)
-> Parser (Maybe Bool) -> Parser (Maybe Int -> ModelsTaskBucket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_done")
      Parser (Maybe Int -> ModelsTaskBucket)
-> Parser (Maybe Int) -> Parser ModelsTaskBucket
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_id")

-- | ToJSON ModelsTaskBucket
instance A.ToJSON ModelsTaskBucket where
  toJSON :: ModelsTaskBucket -> Value
toJSON ModelsTaskBucket {Maybe Bool
Maybe Int
modelsTaskBucketTaskId :: Maybe Int
modelsTaskBucketTaskDone :: Maybe Bool
modelsTaskBucketProjectViewId :: Maybe Int
modelsTaskBucketBucketId :: Maybe Int
$sel:modelsTaskBucketTaskId:ModelsTaskBucket :: ModelsTaskBucket -> Maybe Int
$sel:modelsTaskBucketTaskDone:ModelsTaskBucket :: ModelsTaskBucket -> Maybe Bool
$sel:modelsTaskBucketProjectViewId:ModelsTaskBucket :: ModelsTaskBucket -> Maybe Int
$sel:modelsTaskBucketBucketId:ModelsTaskBucket :: ModelsTaskBucket -> Maybe Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"bucket_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskBucketBucketId
      , Key
"project_view_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskBucketProjectViewId
      , Key
"task_done" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTaskBucketTaskDone
      , Key
"task_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskBucketTaskId
      ]


-- | Construct a value of type 'ModelsTaskBucket' (by applying it's required fields, if any)
mkModelsTaskBucket
  :: ModelsTaskBucket
mkModelsTaskBucket :: ModelsTaskBucket
mkModelsTaskBucket =
  ModelsTaskBucket :: Maybe Int
-> Maybe Int -> Maybe Bool -> Maybe Int -> ModelsTaskBucket
ModelsTaskBucket
  { $sel:modelsTaskBucketBucketId:ModelsTaskBucket :: Maybe Int
modelsTaskBucketBucketId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskBucketProjectViewId:ModelsTaskBucket :: Maybe Int
modelsTaskBucketProjectViewId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskBucketTaskDone:ModelsTaskBucket :: Maybe Bool
modelsTaskBucketTaskDone = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTaskBucketTaskId:ModelsTaskBucket :: Maybe Int
modelsTaskBucketTaskId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskCollection
-- | ModelsTaskCollection
data ModelsTaskCollection = ModelsTaskCollection
  { ModelsTaskCollection -> Maybe Text
modelsTaskCollectionFilter :: !(Maybe Text) -- ^ "filter" - The filter query to match tasks by. Check out https://vikunja.io/docs/filters for a full explanation.
  , ModelsTaskCollection -> Maybe Bool
modelsTaskCollectionFilterIncludeNulls :: !(Maybe Bool) -- ^ "filter_include_nulls" - If set to true, the result will also include null values
  , ModelsTaskCollection -> Maybe [Text]
modelsTaskCollectionOrderBy :: !(Maybe [Text]) -- ^ "order_by" - The query parameter to order the items by. This can be either asc or desc, with asc being the default.
  , ModelsTaskCollection -> Maybe [Text]
modelsTaskCollectionSortBy :: !(Maybe [Text]) -- ^ "sort_by" - The query parameter to sort by. This is for ex. done, priority, etc.
  } deriving (Int -> ModelsTaskCollection -> ShowS
[ModelsTaskCollection] -> ShowS
ModelsTaskCollection -> String
(Int -> ModelsTaskCollection -> ShowS)
-> (ModelsTaskCollection -> String)
-> ([ModelsTaskCollection] -> ShowS)
-> Show ModelsTaskCollection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskCollection] -> ShowS
$cshowList :: [ModelsTaskCollection] -> ShowS
show :: ModelsTaskCollection -> String
$cshow :: ModelsTaskCollection -> String
showsPrec :: Int -> ModelsTaskCollection -> ShowS
$cshowsPrec :: Int -> ModelsTaskCollection -> ShowS
P.Show, ModelsTaskCollection -> ModelsTaskCollection -> Bool
(ModelsTaskCollection -> ModelsTaskCollection -> Bool)
-> (ModelsTaskCollection -> ModelsTaskCollection -> Bool)
-> Eq ModelsTaskCollection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskCollection -> ModelsTaskCollection -> Bool
$c/= :: ModelsTaskCollection -> ModelsTaskCollection -> Bool
== :: ModelsTaskCollection -> ModelsTaskCollection -> Bool
$c== :: ModelsTaskCollection -> ModelsTaskCollection -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskCollection
instance A.FromJSON ModelsTaskCollection where
  parseJSON :: Value -> Parser ModelsTaskCollection
parseJSON = String
-> (Object -> Parser ModelsTaskCollection)
-> Value
-> Parser ModelsTaskCollection
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskCollection" ((Object -> Parser ModelsTaskCollection)
 -> Value -> Parser ModelsTaskCollection)
-> (Object -> Parser ModelsTaskCollection)
-> Value
-> Parser ModelsTaskCollection
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> ModelsTaskCollection
ModelsTaskCollection
      (Maybe Text
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> ModelsTaskCollection)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe [Text] -> Maybe [Text] -> ModelsTaskCollection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter")
      Parser
  (Maybe Bool
   -> Maybe [Text] -> Maybe [Text] -> ModelsTaskCollection)
-> Parser (Maybe Bool)
-> Parser (Maybe [Text] -> Maybe [Text] -> ModelsTaskCollection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter_include_nulls")
      Parser (Maybe [Text] -> Maybe [Text] -> ModelsTaskCollection)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> ModelsTaskCollection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"order_by")
      Parser (Maybe [Text] -> ModelsTaskCollection)
-> Parser (Maybe [Text]) -> Parser ModelsTaskCollection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sort_by")

-- | ToJSON ModelsTaskCollection
instance A.ToJSON ModelsTaskCollection where
  toJSON :: ModelsTaskCollection -> Value
toJSON ModelsTaskCollection {Maybe Bool
Maybe [Text]
Maybe Text
modelsTaskCollectionSortBy :: Maybe [Text]
modelsTaskCollectionOrderBy :: Maybe [Text]
modelsTaskCollectionFilterIncludeNulls :: Maybe Bool
modelsTaskCollectionFilter :: Maybe Text
$sel:modelsTaskCollectionSortBy:ModelsTaskCollection :: ModelsTaskCollection -> Maybe [Text]
$sel:modelsTaskCollectionOrderBy:ModelsTaskCollection :: ModelsTaskCollection -> Maybe [Text]
$sel:modelsTaskCollectionFilterIncludeNulls:ModelsTaskCollection :: ModelsTaskCollection -> Maybe Bool
$sel:modelsTaskCollectionFilter:ModelsTaskCollection :: ModelsTaskCollection -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"filter" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskCollectionFilter
      , Key
"filter_include_nulls" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTaskCollectionFilterIncludeNulls
      , Key
"order_by" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
modelsTaskCollectionOrderBy
      , Key
"sort_by" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
modelsTaskCollectionSortBy
      ]


-- | Construct a value of type 'ModelsTaskCollection' (by applying it's required fields, if any)
mkModelsTaskCollection
  :: ModelsTaskCollection
mkModelsTaskCollection :: ModelsTaskCollection
mkModelsTaskCollection =
  ModelsTaskCollection :: Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> ModelsTaskCollection
ModelsTaskCollection
  { $sel:modelsTaskCollectionFilter:ModelsTaskCollection :: Maybe Text
modelsTaskCollectionFilter = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskCollectionFilterIncludeNulls:ModelsTaskCollection :: Maybe Bool
modelsTaskCollectionFilterIncludeNulls = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTaskCollectionOrderBy:ModelsTaskCollection :: Maybe [Text]
modelsTaskCollectionOrderBy = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:modelsTaskCollectionSortBy:ModelsTaskCollection :: Maybe [Text]
modelsTaskCollectionSortBy = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskComment
-- | ModelsTaskComment
data ModelsTaskComment = ModelsTaskComment
  { ModelsTaskComment -> Maybe UserUser
modelsTaskCommentAuthor :: !(Maybe UserUser) -- ^ "author"
  , ModelsTaskComment -> Maybe Text
modelsTaskCommentComment :: !(Maybe Text) -- ^ "comment"
  , ModelsTaskComment -> Maybe Text
modelsTaskCommentCreated :: !(Maybe Text) -- ^ "created"
  , ModelsTaskComment -> Maybe Int
modelsTaskCommentId :: !(Maybe Int) -- ^ "id"
  , ModelsTaskComment -> Maybe (Map String [UserUser])
modelsTaskCommentReactions :: !(Maybe (Map.Map String [UserUser])) -- ^ "reactions"
  , ModelsTaskComment -> Maybe Text
modelsTaskCommentUpdated :: !(Maybe Text) -- ^ "updated"
  } deriving (Int -> ModelsTaskComment -> ShowS
[ModelsTaskComment] -> ShowS
ModelsTaskComment -> String
(Int -> ModelsTaskComment -> ShowS)
-> (ModelsTaskComment -> String)
-> ([ModelsTaskComment] -> ShowS)
-> Show ModelsTaskComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskComment] -> ShowS
$cshowList :: [ModelsTaskComment] -> ShowS
show :: ModelsTaskComment -> String
$cshow :: ModelsTaskComment -> String
showsPrec :: Int -> ModelsTaskComment -> ShowS
$cshowsPrec :: Int -> ModelsTaskComment -> ShowS
P.Show, ModelsTaskComment -> ModelsTaskComment -> Bool
(ModelsTaskComment -> ModelsTaskComment -> Bool)
-> (ModelsTaskComment -> ModelsTaskComment -> Bool)
-> Eq ModelsTaskComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskComment -> ModelsTaskComment -> Bool
$c/= :: ModelsTaskComment -> ModelsTaskComment -> Bool
== :: ModelsTaskComment -> ModelsTaskComment -> Bool
$c== :: ModelsTaskComment -> ModelsTaskComment -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskComment
instance A.FromJSON ModelsTaskComment where
  parseJSON :: Value -> Parser ModelsTaskComment
parseJSON = String
-> (Object -> Parser ModelsTaskComment)
-> Value
-> Parser ModelsTaskComment
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskComment" ((Object -> Parser ModelsTaskComment)
 -> Value -> Parser ModelsTaskComment)
-> (Object -> Parser ModelsTaskComment)
-> Value
-> Parser ModelsTaskComment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe UserUser
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe (Map String [UserUser])
-> Maybe Text
-> ModelsTaskComment
ModelsTaskComment
      (Maybe UserUser
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe (Map String [UserUser])
 -> Maybe Text
 -> ModelsTaskComment)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe Text
      -> ModelsTaskComment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe Text
   -> ModelsTaskComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe Text
      -> ModelsTaskComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe Text
   -> ModelsTaskComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe (Map String [UserUser])
      -> Maybe Text
      -> ModelsTaskComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Int
   -> Maybe (Map String [UserUser])
   -> Maybe Text
   -> ModelsTaskComment)
-> Parser (Maybe Int)
-> Parser
     (Maybe (Map String [UserUser]) -> Maybe Text -> ModelsTaskComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe (Map String [UserUser]) -> Maybe Text -> ModelsTaskComment)
-> Parser (Maybe (Map String [UserUser]))
-> Parser (Maybe Text -> ModelsTaskComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map String [UserUser]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reactions")
      Parser (Maybe Text -> ModelsTaskComment)
-> Parser (Maybe Text) -> Parser ModelsTaskComment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsTaskComment
instance A.ToJSON ModelsTaskComment where
  toJSON :: ModelsTaskComment -> Value
toJSON ModelsTaskComment {Maybe Int
Maybe Text
Maybe (Map String [UserUser])
Maybe UserUser
modelsTaskCommentUpdated :: Maybe Text
modelsTaskCommentReactions :: Maybe (Map String [UserUser])
modelsTaskCommentId :: Maybe Int
modelsTaskCommentCreated :: Maybe Text
modelsTaskCommentComment :: Maybe Text
modelsTaskCommentAuthor :: Maybe UserUser
$sel:modelsTaskCommentUpdated:ModelsTaskComment :: ModelsTaskComment -> Maybe Text
$sel:modelsTaskCommentReactions:ModelsTaskComment :: ModelsTaskComment -> Maybe (Map String [UserUser])
$sel:modelsTaskCommentId:ModelsTaskComment :: ModelsTaskComment -> Maybe Int
$sel:modelsTaskCommentCreated:ModelsTaskComment :: ModelsTaskComment -> Maybe Text
$sel:modelsTaskCommentComment:ModelsTaskComment :: ModelsTaskComment -> Maybe Text
$sel:modelsTaskCommentAuthor:ModelsTaskComment :: ModelsTaskComment -> Maybe UserUser
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsTaskCommentAuthor
      , Key
"comment" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskCommentComment
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskCommentCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskCommentId
      , Key
"reactions" Key -> Maybe (Map String [UserUser]) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String [UserUser])
modelsTaskCommentReactions
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskCommentUpdated
      ]


-- | Construct a value of type 'ModelsTaskComment' (by applying it's required fields, if any)
mkModelsTaskComment
  :: ModelsTaskComment
mkModelsTaskComment :: ModelsTaskComment
mkModelsTaskComment =
  ModelsTaskComment :: Maybe UserUser
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe (Map String [UserUser])
-> Maybe Text
-> ModelsTaskComment
ModelsTaskComment
  { $sel:modelsTaskCommentAuthor:ModelsTaskComment :: Maybe UserUser
modelsTaskCommentAuthor = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsTaskCommentComment:ModelsTaskComment :: Maybe Text
modelsTaskCommentComment = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskCommentCreated:ModelsTaskComment :: Maybe Text
modelsTaskCommentCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskCommentId:ModelsTaskComment :: Maybe Int
modelsTaskCommentId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskCommentReactions:ModelsTaskComment :: Maybe (Map String [UserUser])
modelsTaskCommentReactions = Maybe (Map String [UserUser])
forall a. Maybe a
Nothing
  , $sel:modelsTaskCommentUpdated:ModelsTaskComment :: Maybe Text
modelsTaskCommentUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskPosition
-- | ModelsTaskPosition
data ModelsTaskPosition = ModelsTaskPosition
  { ModelsTaskPosition -> Maybe Double
modelsTaskPositionPosition :: !(Maybe Double) -- ^ "position" - The position of the task - any task project can be sorted as usual by this parameter. When accessing tasks via kanban buckets, this is primarily used to sort them based on a range We&#39;re using a float64 here to make it possible to put any task within any two other tasks (by changing the number). You would calculate the new position between two tasks with something like task3.position &#x3D; (task2.position - task1.position) / 2. A 64-Bit float leaves plenty of room to initially give tasks a position with 2^16 difference to the previous task which also leaves a lot of room for rearranging and sorting later. Positions are always saved per view. They will automatically be set if you request the tasks through a view endpoint, otherwise they will always be 0. To update them, take a look at the Task Position endpoint.
  , ModelsTaskPosition -> Maybe Int
modelsTaskPositionProjectViewId :: !(Maybe Int) -- ^ "project_view_id" - The project view this task is related to
  , ModelsTaskPosition -> Maybe Int
modelsTaskPositionTaskId :: !(Maybe Int) -- ^ "task_id" - The ID of the task this position is for
  } deriving (Int -> ModelsTaskPosition -> ShowS
[ModelsTaskPosition] -> ShowS
ModelsTaskPosition -> String
(Int -> ModelsTaskPosition -> ShowS)
-> (ModelsTaskPosition -> String)
-> ([ModelsTaskPosition] -> ShowS)
-> Show ModelsTaskPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskPosition] -> ShowS
$cshowList :: [ModelsTaskPosition] -> ShowS
show :: ModelsTaskPosition -> String
$cshow :: ModelsTaskPosition -> String
showsPrec :: Int -> ModelsTaskPosition -> ShowS
$cshowsPrec :: Int -> ModelsTaskPosition -> ShowS
P.Show, ModelsTaskPosition -> ModelsTaskPosition -> Bool
(ModelsTaskPosition -> ModelsTaskPosition -> Bool)
-> (ModelsTaskPosition -> ModelsTaskPosition -> Bool)
-> Eq ModelsTaskPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskPosition -> ModelsTaskPosition -> Bool
$c/= :: ModelsTaskPosition -> ModelsTaskPosition -> Bool
== :: ModelsTaskPosition -> ModelsTaskPosition -> Bool
$c== :: ModelsTaskPosition -> ModelsTaskPosition -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskPosition
instance A.FromJSON ModelsTaskPosition where
  parseJSON :: Value -> Parser ModelsTaskPosition
parseJSON = String
-> (Object -> Parser ModelsTaskPosition)
-> Value
-> Parser ModelsTaskPosition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskPosition" ((Object -> Parser ModelsTaskPosition)
 -> Value -> Parser ModelsTaskPosition)
-> (Object -> Parser ModelsTaskPosition)
-> Value
-> Parser ModelsTaskPosition
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Double -> Maybe Int -> Maybe Int -> ModelsTaskPosition
ModelsTaskPosition
      (Maybe Double -> Maybe Int -> Maybe Int -> ModelsTaskPosition)
-> Parser (Maybe Double)
-> Parser (Maybe Int -> Maybe Int -> ModelsTaskPosition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position")
      Parser (Maybe Int -> Maybe Int -> ModelsTaskPosition)
-> Parser (Maybe Int) -> Parser (Maybe Int -> ModelsTaskPosition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_view_id")
      Parser (Maybe Int -> ModelsTaskPosition)
-> Parser (Maybe Int) -> Parser ModelsTaskPosition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_id")

-- | ToJSON ModelsTaskPosition
instance A.ToJSON ModelsTaskPosition where
  toJSON :: ModelsTaskPosition -> Value
toJSON ModelsTaskPosition {Maybe Double
Maybe Int
modelsTaskPositionTaskId :: Maybe Int
modelsTaskPositionProjectViewId :: Maybe Int
modelsTaskPositionPosition :: Maybe Double
$sel:modelsTaskPositionTaskId:ModelsTaskPosition :: ModelsTaskPosition -> Maybe Int
$sel:modelsTaskPositionProjectViewId:ModelsTaskPosition :: ModelsTaskPosition -> Maybe Int
$sel:modelsTaskPositionPosition:ModelsTaskPosition :: ModelsTaskPosition -> Maybe Double
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"position" Key -> Maybe Double -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
modelsTaskPositionPosition
      , Key
"project_view_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskPositionProjectViewId
      , Key
"task_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskPositionTaskId
      ]


-- | Construct a value of type 'ModelsTaskPosition' (by applying it's required fields, if any)
mkModelsTaskPosition
  :: ModelsTaskPosition
mkModelsTaskPosition :: ModelsTaskPosition
mkModelsTaskPosition =
  ModelsTaskPosition :: Maybe Double -> Maybe Int -> Maybe Int -> ModelsTaskPosition
ModelsTaskPosition
  { $sel:modelsTaskPositionPosition:ModelsTaskPosition :: Maybe Double
modelsTaskPositionPosition = Maybe Double
forall a. Maybe a
Nothing
  , $sel:modelsTaskPositionProjectViewId:ModelsTaskPosition :: Maybe Int
modelsTaskPositionProjectViewId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskPositionTaskId:ModelsTaskPosition :: Maybe Int
modelsTaskPositionTaskId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskRelation
-- | ModelsTaskRelation
data ModelsTaskRelation = ModelsTaskRelation
  { ModelsTaskRelation -> Maybe Text
modelsTaskRelationCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this label was created. You cannot change this value.
  , ModelsTaskRelation -> Maybe UserUser
modelsTaskRelationCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who created this relation
  , ModelsTaskRelation -> Maybe Int
modelsTaskRelationOtherTaskId :: !(Maybe Int) -- ^ "other_task_id" - The ID of the other task, the task which is being related.
  , ModelsTaskRelation -> Maybe ModelsRelationKind
modelsTaskRelationRelationKind :: !(Maybe ModelsRelationKind) -- ^ "relation_kind" - The kind of the relation.
  , ModelsTaskRelation -> Maybe Int
modelsTaskRelationTaskId :: !(Maybe Int) -- ^ "task_id" - The ID of the \&quot;base\&quot; task, the task which has a relation to another.
  } deriving (Int -> ModelsTaskRelation -> ShowS
[ModelsTaskRelation] -> ShowS
ModelsTaskRelation -> String
(Int -> ModelsTaskRelation -> ShowS)
-> (ModelsTaskRelation -> String)
-> ([ModelsTaskRelation] -> ShowS)
-> Show ModelsTaskRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskRelation] -> ShowS
$cshowList :: [ModelsTaskRelation] -> ShowS
show :: ModelsTaskRelation -> String
$cshow :: ModelsTaskRelation -> String
showsPrec :: Int -> ModelsTaskRelation -> ShowS
$cshowsPrec :: Int -> ModelsTaskRelation -> ShowS
P.Show, ModelsTaskRelation -> ModelsTaskRelation -> Bool
(ModelsTaskRelation -> ModelsTaskRelation -> Bool)
-> (ModelsTaskRelation -> ModelsTaskRelation -> Bool)
-> Eq ModelsTaskRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskRelation -> ModelsTaskRelation -> Bool
$c/= :: ModelsTaskRelation -> ModelsTaskRelation -> Bool
== :: ModelsTaskRelation -> ModelsTaskRelation -> Bool
$c== :: ModelsTaskRelation -> ModelsTaskRelation -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskRelation
instance A.FromJSON ModelsTaskRelation where
  parseJSON :: Value -> Parser ModelsTaskRelation
parseJSON = String
-> (Object -> Parser ModelsTaskRelation)
-> Value
-> Parser ModelsTaskRelation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskRelation" ((Object -> Parser ModelsTaskRelation)
 -> Value -> Parser ModelsTaskRelation)
-> (Object -> Parser ModelsTaskRelation)
-> Value
-> Parser ModelsTaskRelation
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe UserUser
-> Maybe Int
-> Maybe ModelsRelationKind
-> Maybe Int
-> ModelsTaskRelation
ModelsTaskRelation
      (Maybe Text
 -> Maybe UserUser
 -> Maybe Int
 -> Maybe ModelsRelationKind
 -> Maybe Int
 -> ModelsTaskRelation)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe Int
      -> Maybe ModelsRelationKind
      -> Maybe Int
      -> ModelsTaskRelation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe Int
   -> Maybe ModelsRelationKind
   -> Maybe Int
   -> ModelsTaskRelation)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Int
      -> Maybe ModelsRelationKind -> Maybe Int -> ModelsTaskRelation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe Int
   -> Maybe ModelsRelationKind -> Maybe Int -> ModelsTaskRelation)
-> Parser (Maybe Int)
-> Parser
     (Maybe ModelsRelationKind -> Maybe Int -> ModelsTaskRelation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"other_task_id")
      Parser
  (Maybe ModelsRelationKind -> Maybe Int -> ModelsTaskRelation)
-> Parser (Maybe ModelsRelationKind)
-> Parser (Maybe Int -> ModelsTaskRelation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsRelationKind)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"relation_kind")
      Parser (Maybe Int -> ModelsTaskRelation)
-> Parser (Maybe Int) -> Parser ModelsTaskRelation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_id")

-- | ToJSON ModelsTaskRelation
instance A.ToJSON ModelsTaskRelation where
  toJSON :: ModelsTaskRelation -> Value
toJSON ModelsTaskRelation {Maybe Int
Maybe Text
Maybe ModelsRelationKind
Maybe UserUser
modelsTaskRelationTaskId :: Maybe Int
modelsTaskRelationRelationKind :: Maybe ModelsRelationKind
modelsTaskRelationOtherTaskId :: Maybe Int
modelsTaskRelationCreatedBy :: Maybe UserUser
modelsTaskRelationCreated :: Maybe Text
$sel:modelsTaskRelationTaskId:ModelsTaskRelation :: ModelsTaskRelation -> Maybe Int
$sel:modelsTaskRelationRelationKind:ModelsTaskRelation :: ModelsTaskRelation -> Maybe ModelsRelationKind
$sel:modelsTaskRelationOtherTaskId:ModelsTaskRelation :: ModelsTaskRelation -> Maybe Int
$sel:modelsTaskRelationCreatedBy:ModelsTaskRelation :: ModelsTaskRelation -> Maybe UserUser
$sel:modelsTaskRelationCreated:ModelsTaskRelation :: ModelsTaskRelation -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskRelationCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsTaskRelationCreatedBy
      , Key
"other_task_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskRelationOtherTaskId
      , Key
"relation_kind" Key -> Maybe ModelsRelationKind -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsRelationKind
modelsTaskRelationRelationKind
      , Key
"task_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskRelationTaskId
      ]


-- | Construct a value of type 'ModelsTaskRelation' (by applying it's required fields, if any)
mkModelsTaskRelation
  :: ModelsTaskRelation
mkModelsTaskRelation :: ModelsTaskRelation
mkModelsTaskRelation =
  ModelsTaskRelation :: Maybe Text
-> Maybe UserUser
-> Maybe Int
-> Maybe ModelsRelationKind
-> Maybe Int
-> ModelsTaskRelation
ModelsTaskRelation
  { $sel:modelsTaskRelationCreated:ModelsTaskRelation :: Maybe Text
modelsTaskRelationCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTaskRelationCreatedBy:ModelsTaskRelation :: Maybe UserUser
modelsTaskRelationCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsTaskRelationOtherTaskId:ModelsTaskRelation :: Maybe Int
modelsTaskRelationOtherTaskId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskRelationRelationKind:ModelsTaskRelation :: Maybe ModelsRelationKind
modelsTaskRelationRelationKind = Maybe ModelsRelationKind
forall a. Maybe a
Nothing
  , $sel:modelsTaskRelationTaskId:ModelsTaskRelation :: Maybe Int
modelsTaskRelationTaskId = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** ModelsTaskReminder
-- | ModelsTaskReminder
data ModelsTaskReminder = ModelsTaskReminder
  { ModelsTaskReminder -> Maybe Int
modelsTaskReminderRelativePeriod :: !(Maybe Int) -- ^ "relative_period" - A period in seconds relative to another date argument. Negative values mean the reminder triggers before the date. Default: 0, tiggers when RelativeTo is due.
  , ModelsTaskReminder -> Maybe ModelsReminderRelation
modelsTaskReminderRelativeTo :: !(Maybe ModelsReminderRelation) -- ^ "relative_to" - The name of the date field to which the relative period refers to.
  , ModelsTaskReminder -> Maybe Text
modelsTaskReminderReminder :: !(Maybe Text) -- ^ "reminder" - The absolute time when the user wants to be reminded of the task.
  } deriving (Int -> ModelsTaskReminder -> ShowS
[ModelsTaskReminder] -> ShowS
ModelsTaskReminder -> String
(Int -> ModelsTaskReminder -> ShowS)
-> (ModelsTaskReminder -> String)
-> ([ModelsTaskReminder] -> ShowS)
-> Show ModelsTaskReminder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskReminder] -> ShowS
$cshowList :: [ModelsTaskReminder] -> ShowS
show :: ModelsTaskReminder -> String
$cshow :: ModelsTaskReminder -> String
showsPrec :: Int -> ModelsTaskReminder -> ShowS
$cshowsPrec :: Int -> ModelsTaskReminder -> ShowS
P.Show, ModelsTaskReminder -> ModelsTaskReminder -> Bool
(ModelsTaskReminder -> ModelsTaskReminder -> Bool)
-> (ModelsTaskReminder -> ModelsTaskReminder -> Bool)
-> Eq ModelsTaskReminder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskReminder -> ModelsTaskReminder -> Bool
$c/= :: ModelsTaskReminder -> ModelsTaskReminder -> Bool
== :: ModelsTaskReminder -> ModelsTaskReminder -> Bool
$c== :: ModelsTaskReminder -> ModelsTaskReminder -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTaskReminder
instance A.FromJSON ModelsTaskReminder where
  parseJSON :: Value -> Parser ModelsTaskReminder
parseJSON = String
-> (Object -> Parser ModelsTaskReminder)
-> Value
-> Parser ModelsTaskReminder
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTaskReminder" ((Object -> Parser ModelsTaskReminder)
 -> Value -> Parser ModelsTaskReminder)
-> (Object -> Parser ModelsTaskReminder)
-> Value
-> Parser ModelsTaskReminder
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int
-> Maybe ModelsReminderRelation -> Maybe Text -> ModelsTaskReminder
ModelsTaskReminder
      (Maybe Int
 -> Maybe ModelsReminderRelation
 -> Maybe Text
 -> ModelsTaskReminder)
-> Parser (Maybe Int)
-> Parser
     (Maybe ModelsReminderRelation -> Maybe Text -> ModelsTaskReminder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"relative_period")
      Parser
  (Maybe ModelsReminderRelation -> Maybe Text -> ModelsTaskReminder)
-> Parser (Maybe ModelsReminderRelation)
-> Parser (Maybe Text -> ModelsTaskReminder)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsReminderRelation)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"relative_to")
      Parser (Maybe Text -> ModelsTaskReminder)
-> Parser (Maybe Text) -> Parser ModelsTaskReminder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reminder")

-- | ToJSON ModelsTaskReminder
instance A.ToJSON ModelsTaskReminder where
  toJSON :: ModelsTaskReminder -> Value
toJSON ModelsTaskReminder {Maybe Int
Maybe Text
Maybe ModelsReminderRelation
modelsTaskReminderReminder :: Maybe Text
modelsTaskReminderRelativeTo :: Maybe ModelsReminderRelation
modelsTaskReminderRelativePeriod :: Maybe Int
$sel:modelsTaskReminderReminder:ModelsTaskReminder :: ModelsTaskReminder -> Maybe Text
$sel:modelsTaskReminderRelativeTo:ModelsTaskReminder :: ModelsTaskReminder -> Maybe ModelsReminderRelation
$sel:modelsTaskReminderRelativePeriod:ModelsTaskReminder :: ModelsTaskReminder -> Maybe Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"relative_period" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTaskReminderRelativePeriod
      , Key
"relative_to" Key -> Maybe ModelsReminderRelation -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsReminderRelation
modelsTaskReminderRelativeTo
      , Key
"reminder" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTaskReminderReminder
      ]


-- | Construct a value of type 'ModelsTaskReminder' (by applying it's required fields, if any)
mkModelsTaskReminder
  :: ModelsTaskReminder
mkModelsTaskReminder :: ModelsTaskReminder
mkModelsTaskReminder =
  ModelsTaskReminder :: Maybe Int
-> Maybe ModelsReminderRelation -> Maybe Text -> ModelsTaskReminder
ModelsTaskReminder
  { $sel:modelsTaskReminderRelativePeriod:ModelsTaskReminder :: Maybe Int
modelsTaskReminderRelativePeriod = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTaskReminderRelativeTo:ModelsTaskReminder :: Maybe ModelsReminderRelation
modelsTaskReminderRelativeTo = Maybe ModelsReminderRelation
forall a. Maybe a
Nothing
  , $sel:modelsTaskReminderReminder:ModelsTaskReminder :: Maybe Text
modelsTaskReminderReminder = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsTeam
-- | ModelsTeam
data ModelsTeam = ModelsTeam
  { ModelsTeam -> Maybe Text
modelsTeamCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this relation was created. You cannot change this value.
  , ModelsTeam -> Maybe UserUser
modelsTeamCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who created this team.
  , ModelsTeam -> Maybe Text
modelsTeamDescription :: !(Maybe Text) -- ^ "description" - The team&#39;s description.
  , ModelsTeam -> Maybe Int
modelsTeamId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this team.
  , ModelsTeam -> Maybe Bool
modelsTeamIncludePublic :: !(Maybe Bool) -- ^ "include_public" - Query parameter controlling whether to include public projects or not
  , ModelsTeam -> Maybe Bool
modelsTeamIsPublic :: !(Maybe Bool) -- ^ "is_public" - Defines wether the team should be publicly discoverable when sharing a project
  , ModelsTeam -> Maybe [ModelsTeamUser]
modelsTeamMembers :: !(Maybe [ModelsTeamUser]) -- ^ "members" - An array of all members in this team.
  , ModelsTeam -> Maybe Text
modelsTeamName :: !(Maybe Text) -- ^ "name" - The name of this team.
  , ModelsTeam -> Maybe Text
modelsTeamOidcId :: !(Maybe Text) -- ^ "oidc_id" - The team&#39;s oidc id delivered by the oidc provider
  , ModelsTeam -> Maybe Text
modelsTeamUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this relation was last updated. You cannot change this value.
  } deriving (Int -> ModelsTeam -> ShowS
[ModelsTeam] -> ShowS
ModelsTeam -> String
(Int -> ModelsTeam -> ShowS)
-> (ModelsTeam -> String)
-> ([ModelsTeam] -> ShowS)
-> Show ModelsTeam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTeam] -> ShowS
$cshowList :: [ModelsTeam] -> ShowS
show :: ModelsTeam -> String
$cshow :: ModelsTeam -> String
showsPrec :: Int -> ModelsTeam -> ShowS
$cshowsPrec :: Int -> ModelsTeam -> ShowS
P.Show, ModelsTeam -> ModelsTeam -> Bool
(ModelsTeam -> ModelsTeam -> Bool)
-> (ModelsTeam -> ModelsTeam -> Bool) -> Eq ModelsTeam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTeam -> ModelsTeam -> Bool
$c/= :: ModelsTeam -> ModelsTeam -> Bool
== :: ModelsTeam -> ModelsTeam -> Bool
$c== :: ModelsTeam -> ModelsTeam -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTeam
instance A.FromJSON ModelsTeam where
  parseJSON :: Value -> Parser ModelsTeam
parseJSON = String
-> (Object -> Parser ModelsTeam) -> Value -> Parser ModelsTeam
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTeam" ((Object -> Parser ModelsTeam) -> Value -> Parser ModelsTeam)
-> (Object -> Parser ModelsTeam) -> Value -> Parser ModelsTeam
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe [ModelsTeamUser]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ModelsTeam
ModelsTeam
      (Maybe Text
 -> Maybe UserUser
 -> Maybe Text
 -> Maybe Int
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe [ModelsTeamUser]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> ModelsTeam)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsTeam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsTeam)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsTeam)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsTeam)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsTeam)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"include_public")
      Parser
  (Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsTeam)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [ModelsTeamUser]
      -> Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_public")
      Parser
  (Maybe [ModelsTeamUser]
   -> Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeam)
-> Parser (Maybe [ModelsTeamUser])
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsTeamUser])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"members")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeam)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Maybe Text -> ModelsTeam)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"oidc_id")
      Parser (Maybe Text -> ModelsTeam)
-> Parser (Maybe Text) -> Parser ModelsTeam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsTeam
instance A.ToJSON ModelsTeam where
  toJSON :: ModelsTeam -> Value
toJSON ModelsTeam {Maybe Bool
Maybe Int
Maybe [ModelsTeamUser]
Maybe Text
Maybe UserUser
modelsTeamUpdated :: Maybe Text
modelsTeamOidcId :: Maybe Text
modelsTeamName :: Maybe Text
modelsTeamMembers :: Maybe [ModelsTeamUser]
modelsTeamIsPublic :: Maybe Bool
modelsTeamIncludePublic :: Maybe Bool
modelsTeamId :: Maybe Int
modelsTeamDescription :: Maybe Text
modelsTeamCreatedBy :: Maybe UserUser
modelsTeamCreated :: Maybe Text
$sel:modelsTeamUpdated:ModelsTeam :: ModelsTeam -> Maybe Text
$sel:modelsTeamOidcId:ModelsTeam :: ModelsTeam -> Maybe Text
$sel:modelsTeamName:ModelsTeam :: ModelsTeam -> Maybe Text
$sel:modelsTeamMembers:ModelsTeam :: ModelsTeam -> Maybe [ModelsTeamUser]
$sel:modelsTeamIsPublic:ModelsTeam :: ModelsTeam -> Maybe Bool
$sel:modelsTeamIncludePublic:ModelsTeam :: ModelsTeam -> Maybe Bool
$sel:modelsTeamId:ModelsTeam :: ModelsTeam -> Maybe Int
$sel:modelsTeamDescription:ModelsTeam :: ModelsTeam -> Maybe Text
$sel:modelsTeamCreatedBy:ModelsTeam :: ModelsTeam -> Maybe UserUser
$sel:modelsTeamCreated:ModelsTeam :: ModelsTeam -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsTeamCreatedBy
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamDescription
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTeamId
      , Key
"include_public" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTeamIncludePublic
      , Key
"is_public" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTeamIsPublic
      , Key
"members" Key -> Maybe [ModelsTeamUser] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsTeamUser]
modelsTeamMembers
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamName
      , Key
"oidc_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamOidcId
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamUpdated
      ]


-- | Construct a value of type 'ModelsTeam' (by applying it's required fields, if any)
mkModelsTeam
  :: ModelsTeam
mkModelsTeam :: ModelsTeam
mkModelsTeam =
  ModelsTeam :: Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe [ModelsTeamUser]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ModelsTeam
ModelsTeam
  { $sel:modelsTeamCreated:ModelsTeam :: Maybe Text
modelsTeamCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamCreatedBy:ModelsTeam :: Maybe UserUser
modelsTeamCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsTeamDescription:ModelsTeam :: Maybe Text
modelsTeamDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamId:ModelsTeam :: Maybe Int
modelsTeamId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTeamIncludePublic:ModelsTeam :: Maybe Bool
modelsTeamIncludePublic = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTeamIsPublic:ModelsTeam :: Maybe Bool
modelsTeamIsPublic = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTeamMembers:ModelsTeam :: Maybe [ModelsTeamUser]
modelsTeamMembers = Maybe [ModelsTeamUser]
forall a. Maybe a
Nothing
  , $sel:modelsTeamName:ModelsTeam :: Maybe Text
modelsTeamName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamOidcId:ModelsTeam :: Maybe Text
modelsTeamOidcId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamUpdated:ModelsTeam :: Maybe Text
modelsTeamUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsTeamMember
-- | ModelsTeamMember
data ModelsTeamMember = ModelsTeamMember
  { ModelsTeamMember -> Maybe Bool
modelsTeamMemberAdmin :: !(Maybe Bool) -- ^ "admin" - Whether or not the member is an admin of the team. See the docs for more about what a team admin can do
  , ModelsTeamMember -> Maybe Text
modelsTeamMemberCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this relation was created. You cannot change this value.
  , ModelsTeamMember -> Maybe Int
modelsTeamMemberId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this team member relation.
  , ModelsTeamMember -> Maybe Text
modelsTeamMemberUsername :: !(Maybe Text) -- ^ "username" - The username of the member. We use this to prevent automated user id entering.
  } deriving (Int -> ModelsTeamMember -> ShowS
[ModelsTeamMember] -> ShowS
ModelsTeamMember -> String
(Int -> ModelsTeamMember -> ShowS)
-> (ModelsTeamMember -> String)
-> ([ModelsTeamMember] -> ShowS)
-> Show ModelsTeamMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTeamMember] -> ShowS
$cshowList :: [ModelsTeamMember] -> ShowS
show :: ModelsTeamMember -> String
$cshow :: ModelsTeamMember -> String
showsPrec :: Int -> ModelsTeamMember -> ShowS
$cshowsPrec :: Int -> ModelsTeamMember -> ShowS
P.Show, ModelsTeamMember -> ModelsTeamMember -> Bool
(ModelsTeamMember -> ModelsTeamMember -> Bool)
-> (ModelsTeamMember -> ModelsTeamMember -> Bool)
-> Eq ModelsTeamMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTeamMember -> ModelsTeamMember -> Bool
$c/= :: ModelsTeamMember -> ModelsTeamMember -> Bool
== :: ModelsTeamMember -> ModelsTeamMember -> Bool
$c== :: ModelsTeamMember -> ModelsTeamMember -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTeamMember
instance A.FromJSON ModelsTeamMember where
  parseJSON :: Value -> Parser ModelsTeamMember
parseJSON = String
-> (Object -> Parser ModelsTeamMember)
-> Value
-> Parser ModelsTeamMember
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTeamMember" ((Object -> Parser ModelsTeamMember)
 -> Value -> Parser ModelsTeamMember)
-> (Object -> Parser ModelsTeamMember)
-> Value
-> Parser ModelsTeamMember
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text -> Maybe Int -> Maybe Text -> ModelsTeamMember
ModelsTeamMember
      (Maybe Bool
 -> Maybe Text -> Maybe Int -> Maybe Text -> ModelsTeamMember)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text -> Maybe Int -> Maybe Text -> ModelsTeamMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"admin")
      Parser (Maybe Text -> Maybe Int -> Maybe Text -> ModelsTeamMember)
-> Parser (Maybe Text)
-> Parser (Maybe Int -> Maybe Text -> ModelsTeamMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Maybe Int -> Maybe Text -> ModelsTeamMember)
-> Parser (Maybe Int) -> Parser (Maybe Text -> ModelsTeamMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> ModelsTeamMember)
-> Parser (Maybe Text) -> Parser ModelsTeamMember
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON ModelsTeamMember
instance A.ToJSON ModelsTeamMember where
  toJSON :: ModelsTeamMember -> Value
toJSON ModelsTeamMember {Maybe Bool
Maybe Int
Maybe Text
modelsTeamMemberUsername :: Maybe Text
modelsTeamMemberId :: Maybe Int
modelsTeamMemberCreated :: Maybe Text
modelsTeamMemberAdmin :: Maybe Bool
$sel:modelsTeamMemberUsername:ModelsTeamMember :: ModelsTeamMember -> Maybe Text
$sel:modelsTeamMemberId:ModelsTeamMember :: ModelsTeamMember -> Maybe Int
$sel:modelsTeamMemberCreated:ModelsTeamMember :: ModelsTeamMember -> Maybe Text
$sel:modelsTeamMemberAdmin:ModelsTeamMember :: ModelsTeamMember -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"admin" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTeamMemberAdmin
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamMemberCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTeamMemberId
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamMemberUsername
      ]


-- | Construct a value of type 'ModelsTeamMember' (by applying it's required fields, if any)
mkModelsTeamMember
  :: ModelsTeamMember
mkModelsTeamMember :: ModelsTeamMember
mkModelsTeamMember =
  ModelsTeamMember :: Maybe Bool
-> Maybe Text -> Maybe Int -> Maybe Text -> ModelsTeamMember
ModelsTeamMember
  { $sel:modelsTeamMemberAdmin:ModelsTeamMember :: Maybe Bool
modelsTeamMemberAdmin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTeamMemberCreated:ModelsTeamMember :: Maybe Text
modelsTeamMemberCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamMemberId:ModelsTeamMember :: Maybe Int
modelsTeamMemberId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTeamMemberUsername:ModelsTeamMember :: Maybe Text
modelsTeamMemberUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsTeamProject
-- | ModelsTeamProject
data ModelsTeamProject = ModelsTeamProject
  { ModelsTeamProject -> Maybe Text
modelsTeamProjectCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this relation was created. You cannot change this value.
  , ModelsTeamProject -> Maybe Int
modelsTeamProjectId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this project &lt;-&gt; team relation.
  , ModelsTeamProject -> Maybe ModelsRight
modelsTeamProjectRight :: !(Maybe ModelsRight) -- ^ "right" - The right this team has. 0 &#x3D; Read only, 1 &#x3D; Read &amp; Write, 2 &#x3D; Admin. See the docs for more details.
  , ModelsTeamProject -> Maybe Int
modelsTeamProjectTeamId :: !(Maybe Int) -- ^ "team_id" - The team id.
  , ModelsTeamProject -> Maybe Text
modelsTeamProjectUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this relation was last updated. You cannot change this value.
  } deriving (Int -> ModelsTeamProject -> ShowS
[ModelsTeamProject] -> ShowS
ModelsTeamProject -> String
(Int -> ModelsTeamProject -> ShowS)
-> (ModelsTeamProject -> String)
-> ([ModelsTeamProject] -> ShowS)
-> Show ModelsTeamProject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTeamProject] -> ShowS
$cshowList :: [ModelsTeamProject] -> ShowS
show :: ModelsTeamProject -> String
$cshow :: ModelsTeamProject -> String
showsPrec :: Int -> ModelsTeamProject -> ShowS
$cshowsPrec :: Int -> ModelsTeamProject -> ShowS
P.Show, ModelsTeamProject -> ModelsTeamProject -> Bool
(ModelsTeamProject -> ModelsTeamProject -> Bool)
-> (ModelsTeamProject -> ModelsTeamProject -> Bool)
-> Eq ModelsTeamProject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTeamProject -> ModelsTeamProject -> Bool
$c/= :: ModelsTeamProject -> ModelsTeamProject -> Bool
== :: ModelsTeamProject -> ModelsTeamProject -> Bool
$c== :: ModelsTeamProject -> ModelsTeamProject -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTeamProject
instance A.FromJSON ModelsTeamProject where
  parseJSON :: Value -> Parser ModelsTeamProject
parseJSON = String
-> (Object -> Parser ModelsTeamProject)
-> Value
-> Parser ModelsTeamProject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTeamProject" ((Object -> Parser ModelsTeamProject)
 -> Value -> Parser ModelsTeamProject)
-> (Object -> Parser ModelsTeamProject)
-> Value
-> Parser ModelsTeamProject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int
-> Maybe ModelsRight
-> Maybe Int
-> Maybe Text
-> ModelsTeamProject
ModelsTeamProject
      (Maybe Text
 -> Maybe Int
 -> Maybe ModelsRight
 -> Maybe Int
 -> Maybe Text
 -> ModelsTeamProject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe ModelsRight
      -> Maybe Int
      -> Maybe Text
      -> ModelsTeamProject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Int
   -> Maybe ModelsRight
   -> Maybe Int
   -> Maybe Text
   -> ModelsTeamProject)
-> Parser (Maybe Int)
-> Parser
     (Maybe ModelsRight -> Maybe Int -> Maybe Text -> ModelsTeamProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe ModelsRight -> Maybe Int -> Maybe Text -> ModelsTeamProject)
-> Parser (Maybe ModelsRight)
-> Parser (Maybe Int -> Maybe Text -> ModelsTeamProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsRight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"right")
      Parser (Maybe Int -> Maybe Text -> ModelsTeamProject)
-> Parser (Maybe Int) -> Parser (Maybe Text -> ModelsTeamProject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"team_id")
      Parser (Maybe Text -> ModelsTeamProject)
-> Parser (Maybe Text) -> Parser ModelsTeamProject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsTeamProject
instance A.ToJSON ModelsTeamProject where
  toJSON :: ModelsTeamProject -> Value
toJSON ModelsTeamProject {Maybe Int
Maybe Text
Maybe ModelsRight
modelsTeamProjectUpdated :: Maybe Text
modelsTeamProjectTeamId :: Maybe Int
modelsTeamProjectRight :: Maybe ModelsRight
modelsTeamProjectId :: Maybe Int
modelsTeamProjectCreated :: Maybe Text
$sel:modelsTeamProjectUpdated:ModelsTeamProject :: ModelsTeamProject -> Maybe Text
$sel:modelsTeamProjectTeamId:ModelsTeamProject :: ModelsTeamProject -> Maybe Int
$sel:modelsTeamProjectRight:ModelsTeamProject :: ModelsTeamProject -> Maybe ModelsRight
$sel:modelsTeamProjectId:ModelsTeamProject :: ModelsTeamProject -> Maybe Int
$sel:modelsTeamProjectCreated:ModelsTeamProject :: ModelsTeamProject -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamProjectCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTeamProjectId
      , Key
"right" Key -> Maybe ModelsRight -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsRight
modelsTeamProjectRight
      , Key
"team_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTeamProjectTeamId
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamProjectUpdated
      ]


-- | Construct a value of type 'ModelsTeamProject' (by applying it's required fields, if any)
mkModelsTeamProject
  :: ModelsTeamProject
mkModelsTeamProject :: ModelsTeamProject
mkModelsTeamProject =
  ModelsTeamProject :: Maybe Text
-> Maybe Int
-> Maybe ModelsRight
-> Maybe Int
-> Maybe Text
-> ModelsTeamProject
ModelsTeamProject
  { $sel:modelsTeamProjectCreated:ModelsTeamProject :: Maybe Text
modelsTeamProjectCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamProjectId:ModelsTeamProject :: Maybe Int
modelsTeamProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTeamProjectRight:ModelsTeamProject :: Maybe ModelsRight
modelsTeamProjectRight = Maybe ModelsRight
forall a. Maybe a
Nothing
  , $sel:modelsTeamProjectTeamId:ModelsTeamProject :: Maybe Int
modelsTeamProjectTeamId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTeamProjectUpdated:ModelsTeamProject :: Maybe Text
modelsTeamProjectUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsTeamUser
-- | ModelsTeamUser
data ModelsTeamUser = ModelsTeamUser
  { ModelsTeamUser -> Maybe Bool
modelsTeamUserAdmin :: !(Maybe Bool) -- ^ "admin" - Whether the member is an admin of the team. See the docs for more about what a team admin can do
  , ModelsTeamUser -> Maybe Text
modelsTeamUserCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this task was created. You cannot change this value.
  , ModelsTeamUser -> Maybe Text
modelsTeamUserEmail :: !(Maybe Text) -- ^ "email" - The user&#39;s email address.
  , ModelsTeamUser -> Maybe Int
modelsTeamUserId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this user.
  , ModelsTeamUser -> Maybe Text
modelsTeamUserName :: !(Maybe Text) -- ^ "name" - The full name of the user.
  , ModelsTeamUser -> Maybe Text
modelsTeamUserUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this task was last updated. You cannot change this value.
  , ModelsTeamUser -> Maybe Text
modelsTeamUserUsername :: !(Maybe Text) -- ^ "username" - The username of the user. Is always unique.
  } deriving (Int -> ModelsTeamUser -> ShowS
[ModelsTeamUser] -> ShowS
ModelsTeamUser -> String
(Int -> ModelsTeamUser -> ShowS)
-> (ModelsTeamUser -> String)
-> ([ModelsTeamUser] -> ShowS)
-> Show ModelsTeamUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTeamUser] -> ShowS
$cshowList :: [ModelsTeamUser] -> ShowS
show :: ModelsTeamUser -> String
$cshow :: ModelsTeamUser -> String
showsPrec :: Int -> ModelsTeamUser -> ShowS
$cshowsPrec :: Int -> ModelsTeamUser -> ShowS
P.Show, ModelsTeamUser -> ModelsTeamUser -> Bool
(ModelsTeamUser -> ModelsTeamUser -> Bool)
-> (ModelsTeamUser -> ModelsTeamUser -> Bool) -> Eq ModelsTeamUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTeamUser -> ModelsTeamUser -> Bool
$c/= :: ModelsTeamUser -> ModelsTeamUser -> Bool
== :: ModelsTeamUser -> ModelsTeamUser -> Bool
$c== :: ModelsTeamUser -> ModelsTeamUser -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTeamUser
instance A.FromJSON ModelsTeamUser where
  parseJSON :: Value -> Parser ModelsTeamUser
parseJSON = String
-> (Object -> Parser ModelsTeamUser)
-> Value
-> Parser ModelsTeamUser
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTeamUser" ((Object -> Parser ModelsTeamUser)
 -> Value -> Parser ModelsTeamUser)
-> (Object -> Parser ModelsTeamUser)
-> Value
-> Parser ModelsTeamUser
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ModelsTeamUser
ModelsTeamUser
      (Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> ModelsTeamUser)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsTeamUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"admin")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsTeamUser)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsTeamUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsTeamUser)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeamUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Int
   -> Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeamUser)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeamUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> ModelsTeamUser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ModelsTeamUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Maybe Text -> ModelsTeamUser)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsTeamUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")
      Parser (Maybe Text -> ModelsTeamUser)
-> Parser (Maybe Text) -> Parser ModelsTeamUser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON ModelsTeamUser
instance A.ToJSON ModelsTeamUser where
  toJSON :: ModelsTeamUser -> Value
toJSON ModelsTeamUser {Maybe Bool
Maybe Int
Maybe Text
modelsTeamUserUsername :: Maybe Text
modelsTeamUserUpdated :: Maybe Text
modelsTeamUserName :: Maybe Text
modelsTeamUserId :: Maybe Int
modelsTeamUserEmail :: Maybe Text
modelsTeamUserCreated :: Maybe Text
modelsTeamUserAdmin :: Maybe Bool
$sel:modelsTeamUserUsername:ModelsTeamUser :: ModelsTeamUser -> Maybe Text
$sel:modelsTeamUserUpdated:ModelsTeamUser :: ModelsTeamUser -> Maybe Text
$sel:modelsTeamUserName:ModelsTeamUser :: ModelsTeamUser -> Maybe Text
$sel:modelsTeamUserId:ModelsTeamUser :: ModelsTeamUser -> Maybe Int
$sel:modelsTeamUserEmail:ModelsTeamUser :: ModelsTeamUser -> Maybe Text
$sel:modelsTeamUserCreated:ModelsTeamUser :: ModelsTeamUser -> Maybe Text
$sel:modelsTeamUserAdmin:ModelsTeamUser :: ModelsTeamUser -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"admin" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTeamUserAdmin
      , Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamUserCreated
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamUserEmail
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTeamUserId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamUserName
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamUserUpdated
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamUserUsername
      ]


-- | Construct a value of type 'ModelsTeamUser' (by applying it's required fields, if any)
mkModelsTeamUser
  :: ModelsTeamUser
mkModelsTeamUser :: ModelsTeamUser
mkModelsTeamUser =
  ModelsTeamUser :: Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ModelsTeamUser
ModelsTeamUser
  { $sel:modelsTeamUserAdmin:ModelsTeamUser :: Maybe Bool
modelsTeamUserAdmin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTeamUserCreated:ModelsTeamUser :: Maybe Text
modelsTeamUserCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamUserEmail:ModelsTeamUser :: Maybe Text
modelsTeamUserEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamUserId:ModelsTeamUser :: Maybe Int
modelsTeamUserId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTeamUserName:ModelsTeamUser :: Maybe Text
modelsTeamUserName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamUserUpdated:ModelsTeamUser :: Maybe Text
modelsTeamUserUpdated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamUserUsername:ModelsTeamUser :: Maybe Text
modelsTeamUserUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsTeamWithRight
-- | ModelsTeamWithRight
data ModelsTeamWithRight = ModelsTeamWithRight
  { ModelsTeamWithRight -> Maybe Text
modelsTeamWithRightCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this relation was created. You cannot change this value.
  , ModelsTeamWithRight -> Maybe UserUser
modelsTeamWithRightCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who created this team.
  , ModelsTeamWithRight -> Maybe Text
modelsTeamWithRightDescription :: !(Maybe Text) -- ^ "description" - The team&#39;s description.
  , ModelsTeamWithRight -> Maybe Int
modelsTeamWithRightId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this team.
  , ModelsTeamWithRight -> Maybe Bool
modelsTeamWithRightIncludePublic :: !(Maybe Bool) -- ^ "include_public" - Query parameter controlling whether to include public projects or not
  , ModelsTeamWithRight -> Maybe Bool
modelsTeamWithRightIsPublic :: !(Maybe Bool) -- ^ "is_public" - Defines wether the team should be publicly discoverable when sharing a project
  , ModelsTeamWithRight -> Maybe [ModelsTeamUser]
modelsTeamWithRightMembers :: !(Maybe [ModelsTeamUser]) -- ^ "members" - An array of all members in this team.
  , ModelsTeamWithRight -> Maybe Text
modelsTeamWithRightName :: !(Maybe Text) -- ^ "name" - The name of this team.
  , ModelsTeamWithRight -> Maybe Text
modelsTeamWithRightOidcId :: !(Maybe Text) -- ^ "oidc_id" - The team&#39;s oidc id delivered by the oidc provider
  , ModelsTeamWithRight -> Maybe ModelsRight
modelsTeamWithRightRight :: !(Maybe ModelsRight) -- ^ "right"
  , ModelsTeamWithRight -> Maybe Text
modelsTeamWithRightUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this relation was last updated. You cannot change this value.
  } deriving (Int -> ModelsTeamWithRight -> ShowS
[ModelsTeamWithRight] -> ShowS
ModelsTeamWithRight -> String
(Int -> ModelsTeamWithRight -> ShowS)
-> (ModelsTeamWithRight -> String)
-> ([ModelsTeamWithRight] -> ShowS)
-> Show ModelsTeamWithRight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTeamWithRight] -> ShowS
$cshowList :: [ModelsTeamWithRight] -> ShowS
show :: ModelsTeamWithRight -> String
$cshow :: ModelsTeamWithRight -> String
showsPrec :: Int -> ModelsTeamWithRight -> ShowS
$cshowsPrec :: Int -> ModelsTeamWithRight -> ShowS
P.Show, ModelsTeamWithRight -> ModelsTeamWithRight -> Bool
(ModelsTeamWithRight -> ModelsTeamWithRight -> Bool)
-> (ModelsTeamWithRight -> ModelsTeamWithRight -> Bool)
-> Eq ModelsTeamWithRight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTeamWithRight -> ModelsTeamWithRight -> Bool
$c/= :: ModelsTeamWithRight -> ModelsTeamWithRight -> Bool
== :: ModelsTeamWithRight -> ModelsTeamWithRight -> Bool
$c== :: ModelsTeamWithRight -> ModelsTeamWithRight -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsTeamWithRight
instance A.FromJSON ModelsTeamWithRight where
  parseJSON :: Value -> Parser ModelsTeamWithRight
parseJSON = String
-> (Object -> Parser ModelsTeamWithRight)
-> Value
-> Parser ModelsTeamWithRight
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsTeamWithRight" ((Object -> Parser ModelsTeamWithRight)
 -> Value -> Parser ModelsTeamWithRight)
-> (Object -> Parser ModelsTeamWithRight)
-> Value
-> Parser ModelsTeamWithRight
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe [ModelsTeamUser]
-> Maybe Text
-> Maybe Text
-> Maybe ModelsRight
-> Maybe Text
-> ModelsTeamWithRight
ModelsTeamWithRight
      (Maybe Text
 -> Maybe UserUser
 -> Maybe Text
 -> Maybe Int
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe [ModelsTeamUser]
 -> Maybe Text
 -> Maybe Text
 -> Maybe ModelsRight
 -> Maybe Text
 -> ModelsTeamWithRight)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> ModelsTeamWithRight)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> ModelsTeamWithRight)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> ModelsTeamWithRight)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> ModelsTeamWithRight)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"include_public")
      Parser
  (Maybe Bool
   -> Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> ModelsTeamWithRight)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [ModelsTeamUser]
      -> Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_public")
      Parser
  (Maybe [ModelsTeamUser]
   -> Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> ModelsTeamWithRight)
-> Parser (Maybe [ModelsTeamUser])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ModelsTeamUser])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"members")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> ModelsTeamWithRight)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ModelsRight -> Maybe Text -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Text
   -> Maybe ModelsRight -> Maybe Text -> ModelsTeamWithRight)
-> Parser (Maybe Text)
-> Parser (Maybe ModelsRight -> Maybe Text -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"oidc_id")
      Parser (Maybe ModelsRight -> Maybe Text -> ModelsTeamWithRight)
-> Parser (Maybe ModelsRight)
-> Parser (Maybe Text -> ModelsTeamWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsRight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"right")
      Parser (Maybe Text -> ModelsTeamWithRight)
-> Parser (Maybe Text) -> Parser ModelsTeamWithRight
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsTeamWithRight
instance A.ToJSON ModelsTeamWithRight where
  toJSON :: ModelsTeamWithRight -> Value
toJSON ModelsTeamWithRight {Maybe Bool
Maybe Int
Maybe [ModelsTeamUser]
Maybe Text
Maybe ModelsRight
Maybe UserUser
modelsTeamWithRightUpdated :: Maybe Text
modelsTeamWithRightRight :: Maybe ModelsRight
modelsTeamWithRightOidcId :: Maybe Text
modelsTeamWithRightName :: Maybe Text
modelsTeamWithRightMembers :: Maybe [ModelsTeamUser]
modelsTeamWithRightIsPublic :: Maybe Bool
modelsTeamWithRightIncludePublic :: Maybe Bool
modelsTeamWithRightId :: Maybe Int
modelsTeamWithRightDescription :: Maybe Text
modelsTeamWithRightCreatedBy :: Maybe UserUser
modelsTeamWithRightCreated :: Maybe Text
$sel:modelsTeamWithRightUpdated:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Text
$sel:modelsTeamWithRightRight:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe ModelsRight
$sel:modelsTeamWithRightOidcId:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Text
$sel:modelsTeamWithRightName:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Text
$sel:modelsTeamWithRightMembers:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe [ModelsTeamUser]
$sel:modelsTeamWithRightIsPublic:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Bool
$sel:modelsTeamWithRightIncludePublic:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Bool
$sel:modelsTeamWithRightId:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Int
$sel:modelsTeamWithRightDescription:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Text
$sel:modelsTeamWithRightCreatedBy:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe UserUser
$sel:modelsTeamWithRightCreated:ModelsTeamWithRight :: ModelsTeamWithRight -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamWithRightCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsTeamWithRightCreatedBy
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamWithRightDescription
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsTeamWithRightId
      , Key
"include_public" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTeamWithRightIncludePublic
      , Key
"is_public" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
modelsTeamWithRightIsPublic
      , Key
"members" Key -> Maybe [ModelsTeamUser] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ModelsTeamUser]
modelsTeamWithRightMembers
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamWithRightName
      , Key
"oidc_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamWithRightOidcId
      , Key
"right" Key -> Maybe ModelsRight -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsRight
modelsTeamWithRightRight
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsTeamWithRightUpdated
      ]


-- | Construct a value of type 'ModelsTeamWithRight' (by applying it's required fields, if any)
mkModelsTeamWithRight
  :: ModelsTeamWithRight
mkModelsTeamWithRight :: ModelsTeamWithRight
mkModelsTeamWithRight =
  ModelsTeamWithRight :: Maybe Text
-> Maybe UserUser
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe [ModelsTeamUser]
-> Maybe Text
-> Maybe Text
-> Maybe ModelsRight
-> Maybe Text
-> ModelsTeamWithRight
ModelsTeamWithRight
  { $sel:modelsTeamWithRightCreated:ModelsTeamWithRight :: Maybe Text
modelsTeamWithRightCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightCreatedBy:ModelsTeamWithRight :: Maybe UserUser
modelsTeamWithRightCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightDescription:ModelsTeamWithRight :: Maybe Text
modelsTeamWithRightDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightId:ModelsTeamWithRight :: Maybe Int
modelsTeamWithRightId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightIncludePublic:ModelsTeamWithRight :: Maybe Bool
modelsTeamWithRightIncludePublic = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightIsPublic:ModelsTeamWithRight :: Maybe Bool
modelsTeamWithRightIsPublic = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightMembers:ModelsTeamWithRight :: Maybe [ModelsTeamUser]
modelsTeamWithRightMembers = Maybe [ModelsTeamUser]
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightName:ModelsTeamWithRight :: Maybe Text
modelsTeamWithRightName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightOidcId:ModelsTeamWithRight :: Maybe Text
modelsTeamWithRightOidcId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightRight:ModelsTeamWithRight :: Maybe ModelsRight
modelsTeamWithRightRight = Maybe ModelsRight
forall a. Maybe a
Nothing
  , $sel:modelsTeamWithRightUpdated:ModelsTeamWithRight :: Maybe Text
modelsTeamWithRightUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsUserWithRight
-- | ModelsUserWithRight
data ModelsUserWithRight = ModelsUserWithRight
  { ModelsUserWithRight -> Maybe Text
modelsUserWithRightCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this task was created. You cannot change this value.
  , ModelsUserWithRight -> Maybe Text
modelsUserWithRightEmail :: !(Maybe Text) -- ^ "email" - The user&#39;s email address.
  , ModelsUserWithRight -> Maybe Int
modelsUserWithRightId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this user.
  , ModelsUserWithRight -> Maybe Text
modelsUserWithRightName :: !(Maybe Text) -- ^ "name" - The full name of the user.
  , ModelsUserWithRight -> Maybe ModelsRight
modelsUserWithRightRight :: !(Maybe ModelsRight) -- ^ "right"
  , ModelsUserWithRight -> Maybe Text
modelsUserWithRightUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this task was last updated. You cannot change this value.
  , ModelsUserWithRight -> Maybe Text
modelsUserWithRightUsername :: !(Maybe Text) -- ^ "username" - The username of the user. Is always unique.
  } deriving (Int -> ModelsUserWithRight -> ShowS
[ModelsUserWithRight] -> ShowS
ModelsUserWithRight -> String
(Int -> ModelsUserWithRight -> ShowS)
-> (ModelsUserWithRight -> String)
-> ([ModelsUserWithRight] -> ShowS)
-> Show ModelsUserWithRight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsUserWithRight] -> ShowS
$cshowList :: [ModelsUserWithRight] -> ShowS
show :: ModelsUserWithRight -> String
$cshow :: ModelsUserWithRight -> String
showsPrec :: Int -> ModelsUserWithRight -> ShowS
$cshowsPrec :: Int -> ModelsUserWithRight -> ShowS
P.Show, ModelsUserWithRight -> ModelsUserWithRight -> Bool
(ModelsUserWithRight -> ModelsUserWithRight -> Bool)
-> (ModelsUserWithRight -> ModelsUserWithRight -> Bool)
-> Eq ModelsUserWithRight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsUserWithRight -> ModelsUserWithRight -> Bool
$c/= :: ModelsUserWithRight -> ModelsUserWithRight -> Bool
== :: ModelsUserWithRight -> ModelsUserWithRight -> Bool
$c== :: ModelsUserWithRight -> ModelsUserWithRight -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsUserWithRight
instance A.FromJSON ModelsUserWithRight where
  parseJSON :: Value -> Parser ModelsUserWithRight
parseJSON = String
-> (Object -> Parser ModelsUserWithRight)
-> Value
-> Parser ModelsUserWithRight
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsUserWithRight" ((Object -> Parser ModelsUserWithRight)
 -> Value -> Parser ModelsUserWithRight)
-> (Object -> Parser ModelsUserWithRight)
-> Value
-> Parser ModelsUserWithRight
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe ModelsRight
-> Maybe Text
-> Maybe Text
-> ModelsUserWithRight
ModelsUserWithRight
      (Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe ModelsRight
 -> Maybe Text
 -> Maybe Text
 -> ModelsUserWithRight)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> Maybe Text
      -> ModelsUserWithRight)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> Maybe Text
   -> ModelsUserWithRight)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> Maybe Text
      -> ModelsUserWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> Maybe Text
   -> ModelsUserWithRight)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe ModelsRight
      -> Maybe Text
      -> Maybe Text
      -> ModelsUserWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe ModelsRight
   -> Maybe Text
   -> Maybe Text
   -> ModelsUserWithRight)
-> Parser (Maybe Text)
-> Parser
     (Maybe ModelsRight
      -> Maybe Text -> Maybe Text -> ModelsUserWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe ModelsRight
   -> Maybe Text -> Maybe Text -> ModelsUserWithRight)
-> Parser (Maybe ModelsRight)
-> Parser (Maybe Text -> Maybe Text -> ModelsUserWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ModelsRight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"right")
      Parser (Maybe Text -> Maybe Text -> ModelsUserWithRight)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> ModelsUserWithRight)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")
      Parser (Maybe Text -> ModelsUserWithRight)
-> Parser (Maybe Text) -> Parser ModelsUserWithRight
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON ModelsUserWithRight
instance A.ToJSON ModelsUserWithRight where
  toJSON :: ModelsUserWithRight -> Value
toJSON ModelsUserWithRight {Maybe Int
Maybe Text
Maybe ModelsRight
modelsUserWithRightUsername :: Maybe Text
modelsUserWithRightUpdated :: Maybe Text
modelsUserWithRightRight :: Maybe ModelsRight
modelsUserWithRightName :: Maybe Text
modelsUserWithRightId :: Maybe Int
modelsUserWithRightEmail :: Maybe Text
modelsUserWithRightCreated :: Maybe Text
$sel:modelsUserWithRightUsername:ModelsUserWithRight :: ModelsUserWithRight -> Maybe Text
$sel:modelsUserWithRightUpdated:ModelsUserWithRight :: ModelsUserWithRight -> Maybe Text
$sel:modelsUserWithRightRight:ModelsUserWithRight :: ModelsUserWithRight -> Maybe ModelsRight
$sel:modelsUserWithRightName:ModelsUserWithRight :: ModelsUserWithRight -> Maybe Text
$sel:modelsUserWithRightId:ModelsUserWithRight :: ModelsUserWithRight -> Maybe Int
$sel:modelsUserWithRightEmail:ModelsUserWithRight :: ModelsUserWithRight -> Maybe Text
$sel:modelsUserWithRightCreated:ModelsUserWithRight :: ModelsUserWithRight -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsUserWithRightCreated
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsUserWithRightEmail
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsUserWithRightId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsUserWithRightName
      , Key
"right" Key -> Maybe ModelsRight -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModelsRight
modelsUserWithRightRight
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsUserWithRightUpdated
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsUserWithRightUsername
      ]


-- | Construct a value of type 'ModelsUserWithRight' (by applying it's required fields, if any)
mkModelsUserWithRight
  :: ModelsUserWithRight
mkModelsUserWithRight :: ModelsUserWithRight
mkModelsUserWithRight =
  ModelsUserWithRight :: Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe ModelsRight
-> Maybe Text
-> Maybe Text
-> ModelsUserWithRight
ModelsUserWithRight
  { $sel:modelsUserWithRightCreated:ModelsUserWithRight :: Maybe Text
modelsUserWithRightCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsUserWithRightEmail:ModelsUserWithRight :: Maybe Text
modelsUserWithRightEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsUserWithRightId:ModelsUserWithRight :: Maybe Int
modelsUserWithRightId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsUserWithRightName:ModelsUserWithRight :: Maybe Text
modelsUserWithRightName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsUserWithRightRight:ModelsUserWithRight :: Maybe ModelsRight
modelsUserWithRightRight = Maybe ModelsRight
forall a. Maybe a
Nothing
  , $sel:modelsUserWithRightUpdated:ModelsUserWithRight :: Maybe Text
modelsUserWithRightUpdated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsUserWithRightUsername:ModelsUserWithRight :: Maybe Text
modelsUserWithRightUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ModelsWebhook
-- | ModelsWebhook
data ModelsWebhook = ModelsWebhook
  { ModelsWebhook -> Maybe Text
modelsWebhookCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this webhook target was created. You cannot change this value.
  , ModelsWebhook -> Maybe UserUser
modelsWebhookCreatedBy :: !(Maybe UserUser) -- ^ "created_by" - The user who initially created the webhook target.
  , ModelsWebhook -> Maybe [Text]
modelsWebhookEvents :: !(Maybe [Text]) -- ^ "events" - The webhook events which should fire this webhook target
  , ModelsWebhook -> Maybe Int
modelsWebhookId :: !(Maybe Int) -- ^ "id" - The generated ID of this webhook target
  , ModelsWebhook -> Maybe Int
modelsWebhookProjectId :: !(Maybe Int) -- ^ "project_id" - The project ID of the project this webhook target belongs to
  , ModelsWebhook -> Maybe Text
modelsWebhookSecret :: !(Maybe Text) -- ^ "secret" - If provided, webhook requests will be signed using HMAC. Check out the docs about how to use this: https://vikunja.io/docs/webhooks/#signing
  , ModelsWebhook -> Maybe Text
modelsWebhookTargetUrl :: !(Maybe Text) -- ^ "target_url" - The target URL where the POST request with the webhook payload will be made
  , ModelsWebhook -> Maybe Text
modelsWebhookUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this webhook target was last updated. You cannot change this value.
  } deriving (Int -> ModelsWebhook -> ShowS
[ModelsWebhook] -> ShowS
ModelsWebhook -> String
(Int -> ModelsWebhook -> ShowS)
-> (ModelsWebhook -> String)
-> ([ModelsWebhook] -> ShowS)
-> Show ModelsWebhook
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsWebhook] -> ShowS
$cshowList :: [ModelsWebhook] -> ShowS
show :: ModelsWebhook -> String
$cshow :: ModelsWebhook -> String
showsPrec :: Int -> ModelsWebhook -> ShowS
$cshowsPrec :: Int -> ModelsWebhook -> ShowS
P.Show, ModelsWebhook -> ModelsWebhook -> Bool
(ModelsWebhook -> ModelsWebhook -> Bool)
-> (ModelsWebhook -> ModelsWebhook -> Bool) -> Eq ModelsWebhook
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsWebhook -> ModelsWebhook -> Bool
$c/= :: ModelsWebhook -> ModelsWebhook -> Bool
== :: ModelsWebhook -> ModelsWebhook -> Bool
$c== :: ModelsWebhook -> ModelsWebhook -> Bool
P.Eq, P.Typeable)

-- | FromJSON ModelsWebhook
instance A.FromJSON ModelsWebhook where
  parseJSON :: Value -> Parser ModelsWebhook
parseJSON = String
-> (Object -> Parser ModelsWebhook)
-> Value
-> Parser ModelsWebhook
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ModelsWebhook" ((Object -> Parser ModelsWebhook) -> Value -> Parser ModelsWebhook)
-> (Object -> Parser ModelsWebhook)
-> Value
-> Parser ModelsWebhook
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe UserUser
-> Maybe [Text]
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ModelsWebhook
ModelsWebhook
      (Maybe Text
 -> Maybe UserUser
 -> Maybe [Text]
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> ModelsWebhook)
-> Parser (Maybe Text)
-> Parser
     (Maybe UserUser
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsWebhook)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe UserUser
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsWebhook)
-> Parser (Maybe UserUser)
-> Parser
     (Maybe [Text]
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsWebhook)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe UserUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_by")
      Parser
  (Maybe [Text]
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsWebhook)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ModelsWebhook)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"events")
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ModelsWebhook)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text -> Maybe Text -> Maybe Text -> ModelsWebhook)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Int
   -> Maybe Text -> Maybe Text -> Maybe Text -> ModelsWebhook)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> ModelsWebhook)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_id")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> ModelsWebhook)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ModelsWebhook)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"secret")
      Parser (Maybe Text -> Maybe Text -> ModelsWebhook)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModelsWebhook)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_url")
      Parser (Maybe Text -> ModelsWebhook)
-> Parser (Maybe Text) -> Parser ModelsWebhook
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON ModelsWebhook
instance A.ToJSON ModelsWebhook where
  toJSON :: ModelsWebhook -> Value
toJSON ModelsWebhook {Maybe Int
Maybe [Text]
Maybe Text
Maybe UserUser
modelsWebhookUpdated :: Maybe Text
modelsWebhookTargetUrl :: Maybe Text
modelsWebhookSecret :: Maybe Text
modelsWebhookProjectId :: Maybe Int
modelsWebhookId :: Maybe Int
modelsWebhookEvents :: Maybe [Text]
modelsWebhookCreatedBy :: Maybe UserUser
modelsWebhookCreated :: Maybe Text
$sel:modelsWebhookUpdated:ModelsWebhook :: ModelsWebhook -> Maybe Text
$sel:modelsWebhookTargetUrl:ModelsWebhook :: ModelsWebhook -> Maybe Text
$sel:modelsWebhookSecret:ModelsWebhook :: ModelsWebhook -> Maybe Text
$sel:modelsWebhookProjectId:ModelsWebhook :: ModelsWebhook -> Maybe Int
$sel:modelsWebhookId:ModelsWebhook :: ModelsWebhook -> Maybe Int
$sel:modelsWebhookEvents:ModelsWebhook :: ModelsWebhook -> Maybe [Text]
$sel:modelsWebhookCreatedBy:ModelsWebhook :: ModelsWebhook -> Maybe UserUser
$sel:modelsWebhookCreated:ModelsWebhook :: ModelsWebhook -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsWebhookCreated
      , Key
"created_by" Key -> Maybe UserUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserUser
modelsWebhookCreatedBy
      , Key
"events" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
modelsWebhookEvents
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsWebhookId
      , Key
"project_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
modelsWebhookProjectId
      , Key
"secret" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsWebhookSecret
      , Key
"target_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsWebhookTargetUrl
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modelsWebhookUpdated
      ]


-- | Construct a value of type 'ModelsWebhook' (by applying it's required fields, if any)
mkModelsWebhook
  :: ModelsWebhook
mkModelsWebhook :: ModelsWebhook
mkModelsWebhook =
  ModelsWebhook :: Maybe Text
-> Maybe UserUser
-> Maybe [Text]
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ModelsWebhook
ModelsWebhook
  { $sel:modelsWebhookCreated:ModelsWebhook :: Maybe Text
modelsWebhookCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsWebhookCreatedBy:ModelsWebhook :: Maybe UserUser
modelsWebhookCreatedBy = Maybe UserUser
forall a. Maybe a
Nothing
  , $sel:modelsWebhookEvents:ModelsWebhook :: Maybe [Text]
modelsWebhookEvents = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:modelsWebhookId:ModelsWebhook :: Maybe Int
modelsWebhookId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsWebhookProjectId:ModelsWebhook :: Maybe Int
modelsWebhookProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:modelsWebhookSecret:ModelsWebhook :: Maybe Text
modelsWebhookSecret = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsWebhookTargetUrl:ModelsWebhook :: Maybe Text
modelsWebhookTargetUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:modelsWebhookUpdated:ModelsWebhook :: Maybe Text
modelsWebhookUpdated = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** NotificationsDatabaseNotification
-- | NotificationsDatabaseNotification
data NotificationsDatabaseNotification = NotificationsDatabaseNotification
  { NotificationsDatabaseNotification -> Maybe Text
notificationsDatabaseNotificationCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this notification was created. You cannot change this value.
  , NotificationsDatabaseNotification -> Maybe Int
notificationsDatabaseNotificationId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this notification.
  , NotificationsDatabaseNotification -> Maybe Text
notificationsDatabaseNotificationName :: !(Maybe Text) -- ^ "name" - The name of the notification
  , NotificationsDatabaseNotification -> Maybe Value
notificationsDatabaseNotificationNotification :: !(Maybe A.Value) -- ^ "notification" - The actual content of the notification.
  , NotificationsDatabaseNotification -> Maybe Text
notificationsDatabaseNotificationReadAt :: !(Maybe Text) -- ^ "read_at" - When this notification is marked as read, this will be updated with the current timestamp.
  } deriving (Int -> NotificationsDatabaseNotification -> ShowS
[NotificationsDatabaseNotification] -> ShowS
NotificationsDatabaseNotification -> String
(Int -> NotificationsDatabaseNotification -> ShowS)
-> (NotificationsDatabaseNotification -> String)
-> ([NotificationsDatabaseNotification] -> ShowS)
-> Show NotificationsDatabaseNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationsDatabaseNotification] -> ShowS
$cshowList :: [NotificationsDatabaseNotification] -> ShowS
show :: NotificationsDatabaseNotification -> String
$cshow :: NotificationsDatabaseNotification -> String
showsPrec :: Int -> NotificationsDatabaseNotification -> ShowS
$cshowsPrec :: Int -> NotificationsDatabaseNotification -> ShowS
P.Show, NotificationsDatabaseNotification
-> NotificationsDatabaseNotification -> Bool
(NotificationsDatabaseNotification
 -> NotificationsDatabaseNotification -> Bool)
-> (NotificationsDatabaseNotification
    -> NotificationsDatabaseNotification -> Bool)
-> Eq NotificationsDatabaseNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationsDatabaseNotification
-> NotificationsDatabaseNotification -> Bool
$c/= :: NotificationsDatabaseNotification
-> NotificationsDatabaseNotification -> Bool
== :: NotificationsDatabaseNotification
-> NotificationsDatabaseNotification -> Bool
$c== :: NotificationsDatabaseNotification
-> NotificationsDatabaseNotification -> Bool
P.Eq, P.Typeable)

-- | FromJSON NotificationsDatabaseNotification
instance A.FromJSON NotificationsDatabaseNotification where
  parseJSON :: Value -> Parser NotificationsDatabaseNotification
parseJSON = String
-> (Object -> Parser NotificationsDatabaseNotification)
-> Value
-> Parser NotificationsDatabaseNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"NotificationsDatabaseNotification" ((Object -> Parser NotificationsDatabaseNotification)
 -> Value -> Parser NotificationsDatabaseNotification)
-> (Object -> Parser NotificationsDatabaseNotification)
-> Value
-> Parser NotificationsDatabaseNotification
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> NotificationsDatabaseNotification
NotificationsDatabaseNotification
      (Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Value
 -> Maybe Text
 -> NotificationsDatabaseNotification)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> NotificationsDatabaseNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> NotificationsDatabaseNotification)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Value -> Maybe Text -> NotificationsDatabaseNotification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Value -> Maybe Text -> NotificationsDatabaseNotification)
-> Parser (Maybe Text)
-> Parser
     (Maybe Value -> Maybe Text -> NotificationsDatabaseNotification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Value -> Maybe Text -> NotificationsDatabaseNotification)
-> Parser (Maybe Value)
-> Parser (Maybe Text -> NotificationsDatabaseNotification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"notification")
      Parser (Maybe Text -> NotificationsDatabaseNotification)
-> Parser (Maybe Text) -> Parser NotificationsDatabaseNotification
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read_at")

-- | ToJSON NotificationsDatabaseNotification
instance A.ToJSON NotificationsDatabaseNotification where
  toJSON :: NotificationsDatabaseNotification -> Value
toJSON NotificationsDatabaseNotification {Maybe Int
Maybe Text
Maybe Value
notificationsDatabaseNotificationReadAt :: Maybe Text
notificationsDatabaseNotificationNotification :: Maybe Value
notificationsDatabaseNotificationName :: Maybe Text
notificationsDatabaseNotificationId :: Maybe Int
notificationsDatabaseNotificationCreated :: Maybe Text
$sel:notificationsDatabaseNotificationReadAt:NotificationsDatabaseNotification :: NotificationsDatabaseNotification -> Maybe Text
$sel:notificationsDatabaseNotificationNotification:NotificationsDatabaseNotification :: NotificationsDatabaseNotification -> Maybe Value
$sel:notificationsDatabaseNotificationName:NotificationsDatabaseNotification :: NotificationsDatabaseNotification -> Maybe Text
$sel:notificationsDatabaseNotificationId:NotificationsDatabaseNotification :: NotificationsDatabaseNotification -> Maybe Int
$sel:notificationsDatabaseNotificationCreated:NotificationsDatabaseNotification :: NotificationsDatabaseNotification -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
notificationsDatabaseNotificationCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
notificationsDatabaseNotificationId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
notificationsDatabaseNotificationName
      , Key
"notification" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
notificationsDatabaseNotificationNotification
      , Key
"read_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
notificationsDatabaseNotificationReadAt
      ]


-- | Construct a value of type 'NotificationsDatabaseNotification' (by applying it's required fields, if any)
mkNotificationsDatabaseNotification
  :: NotificationsDatabaseNotification
mkNotificationsDatabaseNotification :: NotificationsDatabaseNotification
mkNotificationsDatabaseNotification =
  NotificationsDatabaseNotification :: Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> NotificationsDatabaseNotification
NotificationsDatabaseNotification
  { $sel:notificationsDatabaseNotificationCreated:NotificationsDatabaseNotification :: Maybe Text
notificationsDatabaseNotificationCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationsDatabaseNotificationId:NotificationsDatabaseNotification :: Maybe Int
notificationsDatabaseNotificationId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:notificationsDatabaseNotificationName:NotificationsDatabaseNotification :: Maybe Text
notificationsDatabaseNotificationName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationsDatabaseNotificationNotification:NotificationsDatabaseNotification :: Maybe Value
notificationsDatabaseNotificationNotification = Maybe Value
forall a. Maybe a
Nothing
  , $sel:notificationsDatabaseNotificationReadAt:NotificationsDatabaseNotification :: Maybe Text
notificationsDatabaseNotificationReadAt = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OpenidCallback
-- | OpenidCallback
data OpenidCallback = OpenidCallback
  { OpenidCallback -> Maybe Text
openidCallbackCode :: !(Maybe Text) -- ^ "code"
  , OpenidCallback -> Maybe Text
openidCallbackRedirectUrl :: !(Maybe Text) -- ^ "redirect_url"
  , OpenidCallback -> Maybe Text
openidCallbackScope :: !(Maybe Text) -- ^ "scope"
  } deriving (Int -> OpenidCallback -> ShowS
[OpenidCallback] -> ShowS
OpenidCallback -> String
(Int -> OpenidCallback -> ShowS)
-> (OpenidCallback -> String)
-> ([OpenidCallback] -> ShowS)
-> Show OpenidCallback
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenidCallback] -> ShowS
$cshowList :: [OpenidCallback] -> ShowS
show :: OpenidCallback -> String
$cshow :: OpenidCallback -> String
showsPrec :: Int -> OpenidCallback -> ShowS
$cshowsPrec :: Int -> OpenidCallback -> ShowS
P.Show, OpenidCallback -> OpenidCallback -> Bool
(OpenidCallback -> OpenidCallback -> Bool)
-> (OpenidCallback -> OpenidCallback -> Bool) -> Eq OpenidCallback
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenidCallback -> OpenidCallback -> Bool
$c/= :: OpenidCallback -> OpenidCallback -> Bool
== :: OpenidCallback -> OpenidCallback -> Bool
$c== :: OpenidCallback -> OpenidCallback -> Bool
P.Eq, P.Typeable)

-- | FromJSON OpenidCallback
instance A.FromJSON OpenidCallback where
  parseJSON :: Value -> Parser OpenidCallback
parseJSON = String
-> (Object -> Parser OpenidCallback)
-> Value
-> Parser OpenidCallback
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OpenidCallback" ((Object -> Parser OpenidCallback)
 -> Value -> Parser OpenidCallback)
-> (Object -> Parser OpenidCallback)
-> Value
-> Parser OpenidCallback
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> OpenidCallback
OpenidCallback
      (Maybe Text -> Maybe Text -> Maybe Text -> OpenidCallback)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> OpenidCallback)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code")
      Parser (Maybe Text -> Maybe Text -> OpenidCallback)
-> Parser (Maybe Text) -> Parser (Maybe Text -> OpenidCallback)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"redirect_url")
      Parser (Maybe Text -> OpenidCallback)
-> Parser (Maybe Text) -> Parser OpenidCallback
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope")

-- | ToJSON OpenidCallback
instance A.ToJSON OpenidCallback where
  toJSON :: OpenidCallback -> Value
toJSON OpenidCallback {Maybe Text
openidCallbackScope :: Maybe Text
openidCallbackRedirectUrl :: Maybe Text
openidCallbackCode :: Maybe Text
$sel:openidCallbackScope:OpenidCallback :: OpenidCallback -> Maybe Text
$sel:openidCallbackRedirectUrl:OpenidCallback :: OpenidCallback -> Maybe Text
$sel:openidCallbackCode:OpenidCallback :: OpenidCallback -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"code" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidCallbackCode
      , Key
"redirect_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidCallbackRedirectUrl
      , Key
"scope" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidCallbackScope
      ]


-- | Construct a value of type 'OpenidCallback' (by applying it's required fields, if any)
mkOpenidCallback
  :: OpenidCallback
mkOpenidCallback :: OpenidCallback
mkOpenidCallback =
  OpenidCallback :: Maybe Text -> Maybe Text -> Maybe Text -> OpenidCallback
OpenidCallback
  { $sel:openidCallbackCode:OpenidCallback :: Maybe Text
openidCallbackCode = Maybe Text
forall a. Maybe a
Nothing
  , $sel:openidCallbackRedirectUrl:OpenidCallback :: Maybe Text
openidCallbackRedirectUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:openidCallbackScope:OpenidCallback :: Maybe Text
openidCallbackScope = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OpenidProvider
-- | OpenidProvider
data OpenidProvider = OpenidProvider
  { OpenidProvider -> Maybe Text
openidProviderAuthUrl :: !(Maybe Text) -- ^ "auth_url"
  , OpenidProvider -> Maybe Text
openidProviderClientId :: !(Maybe Text) -- ^ "client_id"
  , OpenidProvider -> Maybe Text
openidProviderKey :: !(Maybe Text) -- ^ "key"
  , OpenidProvider -> Maybe Text
openidProviderLogoutUrl :: !(Maybe Text) -- ^ "logout_url"
  , OpenidProvider -> Maybe Text
openidProviderName :: !(Maybe Text) -- ^ "name"
  , OpenidProvider -> Maybe Text
openidProviderScope :: !(Maybe Text) -- ^ "scope"
  } deriving (Int -> OpenidProvider -> ShowS
[OpenidProvider] -> ShowS
OpenidProvider -> String
(Int -> OpenidProvider -> ShowS)
-> (OpenidProvider -> String)
-> ([OpenidProvider] -> ShowS)
-> Show OpenidProvider
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenidProvider] -> ShowS
$cshowList :: [OpenidProvider] -> ShowS
show :: OpenidProvider -> String
$cshow :: OpenidProvider -> String
showsPrec :: Int -> OpenidProvider -> ShowS
$cshowsPrec :: Int -> OpenidProvider -> ShowS
P.Show, OpenidProvider -> OpenidProvider -> Bool
(OpenidProvider -> OpenidProvider -> Bool)
-> (OpenidProvider -> OpenidProvider -> Bool) -> Eq OpenidProvider
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenidProvider -> OpenidProvider -> Bool
$c/= :: OpenidProvider -> OpenidProvider -> Bool
== :: OpenidProvider -> OpenidProvider -> Bool
$c== :: OpenidProvider -> OpenidProvider -> Bool
P.Eq, P.Typeable)

-- | FromJSON OpenidProvider
instance A.FromJSON OpenidProvider where
  parseJSON :: Value -> Parser OpenidProvider
parseJSON = String
-> (Object -> Parser OpenidProvider)
-> Value
-> Parser OpenidProvider
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OpenidProvider" ((Object -> Parser OpenidProvider)
 -> Value -> Parser OpenidProvider)
-> (Object -> Parser OpenidProvider)
-> Value
-> Parser OpenidProvider
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> OpenidProvider
OpenidProvider
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> OpenidProvider)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> OpenidProvider)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"auth_url")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> OpenidProvider)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> OpenidProvider)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_id")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> OpenidProvider)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> OpenidProvider)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> OpenidProvider)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> OpenidProvider)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logout_url")
      Parser (Maybe Text -> Maybe Text -> OpenidProvider)
-> Parser (Maybe Text) -> Parser (Maybe Text -> OpenidProvider)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> OpenidProvider)
-> Parser (Maybe Text) -> Parser OpenidProvider
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope")

-- | ToJSON OpenidProvider
instance A.ToJSON OpenidProvider where
  toJSON :: OpenidProvider -> Value
toJSON OpenidProvider {Maybe Text
openidProviderScope :: Maybe Text
openidProviderName :: Maybe Text
openidProviderLogoutUrl :: Maybe Text
openidProviderKey :: Maybe Text
openidProviderClientId :: Maybe Text
openidProviderAuthUrl :: Maybe Text
$sel:openidProviderScope:OpenidProvider :: OpenidProvider -> Maybe Text
$sel:openidProviderName:OpenidProvider :: OpenidProvider -> Maybe Text
$sel:openidProviderLogoutUrl:OpenidProvider :: OpenidProvider -> Maybe Text
$sel:openidProviderKey:OpenidProvider :: OpenidProvider -> Maybe Text
$sel:openidProviderClientId:OpenidProvider :: OpenidProvider -> Maybe Text
$sel:openidProviderAuthUrl:OpenidProvider :: OpenidProvider -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"auth_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidProviderAuthUrl
      , Key
"client_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidProviderClientId
      , Key
"key" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidProviderKey
      , Key
"logout_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidProviderLogoutUrl
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidProviderName
      , Key
"scope" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openidProviderScope
      ]


-- | Construct a value of type 'OpenidProvider' (by applying it's required fields, if any)
mkOpenidProvider
  :: OpenidProvider
mkOpenidProvider :: OpenidProvider
mkOpenidProvider =
  OpenidProvider :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> OpenidProvider
OpenidProvider
  { $sel:openidProviderAuthUrl:OpenidProvider :: Maybe Text
openidProviderAuthUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:openidProviderClientId:OpenidProvider :: Maybe Text
openidProviderClientId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:openidProviderKey:OpenidProvider :: Maybe Text
openidProviderKey = Maybe Text
forall a. Maybe a
Nothing
  , $sel:openidProviderLogoutUrl:OpenidProvider :: Maybe Text
openidProviderLogoutUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:openidProviderName:OpenidProvider :: Maybe Text
openidProviderName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:openidProviderScope:OpenidProvider :: Maybe Text
openidProviderScope = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** TodoistMigration
-- | TodoistMigration
data TodoistMigration = TodoistMigration
  { TodoistMigration -> Maybe Text
todoistMigrationCode :: !(Maybe Text) -- ^ "code"
  } deriving (Int -> TodoistMigration -> ShowS
[TodoistMigration] -> ShowS
TodoistMigration -> String
(Int -> TodoistMigration -> ShowS)
-> (TodoistMigration -> String)
-> ([TodoistMigration] -> ShowS)
-> Show TodoistMigration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoistMigration] -> ShowS
$cshowList :: [TodoistMigration] -> ShowS
show :: TodoistMigration -> String
$cshow :: TodoistMigration -> String
showsPrec :: Int -> TodoistMigration -> ShowS
$cshowsPrec :: Int -> TodoistMigration -> ShowS
P.Show, TodoistMigration -> TodoistMigration -> Bool
(TodoistMigration -> TodoistMigration -> Bool)
-> (TodoistMigration -> TodoistMigration -> Bool)
-> Eq TodoistMigration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoistMigration -> TodoistMigration -> Bool
$c/= :: TodoistMigration -> TodoistMigration -> Bool
== :: TodoistMigration -> TodoistMigration -> Bool
$c== :: TodoistMigration -> TodoistMigration -> Bool
P.Eq, P.Typeable)

-- | FromJSON TodoistMigration
instance A.FromJSON TodoistMigration where
  parseJSON :: Value -> Parser TodoistMigration
parseJSON = String
-> (Object -> Parser TodoistMigration)
-> Value
-> Parser TodoistMigration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TodoistMigration" ((Object -> Parser TodoistMigration)
 -> Value -> Parser TodoistMigration)
-> (Object -> Parser TodoistMigration)
-> Value
-> Parser TodoistMigration
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> TodoistMigration
TodoistMigration
      (Maybe Text -> TodoistMigration)
-> Parser (Maybe Text) -> Parser TodoistMigration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code")

-- | ToJSON TodoistMigration
instance A.ToJSON TodoistMigration where
  toJSON :: TodoistMigration -> Value
toJSON TodoistMigration {Maybe Text
todoistMigrationCode :: Maybe Text
$sel:todoistMigrationCode:TodoistMigration :: TodoistMigration -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"code" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
todoistMigrationCode
      ]


-- | Construct a value of type 'TodoistMigration' (by applying it's required fields, if any)
mkTodoistMigration
  :: TodoistMigration
mkTodoistMigration :: TodoistMigration
mkTodoistMigration =
  TodoistMigration :: Maybe Text -> TodoistMigration
TodoistMigration
  { $sel:todoistMigrationCode:TodoistMigration :: Maybe Text
todoistMigrationCode = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** TrelloMigration
-- | TrelloMigration
data TrelloMigration = TrelloMigration
  { TrelloMigration -> Maybe Text
trelloMigrationCode :: !(Maybe Text) -- ^ "code"
  } deriving (Int -> TrelloMigration -> ShowS
[TrelloMigration] -> ShowS
TrelloMigration -> String
(Int -> TrelloMigration -> ShowS)
-> (TrelloMigration -> String)
-> ([TrelloMigration] -> ShowS)
-> Show TrelloMigration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrelloMigration] -> ShowS
$cshowList :: [TrelloMigration] -> ShowS
show :: TrelloMigration -> String
$cshow :: TrelloMigration -> String
showsPrec :: Int -> TrelloMigration -> ShowS
$cshowsPrec :: Int -> TrelloMigration -> ShowS
P.Show, TrelloMigration -> TrelloMigration -> Bool
(TrelloMigration -> TrelloMigration -> Bool)
-> (TrelloMigration -> TrelloMigration -> Bool)
-> Eq TrelloMigration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrelloMigration -> TrelloMigration -> Bool
$c/= :: TrelloMigration -> TrelloMigration -> Bool
== :: TrelloMigration -> TrelloMigration -> Bool
$c== :: TrelloMigration -> TrelloMigration -> Bool
P.Eq, P.Typeable)

-- | FromJSON TrelloMigration
instance A.FromJSON TrelloMigration where
  parseJSON :: Value -> Parser TrelloMigration
parseJSON = String
-> (Object -> Parser TrelloMigration)
-> Value
-> Parser TrelloMigration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TrelloMigration" ((Object -> Parser TrelloMigration)
 -> Value -> Parser TrelloMigration)
-> (Object -> Parser TrelloMigration)
-> Value
-> Parser TrelloMigration
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> TrelloMigration
TrelloMigration
      (Maybe Text -> TrelloMigration)
-> Parser (Maybe Text) -> Parser TrelloMigration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code")

-- | ToJSON TrelloMigration
instance A.ToJSON TrelloMigration where
  toJSON :: TrelloMigration -> Value
toJSON TrelloMigration {Maybe Text
trelloMigrationCode :: Maybe Text
$sel:trelloMigrationCode:TrelloMigration :: TrelloMigration -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"code" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
trelloMigrationCode
      ]


-- | Construct a value of type 'TrelloMigration' (by applying it's required fields, if any)
mkTrelloMigration
  :: TrelloMigration
mkTrelloMigration :: TrelloMigration
mkTrelloMigration =
  TrelloMigration :: Maybe Text -> TrelloMigration
TrelloMigration
  { $sel:trelloMigrationCode:TrelloMigration :: Maybe Text
trelloMigrationCode = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserAPIUserPassword
-- | UserAPIUserPassword
data UserAPIUserPassword = UserAPIUserPassword
  { UserAPIUserPassword -> Maybe Text
userAPIUserPasswordEmail :: !(Maybe Text) -- ^ "email" - The user&#39;s email address
  , UserAPIUserPassword -> Maybe Int
userAPIUserPasswordId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this user.
  , UserAPIUserPassword -> Maybe Text
userAPIUserPasswordPassword :: !(Maybe Text) -- ^ "password" - The user&#39;s password in clear text. Only used when registering the user. The maximum limi is 72 bytes, which may be less than 72 characters. This is due to the limit in the bcrypt hashing algorithm used to store passwords in Vikunja.
  , UserAPIUserPassword -> Maybe Text
userAPIUserPasswordUsername :: !(Maybe Text) -- ^ "username" - The user&#39;s username. Cannot contain anything that looks like an url or whitespaces.
  } deriving (Int -> UserAPIUserPassword -> ShowS
[UserAPIUserPassword] -> ShowS
UserAPIUserPassword -> String
(Int -> UserAPIUserPassword -> ShowS)
-> (UserAPIUserPassword -> String)
-> ([UserAPIUserPassword] -> ShowS)
-> Show UserAPIUserPassword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserAPIUserPassword] -> ShowS
$cshowList :: [UserAPIUserPassword] -> ShowS
show :: UserAPIUserPassword -> String
$cshow :: UserAPIUserPassword -> String
showsPrec :: Int -> UserAPIUserPassword -> ShowS
$cshowsPrec :: Int -> UserAPIUserPassword -> ShowS
P.Show, UserAPIUserPassword -> UserAPIUserPassword -> Bool
(UserAPIUserPassword -> UserAPIUserPassword -> Bool)
-> (UserAPIUserPassword -> UserAPIUserPassword -> Bool)
-> Eq UserAPIUserPassword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserAPIUserPassword -> UserAPIUserPassword -> Bool
$c/= :: UserAPIUserPassword -> UserAPIUserPassword -> Bool
== :: UserAPIUserPassword -> UserAPIUserPassword -> Bool
$c== :: UserAPIUserPassword -> UserAPIUserPassword -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserAPIUserPassword
instance A.FromJSON UserAPIUserPassword where
  parseJSON :: Value -> Parser UserAPIUserPassword
parseJSON = String
-> (Object -> Parser UserAPIUserPassword)
-> Value
-> Parser UserAPIUserPassword
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserAPIUserPassword" ((Object -> Parser UserAPIUserPassword)
 -> Value -> Parser UserAPIUserPassword)
-> (Object -> Parser UserAPIUserPassword)
-> Value
-> Parser UserAPIUserPassword
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Int -> Maybe Text -> Maybe Text -> UserAPIUserPassword
UserAPIUserPassword
      (Maybe Text
 -> Maybe Int -> Maybe Text -> Maybe Text -> UserAPIUserPassword)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int -> Maybe Text -> Maybe Text -> UserAPIUserPassword)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Int -> Maybe Text -> Maybe Text -> UserAPIUserPassword)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> Maybe Text -> UserAPIUserPassword)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> UserAPIUserPassword)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> UserAPIUserPassword)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")
      Parser (Maybe Text -> UserAPIUserPassword)
-> Parser (Maybe Text) -> Parser UserAPIUserPassword
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON UserAPIUserPassword
instance A.ToJSON UserAPIUserPassword where
  toJSON :: UserAPIUserPassword -> Value
toJSON UserAPIUserPassword {Maybe Int
Maybe Text
userAPIUserPasswordUsername :: Maybe Text
userAPIUserPasswordPassword :: Maybe Text
userAPIUserPasswordId :: Maybe Int
userAPIUserPasswordEmail :: Maybe Text
$sel:userAPIUserPasswordUsername:UserAPIUserPassword :: UserAPIUserPassword -> Maybe Text
$sel:userAPIUserPasswordPassword:UserAPIUserPassword :: UserAPIUserPassword -> Maybe Text
$sel:userAPIUserPasswordId:UserAPIUserPassword :: UserAPIUserPassword -> Maybe Int
$sel:userAPIUserPasswordEmail:UserAPIUserPassword :: UserAPIUserPassword -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userAPIUserPasswordEmail
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
userAPIUserPasswordId
      , Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userAPIUserPasswordPassword
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userAPIUserPasswordUsername
      ]


-- | Construct a value of type 'UserAPIUserPassword' (by applying it's required fields, if any)
mkUserAPIUserPassword
  :: UserAPIUserPassword
mkUserAPIUserPassword :: UserAPIUserPassword
mkUserAPIUserPassword =
  UserAPIUserPassword :: Maybe Text
-> Maybe Int -> Maybe Text -> Maybe Text -> UserAPIUserPassword
UserAPIUserPassword
  { $sel:userAPIUserPasswordEmail:UserAPIUserPassword :: Maybe Text
userAPIUserPasswordEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userAPIUserPasswordId:UserAPIUserPassword :: Maybe Int
userAPIUserPasswordId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:userAPIUserPasswordPassword:UserAPIUserPassword :: Maybe Text
userAPIUserPasswordPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userAPIUserPasswordUsername:UserAPIUserPassword :: Maybe Text
userAPIUserPasswordUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserEmailConfirm
-- | UserEmailConfirm
data UserEmailConfirm = UserEmailConfirm
  { UserEmailConfirm -> Maybe Text
userEmailConfirmToken :: !(Maybe Text) -- ^ "token" - The email confirm token sent via email.
  } deriving (Int -> UserEmailConfirm -> ShowS
[UserEmailConfirm] -> ShowS
UserEmailConfirm -> String
(Int -> UserEmailConfirm -> ShowS)
-> (UserEmailConfirm -> String)
-> ([UserEmailConfirm] -> ShowS)
-> Show UserEmailConfirm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserEmailConfirm] -> ShowS
$cshowList :: [UserEmailConfirm] -> ShowS
show :: UserEmailConfirm -> String
$cshow :: UserEmailConfirm -> String
showsPrec :: Int -> UserEmailConfirm -> ShowS
$cshowsPrec :: Int -> UserEmailConfirm -> ShowS
P.Show, UserEmailConfirm -> UserEmailConfirm -> Bool
(UserEmailConfirm -> UserEmailConfirm -> Bool)
-> (UserEmailConfirm -> UserEmailConfirm -> Bool)
-> Eq UserEmailConfirm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserEmailConfirm -> UserEmailConfirm -> Bool
$c/= :: UserEmailConfirm -> UserEmailConfirm -> Bool
== :: UserEmailConfirm -> UserEmailConfirm -> Bool
$c== :: UserEmailConfirm -> UserEmailConfirm -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserEmailConfirm
instance A.FromJSON UserEmailConfirm where
  parseJSON :: Value -> Parser UserEmailConfirm
parseJSON = String
-> (Object -> Parser UserEmailConfirm)
-> Value
-> Parser UserEmailConfirm
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserEmailConfirm" ((Object -> Parser UserEmailConfirm)
 -> Value -> Parser UserEmailConfirm)
-> (Object -> Parser UserEmailConfirm)
-> Value
-> Parser UserEmailConfirm
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> UserEmailConfirm
UserEmailConfirm
      (Maybe Text -> UserEmailConfirm)
-> Parser (Maybe Text) -> Parser UserEmailConfirm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token")

-- | ToJSON UserEmailConfirm
instance A.ToJSON UserEmailConfirm where
  toJSON :: UserEmailConfirm -> Value
toJSON UserEmailConfirm {Maybe Text
userEmailConfirmToken :: Maybe Text
$sel:userEmailConfirmToken:UserEmailConfirm :: UserEmailConfirm -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userEmailConfirmToken
      ]


-- | Construct a value of type 'UserEmailConfirm' (by applying it's required fields, if any)
mkUserEmailConfirm
  :: UserEmailConfirm
mkUserEmailConfirm :: UserEmailConfirm
mkUserEmailConfirm =
  UserEmailConfirm :: Maybe Text -> UserEmailConfirm
UserEmailConfirm
  { $sel:userEmailConfirmToken:UserEmailConfirm :: Maybe Text
userEmailConfirmToken = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserEmailUpdate
-- | UserEmailUpdate
data UserEmailUpdate = UserEmailUpdate
  { UserEmailUpdate -> Maybe Text
userEmailUpdateNewEmail :: !(Maybe Text) -- ^ "new_email" - The new email address. Needs to be a valid email address.
  , UserEmailUpdate -> Maybe Text
userEmailUpdatePassword :: !(Maybe Text) -- ^ "password" - The password of the user for confirmation.
  } deriving (Int -> UserEmailUpdate -> ShowS
[UserEmailUpdate] -> ShowS
UserEmailUpdate -> String
(Int -> UserEmailUpdate -> ShowS)
-> (UserEmailUpdate -> String)
-> ([UserEmailUpdate] -> ShowS)
-> Show UserEmailUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserEmailUpdate] -> ShowS
$cshowList :: [UserEmailUpdate] -> ShowS
show :: UserEmailUpdate -> String
$cshow :: UserEmailUpdate -> String
showsPrec :: Int -> UserEmailUpdate -> ShowS
$cshowsPrec :: Int -> UserEmailUpdate -> ShowS
P.Show, UserEmailUpdate -> UserEmailUpdate -> Bool
(UserEmailUpdate -> UserEmailUpdate -> Bool)
-> (UserEmailUpdate -> UserEmailUpdate -> Bool)
-> Eq UserEmailUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserEmailUpdate -> UserEmailUpdate -> Bool
$c/= :: UserEmailUpdate -> UserEmailUpdate -> Bool
== :: UserEmailUpdate -> UserEmailUpdate -> Bool
$c== :: UserEmailUpdate -> UserEmailUpdate -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserEmailUpdate
instance A.FromJSON UserEmailUpdate where
  parseJSON :: Value -> Parser UserEmailUpdate
parseJSON = String
-> (Object -> Parser UserEmailUpdate)
-> Value
-> Parser UserEmailUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserEmailUpdate" ((Object -> Parser UserEmailUpdate)
 -> Value -> Parser UserEmailUpdate)
-> (Object -> Parser UserEmailUpdate)
-> Value
-> Parser UserEmailUpdate
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> UserEmailUpdate
UserEmailUpdate
      (Maybe Text -> Maybe Text -> UserEmailUpdate)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UserEmailUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_email")
      Parser (Maybe Text -> UserEmailUpdate)
-> Parser (Maybe Text) -> Parser UserEmailUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")

-- | ToJSON UserEmailUpdate
instance A.ToJSON UserEmailUpdate where
  toJSON :: UserEmailUpdate -> Value
toJSON UserEmailUpdate {Maybe Text
userEmailUpdatePassword :: Maybe Text
userEmailUpdateNewEmail :: Maybe Text
$sel:userEmailUpdatePassword:UserEmailUpdate :: UserEmailUpdate -> Maybe Text
$sel:userEmailUpdateNewEmail:UserEmailUpdate :: UserEmailUpdate -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"new_email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userEmailUpdateNewEmail
      , Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userEmailUpdatePassword
      ]


-- | Construct a value of type 'UserEmailUpdate' (by applying it's required fields, if any)
mkUserEmailUpdate
  :: UserEmailUpdate
mkUserEmailUpdate :: UserEmailUpdate
mkUserEmailUpdate =
  UserEmailUpdate :: Maybe Text -> Maybe Text -> UserEmailUpdate
UserEmailUpdate
  { $sel:userEmailUpdateNewEmail:UserEmailUpdate :: Maybe Text
userEmailUpdateNewEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userEmailUpdatePassword:UserEmailUpdate :: Maybe Text
userEmailUpdatePassword = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserLogin
-- | UserLogin
data UserLogin = UserLogin
  { UserLogin -> Maybe Bool
userLoginLongToken :: !(Maybe Bool) -- ^ "long_token" - If true, the token returned will be valid a lot longer than default. Useful for \&quot;remember me\&quot; style logins.
  , UserLogin -> Maybe Text
userLoginPassword :: !(Maybe Text) -- ^ "password" - The password for the user.
  , UserLogin -> Maybe Text
userLoginTotpPasscode :: !(Maybe Text) -- ^ "totp_passcode" - The totp passcode of a user. Only needs to be provided when enabled.
  , UserLogin -> Maybe Text
userLoginUsername :: !(Maybe Text) -- ^ "username" - The username used to log in.
  } deriving (Int -> UserLogin -> ShowS
[UserLogin] -> ShowS
UserLogin -> String
(Int -> UserLogin -> ShowS)
-> (UserLogin -> String)
-> ([UserLogin] -> ShowS)
-> Show UserLogin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserLogin] -> ShowS
$cshowList :: [UserLogin] -> ShowS
show :: UserLogin -> String
$cshow :: UserLogin -> String
showsPrec :: Int -> UserLogin -> ShowS
$cshowsPrec :: Int -> UserLogin -> ShowS
P.Show, UserLogin -> UserLogin -> Bool
(UserLogin -> UserLogin -> Bool)
-> (UserLogin -> UserLogin -> Bool) -> Eq UserLogin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserLogin -> UserLogin -> Bool
$c/= :: UserLogin -> UserLogin -> Bool
== :: UserLogin -> UserLogin -> Bool
$c== :: UserLogin -> UserLogin -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserLogin
instance A.FromJSON UserLogin where
  parseJSON :: Value -> Parser UserLogin
parseJSON = String -> (Object -> Parser UserLogin) -> Value -> Parser UserLogin
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserLogin" ((Object -> Parser UserLogin) -> Value -> Parser UserLogin)
-> (Object -> Parser UserLogin) -> Value -> Parser UserLogin
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> Maybe Text -> Maybe Text -> Maybe Text -> UserLogin
UserLogin
      (Maybe Bool -> Maybe Text -> Maybe Text -> Maybe Text -> UserLogin)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> UserLogin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"long_token")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> UserLogin)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> UserLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")
      Parser (Maybe Text -> Maybe Text -> UserLogin)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UserLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"totp_passcode")
      Parser (Maybe Text -> UserLogin)
-> Parser (Maybe Text) -> Parser UserLogin
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON UserLogin
instance A.ToJSON UserLogin where
  toJSON :: UserLogin -> Value
toJSON UserLogin {Maybe Bool
Maybe Text
userLoginUsername :: Maybe Text
userLoginTotpPasscode :: Maybe Text
userLoginPassword :: Maybe Text
userLoginLongToken :: Maybe Bool
$sel:userLoginUsername:UserLogin :: UserLogin -> Maybe Text
$sel:userLoginTotpPasscode:UserLogin :: UserLogin -> Maybe Text
$sel:userLoginPassword:UserLogin :: UserLogin -> Maybe Text
$sel:userLoginLongToken:UserLogin :: UserLogin -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"long_token" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
userLoginLongToken
      , Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userLoginPassword
      , Key
"totp_passcode" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userLoginTotpPasscode
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userLoginUsername
      ]


-- | Construct a value of type 'UserLogin' (by applying it's required fields, if any)
mkUserLogin
  :: UserLogin
mkUserLogin :: UserLogin
mkUserLogin =
  UserLogin :: Maybe Bool -> Maybe Text -> Maybe Text -> Maybe Text -> UserLogin
UserLogin
  { $sel:userLoginLongToken:UserLogin :: Maybe Bool
userLoginLongToken = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userLoginPassword:UserLogin :: Maybe Text
userLoginPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userLoginTotpPasscode:UserLogin :: Maybe Text
userLoginTotpPasscode = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userLoginUsername:UserLogin :: Maybe Text
userLoginUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserPasswordReset
-- | UserPasswordReset
data UserPasswordReset = UserPasswordReset
  { UserPasswordReset -> Maybe Text
userPasswordResetNewPassword :: !(Maybe Text) -- ^ "new_password" - The new password for this user.
  , UserPasswordReset -> Maybe Text
userPasswordResetToken :: !(Maybe Text) -- ^ "token" - The previously issued reset token.
  } deriving (Int -> UserPasswordReset -> ShowS
[UserPasswordReset] -> ShowS
UserPasswordReset -> String
(Int -> UserPasswordReset -> ShowS)
-> (UserPasswordReset -> String)
-> ([UserPasswordReset] -> ShowS)
-> Show UserPasswordReset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserPasswordReset] -> ShowS
$cshowList :: [UserPasswordReset] -> ShowS
show :: UserPasswordReset -> String
$cshow :: UserPasswordReset -> String
showsPrec :: Int -> UserPasswordReset -> ShowS
$cshowsPrec :: Int -> UserPasswordReset -> ShowS
P.Show, UserPasswordReset -> UserPasswordReset -> Bool
(UserPasswordReset -> UserPasswordReset -> Bool)
-> (UserPasswordReset -> UserPasswordReset -> Bool)
-> Eq UserPasswordReset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPasswordReset -> UserPasswordReset -> Bool
$c/= :: UserPasswordReset -> UserPasswordReset -> Bool
== :: UserPasswordReset -> UserPasswordReset -> Bool
$c== :: UserPasswordReset -> UserPasswordReset -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserPasswordReset
instance A.FromJSON UserPasswordReset where
  parseJSON :: Value -> Parser UserPasswordReset
parseJSON = String
-> (Object -> Parser UserPasswordReset)
-> Value
-> Parser UserPasswordReset
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserPasswordReset" ((Object -> Parser UserPasswordReset)
 -> Value -> Parser UserPasswordReset)
-> (Object -> Parser UserPasswordReset)
-> Value
-> Parser UserPasswordReset
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> UserPasswordReset
UserPasswordReset
      (Maybe Text -> Maybe Text -> UserPasswordReset)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UserPasswordReset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_password")
      Parser (Maybe Text -> UserPasswordReset)
-> Parser (Maybe Text) -> Parser UserPasswordReset
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token")

-- | ToJSON UserPasswordReset
instance A.ToJSON UserPasswordReset where
  toJSON :: UserPasswordReset -> Value
toJSON UserPasswordReset {Maybe Text
userPasswordResetToken :: Maybe Text
userPasswordResetNewPassword :: Maybe Text
$sel:userPasswordResetToken:UserPasswordReset :: UserPasswordReset -> Maybe Text
$sel:userPasswordResetNewPassword:UserPasswordReset :: UserPasswordReset -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"new_password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userPasswordResetNewPassword
      , Key
"token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userPasswordResetToken
      ]


-- | Construct a value of type 'UserPasswordReset' (by applying it's required fields, if any)
mkUserPasswordReset
  :: UserPasswordReset
mkUserPasswordReset :: UserPasswordReset
mkUserPasswordReset =
  UserPasswordReset :: Maybe Text -> Maybe Text -> UserPasswordReset
UserPasswordReset
  { $sel:userPasswordResetNewPassword:UserPasswordReset :: Maybe Text
userPasswordResetNewPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userPasswordResetToken:UserPasswordReset :: Maybe Text
userPasswordResetToken = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserPasswordTokenRequest
-- | UserPasswordTokenRequest
data UserPasswordTokenRequest = UserPasswordTokenRequest
  { UserPasswordTokenRequest -> Maybe Text
userPasswordTokenRequestEmail :: !(Maybe Text) -- ^ "email"
  } deriving (Int -> UserPasswordTokenRequest -> ShowS
[UserPasswordTokenRequest] -> ShowS
UserPasswordTokenRequest -> String
(Int -> UserPasswordTokenRequest -> ShowS)
-> (UserPasswordTokenRequest -> String)
-> ([UserPasswordTokenRequest] -> ShowS)
-> Show UserPasswordTokenRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserPasswordTokenRequest] -> ShowS
$cshowList :: [UserPasswordTokenRequest] -> ShowS
show :: UserPasswordTokenRequest -> String
$cshow :: UserPasswordTokenRequest -> String
showsPrec :: Int -> UserPasswordTokenRequest -> ShowS
$cshowsPrec :: Int -> UserPasswordTokenRequest -> ShowS
P.Show, UserPasswordTokenRequest -> UserPasswordTokenRequest -> Bool
(UserPasswordTokenRequest -> UserPasswordTokenRequest -> Bool)
-> (UserPasswordTokenRequest -> UserPasswordTokenRequest -> Bool)
-> Eq UserPasswordTokenRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPasswordTokenRequest -> UserPasswordTokenRequest -> Bool
$c/= :: UserPasswordTokenRequest -> UserPasswordTokenRequest -> Bool
== :: UserPasswordTokenRequest -> UserPasswordTokenRequest -> Bool
$c== :: UserPasswordTokenRequest -> UserPasswordTokenRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserPasswordTokenRequest
instance A.FromJSON UserPasswordTokenRequest where
  parseJSON :: Value -> Parser UserPasswordTokenRequest
parseJSON = String
-> (Object -> Parser UserPasswordTokenRequest)
-> Value
-> Parser UserPasswordTokenRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserPasswordTokenRequest" ((Object -> Parser UserPasswordTokenRequest)
 -> Value -> Parser UserPasswordTokenRequest)
-> (Object -> Parser UserPasswordTokenRequest)
-> Value
-> Parser UserPasswordTokenRequest
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> UserPasswordTokenRequest
UserPasswordTokenRequest
      (Maybe Text -> UserPasswordTokenRequest)
-> Parser (Maybe Text) -> Parser UserPasswordTokenRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")

-- | ToJSON UserPasswordTokenRequest
instance A.ToJSON UserPasswordTokenRequest where
  toJSON :: UserPasswordTokenRequest -> Value
toJSON UserPasswordTokenRequest {Maybe Text
userPasswordTokenRequestEmail :: Maybe Text
$sel:userPasswordTokenRequestEmail:UserPasswordTokenRequest :: UserPasswordTokenRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userPasswordTokenRequestEmail
      ]


-- | Construct a value of type 'UserPasswordTokenRequest' (by applying it's required fields, if any)
mkUserPasswordTokenRequest
  :: UserPasswordTokenRequest
mkUserPasswordTokenRequest :: UserPasswordTokenRequest
mkUserPasswordTokenRequest =
  UserPasswordTokenRequest :: Maybe Text -> UserPasswordTokenRequest
UserPasswordTokenRequest
  { $sel:userPasswordTokenRequestEmail:UserPasswordTokenRequest :: Maybe Text
userPasswordTokenRequestEmail = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserTOTP
-- | UserTOTP
data UserTOTP = UserTOTP
  { UserTOTP -> Maybe Bool
userTOTPEnabled :: !(Maybe Bool) -- ^ "enabled" - The totp entry will only be enabled after the user verified they have a working totp setup.
  , UserTOTP -> Maybe Text
userTOTPSecret :: !(Maybe Text) -- ^ "secret"
  , UserTOTP -> Maybe Text
userTOTPUrl :: !(Maybe Text) -- ^ "url" - The totp url used to be able to enroll the user later
  } deriving (Int -> UserTOTP -> ShowS
[UserTOTP] -> ShowS
UserTOTP -> String
(Int -> UserTOTP -> ShowS)
-> (UserTOTP -> String) -> ([UserTOTP] -> ShowS) -> Show UserTOTP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserTOTP] -> ShowS
$cshowList :: [UserTOTP] -> ShowS
show :: UserTOTP -> String
$cshow :: UserTOTP -> String
showsPrec :: Int -> UserTOTP -> ShowS
$cshowsPrec :: Int -> UserTOTP -> ShowS
P.Show, UserTOTP -> UserTOTP -> Bool
(UserTOTP -> UserTOTP -> Bool)
-> (UserTOTP -> UserTOTP -> Bool) -> Eq UserTOTP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserTOTP -> UserTOTP -> Bool
$c/= :: UserTOTP -> UserTOTP -> Bool
== :: UserTOTP -> UserTOTP -> Bool
$c== :: UserTOTP -> UserTOTP -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserTOTP
instance A.FromJSON UserTOTP where
  parseJSON :: Value -> Parser UserTOTP
parseJSON = String -> (Object -> Parser UserTOTP) -> Value -> Parser UserTOTP
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserTOTP" ((Object -> Parser UserTOTP) -> Value -> Parser UserTOTP)
-> (Object -> Parser UserTOTP) -> Value -> Parser UserTOTP
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> Maybe Text -> Maybe Text -> UserTOTP
UserTOTP
      (Maybe Bool -> Maybe Text -> Maybe Text -> UserTOTP)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Text -> UserTOTP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enabled")
      Parser (Maybe Text -> Maybe Text -> UserTOTP)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UserTOTP)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"secret")
      Parser (Maybe Text -> UserTOTP)
-> Parser (Maybe Text) -> Parser UserTOTP
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON UserTOTP
instance A.ToJSON UserTOTP where
  toJSON :: UserTOTP -> Value
toJSON UserTOTP {Maybe Bool
Maybe Text
userTOTPUrl :: Maybe Text
userTOTPSecret :: Maybe Text
userTOTPEnabled :: Maybe Bool
$sel:userTOTPUrl:UserTOTP :: UserTOTP -> Maybe Text
$sel:userTOTPSecret:UserTOTP :: UserTOTP -> Maybe Text
$sel:userTOTPEnabled:UserTOTP :: UserTOTP -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
userTOTPEnabled
      , Key
"secret" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userTOTPSecret
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userTOTPUrl
      ]


-- | Construct a value of type 'UserTOTP' (by applying it's required fields, if any)
mkUserTOTP
  :: UserTOTP
mkUserTOTP :: UserTOTP
mkUserTOTP =
  UserTOTP :: Maybe Bool -> Maybe Text -> Maybe Text -> UserTOTP
UserTOTP
  { $sel:userTOTPEnabled:UserTOTP :: Maybe Bool
userTOTPEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userTOTPSecret:UserTOTP :: Maybe Text
userTOTPSecret = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userTOTPUrl:UserTOTP :: Maybe Text
userTOTPUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserTOTPPasscode
-- | UserTOTPPasscode
data UserTOTPPasscode = UserTOTPPasscode
  { UserTOTPPasscode -> Maybe Text
userTOTPPasscodePasscode :: !(Maybe Text) -- ^ "passcode"
  } deriving (Int -> UserTOTPPasscode -> ShowS
[UserTOTPPasscode] -> ShowS
UserTOTPPasscode -> String
(Int -> UserTOTPPasscode -> ShowS)
-> (UserTOTPPasscode -> String)
-> ([UserTOTPPasscode] -> ShowS)
-> Show UserTOTPPasscode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserTOTPPasscode] -> ShowS
$cshowList :: [UserTOTPPasscode] -> ShowS
show :: UserTOTPPasscode -> String
$cshow :: UserTOTPPasscode -> String
showsPrec :: Int -> UserTOTPPasscode -> ShowS
$cshowsPrec :: Int -> UserTOTPPasscode -> ShowS
P.Show, UserTOTPPasscode -> UserTOTPPasscode -> Bool
(UserTOTPPasscode -> UserTOTPPasscode -> Bool)
-> (UserTOTPPasscode -> UserTOTPPasscode -> Bool)
-> Eq UserTOTPPasscode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserTOTPPasscode -> UserTOTPPasscode -> Bool
$c/= :: UserTOTPPasscode -> UserTOTPPasscode -> Bool
== :: UserTOTPPasscode -> UserTOTPPasscode -> Bool
$c== :: UserTOTPPasscode -> UserTOTPPasscode -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserTOTPPasscode
instance A.FromJSON UserTOTPPasscode where
  parseJSON :: Value -> Parser UserTOTPPasscode
parseJSON = String
-> (Object -> Parser UserTOTPPasscode)
-> Value
-> Parser UserTOTPPasscode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserTOTPPasscode" ((Object -> Parser UserTOTPPasscode)
 -> Value -> Parser UserTOTPPasscode)
-> (Object -> Parser UserTOTPPasscode)
-> Value
-> Parser UserTOTPPasscode
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> UserTOTPPasscode
UserTOTPPasscode
      (Maybe Text -> UserTOTPPasscode)
-> Parser (Maybe Text) -> Parser UserTOTPPasscode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"passcode")

-- | ToJSON UserTOTPPasscode
instance A.ToJSON UserTOTPPasscode where
  toJSON :: UserTOTPPasscode -> Value
toJSON UserTOTPPasscode {Maybe Text
userTOTPPasscodePasscode :: Maybe Text
$sel:userTOTPPasscodePasscode:UserTOTPPasscode :: UserTOTPPasscode -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"passcode" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userTOTPPasscodePasscode
      ]


-- | Construct a value of type 'UserTOTPPasscode' (by applying it's required fields, if any)
mkUserTOTPPasscode
  :: UserTOTPPasscode
mkUserTOTPPasscode :: UserTOTPPasscode
mkUserTOTPPasscode =
  UserTOTPPasscode :: Maybe Text -> UserTOTPPasscode
UserTOTPPasscode
  { $sel:userTOTPPasscodePasscode:UserTOTPPasscode :: Maybe Text
userTOTPPasscodePasscode = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserToken
-- | UserToken
data UserToken = UserToken
  { UserToken -> Maybe Text
userTokenCreated :: !(Maybe Text) -- ^ "created"
  , UserToken -> Maybe Int
userTokenId :: !(Maybe Int) -- ^ "id"
  , UserToken -> Maybe Text
userTokenToken :: !(Maybe Text) -- ^ "token"
  } deriving (Int -> UserToken -> ShowS
[UserToken] -> ShowS
UserToken -> String
(Int -> UserToken -> ShowS)
-> (UserToken -> String)
-> ([UserToken] -> ShowS)
-> Show UserToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserToken] -> ShowS
$cshowList :: [UserToken] -> ShowS
show :: UserToken -> String
$cshow :: UserToken -> String
showsPrec :: Int -> UserToken -> ShowS
$cshowsPrec :: Int -> UserToken -> ShowS
P.Show, UserToken -> UserToken -> Bool
(UserToken -> UserToken -> Bool)
-> (UserToken -> UserToken -> Bool) -> Eq UserToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserToken -> UserToken -> Bool
$c/= :: UserToken -> UserToken -> Bool
== :: UserToken -> UserToken -> Bool
$c== :: UserToken -> UserToken -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserToken
instance A.FromJSON UserToken where
  parseJSON :: Value -> Parser UserToken
parseJSON = String -> (Object -> Parser UserToken) -> Value -> Parser UserToken
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserToken" ((Object -> Parser UserToken) -> Value -> Parser UserToken)
-> (Object -> Parser UserToken) -> Value -> Parser UserToken
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Int -> Maybe Text -> UserToken
UserToken
      (Maybe Text -> Maybe Int -> Maybe Text -> UserToken)
-> Parser (Maybe Text)
-> Parser (Maybe Int -> Maybe Text -> UserToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Maybe Int -> Maybe Text -> UserToken)
-> Parser (Maybe Int) -> Parser (Maybe Text -> UserToken)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> UserToken)
-> Parser (Maybe Text) -> Parser UserToken
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token")

-- | ToJSON UserToken
instance A.ToJSON UserToken where
  toJSON :: UserToken -> Value
toJSON UserToken {Maybe Int
Maybe Text
userTokenToken :: Maybe Text
userTokenId :: Maybe Int
userTokenCreated :: Maybe Text
$sel:userTokenToken:UserToken :: UserToken -> Maybe Text
$sel:userTokenId:UserToken :: UserToken -> Maybe Int
$sel:userTokenCreated:UserToken :: UserToken -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userTokenCreated
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
userTokenId
      , Key
"token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userTokenToken
      ]


-- | Construct a value of type 'UserToken' (by applying it's required fields, if any)
mkUserToken
  :: UserToken
mkUserToken :: UserToken
mkUserToken =
  UserToken :: Maybe Text -> Maybe Int -> Maybe Text -> UserToken
UserToken
  { $sel:userTokenCreated:UserToken :: Maybe Text
userTokenCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userTokenId:UserToken :: Maybe Int
userTokenId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:userTokenToken:UserToken :: Maybe Text
userTokenToken = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserUser
-- | UserUser
data UserUser = UserUser
  { UserUser -> Maybe Text
userUserCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this task was created. You cannot change this value.
  , UserUser -> Maybe Text
userUserEmail :: !(Maybe Text) -- ^ "email" - The user&#39;s email address.
  , UserUser -> Maybe Int
userUserId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this user.
  , UserUser -> Maybe Text
userUserName :: !(Maybe Text) -- ^ "name" - The full name of the user.
  , UserUser -> Maybe Text
userUserUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this task was last updated. You cannot change this value.
  , UserUser -> Maybe Text
userUserUsername :: !(Maybe Text) -- ^ "username" - The username of the user. Is always unique.
  } deriving (Int -> UserUser -> ShowS
[UserUser] -> ShowS
UserUser -> String
(Int -> UserUser -> ShowS)
-> (UserUser -> String) -> ([UserUser] -> ShowS) -> Show UserUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserUser] -> ShowS
$cshowList :: [UserUser] -> ShowS
show :: UserUser -> String
$cshow :: UserUser -> String
showsPrec :: Int -> UserUser -> ShowS
$cshowsPrec :: Int -> UserUser -> ShowS
P.Show, UserUser -> UserUser -> Bool
(UserUser -> UserUser -> Bool)
-> (UserUser -> UserUser -> Bool) -> Eq UserUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserUser -> UserUser -> Bool
$c/= :: UserUser -> UserUser -> Bool
== :: UserUser -> UserUser -> Bool
$c== :: UserUser -> UserUser -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserUser
instance A.FromJSON UserUser where
  parseJSON :: Value -> Parser UserUser
parseJSON = String -> (Object -> Parser UserUser) -> Value -> Parser UserUser
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserUser" ((Object -> Parser UserUser) -> Value -> Parser UserUser)
-> (Object -> Parser UserUser) -> Value -> Parser UserUser
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> UserUser
UserUser
      (Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> UserUser)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int -> Maybe Text -> Maybe Text -> Maybe Text -> UserUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Int -> Maybe Text -> Maybe Text -> Maybe Text -> UserUser)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int -> Maybe Text -> Maybe Text -> Maybe Text -> UserUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Int -> Maybe Text -> Maybe Text -> Maybe Text -> UserUser)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> UserUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> UserUser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> UserUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Maybe Text -> UserUser)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UserUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")
      Parser (Maybe Text -> UserUser)
-> Parser (Maybe Text) -> Parser UserUser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON UserUser
instance A.ToJSON UserUser where
  toJSON :: UserUser -> Value
toJSON UserUser {Maybe Int
Maybe Text
userUserUsername :: Maybe Text
userUserUpdated :: Maybe Text
userUserName :: Maybe Text
userUserId :: Maybe Int
userUserEmail :: Maybe Text
userUserCreated :: Maybe Text
$sel:userUserUsername:UserUser :: UserUser -> Maybe Text
$sel:userUserUpdated:UserUser :: UserUser -> Maybe Text
$sel:userUserName:UserUser :: UserUser -> Maybe Text
$sel:userUserId:UserUser :: UserUser -> Maybe Int
$sel:userUserEmail:UserUser :: UserUser -> Maybe Text
$sel:userUserCreated:UserUser :: UserUser -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userUserCreated
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userUserEmail
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
userUserId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userUserName
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userUserUpdated
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userUserUsername
      ]


-- | Construct a value of type 'UserUser' (by applying it's required fields, if any)
mkUserUser
  :: UserUser
mkUserUser :: UserUser
mkUserUser =
  UserUser :: Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> UserUser
UserUser
  { $sel:userUserCreated:UserUser :: Maybe Text
userUserCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userUserEmail:UserUser :: Maybe Text
userUserEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userUserId:UserUser :: Maybe Int
userUserId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:userUserName:UserUser :: Maybe Text
userUserName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userUserUpdated:UserUser :: Maybe Text
userUserUpdated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userUserUsername:UserUser :: Maybe Text
userUserUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1AuthInfo
-- | V1AuthInfo
data V1AuthInfo = V1AuthInfo
  { V1AuthInfo -> Maybe V1LocalAuthInfo
v1AuthInfoLocal :: !(Maybe V1LocalAuthInfo) -- ^ "local"
  , V1AuthInfo -> Maybe V1OpenIDAuthInfo
v1AuthInfoOpenidConnect :: !(Maybe V1OpenIDAuthInfo) -- ^ "openid_connect"
  } deriving (Int -> V1AuthInfo -> ShowS
[V1AuthInfo] -> ShowS
V1AuthInfo -> String
(Int -> V1AuthInfo -> ShowS)
-> (V1AuthInfo -> String)
-> ([V1AuthInfo] -> ShowS)
-> Show V1AuthInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1AuthInfo] -> ShowS
$cshowList :: [V1AuthInfo] -> ShowS
show :: V1AuthInfo -> String
$cshow :: V1AuthInfo -> String
showsPrec :: Int -> V1AuthInfo -> ShowS
$cshowsPrec :: Int -> V1AuthInfo -> ShowS
P.Show, V1AuthInfo -> V1AuthInfo -> Bool
(V1AuthInfo -> V1AuthInfo -> Bool)
-> (V1AuthInfo -> V1AuthInfo -> Bool) -> Eq V1AuthInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1AuthInfo -> V1AuthInfo -> Bool
$c/= :: V1AuthInfo -> V1AuthInfo -> Bool
== :: V1AuthInfo -> V1AuthInfo -> Bool
$c== :: V1AuthInfo -> V1AuthInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1AuthInfo
instance A.FromJSON V1AuthInfo where
  parseJSON :: Value -> Parser V1AuthInfo
parseJSON = String
-> (Object -> Parser V1AuthInfo) -> Value -> Parser V1AuthInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1AuthInfo" ((Object -> Parser V1AuthInfo) -> Value -> Parser V1AuthInfo)
-> (Object -> Parser V1AuthInfo) -> Value -> Parser V1AuthInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe V1LocalAuthInfo -> Maybe V1OpenIDAuthInfo -> V1AuthInfo
V1AuthInfo
      (Maybe V1LocalAuthInfo -> Maybe V1OpenIDAuthInfo -> V1AuthInfo)
-> Parser (Maybe V1LocalAuthInfo)
-> Parser (Maybe V1OpenIDAuthInfo -> V1AuthInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe V1LocalAuthInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"local")
      Parser (Maybe V1OpenIDAuthInfo -> V1AuthInfo)
-> Parser (Maybe V1OpenIDAuthInfo) -> Parser V1AuthInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe V1OpenIDAuthInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"openid_connect")

-- | ToJSON V1AuthInfo
instance A.ToJSON V1AuthInfo where
  toJSON :: V1AuthInfo -> Value
toJSON V1AuthInfo {Maybe V1OpenIDAuthInfo
Maybe V1LocalAuthInfo
v1AuthInfoOpenidConnect :: Maybe V1OpenIDAuthInfo
v1AuthInfoLocal :: Maybe V1LocalAuthInfo
$sel:v1AuthInfoOpenidConnect:V1AuthInfo :: V1AuthInfo -> Maybe V1OpenIDAuthInfo
$sel:v1AuthInfoLocal:V1AuthInfo :: V1AuthInfo -> Maybe V1LocalAuthInfo
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"local" Key -> Maybe V1LocalAuthInfo -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe V1LocalAuthInfo
v1AuthInfoLocal
      , Key
"openid_connect" Key -> Maybe V1OpenIDAuthInfo -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe V1OpenIDAuthInfo
v1AuthInfoOpenidConnect
      ]


-- | Construct a value of type 'V1AuthInfo' (by applying it's required fields, if any)
mkV1AuthInfo
  :: V1AuthInfo
mkV1AuthInfo :: V1AuthInfo
mkV1AuthInfo =
  V1AuthInfo :: Maybe V1LocalAuthInfo -> Maybe V1OpenIDAuthInfo -> V1AuthInfo
V1AuthInfo
  { $sel:v1AuthInfoLocal:V1AuthInfo :: Maybe V1LocalAuthInfo
v1AuthInfoLocal = Maybe V1LocalAuthInfo
forall a. Maybe a
Nothing
  , $sel:v1AuthInfoOpenidConnect:V1AuthInfo :: Maybe V1OpenIDAuthInfo
v1AuthInfoOpenidConnect = Maybe V1OpenIDAuthInfo
forall a. Maybe a
Nothing
  }

-- ** V1LegalInfo
-- | V1LegalInfo
data V1LegalInfo = V1LegalInfo
  { V1LegalInfo -> Maybe Text
v1LegalInfoImprintUrl :: !(Maybe Text) -- ^ "imprint_url"
  , V1LegalInfo -> Maybe Text
v1LegalInfoPrivacyPolicyUrl :: !(Maybe Text) -- ^ "privacy_policy_url"
  } deriving (Int -> V1LegalInfo -> ShowS
[V1LegalInfo] -> ShowS
V1LegalInfo -> String
(Int -> V1LegalInfo -> ShowS)
-> (V1LegalInfo -> String)
-> ([V1LegalInfo] -> ShowS)
-> Show V1LegalInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1LegalInfo] -> ShowS
$cshowList :: [V1LegalInfo] -> ShowS
show :: V1LegalInfo -> String
$cshow :: V1LegalInfo -> String
showsPrec :: Int -> V1LegalInfo -> ShowS
$cshowsPrec :: Int -> V1LegalInfo -> ShowS
P.Show, V1LegalInfo -> V1LegalInfo -> Bool
(V1LegalInfo -> V1LegalInfo -> Bool)
-> (V1LegalInfo -> V1LegalInfo -> Bool) -> Eq V1LegalInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1LegalInfo -> V1LegalInfo -> Bool
$c/= :: V1LegalInfo -> V1LegalInfo -> Bool
== :: V1LegalInfo -> V1LegalInfo -> Bool
$c== :: V1LegalInfo -> V1LegalInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1LegalInfo
instance A.FromJSON V1LegalInfo where
  parseJSON :: Value -> Parser V1LegalInfo
parseJSON = String
-> (Object -> Parser V1LegalInfo) -> Value -> Parser V1LegalInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1LegalInfo" ((Object -> Parser V1LegalInfo) -> Value -> Parser V1LegalInfo)
-> (Object -> Parser V1LegalInfo) -> Value -> Parser V1LegalInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> V1LegalInfo
V1LegalInfo
      (Maybe Text -> Maybe Text -> V1LegalInfo)
-> Parser (Maybe Text) -> Parser (Maybe Text -> V1LegalInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"imprint_url")
      Parser (Maybe Text -> V1LegalInfo)
-> Parser (Maybe Text) -> Parser V1LegalInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"privacy_policy_url")

-- | ToJSON V1LegalInfo
instance A.ToJSON V1LegalInfo where
  toJSON :: V1LegalInfo -> Value
toJSON V1LegalInfo {Maybe Text
v1LegalInfoPrivacyPolicyUrl :: Maybe Text
v1LegalInfoImprintUrl :: Maybe Text
$sel:v1LegalInfoPrivacyPolicyUrl:V1LegalInfo :: V1LegalInfo -> Maybe Text
$sel:v1LegalInfoImprintUrl:V1LegalInfo :: V1LegalInfo -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"imprint_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1LegalInfoImprintUrl
      , Key
"privacy_policy_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1LegalInfoPrivacyPolicyUrl
      ]


-- | Construct a value of type 'V1LegalInfo' (by applying it's required fields, if any)
mkV1LegalInfo
  :: V1LegalInfo
mkV1LegalInfo :: V1LegalInfo
mkV1LegalInfo =
  V1LegalInfo :: Maybe Text -> Maybe Text -> V1LegalInfo
V1LegalInfo
  { $sel:v1LegalInfoImprintUrl:V1LegalInfo :: Maybe Text
v1LegalInfoImprintUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1LegalInfoPrivacyPolicyUrl:V1LegalInfo :: Maybe Text
v1LegalInfoPrivacyPolicyUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1LinkShareAuth
-- | V1LinkShareAuth
data V1LinkShareAuth = V1LinkShareAuth
  { V1LinkShareAuth -> Maybe Text
v1LinkShareAuthPassword :: !(Maybe Text) -- ^ "password"
  } deriving (Int -> V1LinkShareAuth -> ShowS
[V1LinkShareAuth] -> ShowS
V1LinkShareAuth -> String
(Int -> V1LinkShareAuth -> ShowS)
-> (V1LinkShareAuth -> String)
-> ([V1LinkShareAuth] -> ShowS)
-> Show V1LinkShareAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1LinkShareAuth] -> ShowS
$cshowList :: [V1LinkShareAuth] -> ShowS
show :: V1LinkShareAuth -> String
$cshow :: V1LinkShareAuth -> String
showsPrec :: Int -> V1LinkShareAuth -> ShowS
$cshowsPrec :: Int -> V1LinkShareAuth -> ShowS
P.Show, V1LinkShareAuth -> V1LinkShareAuth -> Bool
(V1LinkShareAuth -> V1LinkShareAuth -> Bool)
-> (V1LinkShareAuth -> V1LinkShareAuth -> Bool)
-> Eq V1LinkShareAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1LinkShareAuth -> V1LinkShareAuth -> Bool
$c/= :: V1LinkShareAuth -> V1LinkShareAuth -> Bool
== :: V1LinkShareAuth -> V1LinkShareAuth -> Bool
$c== :: V1LinkShareAuth -> V1LinkShareAuth -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1LinkShareAuth
instance A.FromJSON V1LinkShareAuth where
  parseJSON :: Value -> Parser V1LinkShareAuth
parseJSON = String
-> (Object -> Parser V1LinkShareAuth)
-> Value
-> Parser V1LinkShareAuth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1LinkShareAuth" ((Object -> Parser V1LinkShareAuth)
 -> Value -> Parser V1LinkShareAuth)
-> (Object -> Parser V1LinkShareAuth)
-> Value
-> Parser V1LinkShareAuth
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> V1LinkShareAuth
V1LinkShareAuth
      (Maybe Text -> V1LinkShareAuth)
-> Parser (Maybe Text) -> Parser V1LinkShareAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")

-- | ToJSON V1LinkShareAuth
instance A.ToJSON V1LinkShareAuth where
  toJSON :: V1LinkShareAuth -> Value
toJSON V1LinkShareAuth {Maybe Text
v1LinkShareAuthPassword :: Maybe Text
$sel:v1LinkShareAuthPassword:V1LinkShareAuth :: V1LinkShareAuth -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1LinkShareAuthPassword
      ]


-- | Construct a value of type 'V1LinkShareAuth' (by applying it's required fields, if any)
mkV1LinkShareAuth
  :: V1LinkShareAuth
mkV1LinkShareAuth :: V1LinkShareAuth
mkV1LinkShareAuth =
  V1LinkShareAuth :: Maybe Text -> V1LinkShareAuth
V1LinkShareAuth
  { $sel:v1LinkShareAuthPassword:V1LinkShareAuth :: Maybe Text
v1LinkShareAuthPassword = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1LocalAuthInfo
-- | V1LocalAuthInfo
data V1LocalAuthInfo = V1LocalAuthInfo
  { V1LocalAuthInfo -> Maybe Bool
v1LocalAuthInfoEnabled :: !(Maybe Bool) -- ^ "enabled"
  } deriving (Int -> V1LocalAuthInfo -> ShowS
[V1LocalAuthInfo] -> ShowS
V1LocalAuthInfo -> String
(Int -> V1LocalAuthInfo -> ShowS)
-> (V1LocalAuthInfo -> String)
-> ([V1LocalAuthInfo] -> ShowS)
-> Show V1LocalAuthInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1LocalAuthInfo] -> ShowS
$cshowList :: [V1LocalAuthInfo] -> ShowS
show :: V1LocalAuthInfo -> String
$cshow :: V1LocalAuthInfo -> String
showsPrec :: Int -> V1LocalAuthInfo -> ShowS
$cshowsPrec :: Int -> V1LocalAuthInfo -> ShowS
P.Show, V1LocalAuthInfo -> V1LocalAuthInfo -> Bool
(V1LocalAuthInfo -> V1LocalAuthInfo -> Bool)
-> (V1LocalAuthInfo -> V1LocalAuthInfo -> Bool)
-> Eq V1LocalAuthInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1LocalAuthInfo -> V1LocalAuthInfo -> Bool
$c/= :: V1LocalAuthInfo -> V1LocalAuthInfo -> Bool
== :: V1LocalAuthInfo -> V1LocalAuthInfo -> Bool
$c== :: V1LocalAuthInfo -> V1LocalAuthInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1LocalAuthInfo
instance A.FromJSON V1LocalAuthInfo where
  parseJSON :: Value -> Parser V1LocalAuthInfo
parseJSON = String
-> (Object -> Parser V1LocalAuthInfo)
-> Value
-> Parser V1LocalAuthInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1LocalAuthInfo" ((Object -> Parser V1LocalAuthInfo)
 -> Value -> Parser V1LocalAuthInfo)
-> (Object -> Parser V1LocalAuthInfo)
-> Value
-> Parser V1LocalAuthInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> V1LocalAuthInfo
V1LocalAuthInfo
      (Maybe Bool -> V1LocalAuthInfo)
-> Parser (Maybe Bool) -> Parser V1LocalAuthInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enabled")

-- | ToJSON V1LocalAuthInfo
instance A.ToJSON V1LocalAuthInfo where
  toJSON :: V1LocalAuthInfo -> Value
toJSON V1LocalAuthInfo {Maybe Bool
v1LocalAuthInfoEnabled :: Maybe Bool
$sel:v1LocalAuthInfoEnabled:V1LocalAuthInfo :: V1LocalAuthInfo -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1LocalAuthInfoEnabled
      ]


-- | Construct a value of type 'V1LocalAuthInfo' (by applying it's required fields, if any)
mkV1LocalAuthInfo
  :: V1LocalAuthInfo
mkV1LocalAuthInfo :: V1LocalAuthInfo
mkV1LocalAuthInfo =
  V1LocalAuthInfo :: Maybe Bool -> V1LocalAuthInfo
V1LocalAuthInfo
  { $sel:v1LocalAuthInfoEnabled:V1LocalAuthInfo :: Maybe Bool
v1LocalAuthInfoEnabled = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** V1OpenIDAuthInfo
-- | V1OpenIDAuthInfo
data V1OpenIDAuthInfo = V1OpenIDAuthInfo
  { V1OpenIDAuthInfo -> Maybe Bool
v1OpenIDAuthInfoEnabled :: !(Maybe Bool) -- ^ "enabled"
  , V1OpenIDAuthInfo -> Maybe [OpenidProvider]
v1OpenIDAuthInfoProviders :: !(Maybe [OpenidProvider]) -- ^ "providers"
  } deriving (Int -> V1OpenIDAuthInfo -> ShowS
[V1OpenIDAuthInfo] -> ShowS
V1OpenIDAuthInfo -> String
(Int -> V1OpenIDAuthInfo -> ShowS)
-> (V1OpenIDAuthInfo -> String)
-> ([V1OpenIDAuthInfo] -> ShowS)
-> Show V1OpenIDAuthInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1OpenIDAuthInfo] -> ShowS
$cshowList :: [V1OpenIDAuthInfo] -> ShowS
show :: V1OpenIDAuthInfo -> String
$cshow :: V1OpenIDAuthInfo -> String
showsPrec :: Int -> V1OpenIDAuthInfo -> ShowS
$cshowsPrec :: Int -> V1OpenIDAuthInfo -> ShowS
P.Show, V1OpenIDAuthInfo -> V1OpenIDAuthInfo -> Bool
(V1OpenIDAuthInfo -> V1OpenIDAuthInfo -> Bool)
-> (V1OpenIDAuthInfo -> V1OpenIDAuthInfo -> Bool)
-> Eq V1OpenIDAuthInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1OpenIDAuthInfo -> V1OpenIDAuthInfo -> Bool
$c/= :: V1OpenIDAuthInfo -> V1OpenIDAuthInfo -> Bool
== :: V1OpenIDAuthInfo -> V1OpenIDAuthInfo -> Bool
$c== :: V1OpenIDAuthInfo -> V1OpenIDAuthInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1OpenIDAuthInfo
instance A.FromJSON V1OpenIDAuthInfo where
  parseJSON :: Value -> Parser V1OpenIDAuthInfo
parseJSON = String
-> (Object -> Parser V1OpenIDAuthInfo)
-> Value
-> Parser V1OpenIDAuthInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1OpenIDAuthInfo" ((Object -> Parser V1OpenIDAuthInfo)
 -> Value -> Parser V1OpenIDAuthInfo)
-> (Object -> Parser V1OpenIDAuthInfo)
-> Value
-> Parser V1OpenIDAuthInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> Maybe [OpenidProvider] -> V1OpenIDAuthInfo
V1OpenIDAuthInfo
      (Maybe Bool -> Maybe [OpenidProvider] -> V1OpenIDAuthInfo)
-> Parser (Maybe Bool)
-> Parser (Maybe [OpenidProvider] -> V1OpenIDAuthInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enabled")
      Parser (Maybe [OpenidProvider] -> V1OpenIDAuthInfo)
-> Parser (Maybe [OpenidProvider]) -> Parser V1OpenIDAuthInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [OpenidProvider])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"providers")

-- | ToJSON V1OpenIDAuthInfo
instance A.ToJSON V1OpenIDAuthInfo where
  toJSON :: V1OpenIDAuthInfo -> Value
toJSON V1OpenIDAuthInfo {Maybe Bool
Maybe [OpenidProvider]
v1OpenIDAuthInfoProviders :: Maybe [OpenidProvider]
v1OpenIDAuthInfoEnabled :: Maybe Bool
$sel:v1OpenIDAuthInfoProviders:V1OpenIDAuthInfo :: V1OpenIDAuthInfo -> Maybe [OpenidProvider]
$sel:v1OpenIDAuthInfoEnabled:V1OpenIDAuthInfo :: V1OpenIDAuthInfo -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1OpenIDAuthInfoEnabled
      , Key
"providers" Key -> Maybe [OpenidProvider] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [OpenidProvider]
v1OpenIDAuthInfoProviders
      ]


-- | Construct a value of type 'V1OpenIDAuthInfo' (by applying it's required fields, if any)
mkV1OpenIDAuthInfo
  :: V1OpenIDAuthInfo
mkV1OpenIDAuthInfo :: V1OpenIDAuthInfo
mkV1OpenIDAuthInfo =
  V1OpenIDAuthInfo :: Maybe Bool -> Maybe [OpenidProvider] -> V1OpenIDAuthInfo
V1OpenIDAuthInfo
  { $sel:v1OpenIDAuthInfoEnabled:V1OpenIDAuthInfo :: Maybe Bool
v1OpenIDAuthInfoEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1OpenIDAuthInfoProviders:V1OpenIDAuthInfo :: Maybe [OpenidProvider]
v1OpenIDAuthInfoProviders = Maybe [OpenidProvider]
forall a. Maybe a
Nothing
  }

-- ** V1UserAvatarProvider
-- | V1UserAvatarProvider
data V1UserAvatarProvider = V1UserAvatarProvider
  { V1UserAvatarProvider -> Maybe Text
v1UserAvatarProviderAvatarProvider :: !(Maybe Text) -- ^ "avatar_provider" - The avatar provider. Valid types are &#x60;gravatar&#x60; (uses the user email), &#x60;upload&#x60;, &#x60;initials&#x60;, &#x60;marble&#x60; (generates a random avatar for each user), &#x60;default&#x60;.
  } deriving (Int -> V1UserAvatarProvider -> ShowS
[V1UserAvatarProvider] -> ShowS
V1UserAvatarProvider -> String
(Int -> V1UserAvatarProvider -> ShowS)
-> (V1UserAvatarProvider -> String)
-> ([V1UserAvatarProvider] -> ShowS)
-> Show V1UserAvatarProvider
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1UserAvatarProvider] -> ShowS
$cshowList :: [V1UserAvatarProvider] -> ShowS
show :: V1UserAvatarProvider -> String
$cshow :: V1UserAvatarProvider -> String
showsPrec :: Int -> V1UserAvatarProvider -> ShowS
$cshowsPrec :: Int -> V1UserAvatarProvider -> ShowS
P.Show, V1UserAvatarProvider -> V1UserAvatarProvider -> Bool
(V1UserAvatarProvider -> V1UserAvatarProvider -> Bool)
-> (V1UserAvatarProvider -> V1UserAvatarProvider -> Bool)
-> Eq V1UserAvatarProvider
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1UserAvatarProvider -> V1UserAvatarProvider -> Bool
$c/= :: V1UserAvatarProvider -> V1UserAvatarProvider -> Bool
== :: V1UserAvatarProvider -> V1UserAvatarProvider -> Bool
$c== :: V1UserAvatarProvider -> V1UserAvatarProvider -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1UserAvatarProvider
instance A.FromJSON V1UserAvatarProvider where
  parseJSON :: Value -> Parser V1UserAvatarProvider
parseJSON = String
-> (Object -> Parser V1UserAvatarProvider)
-> Value
-> Parser V1UserAvatarProvider
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1UserAvatarProvider" ((Object -> Parser V1UserAvatarProvider)
 -> Value -> Parser V1UserAvatarProvider)
-> (Object -> Parser V1UserAvatarProvider)
-> Value
-> Parser V1UserAvatarProvider
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> V1UserAvatarProvider
V1UserAvatarProvider
      (Maybe Text -> V1UserAvatarProvider)
-> Parser (Maybe Text) -> Parser V1UserAvatarProvider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar_provider")

-- | ToJSON V1UserAvatarProvider
instance A.ToJSON V1UserAvatarProvider where
  toJSON :: V1UserAvatarProvider -> Value
toJSON V1UserAvatarProvider {Maybe Text
v1UserAvatarProviderAvatarProvider :: Maybe Text
$sel:v1UserAvatarProviderAvatarProvider:V1UserAvatarProvider :: V1UserAvatarProvider -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"avatar_provider" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserAvatarProviderAvatarProvider
      ]


-- | Construct a value of type 'V1UserAvatarProvider' (by applying it's required fields, if any)
mkV1UserAvatarProvider
  :: V1UserAvatarProvider
mkV1UserAvatarProvider :: V1UserAvatarProvider
mkV1UserAvatarProvider =
  V1UserAvatarProvider :: Maybe Text -> V1UserAvatarProvider
V1UserAvatarProvider
  { $sel:v1UserAvatarProviderAvatarProvider:V1UserAvatarProvider :: Maybe Text
v1UserAvatarProviderAvatarProvider = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1UserDeletionRequestConfirm
-- | V1UserDeletionRequestConfirm
data V1UserDeletionRequestConfirm = V1UserDeletionRequestConfirm
  { V1UserDeletionRequestConfirm -> Maybe Text
v1UserDeletionRequestConfirmToken :: !(Maybe Text) -- ^ "token"
  } deriving (Int -> V1UserDeletionRequestConfirm -> ShowS
[V1UserDeletionRequestConfirm] -> ShowS
V1UserDeletionRequestConfirm -> String
(Int -> V1UserDeletionRequestConfirm -> ShowS)
-> (V1UserDeletionRequestConfirm -> String)
-> ([V1UserDeletionRequestConfirm] -> ShowS)
-> Show V1UserDeletionRequestConfirm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1UserDeletionRequestConfirm] -> ShowS
$cshowList :: [V1UserDeletionRequestConfirm] -> ShowS
show :: V1UserDeletionRequestConfirm -> String
$cshow :: V1UserDeletionRequestConfirm -> String
showsPrec :: Int -> V1UserDeletionRequestConfirm -> ShowS
$cshowsPrec :: Int -> V1UserDeletionRequestConfirm -> ShowS
P.Show, V1UserDeletionRequestConfirm
-> V1UserDeletionRequestConfirm -> Bool
(V1UserDeletionRequestConfirm
 -> V1UserDeletionRequestConfirm -> Bool)
-> (V1UserDeletionRequestConfirm
    -> V1UserDeletionRequestConfirm -> Bool)
-> Eq V1UserDeletionRequestConfirm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1UserDeletionRequestConfirm
-> V1UserDeletionRequestConfirm -> Bool
$c/= :: V1UserDeletionRequestConfirm
-> V1UserDeletionRequestConfirm -> Bool
== :: V1UserDeletionRequestConfirm
-> V1UserDeletionRequestConfirm -> Bool
$c== :: V1UserDeletionRequestConfirm
-> V1UserDeletionRequestConfirm -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1UserDeletionRequestConfirm
instance A.FromJSON V1UserDeletionRequestConfirm where
  parseJSON :: Value -> Parser V1UserDeletionRequestConfirm
parseJSON = String
-> (Object -> Parser V1UserDeletionRequestConfirm)
-> Value
-> Parser V1UserDeletionRequestConfirm
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1UserDeletionRequestConfirm" ((Object -> Parser V1UserDeletionRequestConfirm)
 -> Value -> Parser V1UserDeletionRequestConfirm)
-> (Object -> Parser V1UserDeletionRequestConfirm)
-> Value
-> Parser V1UserDeletionRequestConfirm
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> V1UserDeletionRequestConfirm
V1UserDeletionRequestConfirm
      (Maybe Text -> V1UserDeletionRequestConfirm)
-> Parser (Maybe Text) -> Parser V1UserDeletionRequestConfirm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token")

-- | ToJSON V1UserDeletionRequestConfirm
instance A.ToJSON V1UserDeletionRequestConfirm where
  toJSON :: V1UserDeletionRequestConfirm -> Value
toJSON V1UserDeletionRequestConfirm {Maybe Text
v1UserDeletionRequestConfirmToken :: Maybe Text
$sel:v1UserDeletionRequestConfirmToken:V1UserDeletionRequestConfirm :: V1UserDeletionRequestConfirm -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserDeletionRequestConfirmToken
      ]


-- | Construct a value of type 'V1UserDeletionRequestConfirm' (by applying it's required fields, if any)
mkV1UserDeletionRequestConfirm
  :: V1UserDeletionRequestConfirm
mkV1UserDeletionRequestConfirm :: V1UserDeletionRequestConfirm
mkV1UserDeletionRequestConfirm =
  V1UserDeletionRequestConfirm :: Maybe Text -> V1UserDeletionRequestConfirm
V1UserDeletionRequestConfirm
  { $sel:v1UserDeletionRequestConfirmToken:V1UserDeletionRequestConfirm :: Maybe Text
v1UserDeletionRequestConfirmToken = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1UserPassword
-- | V1UserPassword
data V1UserPassword = V1UserPassword
  { V1UserPassword -> Maybe Text
v1UserPasswordNewPassword :: !(Maybe Text) -- ^ "new_password"
  , V1UserPassword -> Maybe Text
v1UserPasswordOldPassword :: !(Maybe Text) -- ^ "old_password"
  } deriving (Int -> V1UserPassword -> ShowS
[V1UserPassword] -> ShowS
V1UserPassword -> String
(Int -> V1UserPassword -> ShowS)
-> (V1UserPassword -> String)
-> ([V1UserPassword] -> ShowS)
-> Show V1UserPassword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1UserPassword] -> ShowS
$cshowList :: [V1UserPassword] -> ShowS
show :: V1UserPassword -> String
$cshow :: V1UserPassword -> String
showsPrec :: Int -> V1UserPassword -> ShowS
$cshowsPrec :: Int -> V1UserPassword -> ShowS
P.Show, V1UserPassword -> V1UserPassword -> Bool
(V1UserPassword -> V1UserPassword -> Bool)
-> (V1UserPassword -> V1UserPassword -> Bool) -> Eq V1UserPassword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1UserPassword -> V1UserPassword -> Bool
$c/= :: V1UserPassword -> V1UserPassword -> Bool
== :: V1UserPassword -> V1UserPassword -> Bool
$c== :: V1UserPassword -> V1UserPassword -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1UserPassword
instance A.FromJSON V1UserPassword where
  parseJSON :: Value -> Parser V1UserPassword
parseJSON = String
-> (Object -> Parser V1UserPassword)
-> Value
-> Parser V1UserPassword
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1UserPassword" ((Object -> Parser V1UserPassword)
 -> Value -> Parser V1UserPassword)
-> (Object -> Parser V1UserPassword)
-> Value
-> Parser V1UserPassword
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> V1UserPassword
V1UserPassword
      (Maybe Text -> Maybe Text -> V1UserPassword)
-> Parser (Maybe Text) -> Parser (Maybe Text -> V1UserPassword)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_password")
      Parser (Maybe Text -> V1UserPassword)
-> Parser (Maybe Text) -> Parser V1UserPassword
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_password")

-- | ToJSON V1UserPassword
instance A.ToJSON V1UserPassword where
  toJSON :: V1UserPassword -> Value
toJSON V1UserPassword {Maybe Text
v1UserPasswordOldPassword :: Maybe Text
v1UserPasswordNewPassword :: Maybe Text
$sel:v1UserPasswordOldPassword:V1UserPassword :: V1UserPassword -> Maybe Text
$sel:v1UserPasswordNewPassword:V1UserPassword :: V1UserPassword -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"new_password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserPasswordNewPassword
      , Key
"old_password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserPasswordOldPassword
      ]


-- | Construct a value of type 'V1UserPassword' (by applying it's required fields, if any)
mkV1UserPassword
  :: V1UserPassword
mkV1UserPassword :: V1UserPassword
mkV1UserPassword =
  V1UserPassword :: Maybe Text -> Maybe Text -> V1UserPassword
V1UserPassword
  { $sel:v1UserPasswordNewPassword:V1UserPassword :: Maybe Text
v1UserPasswordNewPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserPasswordOldPassword:V1UserPassword :: Maybe Text
v1UserPasswordOldPassword = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1UserPasswordConfirmation
-- | V1UserPasswordConfirmation
data V1UserPasswordConfirmation = V1UserPasswordConfirmation
  { V1UserPasswordConfirmation -> Maybe Text
v1UserPasswordConfirmationPassword :: !(Maybe Text) -- ^ "password"
  } deriving (Int -> V1UserPasswordConfirmation -> ShowS
[V1UserPasswordConfirmation] -> ShowS
V1UserPasswordConfirmation -> String
(Int -> V1UserPasswordConfirmation -> ShowS)
-> (V1UserPasswordConfirmation -> String)
-> ([V1UserPasswordConfirmation] -> ShowS)
-> Show V1UserPasswordConfirmation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1UserPasswordConfirmation] -> ShowS
$cshowList :: [V1UserPasswordConfirmation] -> ShowS
show :: V1UserPasswordConfirmation -> String
$cshow :: V1UserPasswordConfirmation -> String
showsPrec :: Int -> V1UserPasswordConfirmation -> ShowS
$cshowsPrec :: Int -> V1UserPasswordConfirmation -> ShowS
P.Show, V1UserPasswordConfirmation -> V1UserPasswordConfirmation -> Bool
(V1UserPasswordConfirmation -> V1UserPasswordConfirmation -> Bool)
-> (V1UserPasswordConfirmation
    -> V1UserPasswordConfirmation -> Bool)
-> Eq V1UserPasswordConfirmation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1UserPasswordConfirmation -> V1UserPasswordConfirmation -> Bool
$c/= :: V1UserPasswordConfirmation -> V1UserPasswordConfirmation -> Bool
== :: V1UserPasswordConfirmation -> V1UserPasswordConfirmation -> Bool
$c== :: V1UserPasswordConfirmation -> V1UserPasswordConfirmation -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1UserPasswordConfirmation
instance A.FromJSON V1UserPasswordConfirmation where
  parseJSON :: Value -> Parser V1UserPasswordConfirmation
parseJSON = String
-> (Object -> Parser V1UserPasswordConfirmation)
-> Value
-> Parser V1UserPasswordConfirmation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1UserPasswordConfirmation" ((Object -> Parser V1UserPasswordConfirmation)
 -> Value -> Parser V1UserPasswordConfirmation)
-> (Object -> Parser V1UserPasswordConfirmation)
-> Value
-> Parser V1UserPasswordConfirmation
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> V1UserPasswordConfirmation
V1UserPasswordConfirmation
      (Maybe Text -> V1UserPasswordConfirmation)
-> Parser (Maybe Text) -> Parser V1UserPasswordConfirmation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")

-- | ToJSON V1UserPasswordConfirmation
instance A.ToJSON V1UserPasswordConfirmation where
  toJSON :: V1UserPasswordConfirmation -> Value
toJSON V1UserPasswordConfirmation {Maybe Text
v1UserPasswordConfirmationPassword :: Maybe Text
$sel:v1UserPasswordConfirmationPassword:V1UserPasswordConfirmation :: V1UserPasswordConfirmation -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserPasswordConfirmationPassword
      ]


-- | Construct a value of type 'V1UserPasswordConfirmation' (by applying it's required fields, if any)
mkV1UserPasswordConfirmation
  :: V1UserPasswordConfirmation
mkV1UserPasswordConfirmation :: V1UserPasswordConfirmation
mkV1UserPasswordConfirmation =
  V1UserPasswordConfirmation :: Maybe Text -> V1UserPasswordConfirmation
V1UserPasswordConfirmation
  { $sel:v1UserPasswordConfirmationPassword:V1UserPasswordConfirmation :: Maybe Text
v1UserPasswordConfirmationPassword = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1UserSettings
-- | V1UserSettings
data V1UserSettings = V1UserSettings
  { V1UserSettings -> Maybe Int
v1UserSettingsDefaultProjectId :: !(Maybe Int) -- ^ "default_project_id" - If a task is created without a specified project this value should be used. Applies to tasks made directly in API and from clients.
  , V1UserSettings -> Maybe Bool
v1UserSettingsDiscoverableByEmail :: !(Maybe Bool) -- ^ "discoverable_by_email" - If true, the user can be found when searching for their exact email.
  , V1UserSettings -> Maybe Bool
v1UserSettingsDiscoverableByName :: !(Maybe Bool) -- ^ "discoverable_by_name" - If true, this user can be found by their name or parts of it when searching for it.
  , V1UserSettings -> Maybe Bool
v1UserSettingsEmailRemindersEnabled :: !(Maybe Bool) -- ^ "email_reminders_enabled" - If enabled, sends email reminders of tasks to the user.
  , V1UserSettings -> Maybe Value
v1UserSettingsFrontendSettings :: !(Maybe A.Value) -- ^ "frontend_settings" - Additional settings only used by the frontend
  , V1UserSettings -> Maybe Text
v1UserSettingsLanguage :: !(Maybe Text) -- ^ "language" - The user&#39;s language
  , V1UserSettings -> Maybe Text
v1UserSettingsName :: !(Maybe Text) -- ^ "name" - The new name of the current user.
  , V1UserSettings -> Maybe Bool
v1UserSettingsOverdueTasksRemindersEnabled :: !(Maybe Bool) -- ^ "overdue_tasks_reminders_enabled" - If enabled, the user will get an email for their overdue tasks each morning.
  , V1UserSettings -> Maybe Text
v1UserSettingsOverdueTasksRemindersTime :: !(Maybe Text) -- ^ "overdue_tasks_reminders_time" - The time when the daily summary of overdue tasks will be sent via email.
  , V1UserSettings -> Maybe Text
v1UserSettingsTimezone :: !(Maybe Text) -- ^ "timezone" - The user&#39;s time zone. Used to send task reminders in the time zone of the user.
  , V1UserSettings -> Maybe Int
v1UserSettingsWeekStart :: !(Maybe Int) -- ^ "week_start" - The day when the week starts for this user. 0 &#x3D; sunday, 1 &#x3D; monday, etc.
  } deriving (Int -> V1UserSettings -> ShowS
[V1UserSettings] -> ShowS
V1UserSettings -> String
(Int -> V1UserSettings -> ShowS)
-> (V1UserSettings -> String)
-> ([V1UserSettings] -> ShowS)
-> Show V1UserSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1UserSettings] -> ShowS
$cshowList :: [V1UserSettings] -> ShowS
show :: V1UserSettings -> String
$cshow :: V1UserSettings -> String
showsPrec :: Int -> V1UserSettings -> ShowS
$cshowsPrec :: Int -> V1UserSettings -> ShowS
P.Show, V1UserSettings -> V1UserSettings -> Bool
(V1UserSettings -> V1UserSettings -> Bool)
-> (V1UserSettings -> V1UserSettings -> Bool) -> Eq V1UserSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1UserSettings -> V1UserSettings -> Bool
$c/= :: V1UserSettings -> V1UserSettings -> Bool
== :: V1UserSettings -> V1UserSettings -> Bool
$c== :: V1UserSettings -> V1UserSettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1UserSettings
instance A.FromJSON V1UserSettings where
  parseJSON :: Value -> Parser V1UserSettings
parseJSON = String
-> (Object -> Parser V1UserSettings)
-> Value
-> Parser V1UserSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1UserSettings" ((Object -> Parser V1UserSettings)
 -> Value -> Parser V1UserSettings)
-> (Object -> Parser V1UserSettings)
-> Value
-> Parser V1UserSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> V1UserSettings
V1UserSettings
      (Maybe Int
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Value
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> V1UserSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> V1UserSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_project_id")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> V1UserSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"discoverable_by_email")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> V1UserSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"discoverable_by_name")
      Parser
  (Maybe Bool
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> V1UserSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email_reminders_enabled")
      Parser
  (Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> V1UserSettings)
-> Parser (Maybe Value)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontend_settings")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> V1UserSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> V1UserSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text -> Maybe Text -> Maybe Int -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Bool
   -> Maybe Text -> Maybe Text -> Maybe Int -> V1UserSettings)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Text -> Maybe Int -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"overdue_tasks_reminders_enabled")
      Parser (Maybe Text -> Maybe Text -> Maybe Int -> V1UserSettings)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Int -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"overdue_tasks_reminders_time")
      Parser (Maybe Text -> Maybe Int -> V1UserSettings)
-> Parser (Maybe Text) -> Parser (Maybe Int -> V1UserSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timezone")
      Parser (Maybe Int -> V1UserSettings)
-> Parser (Maybe Int) -> Parser V1UserSettings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"week_start")

-- | ToJSON V1UserSettings
instance A.ToJSON V1UserSettings where
  toJSON :: V1UserSettings -> Value
toJSON V1UserSettings {Maybe Bool
Maybe Int
Maybe Text
Maybe Value
v1UserSettingsWeekStart :: Maybe Int
v1UserSettingsTimezone :: Maybe Text
v1UserSettingsOverdueTasksRemindersTime :: Maybe Text
v1UserSettingsOverdueTasksRemindersEnabled :: Maybe Bool
v1UserSettingsName :: Maybe Text
v1UserSettingsLanguage :: Maybe Text
v1UserSettingsFrontendSettings :: Maybe Value
v1UserSettingsEmailRemindersEnabled :: Maybe Bool
v1UserSettingsDiscoverableByName :: Maybe Bool
v1UserSettingsDiscoverableByEmail :: Maybe Bool
v1UserSettingsDefaultProjectId :: Maybe Int
$sel:v1UserSettingsWeekStart:V1UserSettings :: V1UserSettings -> Maybe Int
$sel:v1UserSettingsTimezone:V1UserSettings :: V1UserSettings -> Maybe Text
$sel:v1UserSettingsOverdueTasksRemindersTime:V1UserSettings :: V1UserSettings -> Maybe Text
$sel:v1UserSettingsOverdueTasksRemindersEnabled:V1UserSettings :: V1UserSettings -> Maybe Bool
$sel:v1UserSettingsName:V1UserSettings :: V1UserSettings -> Maybe Text
$sel:v1UserSettingsLanguage:V1UserSettings :: V1UserSettings -> Maybe Text
$sel:v1UserSettingsFrontendSettings:V1UserSettings :: V1UserSettings -> Maybe Value
$sel:v1UserSettingsEmailRemindersEnabled:V1UserSettings :: V1UserSettings -> Maybe Bool
$sel:v1UserSettingsDiscoverableByName:V1UserSettings :: V1UserSettings -> Maybe Bool
$sel:v1UserSettingsDiscoverableByEmail:V1UserSettings :: V1UserSettings -> Maybe Bool
$sel:v1UserSettingsDefaultProjectId:V1UserSettings :: V1UserSettings -> Maybe Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"default_project_id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
v1UserSettingsDefaultProjectId
      , Key
"discoverable_by_email" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1UserSettingsDiscoverableByEmail
      , Key
"discoverable_by_name" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1UserSettingsDiscoverableByName
      , Key
"email_reminders_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1UserSettingsEmailRemindersEnabled
      , Key
"frontend_settings" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
v1UserSettingsFrontendSettings
      , Key
"language" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserSettingsLanguage
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserSettingsName
      , Key
"overdue_tasks_reminders_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1UserSettingsOverdueTasksRemindersEnabled
      , Key
"overdue_tasks_reminders_time" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserSettingsOverdueTasksRemindersTime
      , Key
"timezone" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserSettingsTimezone
      , Key
"week_start" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
v1UserSettingsWeekStart
      ]


-- | Construct a value of type 'V1UserSettings' (by applying it's required fields, if any)
mkV1UserSettings
  :: V1UserSettings
mkV1UserSettings :: V1UserSettings
mkV1UserSettings =
  V1UserSettings :: Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> V1UserSettings
V1UserSettings
  { $sel:v1UserSettingsDefaultProjectId:V1UserSettings :: Maybe Int
v1UserSettingsDefaultProjectId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsDiscoverableByEmail:V1UserSettings :: Maybe Bool
v1UserSettingsDiscoverableByEmail = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsDiscoverableByName:V1UserSettings :: Maybe Bool
v1UserSettingsDiscoverableByName = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsEmailRemindersEnabled:V1UserSettings :: Maybe Bool
v1UserSettingsEmailRemindersEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsFrontendSettings:V1UserSettings :: Maybe Value
v1UserSettingsFrontendSettings = Maybe Value
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsLanguage:V1UserSettings :: Maybe Text
v1UserSettingsLanguage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsName:V1UserSettings :: Maybe Text
v1UserSettingsName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsOverdueTasksRemindersEnabled:V1UserSettings :: Maybe Bool
v1UserSettingsOverdueTasksRemindersEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsOverdueTasksRemindersTime:V1UserSettings :: Maybe Text
v1UserSettingsOverdueTasksRemindersTime = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsTimezone:V1UserSettings :: Maybe Text
v1UserSettingsTimezone = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserSettingsWeekStart:V1UserSettings :: Maybe Int
v1UserSettingsWeekStart = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** V1UserWithSettings
-- | V1UserWithSettings
data V1UserWithSettings = V1UserWithSettings
  { V1UserWithSettings -> Maybe Text
v1UserWithSettingsCreated :: !(Maybe Text) -- ^ "created" - A timestamp when this task was created. You cannot change this value.
  , V1UserWithSettings -> Maybe Text
v1UserWithSettingsDeletionScheduledAt :: !(Maybe Text) -- ^ "deletion_scheduled_at"
  , V1UserWithSettings -> Maybe Text
v1UserWithSettingsEmail :: !(Maybe Text) -- ^ "email" - The user&#39;s email address.
  , V1UserWithSettings -> Maybe Int
v1UserWithSettingsId :: !(Maybe Int) -- ^ "id" - The unique, numeric id of this user.
  , V1UserWithSettings -> Maybe Bool
v1UserWithSettingsIsLocalUser :: !(Maybe Bool) -- ^ "is_local_user"
  , V1UserWithSettings -> Maybe Text
v1UserWithSettingsName :: !(Maybe Text) -- ^ "name" - The full name of the user.
  , V1UserWithSettings -> Maybe V1UserSettings
v1UserWithSettingsSettings :: !(Maybe V1UserSettings) -- ^ "settings"
  , V1UserWithSettings -> Maybe Text
v1UserWithSettingsUpdated :: !(Maybe Text) -- ^ "updated" - A timestamp when this task was last updated. You cannot change this value.
  , V1UserWithSettings -> Maybe Text
v1UserWithSettingsUsername :: !(Maybe Text) -- ^ "username" - The username of the user. Is always unique.
  } deriving (Int -> V1UserWithSettings -> ShowS
[V1UserWithSettings] -> ShowS
V1UserWithSettings -> String
(Int -> V1UserWithSettings -> ShowS)
-> (V1UserWithSettings -> String)
-> ([V1UserWithSettings] -> ShowS)
-> Show V1UserWithSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1UserWithSettings] -> ShowS
$cshowList :: [V1UserWithSettings] -> ShowS
show :: V1UserWithSettings -> String
$cshow :: V1UserWithSettings -> String
showsPrec :: Int -> V1UserWithSettings -> ShowS
$cshowsPrec :: Int -> V1UserWithSettings -> ShowS
P.Show, V1UserWithSettings -> V1UserWithSettings -> Bool
(V1UserWithSettings -> V1UserWithSettings -> Bool)
-> (V1UserWithSettings -> V1UserWithSettings -> Bool)
-> Eq V1UserWithSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1UserWithSettings -> V1UserWithSettings -> Bool
$c/= :: V1UserWithSettings -> V1UserWithSettings -> Bool
== :: V1UserWithSettings -> V1UserWithSettings -> Bool
$c== :: V1UserWithSettings -> V1UserWithSettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1UserWithSettings
instance A.FromJSON V1UserWithSettings where
  parseJSON :: Value -> Parser V1UserWithSettings
parseJSON = String
-> (Object -> Parser V1UserWithSettings)
-> Value
-> Parser V1UserWithSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1UserWithSettings" ((Object -> Parser V1UserWithSettings)
 -> Value -> Parser V1UserWithSettings)
-> (Object -> Parser V1UserWithSettings)
-> Value
-> Parser V1UserWithSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Text
-> Maybe V1UserSettings
-> Maybe Text
-> Maybe Text
-> V1UserWithSettings
V1UserWithSettings
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Bool
 -> Maybe Text
 -> Maybe V1UserSettings
 -> Maybe Text
 -> Maybe Text
 -> V1UserWithSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Text
      -> Maybe V1UserSettings
      -> Maybe Text
      -> Maybe Text
      -> V1UserWithSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Text
   -> Maybe V1UserSettings
   -> Maybe Text
   -> Maybe Text
   -> V1UserWithSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Text
      -> Maybe V1UserSettings
      -> Maybe Text
      -> Maybe Text
      -> V1UserWithSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deletion_scheduled_at")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Text
   -> Maybe V1UserSettings
   -> Maybe Text
   -> Maybe Text
   -> V1UserWithSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe Text
      -> Maybe V1UserSettings
      -> Maybe Text
      -> Maybe Text
      -> V1UserWithSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe Text
   -> Maybe V1UserSettings
   -> Maybe Text
   -> Maybe Text
   -> V1UserWithSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe V1UserSettings
      -> Maybe Text
      -> Maybe Text
      -> V1UserWithSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe V1UserSettings
   -> Maybe Text
   -> Maybe Text
   -> V1UserWithSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe V1UserSettings
      -> Maybe Text
      -> Maybe Text
      -> V1UserWithSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_local_user")
      Parser
  (Maybe Text
   -> Maybe V1UserSettings
   -> Maybe Text
   -> Maybe Text
   -> V1UserWithSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe V1UserSettings
      -> Maybe Text -> Maybe Text -> V1UserWithSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe V1UserSettings
   -> Maybe Text -> Maybe Text -> V1UserWithSettings)
-> Parser (Maybe V1UserSettings)
-> Parser (Maybe Text -> Maybe Text -> V1UserWithSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe V1UserSettings)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"settings")
      Parser (Maybe Text -> Maybe Text -> V1UserWithSettings)
-> Parser (Maybe Text) -> Parser (Maybe Text -> V1UserWithSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")
      Parser (Maybe Text -> V1UserWithSettings)
-> Parser (Maybe Text) -> Parser V1UserWithSettings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON V1UserWithSettings
instance A.ToJSON V1UserWithSettings where
  toJSON :: V1UserWithSettings -> Value
toJSON V1UserWithSettings {Maybe Bool
Maybe Int
Maybe Text
Maybe V1UserSettings
v1UserWithSettingsUsername :: Maybe Text
v1UserWithSettingsUpdated :: Maybe Text
v1UserWithSettingsSettings :: Maybe V1UserSettings
v1UserWithSettingsName :: Maybe Text
v1UserWithSettingsIsLocalUser :: Maybe Bool
v1UserWithSettingsId :: Maybe Int
v1UserWithSettingsEmail :: Maybe Text
v1UserWithSettingsDeletionScheduledAt :: Maybe Text
v1UserWithSettingsCreated :: Maybe Text
$sel:v1UserWithSettingsUsername:V1UserWithSettings :: V1UserWithSettings -> Maybe Text
$sel:v1UserWithSettingsUpdated:V1UserWithSettings :: V1UserWithSettings -> Maybe Text
$sel:v1UserWithSettingsSettings:V1UserWithSettings :: V1UserWithSettings -> Maybe V1UserSettings
$sel:v1UserWithSettingsName:V1UserWithSettings :: V1UserWithSettings -> Maybe Text
$sel:v1UserWithSettingsIsLocalUser:V1UserWithSettings :: V1UserWithSettings -> Maybe Bool
$sel:v1UserWithSettingsId:V1UserWithSettings :: V1UserWithSettings -> Maybe Int
$sel:v1UserWithSettingsEmail:V1UserWithSettings :: V1UserWithSettings -> Maybe Text
$sel:v1UserWithSettingsDeletionScheduledAt:V1UserWithSettings :: V1UserWithSettings -> Maybe Text
$sel:v1UserWithSettingsCreated:V1UserWithSettings :: V1UserWithSettings -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserWithSettingsCreated
      , Key
"deletion_scheduled_at" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserWithSettingsDeletionScheduledAt
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserWithSettingsEmail
      , Key
"id" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
v1UserWithSettingsId
      , Key
"is_local_user" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1UserWithSettingsIsLocalUser
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserWithSettingsName
      , Key
"settings" Key -> Maybe V1UserSettings -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe V1UserSettings
v1UserWithSettingsSettings
      , Key
"updated" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserWithSettingsUpdated
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1UserWithSettingsUsername
      ]


-- | Construct a value of type 'V1UserWithSettings' (by applying it's required fields, if any)
mkV1UserWithSettings
  :: V1UserWithSettings
mkV1UserWithSettings :: V1UserWithSettings
mkV1UserWithSettings =
  V1UserWithSettings :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Text
-> Maybe V1UserSettings
-> Maybe Text
-> Maybe Text
-> V1UserWithSettings
V1UserWithSettings
  { $sel:v1UserWithSettingsCreated:V1UserWithSettings :: Maybe Text
v1UserWithSettingsCreated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsDeletionScheduledAt:V1UserWithSettings :: Maybe Text
v1UserWithSettingsDeletionScheduledAt = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsEmail:V1UserWithSettings :: Maybe Text
v1UserWithSettingsEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsId:V1UserWithSettings :: Maybe Int
v1UserWithSettingsId = Maybe Int
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsIsLocalUser:V1UserWithSettings :: Maybe Bool
v1UserWithSettingsIsLocalUser = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsName:V1UserWithSettings :: Maybe Text
v1UserWithSettingsName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsSettings:V1UserWithSettings :: Maybe V1UserSettings
v1UserWithSettingsSettings = Maybe V1UserSettings
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsUpdated:V1UserWithSettings :: Maybe Text
v1UserWithSettingsUpdated = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1UserWithSettingsUsername:V1UserWithSettings :: Maybe Text
v1UserWithSettingsUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** V1VikunjaInfos
-- | V1VikunjaInfos
data V1VikunjaInfos = V1VikunjaInfos
  { V1VikunjaInfos -> Maybe V1AuthInfo
v1VikunjaInfosAuth :: !(Maybe V1AuthInfo) -- ^ "auth"
  , V1VikunjaInfos -> Maybe [Text]
v1VikunjaInfosAvailableMigrators :: !(Maybe [Text]) -- ^ "available_migrators"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosCaldavEnabled :: !(Maybe Bool) -- ^ "caldav_enabled"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosDemoModeEnabled :: !(Maybe Bool) -- ^ "demo_mode_enabled"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosEmailRemindersEnabled :: !(Maybe Bool) -- ^ "email_reminders_enabled"
  , V1VikunjaInfos -> Maybe [Text]
v1VikunjaInfosEnabledBackgroundProviders :: !(Maybe [Text]) -- ^ "enabled_background_providers"
  , V1VikunjaInfos -> Maybe Text
v1VikunjaInfosFrontendUrl :: !(Maybe Text) -- ^ "frontend_url"
  , V1VikunjaInfos -> Maybe V1LegalInfo
v1VikunjaInfosLegal :: !(Maybe V1LegalInfo) -- ^ "legal"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosLinkSharingEnabled :: !(Maybe Bool) -- ^ "link_sharing_enabled"
  , V1VikunjaInfos -> Maybe Text
v1VikunjaInfosMaxFileSize :: !(Maybe Text) -- ^ "max_file_size"
  , V1VikunjaInfos -> Maybe Text
v1VikunjaInfosMotd :: !(Maybe Text) -- ^ "motd"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosPublicTeamsEnabled :: !(Maybe Bool) -- ^ "public_teams_enabled"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosRegistrationEnabled :: !(Maybe Bool) -- ^ "registration_enabled"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosTaskAttachmentsEnabled :: !(Maybe Bool) -- ^ "task_attachments_enabled"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosTaskCommentsEnabled :: !(Maybe Bool) -- ^ "task_comments_enabled"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosTotpEnabled :: !(Maybe Bool) -- ^ "totp_enabled"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosUserDeletionEnabled :: !(Maybe Bool) -- ^ "user_deletion_enabled"
  , V1VikunjaInfos -> Maybe Text
v1VikunjaInfosVersion :: !(Maybe Text) -- ^ "version"
  , V1VikunjaInfos -> Maybe Bool
v1VikunjaInfosWebhooksEnabled :: !(Maybe Bool) -- ^ "webhooks_enabled"
  } deriving (Int -> V1VikunjaInfos -> ShowS
[V1VikunjaInfos] -> ShowS
V1VikunjaInfos -> String
(Int -> V1VikunjaInfos -> ShowS)
-> (V1VikunjaInfos -> String)
-> ([V1VikunjaInfos] -> ShowS)
-> Show V1VikunjaInfos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1VikunjaInfos] -> ShowS
$cshowList :: [V1VikunjaInfos] -> ShowS
show :: V1VikunjaInfos -> String
$cshow :: V1VikunjaInfos -> String
showsPrec :: Int -> V1VikunjaInfos -> ShowS
$cshowsPrec :: Int -> V1VikunjaInfos -> ShowS
P.Show, V1VikunjaInfos -> V1VikunjaInfos -> Bool
(V1VikunjaInfos -> V1VikunjaInfos -> Bool)
-> (V1VikunjaInfos -> V1VikunjaInfos -> Bool) -> Eq V1VikunjaInfos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1VikunjaInfos -> V1VikunjaInfos -> Bool
$c/= :: V1VikunjaInfos -> V1VikunjaInfos -> Bool
== :: V1VikunjaInfos -> V1VikunjaInfos -> Bool
$c== :: V1VikunjaInfos -> V1VikunjaInfos -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1VikunjaInfos
instance A.FromJSON V1VikunjaInfos where
  parseJSON :: Value -> Parser V1VikunjaInfos
parseJSON = String
-> (Object -> Parser V1VikunjaInfos)
-> Value
-> Parser V1VikunjaInfos
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"V1VikunjaInfos" ((Object -> Parser V1VikunjaInfos)
 -> Value -> Parser V1VikunjaInfos)
-> (Object -> Parser V1VikunjaInfos)
-> Value
-> Parser V1VikunjaInfos
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe V1AuthInfo
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe V1LegalInfo
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> V1VikunjaInfos
V1VikunjaInfos
      (Maybe V1AuthInfo
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe V1LegalInfo
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> V1VikunjaInfos)
-> Parser (Maybe V1AuthInfo)
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe V1LegalInfo
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe V1AuthInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"auth")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe V1LegalInfo
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe V1LegalInfo
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"available_migrators")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe V1LegalInfo
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe V1LegalInfo
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"caldav_enabled")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe V1LegalInfo
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe V1LegalInfo
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"demo_mode_enabled")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe V1LegalInfo
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe V1LegalInfo
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email_reminders_enabled")
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe V1LegalInfo
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe V1LegalInfo
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enabled_background_providers")
      Parser
  (Maybe Text
   -> Maybe V1LegalInfo
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Text)
-> Parser
     (Maybe V1LegalInfo
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontend_url")
      Parser
  (Maybe V1LegalInfo
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe V1LegalInfo)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe V1LegalInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"legal")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"link_sharing_enabled")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_file_size")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"motd")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"public_teams_enabled")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"registration_enabled")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_attachments_enabled")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool -> Maybe Text -> Maybe Bool -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"task_comments_enabled")
      Parser
  (Maybe Bool
   -> Maybe Bool -> Maybe Text -> Maybe Bool -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Text -> Maybe Bool -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"totp_enabled")
      Parser (Maybe Bool -> Maybe Text -> Maybe Bool -> V1VikunjaInfos)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Bool -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_deletion_enabled")
      Parser (Maybe Text -> Maybe Bool -> V1VikunjaInfos)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> V1VikunjaInfos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")
      Parser (Maybe Bool -> V1VikunjaInfos)
-> Parser (Maybe Bool) -> Parser V1VikunjaInfos
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"webhooks_enabled")

-- | ToJSON V1VikunjaInfos
instance A.ToJSON V1VikunjaInfos where
  toJSON :: V1VikunjaInfos -> Value
toJSON V1VikunjaInfos {Maybe Bool
Maybe [Text]
Maybe Text
Maybe V1LegalInfo
Maybe V1AuthInfo
v1VikunjaInfosWebhooksEnabled :: Maybe Bool
v1VikunjaInfosVersion :: Maybe Text
v1VikunjaInfosUserDeletionEnabled :: Maybe Bool
v1VikunjaInfosTotpEnabled :: Maybe Bool
v1VikunjaInfosTaskCommentsEnabled :: Maybe Bool
v1VikunjaInfosTaskAttachmentsEnabled :: Maybe Bool
v1VikunjaInfosRegistrationEnabled :: Maybe Bool
v1VikunjaInfosPublicTeamsEnabled :: Maybe Bool
v1VikunjaInfosMotd :: Maybe Text
v1VikunjaInfosMaxFileSize :: Maybe Text
v1VikunjaInfosLinkSharingEnabled :: Maybe Bool
v1VikunjaInfosLegal :: Maybe V1LegalInfo
v1VikunjaInfosFrontendUrl :: Maybe Text
v1VikunjaInfosEnabledBackgroundProviders :: Maybe [Text]
v1VikunjaInfosEmailRemindersEnabled :: Maybe Bool
v1VikunjaInfosDemoModeEnabled :: Maybe Bool
v1VikunjaInfosCaldavEnabled :: Maybe Bool
v1VikunjaInfosAvailableMigrators :: Maybe [Text]
v1VikunjaInfosAuth :: Maybe V1AuthInfo
$sel:v1VikunjaInfosWebhooksEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosVersion:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Text
$sel:v1VikunjaInfosUserDeletionEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosTotpEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosTaskCommentsEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosTaskAttachmentsEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosRegistrationEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosPublicTeamsEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosMotd:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Text
$sel:v1VikunjaInfosMaxFileSize:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Text
$sel:v1VikunjaInfosLinkSharingEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosLegal:V1VikunjaInfos :: V1VikunjaInfos -> Maybe V1LegalInfo
$sel:v1VikunjaInfosFrontendUrl:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Text
$sel:v1VikunjaInfosEnabledBackgroundProviders:V1VikunjaInfos :: V1VikunjaInfos -> Maybe [Text]
$sel:v1VikunjaInfosEmailRemindersEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosDemoModeEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosCaldavEnabled:V1VikunjaInfos :: V1VikunjaInfos -> Maybe Bool
$sel:v1VikunjaInfosAvailableMigrators:V1VikunjaInfos :: V1VikunjaInfos -> Maybe [Text]
$sel:v1VikunjaInfosAuth:V1VikunjaInfos :: V1VikunjaInfos -> Maybe V1AuthInfo
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"auth" Key -> Maybe V1AuthInfo -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe V1AuthInfo
v1VikunjaInfosAuth
      , Key
"available_migrators" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
v1VikunjaInfosAvailableMigrators
      , Key
"caldav_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosCaldavEnabled
      , Key
"demo_mode_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosDemoModeEnabled
      , Key
"email_reminders_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosEmailRemindersEnabled
      , Key
"enabled_background_providers" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
v1VikunjaInfosEnabledBackgroundProviders
      , Key
"frontend_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1VikunjaInfosFrontendUrl
      , Key
"legal" Key -> Maybe V1LegalInfo -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe V1LegalInfo
v1VikunjaInfosLegal
      , Key
"link_sharing_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosLinkSharingEnabled
      , Key
"max_file_size" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1VikunjaInfosMaxFileSize
      , Key
"motd" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1VikunjaInfosMotd
      , Key
"public_teams_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosPublicTeamsEnabled
      , Key
"registration_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosRegistrationEnabled
      , Key
"task_attachments_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosTaskAttachmentsEnabled
      , Key
"task_comments_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosTaskCommentsEnabled
      , Key
"totp_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosTotpEnabled
      , Key
"user_deletion_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosUserDeletionEnabled
      , Key
"version" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1VikunjaInfosVersion
      , Key
"webhooks_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
v1VikunjaInfosWebhooksEnabled
      ]


-- | Construct a value of type 'V1VikunjaInfos' (by applying it's required fields, if any)
mkV1VikunjaInfos
  :: V1VikunjaInfos
mkV1VikunjaInfos :: V1VikunjaInfos
mkV1VikunjaInfos =
  V1VikunjaInfos :: Maybe V1AuthInfo
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe V1LegalInfo
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> V1VikunjaInfos
V1VikunjaInfos
  { $sel:v1VikunjaInfosAuth:V1VikunjaInfos :: Maybe V1AuthInfo
v1VikunjaInfosAuth = Maybe V1AuthInfo
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosAvailableMigrators:V1VikunjaInfos :: Maybe [Text]
v1VikunjaInfosAvailableMigrators = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosCaldavEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosCaldavEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosDemoModeEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosDemoModeEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosEmailRemindersEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosEmailRemindersEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosEnabledBackgroundProviders:V1VikunjaInfos :: Maybe [Text]
v1VikunjaInfosEnabledBackgroundProviders = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosFrontendUrl:V1VikunjaInfos :: Maybe Text
v1VikunjaInfosFrontendUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosLegal:V1VikunjaInfos :: Maybe V1LegalInfo
v1VikunjaInfosLegal = Maybe V1LegalInfo
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosLinkSharingEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosLinkSharingEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosMaxFileSize:V1VikunjaInfos :: Maybe Text
v1VikunjaInfosMaxFileSize = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosMotd:V1VikunjaInfos :: Maybe Text
v1VikunjaInfosMotd = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosPublicTeamsEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosPublicTeamsEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosRegistrationEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosRegistrationEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosTaskAttachmentsEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosTaskAttachmentsEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosTaskCommentsEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosTaskCommentsEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosTotpEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosTotpEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosUserDeletionEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosUserDeletionEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosVersion:V1VikunjaInfos :: Maybe Text
v1VikunjaInfosVersion = Maybe Text
forall a. Maybe a
Nothing
  , $sel:v1VikunjaInfosWebhooksEnabled:V1VikunjaInfos :: Maybe Bool
v1VikunjaInfosWebhooksEnabled = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** WebHTTPError
-- | WebHTTPError
data WebHTTPError = WebHTTPError
  { WebHTTPError -> Maybe Int
webHTTPErrorCode :: !(Maybe Int) -- ^ "code"
  , WebHTTPError -> Maybe Text
webHTTPErrorMessage :: !(Maybe Text) -- ^ "message"
  } deriving (Int -> WebHTTPError -> ShowS
[WebHTTPError] -> ShowS
WebHTTPError -> String
(Int -> WebHTTPError -> ShowS)
-> (WebHTTPError -> String)
-> ([WebHTTPError] -> ShowS)
-> Show WebHTTPError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebHTTPError] -> ShowS
$cshowList :: [WebHTTPError] -> ShowS
show :: WebHTTPError -> String
$cshow :: WebHTTPError -> String
showsPrec :: Int -> WebHTTPError -> ShowS
$cshowsPrec :: Int -> WebHTTPError -> ShowS
P.Show, WebHTTPError -> WebHTTPError -> Bool
(WebHTTPError -> WebHTTPError -> Bool)
-> (WebHTTPError -> WebHTTPError -> Bool) -> Eq WebHTTPError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebHTTPError -> WebHTTPError -> Bool
$c/= :: WebHTTPError -> WebHTTPError -> Bool
== :: WebHTTPError -> WebHTTPError -> Bool
$c== :: WebHTTPError -> WebHTTPError -> Bool
P.Eq, P.Typeable)

-- | FromJSON WebHTTPError
instance A.FromJSON WebHTTPError where
  parseJSON :: Value -> Parser WebHTTPError
parseJSON = String
-> (Object -> Parser WebHTTPError) -> Value -> Parser WebHTTPError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebHTTPError" ((Object -> Parser WebHTTPError) -> Value -> Parser WebHTTPError)
-> (Object -> Parser WebHTTPError) -> Value -> Parser WebHTTPError
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int -> Maybe Text -> WebHTTPError
WebHTTPError
      (Maybe Int -> Maybe Text -> WebHTTPError)
-> Parser (Maybe Int) -> Parser (Maybe Text -> WebHTTPError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code")
      Parser (Maybe Text -> WebHTTPError)
-> Parser (Maybe Text) -> Parser WebHTTPError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")

-- | ToJSON WebHTTPError
instance A.ToJSON WebHTTPError where
  toJSON :: WebHTTPError -> Value
toJSON WebHTTPError {Maybe Int
Maybe Text
webHTTPErrorMessage :: Maybe Text
webHTTPErrorCode :: Maybe Int
$sel:webHTTPErrorMessage:WebHTTPError :: WebHTTPError -> Maybe Text
$sel:webHTTPErrorCode:WebHTTPError :: WebHTTPError -> Maybe Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"code" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
webHTTPErrorCode
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
webHTTPErrorMessage
      ]


-- | Construct a value of type 'WebHTTPError' (by applying it's required fields, if any)
mkWebHTTPError
  :: WebHTTPError
mkWebHTTPError :: WebHTTPError
mkWebHTTPError =
  WebHTTPError :: Maybe Int -> Maybe Text -> WebHTTPError
WebHTTPError
  { $sel:webHTTPErrorCode:WebHTTPError :: Maybe Int
webHTTPErrorCode = Maybe Int
forall a. Maybe a
Nothing
  , $sel:webHTTPErrorMessage:WebHTTPError :: Maybe Text
webHTTPErrorMessage = Maybe Text
forall a. Maybe a
Nothing
  }


-- * Enums


-- ** ModelsBucketConfigurationModeKind

-- | Enum of 'Int'
data ModelsBucketConfigurationModeKind
  = ModelsBucketConfigurationModeKindBucketConfigurationModeNone -- ^ @0@
  | ModelsBucketConfigurationModeKindBucketConfigurationModeManual -- ^ @1@
  | ModelsBucketConfigurationModeKindBucketConfigurationModeFilter -- ^ @2@
  deriving (Int -> ModelsBucketConfigurationModeKind -> ShowS
[ModelsBucketConfigurationModeKind] -> ShowS
ModelsBucketConfigurationModeKind -> String
(Int -> ModelsBucketConfigurationModeKind -> ShowS)
-> (ModelsBucketConfigurationModeKind -> String)
-> ([ModelsBucketConfigurationModeKind] -> ShowS)
-> Show ModelsBucketConfigurationModeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsBucketConfigurationModeKind] -> ShowS
$cshowList :: [ModelsBucketConfigurationModeKind] -> ShowS
show :: ModelsBucketConfigurationModeKind -> String
$cshow :: ModelsBucketConfigurationModeKind -> String
showsPrec :: Int -> ModelsBucketConfigurationModeKind -> ShowS
$cshowsPrec :: Int -> ModelsBucketConfigurationModeKind -> ShowS
P.Show, ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
(ModelsBucketConfigurationModeKind
 -> ModelsBucketConfigurationModeKind -> Bool)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind -> Bool)
-> Eq ModelsBucketConfigurationModeKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
$c/= :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
== :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
$c== :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
P.Eq, P.Typeable, Eq ModelsBucketConfigurationModeKind
Eq ModelsBucketConfigurationModeKind
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind -> Ordering)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind -> Bool)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind -> Bool)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind -> Bool)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind -> Bool)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind)
-> Ord ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Ordering
ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
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
min :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
$cmin :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
max :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
$cmax :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
>= :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
$c>= :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
> :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
$c> :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
<= :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
$c<= :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
< :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
$c< :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Bool
compare :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Ordering
$ccompare :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind -> Ordering
$cp1Ord :: Eq ModelsBucketConfigurationModeKind
P.Ord, ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> Bounded ModelsBucketConfigurationModeKind
forall a. a -> a -> Bounded a
maxBound :: ModelsBucketConfigurationModeKind
$cmaxBound :: ModelsBucketConfigurationModeKind
minBound :: ModelsBucketConfigurationModeKind
$cminBound :: ModelsBucketConfigurationModeKind
P.Bounded, Int -> ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKind -> Int
ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
(ModelsBucketConfigurationModeKind
 -> ModelsBucketConfigurationModeKind)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind)
-> (Int -> ModelsBucketConfigurationModeKind)
-> (ModelsBucketConfigurationModeKind -> Int)
-> (ModelsBucketConfigurationModeKind
    -> [ModelsBucketConfigurationModeKind])
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind
    -> [ModelsBucketConfigurationModeKind])
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind
    -> [ModelsBucketConfigurationModeKind])
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind
    -> [ModelsBucketConfigurationModeKind])
-> Enum ModelsBucketConfigurationModeKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
$cenumFromThenTo :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
enumFromTo :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
$cenumFromTo :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
enumFromThen :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
$cenumFromThen :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
enumFrom :: ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
$cenumFrom :: ModelsBucketConfigurationModeKind
-> [ModelsBucketConfigurationModeKind]
fromEnum :: ModelsBucketConfigurationModeKind -> Int
$cfromEnum :: ModelsBucketConfigurationModeKind -> Int
toEnum :: Int -> ModelsBucketConfigurationModeKind
$ctoEnum :: Int -> ModelsBucketConfigurationModeKind
pred :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
$cpred :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
succ :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
$csucc :: ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
P.Enum)

instance A.ToJSON ModelsBucketConfigurationModeKind where toJSON :: ModelsBucketConfigurationModeKind -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Int -> Value)
-> (ModelsBucketConfigurationModeKind -> Int)
-> ModelsBucketConfigurationModeKind
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsBucketConfigurationModeKind -> Int
fromModelsBucketConfigurationModeKind
instance A.FromJSON ModelsBucketConfigurationModeKind where parseJSON :: Value -> Parser ModelsBucketConfigurationModeKind
parseJSON Value
o = (String -> Parser ModelsBucketConfigurationModeKind)
-> (ModelsBucketConfigurationModeKind
    -> Parser ModelsBucketConfigurationModeKind)
-> Either String ModelsBucketConfigurationModeKind
-> Parser ModelsBucketConfigurationModeKind
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either String -> Parser ModelsBucketConfigurationModeKind
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (ModelsBucketConfigurationModeKind
-> Parser ModelsBucketConfigurationModeKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModelsBucketConfigurationModeKind
 -> Parser ModelsBucketConfigurationModeKind)
-> (ModelsBucketConfigurationModeKind
    -> ModelsBucketConfigurationModeKind)
-> ModelsBucketConfigurationModeKind
-> Parser ModelsBucketConfigurationModeKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsBucketConfigurationModeKind
-> ModelsBucketConfigurationModeKind
forall a. a -> a
P.id) (Either String ModelsBucketConfigurationModeKind
 -> Parser ModelsBucketConfigurationModeKind)
-> (Int -> Either String ModelsBucketConfigurationModeKind)
-> Int
-> Parser ModelsBucketConfigurationModeKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsBucketConfigurationModeKind
toModelsBucketConfigurationModeKind (Int -> Parser ModelsBucketConfigurationModeKind)
-> Parser Int -> Parser ModelsBucketConfigurationModeKind
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ModelsBucketConfigurationModeKind where toQueryParam :: ModelsBucketConfigurationModeKind -> Text
toQueryParam = Int -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Int -> Text)
-> (ModelsBucketConfigurationModeKind -> Int)
-> ModelsBucketConfigurationModeKind
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsBucketConfigurationModeKind -> Int
fromModelsBucketConfigurationModeKind
instance WH.FromHttpApiData ModelsBucketConfigurationModeKind where parseQueryParam :: Text -> Either Text ModelsBucketConfigurationModeKind
parseQueryParam Text
o = Text -> Either Text Int
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Int
-> (Int -> Either Text ModelsBucketConfigurationModeKind)
-> Either Text ModelsBucketConfigurationModeKind
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text)
-> Either String ModelsBucketConfigurationModeKind
-> Either Text ModelsBucketConfigurationModeKind
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left String -> Text
T.pack (Either String ModelsBucketConfigurationModeKind
 -> Either Text ModelsBucketConfigurationModeKind)
-> (Int -> Either String ModelsBucketConfigurationModeKind)
-> Int
-> Either Text ModelsBucketConfigurationModeKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsBucketConfigurationModeKind
toModelsBucketConfigurationModeKind
instance MimeRender MimeMultipartFormData ModelsBucketConfigurationModeKind where mimeRender :: Proxy MimeMultipartFormData
-> ModelsBucketConfigurationModeKind -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ModelsBucketConfigurationModeKind -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ModelsBucketConfigurationModeKind' enum
fromModelsBucketConfigurationModeKind :: ModelsBucketConfigurationModeKind -> Int
fromModelsBucketConfigurationModeKind :: ModelsBucketConfigurationModeKind -> Int
fromModelsBucketConfigurationModeKind = \case
  ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKindBucketConfigurationModeNone -> Int
0
  ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKindBucketConfigurationModeManual -> Int
1
  ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKindBucketConfigurationModeFilter -> Int
2

-- | parse 'ModelsBucketConfigurationModeKind' enum
toModelsBucketConfigurationModeKind :: Int -> P.Either String ModelsBucketConfigurationModeKind
toModelsBucketConfigurationModeKind :: Int -> Either String ModelsBucketConfigurationModeKind
toModelsBucketConfigurationModeKind = \case
  Int
0 -> ModelsBucketConfigurationModeKind
-> Either String ModelsBucketConfigurationModeKind
forall a b. b -> Either a b
P.Right ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKindBucketConfigurationModeNone
  Int
1 -> ModelsBucketConfigurationModeKind
-> Either String ModelsBucketConfigurationModeKind
forall a b. b -> Either a b
P.Right ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKindBucketConfigurationModeManual
  Int
2 -> ModelsBucketConfigurationModeKind
-> Either String ModelsBucketConfigurationModeKind
forall a b. b -> Either a b
P.Right ModelsBucketConfigurationModeKind
ModelsBucketConfigurationModeKindBucketConfigurationModeFilter
  Int
s -> String -> Either String ModelsBucketConfigurationModeKind
forall a b. a -> Either a b
P.Left (String -> Either String ModelsBucketConfigurationModeKind)
-> String -> Either String ModelsBucketConfigurationModeKind
forall a b. (a -> b) -> a -> b
$ String
"toModelsBucketConfigurationModeKind: enum parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Int -> String
forall a. Show a => a -> String
P.show Int
s


-- ** ModelsProjectViewKind

-- | Enum of 'Int'
data ModelsProjectViewKind
  = ModelsProjectViewKindProjectViewKindList -- ^ @0@
  | ModelsProjectViewKindProjectViewKindGantt -- ^ @1@
  | ModelsProjectViewKindProjectViewKindTable -- ^ @2@
  | ModelsProjectViewKindProjectViewKindKanban -- ^ @3@
  deriving (Int -> ModelsProjectViewKind -> ShowS
[ModelsProjectViewKind] -> ShowS
ModelsProjectViewKind -> String
(Int -> ModelsProjectViewKind -> ShowS)
-> (ModelsProjectViewKind -> String)
-> ([ModelsProjectViewKind] -> ShowS)
-> Show ModelsProjectViewKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsProjectViewKind] -> ShowS
$cshowList :: [ModelsProjectViewKind] -> ShowS
show :: ModelsProjectViewKind -> String
$cshow :: ModelsProjectViewKind -> String
showsPrec :: Int -> ModelsProjectViewKind -> ShowS
$cshowsPrec :: Int -> ModelsProjectViewKind -> ShowS
P.Show, ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
(ModelsProjectViewKind -> ModelsProjectViewKind -> Bool)
-> (ModelsProjectViewKind -> ModelsProjectViewKind -> Bool)
-> Eq ModelsProjectViewKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
$c/= :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
== :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
$c== :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
P.Eq, P.Typeable, Eq ModelsProjectViewKind
Eq ModelsProjectViewKind
-> (ModelsProjectViewKind -> ModelsProjectViewKind -> Ordering)
-> (ModelsProjectViewKind -> ModelsProjectViewKind -> Bool)
-> (ModelsProjectViewKind -> ModelsProjectViewKind -> Bool)
-> (ModelsProjectViewKind -> ModelsProjectViewKind -> Bool)
-> (ModelsProjectViewKind -> ModelsProjectViewKind -> Bool)
-> (ModelsProjectViewKind
    -> ModelsProjectViewKind -> ModelsProjectViewKind)
-> (ModelsProjectViewKind
    -> ModelsProjectViewKind -> ModelsProjectViewKind)
-> Ord ModelsProjectViewKind
ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
ModelsProjectViewKind -> ModelsProjectViewKind -> Ordering
ModelsProjectViewKind
-> ModelsProjectViewKind -> ModelsProjectViewKind
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
min :: ModelsProjectViewKind
-> ModelsProjectViewKind -> ModelsProjectViewKind
$cmin :: ModelsProjectViewKind
-> ModelsProjectViewKind -> ModelsProjectViewKind
max :: ModelsProjectViewKind
-> ModelsProjectViewKind -> ModelsProjectViewKind
$cmax :: ModelsProjectViewKind
-> ModelsProjectViewKind -> ModelsProjectViewKind
>= :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
$c>= :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
> :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
$c> :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
<= :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
$c<= :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
< :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
$c< :: ModelsProjectViewKind -> ModelsProjectViewKind -> Bool
compare :: ModelsProjectViewKind -> ModelsProjectViewKind -> Ordering
$ccompare :: ModelsProjectViewKind -> ModelsProjectViewKind -> Ordering
$cp1Ord :: Eq ModelsProjectViewKind
P.Ord, ModelsProjectViewKind
ModelsProjectViewKind
-> ModelsProjectViewKind -> Bounded ModelsProjectViewKind
forall a. a -> a -> Bounded a
maxBound :: ModelsProjectViewKind
$cmaxBound :: ModelsProjectViewKind
minBound :: ModelsProjectViewKind
$cminBound :: ModelsProjectViewKind
P.Bounded, Int -> ModelsProjectViewKind
ModelsProjectViewKind -> Int
ModelsProjectViewKind -> [ModelsProjectViewKind]
ModelsProjectViewKind -> ModelsProjectViewKind
ModelsProjectViewKind
-> ModelsProjectViewKind -> [ModelsProjectViewKind]
ModelsProjectViewKind
-> ModelsProjectViewKind
-> ModelsProjectViewKind
-> [ModelsProjectViewKind]
(ModelsProjectViewKind -> ModelsProjectViewKind)
-> (ModelsProjectViewKind -> ModelsProjectViewKind)
-> (Int -> ModelsProjectViewKind)
-> (ModelsProjectViewKind -> Int)
-> (ModelsProjectViewKind -> [ModelsProjectViewKind])
-> (ModelsProjectViewKind
    -> ModelsProjectViewKind -> [ModelsProjectViewKind])
-> (ModelsProjectViewKind
    -> ModelsProjectViewKind -> [ModelsProjectViewKind])
-> (ModelsProjectViewKind
    -> ModelsProjectViewKind
    -> ModelsProjectViewKind
    -> [ModelsProjectViewKind])
-> Enum ModelsProjectViewKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModelsProjectViewKind
-> ModelsProjectViewKind
-> ModelsProjectViewKind
-> [ModelsProjectViewKind]
$cenumFromThenTo :: ModelsProjectViewKind
-> ModelsProjectViewKind
-> ModelsProjectViewKind
-> [ModelsProjectViewKind]
enumFromTo :: ModelsProjectViewKind
-> ModelsProjectViewKind -> [ModelsProjectViewKind]
$cenumFromTo :: ModelsProjectViewKind
-> ModelsProjectViewKind -> [ModelsProjectViewKind]
enumFromThen :: ModelsProjectViewKind
-> ModelsProjectViewKind -> [ModelsProjectViewKind]
$cenumFromThen :: ModelsProjectViewKind
-> ModelsProjectViewKind -> [ModelsProjectViewKind]
enumFrom :: ModelsProjectViewKind -> [ModelsProjectViewKind]
$cenumFrom :: ModelsProjectViewKind -> [ModelsProjectViewKind]
fromEnum :: ModelsProjectViewKind -> Int
$cfromEnum :: ModelsProjectViewKind -> Int
toEnum :: Int -> ModelsProjectViewKind
$ctoEnum :: Int -> ModelsProjectViewKind
pred :: ModelsProjectViewKind -> ModelsProjectViewKind
$cpred :: ModelsProjectViewKind -> ModelsProjectViewKind
succ :: ModelsProjectViewKind -> ModelsProjectViewKind
$csucc :: ModelsProjectViewKind -> ModelsProjectViewKind
P.Enum)

instance A.ToJSON ModelsProjectViewKind where toJSON :: ModelsProjectViewKind -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Int -> Value)
-> (ModelsProjectViewKind -> Int) -> ModelsProjectViewKind -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsProjectViewKind -> Int
fromModelsProjectViewKind
instance A.FromJSON ModelsProjectViewKind where parseJSON :: Value -> Parser ModelsProjectViewKind
parseJSON Value
o = (String -> Parser ModelsProjectViewKind)
-> (ModelsProjectViewKind -> Parser ModelsProjectViewKind)
-> Either String ModelsProjectViewKind
-> Parser ModelsProjectViewKind
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either String -> Parser ModelsProjectViewKind
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (ModelsProjectViewKind -> Parser ModelsProjectViewKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModelsProjectViewKind -> Parser ModelsProjectViewKind)
-> (ModelsProjectViewKind -> ModelsProjectViewKind)
-> ModelsProjectViewKind
-> Parser ModelsProjectViewKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsProjectViewKind -> ModelsProjectViewKind
forall a. a -> a
P.id) (Either String ModelsProjectViewKind
 -> Parser ModelsProjectViewKind)
-> (Int -> Either String ModelsProjectViewKind)
-> Int
-> Parser ModelsProjectViewKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsProjectViewKind
toModelsProjectViewKind (Int -> Parser ModelsProjectViewKind)
-> Parser Int -> Parser ModelsProjectViewKind
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ModelsProjectViewKind where toQueryParam :: ModelsProjectViewKind -> Text
toQueryParam = Int -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Int -> Text)
-> (ModelsProjectViewKind -> Int) -> ModelsProjectViewKind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsProjectViewKind -> Int
fromModelsProjectViewKind
instance WH.FromHttpApiData ModelsProjectViewKind where parseQueryParam :: Text -> Either Text ModelsProjectViewKind
parseQueryParam Text
o = Text -> Either Text Int
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Int
-> (Int -> Either Text ModelsProjectViewKind)
-> Either Text ModelsProjectViewKind
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text)
-> Either String ModelsProjectViewKind
-> Either Text ModelsProjectViewKind
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left String -> Text
T.pack (Either String ModelsProjectViewKind
 -> Either Text ModelsProjectViewKind)
-> (Int -> Either String ModelsProjectViewKind)
-> Int
-> Either Text ModelsProjectViewKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsProjectViewKind
toModelsProjectViewKind
instance MimeRender MimeMultipartFormData ModelsProjectViewKind where mimeRender :: Proxy MimeMultipartFormData -> ModelsProjectViewKind -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ModelsProjectViewKind -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ModelsProjectViewKind' enum
fromModelsProjectViewKind :: ModelsProjectViewKind -> Int
fromModelsProjectViewKind :: ModelsProjectViewKind -> Int
fromModelsProjectViewKind = \case
  ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindList -> Int
0
  ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindGantt -> Int
1
  ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindTable -> Int
2
  ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindKanban -> Int
3

-- | parse 'ModelsProjectViewKind' enum
toModelsProjectViewKind :: Int -> P.Either String ModelsProjectViewKind
toModelsProjectViewKind :: Int -> Either String ModelsProjectViewKind
toModelsProjectViewKind = \case
  Int
0 -> ModelsProjectViewKind -> Either String ModelsProjectViewKind
forall a b. b -> Either a b
P.Right ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindList
  Int
1 -> ModelsProjectViewKind -> Either String ModelsProjectViewKind
forall a b. b -> Either a b
P.Right ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindGantt
  Int
2 -> ModelsProjectViewKind -> Either String ModelsProjectViewKind
forall a b. b -> Either a b
P.Right ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindTable
  Int
3 -> ModelsProjectViewKind -> Either String ModelsProjectViewKind
forall a b. b -> Either a b
P.Right ModelsProjectViewKind
ModelsProjectViewKindProjectViewKindKanban
  Int
s -> String -> Either String ModelsProjectViewKind
forall a b. a -> Either a b
P.Left (String -> Either String ModelsProjectViewKind)
-> String -> Either String ModelsProjectViewKind
forall a b. (a -> b) -> a -> b
$ String
"toModelsProjectViewKind: enum parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Int -> String
forall a. Show a => a -> String
P.show Int
s


-- ** ModelsRelationKind

-- | Enum of 'Text'
data ModelsRelationKind
  = ModelsRelationKindRelationKindUnknown -- ^ @"unknown"@
  | ModelsRelationKindRelationKindSubtask -- ^ @"subtask"@
  | ModelsRelationKindRelationKindParenttask -- ^ @"parenttask"@
  | ModelsRelationKindRelationKindRelated -- ^ @"related"@
  | ModelsRelationKindRelationKindDuplicateOf -- ^ @"duplicateof"@
  | ModelsRelationKindRelationKindDuplicates -- ^ @"duplicates"@
  | ModelsRelationKindRelationKindBlocking -- ^ @"blocking"@
  | ModelsRelationKindRelationKindBlocked -- ^ @"blocked"@
  | ModelsRelationKindRelationKindPreceeds -- ^ @"precedes"@
  | ModelsRelationKindRelationKindFollows -- ^ @"follows"@
  | ModelsRelationKindRelationKindCopiedFrom -- ^ @"copiedfrom"@
  | ModelsRelationKindRelationKindCopiedTo -- ^ @"copiedto"@
  deriving (Int -> ModelsRelationKind -> ShowS
[ModelsRelationKind] -> ShowS
ModelsRelationKind -> String
(Int -> ModelsRelationKind -> ShowS)
-> (ModelsRelationKind -> String)
-> ([ModelsRelationKind] -> ShowS)
-> Show ModelsRelationKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsRelationKind] -> ShowS
$cshowList :: [ModelsRelationKind] -> ShowS
show :: ModelsRelationKind -> String
$cshow :: ModelsRelationKind -> String
showsPrec :: Int -> ModelsRelationKind -> ShowS
$cshowsPrec :: Int -> ModelsRelationKind -> ShowS
P.Show, ModelsRelationKind -> ModelsRelationKind -> Bool
(ModelsRelationKind -> ModelsRelationKind -> Bool)
-> (ModelsRelationKind -> ModelsRelationKind -> Bool)
-> Eq ModelsRelationKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsRelationKind -> ModelsRelationKind -> Bool
$c/= :: ModelsRelationKind -> ModelsRelationKind -> Bool
== :: ModelsRelationKind -> ModelsRelationKind -> Bool
$c== :: ModelsRelationKind -> ModelsRelationKind -> Bool
P.Eq, P.Typeable, Eq ModelsRelationKind
Eq ModelsRelationKind
-> (ModelsRelationKind -> ModelsRelationKind -> Ordering)
-> (ModelsRelationKind -> ModelsRelationKind -> Bool)
-> (ModelsRelationKind -> ModelsRelationKind -> Bool)
-> (ModelsRelationKind -> ModelsRelationKind -> Bool)
-> (ModelsRelationKind -> ModelsRelationKind -> Bool)
-> (ModelsRelationKind -> ModelsRelationKind -> ModelsRelationKind)
-> (ModelsRelationKind -> ModelsRelationKind -> ModelsRelationKind)
-> Ord ModelsRelationKind
ModelsRelationKind -> ModelsRelationKind -> Bool
ModelsRelationKind -> ModelsRelationKind -> Ordering
ModelsRelationKind -> ModelsRelationKind -> ModelsRelationKind
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
min :: ModelsRelationKind -> ModelsRelationKind -> ModelsRelationKind
$cmin :: ModelsRelationKind -> ModelsRelationKind -> ModelsRelationKind
max :: ModelsRelationKind -> ModelsRelationKind -> ModelsRelationKind
$cmax :: ModelsRelationKind -> ModelsRelationKind -> ModelsRelationKind
>= :: ModelsRelationKind -> ModelsRelationKind -> Bool
$c>= :: ModelsRelationKind -> ModelsRelationKind -> Bool
> :: ModelsRelationKind -> ModelsRelationKind -> Bool
$c> :: ModelsRelationKind -> ModelsRelationKind -> Bool
<= :: ModelsRelationKind -> ModelsRelationKind -> Bool
$c<= :: ModelsRelationKind -> ModelsRelationKind -> Bool
< :: ModelsRelationKind -> ModelsRelationKind -> Bool
$c< :: ModelsRelationKind -> ModelsRelationKind -> Bool
compare :: ModelsRelationKind -> ModelsRelationKind -> Ordering
$ccompare :: ModelsRelationKind -> ModelsRelationKind -> Ordering
$cp1Ord :: Eq ModelsRelationKind
P.Ord, ModelsRelationKind
ModelsRelationKind
-> ModelsRelationKind -> Bounded ModelsRelationKind
forall a. a -> a -> Bounded a
maxBound :: ModelsRelationKind
$cmaxBound :: ModelsRelationKind
minBound :: ModelsRelationKind
$cminBound :: ModelsRelationKind
P.Bounded, Int -> ModelsRelationKind
ModelsRelationKind -> Int
ModelsRelationKind -> [ModelsRelationKind]
ModelsRelationKind -> ModelsRelationKind
ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
ModelsRelationKind
-> ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
(ModelsRelationKind -> ModelsRelationKind)
-> (ModelsRelationKind -> ModelsRelationKind)
-> (Int -> ModelsRelationKind)
-> (ModelsRelationKind -> Int)
-> (ModelsRelationKind -> [ModelsRelationKind])
-> (ModelsRelationKind
    -> ModelsRelationKind -> [ModelsRelationKind])
-> (ModelsRelationKind
    -> ModelsRelationKind -> [ModelsRelationKind])
-> (ModelsRelationKind
    -> ModelsRelationKind
    -> ModelsRelationKind
    -> [ModelsRelationKind])
-> Enum ModelsRelationKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModelsRelationKind
-> ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
$cenumFromThenTo :: ModelsRelationKind
-> ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
enumFromTo :: ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
$cenumFromTo :: ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
enumFromThen :: ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
$cenumFromThen :: ModelsRelationKind -> ModelsRelationKind -> [ModelsRelationKind]
enumFrom :: ModelsRelationKind -> [ModelsRelationKind]
$cenumFrom :: ModelsRelationKind -> [ModelsRelationKind]
fromEnum :: ModelsRelationKind -> Int
$cfromEnum :: ModelsRelationKind -> Int
toEnum :: Int -> ModelsRelationKind
$ctoEnum :: Int -> ModelsRelationKind
pred :: ModelsRelationKind -> ModelsRelationKind
$cpred :: ModelsRelationKind -> ModelsRelationKind
succ :: ModelsRelationKind -> ModelsRelationKind
$csucc :: ModelsRelationKind -> ModelsRelationKind
P.Enum)

instance A.ToJSON ModelsRelationKind where toJSON :: ModelsRelationKind -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ModelsRelationKind -> Text) -> ModelsRelationKind -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsRelationKind -> Text
fromModelsRelationKind
instance A.FromJSON ModelsRelationKind where parseJSON :: Value -> Parser ModelsRelationKind
parseJSON Value
o = (String -> Parser ModelsRelationKind)
-> (ModelsRelationKind -> Parser ModelsRelationKind)
-> Either String ModelsRelationKind
-> Parser ModelsRelationKind
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either String -> Parser ModelsRelationKind
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (ModelsRelationKind -> Parser ModelsRelationKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModelsRelationKind -> Parser ModelsRelationKind)
-> (ModelsRelationKind -> ModelsRelationKind)
-> ModelsRelationKind
-> Parser ModelsRelationKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsRelationKind -> ModelsRelationKind
forall a. a -> a
P.id) (Either String ModelsRelationKind -> Parser ModelsRelationKind)
-> (Text -> Either String ModelsRelationKind)
-> Text
-> Parser ModelsRelationKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ModelsRelationKind
toModelsRelationKind (Text -> Parser ModelsRelationKind)
-> Parser Text -> Parser ModelsRelationKind
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ModelsRelationKind where toQueryParam :: ModelsRelationKind -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ModelsRelationKind -> Text) -> ModelsRelationKind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsRelationKind -> Text
fromModelsRelationKind
instance WH.FromHttpApiData ModelsRelationKind where parseQueryParam :: Text -> Either Text ModelsRelationKind
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ModelsRelationKind)
-> Either Text ModelsRelationKind
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text)
-> Either String ModelsRelationKind
-> Either Text ModelsRelationKind
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left String -> Text
T.pack (Either String ModelsRelationKind
 -> Either Text ModelsRelationKind)
-> (Text -> Either String ModelsRelationKind)
-> Text
-> Either Text ModelsRelationKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ModelsRelationKind
toModelsRelationKind
instance MimeRender MimeMultipartFormData ModelsRelationKind where mimeRender :: Proxy MimeMultipartFormData -> ModelsRelationKind -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ModelsRelationKind -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ModelsRelationKind' enum
fromModelsRelationKind :: ModelsRelationKind -> Text
fromModelsRelationKind :: ModelsRelationKind -> Text
fromModelsRelationKind = \case
  ModelsRelationKind
ModelsRelationKindRelationKindUnknown -> Text
"unknown"
  ModelsRelationKind
ModelsRelationKindRelationKindSubtask -> Text
"subtask"
  ModelsRelationKind
ModelsRelationKindRelationKindParenttask -> Text
"parenttask"
  ModelsRelationKind
ModelsRelationKindRelationKindRelated -> Text
"related"
  ModelsRelationKind
ModelsRelationKindRelationKindDuplicateOf -> Text
"duplicateof"
  ModelsRelationKind
ModelsRelationKindRelationKindDuplicates -> Text
"duplicates"
  ModelsRelationKind
ModelsRelationKindRelationKindBlocking -> Text
"blocking"
  ModelsRelationKind
ModelsRelationKindRelationKindBlocked -> Text
"blocked"
  ModelsRelationKind
ModelsRelationKindRelationKindPreceeds -> Text
"precedes"
  ModelsRelationKind
ModelsRelationKindRelationKindFollows -> Text
"follows"
  ModelsRelationKind
ModelsRelationKindRelationKindCopiedFrom -> Text
"copiedfrom"
  ModelsRelationKind
ModelsRelationKindRelationKindCopiedTo -> Text
"copiedto"

-- | parse 'ModelsRelationKind' enum
toModelsRelationKind :: Text -> P.Either String ModelsRelationKind
toModelsRelationKind :: Text -> Either String ModelsRelationKind
toModelsRelationKind = \case
  Text
"unknown" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindUnknown
  Text
"subtask" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindSubtask
  Text
"parenttask" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindParenttask
  Text
"related" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindRelated
  Text
"duplicateof" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindDuplicateOf
  Text
"duplicates" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindDuplicates
  Text
"blocking" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindBlocking
  Text
"blocked" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindBlocked
  Text
"precedes" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindPreceeds
  Text
"follows" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindFollows
  Text
"copiedfrom" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindCopiedFrom
  Text
"copiedto" -> ModelsRelationKind -> Either String ModelsRelationKind
forall a b. b -> Either a b
P.Right ModelsRelationKind
ModelsRelationKindRelationKindCopiedTo
  Text
s -> String -> Either String ModelsRelationKind
forall a b. a -> Either a b
P.Left (String -> Either String ModelsRelationKind)
-> String -> Either String ModelsRelationKind
forall a b. (a -> b) -> a -> b
$ String
"toModelsRelationKind: enum parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> String
forall a. Show a => a -> String
P.show Text
s


-- ** ModelsReminderRelation

-- | Enum of 'Text'
data ModelsReminderRelation
  = ModelsReminderRelationReminderRelationDueDate -- ^ @"due_date"@
  | ModelsReminderRelationReminderRelationStartDate -- ^ @"start_date"@
  | ModelsReminderRelationReminderRelationEndDate -- ^ @"end_date"@
  deriving (Int -> ModelsReminderRelation -> ShowS
[ModelsReminderRelation] -> ShowS
ModelsReminderRelation -> String
(Int -> ModelsReminderRelation -> ShowS)
-> (ModelsReminderRelation -> String)
-> ([ModelsReminderRelation] -> ShowS)
-> Show ModelsReminderRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsReminderRelation] -> ShowS
$cshowList :: [ModelsReminderRelation] -> ShowS
show :: ModelsReminderRelation -> String
$cshow :: ModelsReminderRelation -> String
showsPrec :: Int -> ModelsReminderRelation -> ShowS
$cshowsPrec :: Int -> ModelsReminderRelation -> ShowS
P.Show, ModelsReminderRelation -> ModelsReminderRelation -> Bool
(ModelsReminderRelation -> ModelsReminderRelation -> Bool)
-> (ModelsReminderRelation -> ModelsReminderRelation -> Bool)
-> Eq ModelsReminderRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
$c/= :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
== :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
$c== :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
P.Eq, P.Typeable, Eq ModelsReminderRelation
Eq ModelsReminderRelation
-> (ModelsReminderRelation -> ModelsReminderRelation -> Ordering)
-> (ModelsReminderRelation -> ModelsReminderRelation -> Bool)
-> (ModelsReminderRelation -> ModelsReminderRelation -> Bool)
-> (ModelsReminderRelation -> ModelsReminderRelation -> Bool)
-> (ModelsReminderRelation -> ModelsReminderRelation -> Bool)
-> (ModelsReminderRelation
    -> ModelsReminderRelation -> ModelsReminderRelation)
-> (ModelsReminderRelation
    -> ModelsReminderRelation -> ModelsReminderRelation)
-> Ord ModelsReminderRelation
ModelsReminderRelation -> ModelsReminderRelation -> Bool
ModelsReminderRelation -> ModelsReminderRelation -> Ordering
ModelsReminderRelation
-> ModelsReminderRelation -> ModelsReminderRelation
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
min :: ModelsReminderRelation
-> ModelsReminderRelation -> ModelsReminderRelation
$cmin :: ModelsReminderRelation
-> ModelsReminderRelation -> ModelsReminderRelation
max :: ModelsReminderRelation
-> ModelsReminderRelation -> ModelsReminderRelation
$cmax :: ModelsReminderRelation
-> ModelsReminderRelation -> ModelsReminderRelation
>= :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
$c>= :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
> :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
$c> :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
<= :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
$c<= :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
< :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
$c< :: ModelsReminderRelation -> ModelsReminderRelation -> Bool
compare :: ModelsReminderRelation -> ModelsReminderRelation -> Ordering
$ccompare :: ModelsReminderRelation -> ModelsReminderRelation -> Ordering
$cp1Ord :: Eq ModelsReminderRelation
P.Ord, ModelsReminderRelation
ModelsReminderRelation
-> ModelsReminderRelation -> Bounded ModelsReminderRelation
forall a. a -> a -> Bounded a
maxBound :: ModelsReminderRelation
$cmaxBound :: ModelsReminderRelation
minBound :: ModelsReminderRelation
$cminBound :: ModelsReminderRelation
P.Bounded, Int -> ModelsReminderRelation
ModelsReminderRelation -> Int
ModelsReminderRelation -> [ModelsReminderRelation]
ModelsReminderRelation -> ModelsReminderRelation
ModelsReminderRelation
-> ModelsReminderRelation -> [ModelsReminderRelation]
ModelsReminderRelation
-> ModelsReminderRelation
-> ModelsReminderRelation
-> [ModelsReminderRelation]
(ModelsReminderRelation -> ModelsReminderRelation)
-> (ModelsReminderRelation -> ModelsReminderRelation)
-> (Int -> ModelsReminderRelation)
-> (ModelsReminderRelation -> Int)
-> (ModelsReminderRelation -> [ModelsReminderRelation])
-> (ModelsReminderRelation
    -> ModelsReminderRelation -> [ModelsReminderRelation])
-> (ModelsReminderRelation
    -> ModelsReminderRelation -> [ModelsReminderRelation])
-> (ModelsReminderRelation
    -> ModelsReminderRelation
    -> ModelsReminderRelation
    -> [ModelsReminderRelation])
-> Enum ModelsReminderRelation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModelsReminderRelation
-> ModelsReminderRelation
-> ModelsReminderRelation
-> [ModelsReminderRelation]
$cenumFromThenTo :: ModelsReminderRelation
-> ModelsReminderRelation
-> ModelsReminderRelation
-> [ModelsReminderRelation]
enumFromTo :: ModelsReminderRelation
-> ModelsReminderRelation -> [ModelsReminderRelation]
$cenumFromTo :: ModelsReminderRelation
-> ModelsReminderRelation -> [ModelsReminderRelation]
enumFromThen :: ModelsReminderRelation
-> ModelsReminderRelation -> [ModelsReminderRelation]
$cenumFromThen :: ModelsReminderRelation
-> ModelsReminderRelation -> [ModelsReminderRelation]
enumFrom :: ModelsReminderRelation -> [ModelsReminderRelation]
$cenumFrom :: ModelsReminderRelation -> [ModelsReminderRelation]
fromEnum :: ModelsReminderRelation -> Int
$cfromEnum :: ModelsReminderRelation -> Int
toEnum :: Int -> ModelsReminderRelation
$ctoEnum :: Int -> ModelsReminderRelation
pred :: ModelsReminderRelation -> ModelsReminderRelation
$cpred :: ModelsReminderRelation -> ModelsReminderRelation
succ :: ModelsReminderRelation -> ModelsReminderRelation
$csucc :: ModelsReminderRelation -> ModelsReminderRelation
P.Enum)

instance A.ToJSON ModelsReminderRelation where toJSON :: ModelsReminderRelation -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ModelsReminderRelation -> Text)
-> ModelsReminderRelation
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsReminderRelation -> Text
fromModelsReminderRelation
instance A.FromJSON ModelsReminderRelation where parseJSON :: Value -> Parser ModelsReminderRelation
parseJSON Value
o = (String -> Parser ModelsReminderRelation)
-> (ModelsReminderRelation -> Parser ModelsReminderRelation)
-> Either String ModelsReminderRelation
-> Parser ModelsReminderRelation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either String -> Parser ModelsReminderRelation
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (ModelsReminderRelation -> Parser ModelsReminderRelation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModelsReminderRelation -> Parser ModelsReminderRelation)
-> (ModelsReminderRelation -> ModelsReminderRelation)
-> ModelsReminderRelation
-> Parser ModelsReminderRelation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsReminderRelation -> ModelsReminderRelation
forall a. a -> a
P.id) (Either String ModelsReminderRelation
 -> Parser ModelsReminderRelation)
-> (Text -> Either String ModelsReminderRelation)
-> Text
-> Parser ModelsReminderRelation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ModelsReminderRelation
toModelsReminderRelation (Text -> Parser ModelsReminderRelation)
-> Parser Text -> Parser ModelsReminderRelation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ModelsReminderRelation where toQueryParam :: ModelsReminderRelation -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ModelsReminderRelation -> Text)
-> ModelsReminderRelation
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsReminderRelation -> Text
fromModelsReminderRelation
instance WH.FromHttpApiData ModelsReminderRelation where parseQueryParam :: Text -> Either Text ModelsReminderRelation
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ModelsReminderRelation)
-> Either Text ModelsReminderRelation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text)
-> Either String ModelsReminderRelation
-> Either Text ModelsReminderRelation
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left String -> Text
T.pack (Either String ModelsReminderRelation
 -> Either Text ModelsReminderRelation)
-> (Text -> Either String ModelsReminderRelation)
-> Text
-> Either Text ModelsReminderRelation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ModelsReminderRelation
toModelsReminderRelation
instance MimeRender MimeMultipartFormData ModelsReminderRelation where mimeRender :: Proxy MimeMultipartFormData -> ModelsReminderRelation -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ModelsReminderRelation -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ModelsReminderRelation' enum
fromModelsReminderRelation :: ModelsReminderRelation -> Text
fromModelsReminderRelation :: ModelsReminderRelation -> Text
fromModelsReminderRelation = \case
  ModelsReminderRelation
ModelsReminderRelationReminderRelationDueDate -> Text
"due_date"
  ModelsReminderRelation
ModelsReminderRelationReminderRelationStartDate -> Text
"start_date"
  ModelsReminderRelation
ModelsReminderRelationReminderRelationEndDate -> Text
"end_date"

-- | parse 'ModelsReminderRelation' enum
toModelsReminderRelation :: Text -> P.Either String ModelsReminderRelation
toModelsReminderRelation :: Text -> Either String ModelsReminderRelation
toModelsReminderRelation = \case
  Text
"due_date" -> ModelsReminderRelation -> Either String ModelsReminderRelation
forall a b. b -> Either a b
P.Right ModelsReminderRelation
ModelsReminderRelationReminderRelationDueDate
  Text
"start_date" -> ModelsReminderRelation -> Either String ModelsReminderRelation
forall a b. b -> Either a b
P.Right ModelsReminderRelation
ModelsReminderRelationReminderRelationStartDate
  Text
"end_date" -> ModelsReminderRelation -> Either String ModelsReminderRelation
forall a b. b -> Either a b
P.Right ModelsReminderRelation
ModelsReminderRelationReminderRelationEndDate
  Text
s -> String -> Either String ModelsReminderRelation
forall a b. a -> Either a b
P.Left (String -> Either String ModelsReminderRelation)
-> String -> Either String ModelsReminderRelation
forall a b. (a -> b) -> a -> b
$ String
"toModelsReminderRelation: enum parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> String
forall a. Show a => a -> String
P.show Text
s


-- ** ModelsRight

-- | Enum of 'Int'
data ModelsRight
  = ModelsRightRightRead -- ^ @0@
  | ModelsRightRightWrite -- ^ @1@
  | ModelsRightRightAdmin -- ^ @2@
  deriving (Int -> ModelsRight -> ShowS
[ModelsRight] -> ShowS
ModelsRight -> String
(Int -> ModelsRight -> ShowS)
-> (ModelsRight -> String)
-> ([ModelsRight] -> ShowS)
-> Show ModelsRight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsRight] -> ShowS
$cshowList :: [ModelsRight] -> ShowS
show :: ModelsRight -> String
$cshow :: ModelsRight -> String
showsPrec :: Int -> ModelsRight -> ShowS
$cshowsPrec :: Int -> ModelsRight -> ShowS
P.Show, ModelsRight -> ModelsRight -> Bool
(ModelsRight -> ModelsRight -> Bool)
-> (ModelsRight -> ModelsRight -> Bool) -> Eq ModelsRight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsRight -> ModelsRight -> Bool
$c/= :: ModelsRight -> ModelsRight -> Bool
== :: ModelsRight -> ModelsRight -> Bool
$c== :: ModelsRight -> ModelsRight -> Bool
P.Eq, P.Typeable, Eq ModelsRight
Eq ModelsRight
-> (ModelsRight -> ModelsRight -> Ordering)
-> (ModelsRight -> ModelsRight -> Bool)
-> (ModelsRight -> ModelsRight -> Bool)
-> (ModelsRight -> ModelsRight -> Bool)
-> (ModelsRight -> ModelsRight -> Bool)
-> (ModelsRight -> ModelsRight -> ModelsRight)
-> (ModelsRight -> ModelsRight -> ModelsRight)
-> Ord ModelsRight
ModelsRight -> ModelsRight -> Bool
ModelsRight -> ModelsRight -> Ordering
ModelsRight -> ModelsRight -> ModelsRight
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
min :: ModelsRight -> ModelsRight -> ModelsRight
$cmin :: ModelsRight -> ModelsRight -> ModelsRight
max :: ModelsRight -> ModelsRight -> ModelsRight
$cmax :: ModelsRight -> ModelsRight -> ModelsRight
>= :: ModelsRight -> ModelsRight -> Bool
$c>= :: ModelsRight -> ModelsRight -> Bool
> :: ModelsRight -> ModelsRight -> Bool
$c> :: ModelsRight -> ModelsRight -> Bool
<= :: ModelsRight -> ModelsRight -> Bool
$c<= :: ModelsRight -> ModelsRight -> Bool
< :: ModelsRight -> ModelsRight -> Bool
$c< :: ModelsRight -> ModelsRight -> Bool
compare :: ModelsRight -> ModelsRight -> Ordering
$ccompare :: ModelsRight -> ModelsRight -> Ordering
$cp1Ord :: Eq ModelsRight
P.Ord, ModelsRight
ModelsRight -> ModelsRight -> Bounded ModelsRight
forall a. a -> a -> Bounded a
maxBound :: ModelsRight
$cmaxBound :: ModelsRight
minBound :: ModelsRight
$cminBound :: ModelsRight
P.Bounded, Int -> ModelsRight
ModelsRight -> Int
ModelsRight -> [ModelsRight]
ModelsRight -> ModelsRight
ModelsRight -> ModelsRight -> [ModelsRight]
ModelsRight -> ModelsRight -> ModelsRight -> [ModelsRight]
(ModelsRight -> ModelsRight)
-> (ModelsRight -> ModelsRight)
-> (Int -> ModelsRight)
-> (ModelsRight -> Int)
-> (ModelsRight -> [ModelsRight])
-> (ModelsRight -> ModelsRight -> [ModelsRight])
-> (ModelsRight -> ModelsRight -> [ModelsRight])
-> (ModelsRight -> ModelsRight -> ModelsRight -> [ModelsRight])
-> Enum ModelsRight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModelsRight -> ModelsRight -> ModelsRight -> [ModelsRight]
$cenumFromThenTo :: ModelsRight -> ModelsRight -> ModelsRight -> [ModelsRight]
enumFromTo :: ModelsRight -> ModelsRight -> [ModelsRight]
$cenumFromTo :: ModelsRight -> ModelsRight -> [ModelsRight]
enumFromThen :: ModelsRight -> ModelsRight -> [ModelsRight]
$cenumFromThen :: ModelsRight -> ModelsRight -> [ModelsRight]
enumFrom :: ModelsRight -> [ModelsRight]
$cenumFrom :: ModelsRight -> [ModelsRight]
fromEnum :: ModelsRight -> Int
$cfromEnum :: ModelsRight -> Int
toEnum :: Int -> ModelsRight
$ctoEnum :: Int -> ModelsRight
pred :: ModelsRight -> ModelsRight
$cpred :: ModelsRight -> ModelsRight
succ :: ModelsRight -> ModelsRight
$csucc :: ModelsRight -> ModelsRight
P.Enum)

instance A.ToJSON ModelsRight where toJSON :: ModelsRight -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Int -> Value) -> (ModelsRight -> Int) -> ModelsRight -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsRight -> Int
fromModelsRight
instance A.FromJSON ModelsRight where parseJSON :: Value -> Parser ModelsRight
parseJSON Value
o = (String -> Parser ModelsRight)
-> (ModelsRight -> Parser ModelsRight)
-> Either String ModelsRight
-> Parser ModelsRight
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either String -> Parser ModelsRight
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (ModelsRight -> Parser ModelsRight
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModelsRight -> Parser ModelsRight)
-> (ModelsRight -> ModelsRight)
-> ModelsRight
-> Parser ModelsRight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsRight -> ModelsRight
forall a. a -> a
P.id) (Either String ModelsRight -> Parser ModelsRight)
-> (Int -> Either String ModelsRight) -> Int -> Parser ModelsRight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsRight
toModelsRight (Int -> Parser ModelsRight) -> Parser Int -> Parser ModelsRight
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ModelsRight where toQueryParam :: ModelsRight -> Text
toQueryParam = Int -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Int -> Text) -> (ModelsRight -> Int) -> ModelsRight -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsRight -> Int
fromModelsRight
instance WH.FromHttpApiData ModelsRight where parseQueryParam :: Text -> Either Text ModelsRight
parseQueryParam Text
o = Text -> Either Text Int
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Int
-> (Int -> Either Text ModelsRight) -> Either Text ModelsRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text)
-> Either String ModelsRight -> Either Text ModelsRight
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left String -> Text
T.pack (Either String ModelsRight -> Either Text ModelsRight)
-> (Int -> Either String ModelsRight)
-> Int
-> Either Text ModelsRight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsRight
toModelsRight
instance MimeRender MimeMultipartFormData ModelsRight where mimeRender :: Proxy MimeMultipartFormData -> ModelsRight -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ModelsRight -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ModelsRight' enum
fromModelsRight :: ModelsRight -> Int
fromModelsRight :: ModelsRight -> Int
fromModelsRight = \case
  ModelsRight
ModelsRightRightRead -> Int
0
  ModelsRight
ModelsRightRightWrite -> Int
1
  ModelsRight
ModelsRightRightAdmin -> Int
2

-- | parse 'ModelsRight' enum
toModelsRight :: Int -> P.Either String ModelsRight
toModelsRight :: Int -> Either String ModelsRight
toModelsRight = \case
  Int
0 -> ModelsRight -> Either String ModelsRight
forall a b. b -> Either a b
P.Right ModelsRight
ModelsRightRightRead
  Int
1 -> ModelsRight -> Either String ModelsRight
forall a b. b -> Either a b
P.Right ModelsRight
ModelsRightRightWrite
  Int
2 -> ModelsRight -> Either String ModelsRight
forall a b. b -> Either a b
P.Right ModelsRight
ModelsRightRightAdmin
  Int
s -> String -> Either String ModelsRight
forall a b. a -> Either a b
P.Left (String -> Either String ModelsRight)
-> String -> Either String ModelsRight
forall a b. (a -> b) -> a -> b
$ String
"toModelsRight: enum parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Int -> String
forall a. Show a => a -> String
P.show Int
s


-- ** ModelsSharingType

-- | Enum of 'Int'
data ModelsSharingType
  = ModelsSharingTypeSharingTypeUnknown -- ^ @0@
  | ModelsSharingTypeSharingTypeWithoutPassword -- ^ @1@
  | ModelsSharingTypeSharingTypeWithPassword -- ^ @2@
  deriving (Int -> ModelsSharingType -> ShowS
[ModelsSharingType] -> ShowS
ModelsSharingType -> String
(Int -> ModelsSharingType -> ShowS)
-> (ModelsSharingType -> String)
-> ([ModelsSharingType] -> ShowS)
-> Show ModelsSharingType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsSharingType] -> ShowS
$cshowList :: [ModelsSharingType] -> ShowS
show :: ModelsSharingType -> String
$cshow :: ModelsSharingType -> String
showsPrec :: Int -> ModelsSharingType -> ShowS
$cshowsPrec :: Int -> ModelsSharingType -> ShowS
P.Show, ModelsSharingType -> ModelsSharingType -> Bool
(ModelsSharingType -> ModelsSharingType -> Bool)
-> (ModelsSharingType -> ModelsSharingType -> Bool)
-> Eq ModelsSharingType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsSharingType -> ModelsSharingType -> Bool
$c/= :: ModelsSharingType -> ModelsSharingType -> Bool
== :: ModelsSharingType -> ModelsSharingType -> Bool
$c== :: ModelsSharingType -> ModelsSharingType -> Bool
P.Eq, P.Typeable, Eq ModelsSharingType
Eq ModelsSharingType
-> (ModelsSharingType -> ModelsSharingType -> Ordering)
-> (ModelsSharingType -> ModelsSharingType -> Bool)
-> (ModelsSharingType -> ModelsSharingType -> Bool)
-> (ModelsSharingType -> ModelsSharingType -> Bool)
-> (ModelsSharingType -> ModelsSharingType -> Bool)
-> (ModelsSharingType -> ModelsSharingType -> ModelsSharingType)
-> (ModelsSharingType -> ModelsSharingType -> ModelsSharingType)
-> Ord ModelsSharingType
ModelsSharingType -> ModelsSharingType -> Bool
ModelsSharingType -> ModelsSharingType -> Ordering
ModelsSharingType -> ModelsSharingType -> ModelsSharingType
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
min :: ModelsSharingType -> ModelsSharingType -> ModelsSharingType
$cmin :: ModelsSharingType -> ModelsSharingType -> ModelsSharingType
max :: ModelsSharingType -> ModelsSharingType -> ModelsSharingType
$cmax :: ModelsSharingType -> ModelsSharingType -> ModelsSharingType
>= :: ModelsSharingType -> ModelsSharingType -> Bool
$c>= :: ModelsSharingType -> ModelsSharingType -> Bool
> :: ModelsSharingType -> ModelsSharingType -> Bool
$c> :: ModelsSharingType -> ModelsSharingType -> Bool
<= :: ModelsSharingType -> ModelsSharingType -> Bool
$c<= :: ModelsSharingType -> ModelsSharingType -> Bool
< :: ModelsSharingType -> ModelsSharingType -> Bool
$c< :: ModelsSharingType -> ModelsSharingType -> Bool
compare :: ModelsSharingType -> ModelsSharingType -> Ordering
$ccompare :: ModelsSharingType -> ModelsSharingType -> Ordering
$cp1Ord :: Eq ModelsSharingType
P.Ord, ModelsSharingType
ModelsSharingType -> ModelsSharingType -> Bounded ModelsSharingType
forall a. a -> a -> Bounded a
maxBound :: ModelsSharingType
$cmaxBound :: ModelsSharingType
minBound :: ModelsSharingType
$cminBound :: ModelsSharingType
P.Bounded, Int -> ModelsSharingType
ModelsSharingType -> Int
ModelsSharingType -> [ModelsSharingType]
ModelsSharingType -> ModelsSharingType
ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
ModelsSharingType
-> ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
(ModelsSharingType -> ModelsSharingType)
-> (ModelsSharingType -> ModelsSharingType)
-> (Int -> ModelsSharingType)
-> (ModelsSharingType -> Int)
-> (ModelsSharingType -> [ModelsSharingType])
-> (ModelsSharingType -> ModelsSharingType -> [ModelsSharingType])
-> (ModelsSharingType -> ModelsSharingType -> [ModelsSharingType])
-> (ModelsSharingType
    -> ModelsSharingType -> ModelsSharingType -> [ModelsSharingType])
-> Enum ModelsSharingType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModelsSharingType
-> ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
$cenumFromThenTo :: ModelsSharingType
-> ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
enumFromTo :: ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
$cenumFromTo :: ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
enumFromThen :: ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
$cenumFromThen :: ModelsSharingType -> ModelsSharingType -> [ModelsSharingType]
enumFrom :: ModelsSharingType -> [ModelsSharingType]
$cenumFrom :: ModelsSharingType -> [ModelsSharingType]
fromEnum :: ModelsSharingType -> Int
$cfromEnum :: ModelsSharingType -> Int
toEnum :: Int -> ModelsSharingType
$ctoEnum :: Int -> ModelsSharingType
pred :: ModelsSharingType -> ModelsSharingType
$cpred :: ModelsSharingType -> ModelsSharingType
succ :: ModelsSharingType -> ModelsSharingType
$csucc :: ModelsSharingType -> ModelsSharingType
P.Enum)

instance A.ToJSON ModelsSharingType where toJSON :: ModelsSharingType -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Int -> Value)
-> (ModelsSharingType -> Int) -> ModelsSharingType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsSharingType -> Int
fromModelsSharingType
instance A.FromJSON ModelsSharingType where parseJSON :: Value -> Parser ModelsSharingType
parseJSON Value
o = (String -> Parser ModelsSharingType)
-> (ModelsSharingType -> Parser ModelsSharingType)
-> Either String ModelsSharingType
-> Parser ModelsSharingType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either String -> Parser ModelsSharingType
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (ModelsSharingType -> Parser ModelsSharingType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModelsSharingType -> Parser ModelsSharingType)
-> (ModelsSharingType -> ModelsSharingType)
-> ModelsSharingType
-> Parser ModelsSharingType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsSharingType -> ModelsSharingType
forall a. a -> a
P.id) (Either String ModelsSharingType -> Parser ModelsSharingType)
-> (Int -> Either String ModelsSharingType)
-> Int
-> Parser ModelsSharingType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsSharingType
toModelsSharingType (Int -> Parser ModelsSharingType)
-> Parser Int -> Parser ModelsSharingType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ModelsSharingType where toQueryParam :: ModelsSharingType -> Text
toQueryParam = Int -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Int -> Text)
-> (ModelsSharingType -> Int) -> ModelsSharingType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsSharingType -> Int
fromModelsSharingType
instance WH.FromHttpApiData ModelsSharingType where parseQueryParam :: Text -> Either Text ModelsSharingType
parseQueryParam Text
o = Text -> Either Text Int
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Int
-> (Int -> Either Text ModelsSharingType)
-> Either Text ModelsSharingType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text)
-> Either String ModelsSharingType -> Either Text ModelsSharingType
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left String -> Text
T.pack (Either String ModelsSharingType -> Either Text ModelsSharingType)
-> (Int -> Either String ModelsSharingType)
-> Int
-> Either Text ModelsSharingType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsSharingType
toModelsSharingType
instance MimeRender MimeMultipartFormData ModelsSharingType where mimeRender :: Proxy MimeMultipartFormData -> ModelsSharingType -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ModelsSharingType -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ModelsSharingType' enum
fromModelsSharingType :: ModelsSharingType -> Int
fromModelsSharingType :: ModelsSharingType -> Int
fromModelsSharingType = \case
  ModelsSharingType
ModelsSharingTypeSharingTypeUnknown -> Int
0
  ModelsSharingType
ModelsSharingTypeSharingTypeWithoutPassword -> Int
1
  ModelsSharingType
ModelsSharingTypeSharingTypeWithPassword -> Int
2

-- | parse 'ModelsSharingType' enum
toModelsSharingType :: Int -> P.Either String ModelsSharingType
toModelsSharingType :: Int -> Either String ModelsSharingType
toModelsSharingType = \case
  Int
0 -> ModelsSharingType -> Either String ModelsSharingType
forall a b. b -> Either a b
P.Right ModelsSharingType
ModelsSharingTypeSharingTypeUnknown
  Int
1 -> ModelsSharingType -> Either String ModelsSharingType
forall a b. b -> Either a b
P.Right ModelsSharingType
ModelsSharingTypeSharingTypeWithoutPassword
  Int
2 -> ModelsSharingType -> Either String ModelsSharingType
forall a b. b -> Either a b
P.Right ModelsSharingType
ModelsSharingTypeSharingTypeWithPassword
  Int
s -> String -> Either String ModelsSharingType
forall a b. a -> Either a b
P.Left (String -> Either String ModelsSharingType)
-> String -> Either String ModelsSharingType
forall a b. (a -> b) -> a -> b
$ String
"toModelsSharingType: enum parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Int -> String
forall a. Show a => a -> String
P.show Int
s


-- ** ModelsTaskRepeatMode

-- | Enum of 'Int'
data ModelsTaskRepeatMode
  = ModelsTaskRepeatModeTaskRepeatModeDefault -- ^ @0@
  | ModelsTaskRepeatModeTaskRepeatModeMonth -- ^ @1@
  | ModelsTaskRepeatModeTaskRepeatModeFromCurrentDate -- ^ @2@
  deriving (Int -> ModelsTaskRepeatMode -> ShowS
[ModelsTaskRepeatMode] -> ShowS
ModelsTaskRepeatMode -> String
(Int -> ModelsTaskRepeatMode -> ShowS)
-> (ModelsTaskRepeatMode -> String)
-> ([ModelsTaskRepeatMode] -> ShowS)
-> Show ModelsTaskRepeatMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelsTaskRepeatMode] -> ShowS
$cshowList :: [ModelsTaskRepeatMode] -> ShowS
show :: ModelsTaskRepeatMode -> String
$cshow :: ModelsTaskRepeatMode -> String
showsPrec :: Int -> ModelsTaskRepeatMode -> ShowS
$cshowsPrec :: Int -> ModelsTaskRepeatMode -> ShowS
P.Show, ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
(ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool)
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool)
-> Eq ModelsTaskRepeatMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
$c/= :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
== :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
$c== :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
P.Eq, P.Typeable, Eq ModelsTaskRepeatMode
Eq ModelsTaskRepeatMode
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Ordering)
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool)
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool)
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool)
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool)
-> (ModelsTaskRepeatMode
    -> ModelsTaskRepeatMode -> ModelsTaskRepeatMode)
-> (ModelsTaskRepeatMode
    -> ModelsTaskRepeatMode -> ModelsTaskRepeatMode)
-> Ord ModelsTaskRepeatMode
ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Ordering
ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> ModelsTaskRepeatMode
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
min :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> ModelsTaskRepeatMode
$cmin :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> ModelsTaskRepeatMode
max :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> ModelsTaskRepeatMode
$cmax :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> ModelsTaskRepeatMode
>= :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
$c>= :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
> :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
$c> :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
<= :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
$c<= :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
< :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
$c< :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Bool
compare :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Ordering
$ccompare :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode -> Ordering
$cp1Ord :: Eq ModelsTaskRepeatMode
P.Ord, ModelsTaskRepeatMode
ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> Bounded ModelsTaskRepeatMode
forall a. a -> a -> Bounded a
maxBound :: ModelsTaskRepeatMode
$cmaxBound :: ModelsTaskRepeatMode
minBound :: ModelsTaskRepeatMode
$cminBound :: ModelsTaskRepeatMode
P.Bounded, Int -> ModelsTaskRepeatMode
ModelsTaskRepeatMode -> Int
ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
ModelsTaskRepeatMode -> ModelsTaskRepeatMode
ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
ModelsTaskRepeatMode
-> ModelsTaskRepeatMode
-> ModelsTaskRepeatMode
-> [ModelsTaskRepeatMode]
(ModelsTaskRepeatMode -> ModelsTaskRepeatMode)
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode)
-> (Int -> ModelsTaskRepeatMode)
-> (ModelsTaskRepeatMode -> Int)
-> (ModelsTaskRepeatMode -> [ModelsTaskRepeatMode])
-> (ModelsTaskRepeatMode
    -> ModelsTaskRepeatMode -> [ModelsTaskRepeatMode])
-> (ModelsTaskRepeatMode
    -> ModelsTaskRepeatMode -> [ModelsTaskRepeatMode])
-> (ModelsTaskRepeatMode
    -> ModelsTaskRepeatMode
    -> ModelsTaskRepeatMode
    -> [ModelsTaskRepeatMode])
-> Enum ModelsTaskRepeatMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode
-> ModelsTaskRepeatMode
-> [ModelsTaskRepeatMode]
$cenumFromThenTo :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode
-> ModelsTaskRepeatMode
-> [ModelsTaskRepeatMode]
enumFromTo :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
$cenumFromTo :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
enumFromThen :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
$cenumFromThen :: ModelsTaskRepeatMode
-> ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
enumFrom :: ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
$cenumFrom :: ModelsTaskRepeatMode -> [ModelsTaskRepeatMode]
fromEnum :: ModelsTaskRepeatMode -> Int
$cfromEnum :: ModelsTaskRepeatMode -> Int
toEnum :: Int -> ModelsTaskRepeatMode
$ctoEnum :: Int -> ModelsTaskRepeatMode
pred :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode
$cpred :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode
succ :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode
$csucc :: ModelsTaskRepeatMode -> ModelsTaskRepeatMode
P.Enum)

instance A.ToJSON ModelsTaskRepeatMode where toJSON :: ModelsTaskRepeatMode -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Int -> Value)
-> (ModelsTaskRepeatMode -> Int) -> ModelsTaskRepeatMode -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsTaskRepeatMode -> Int
fromModelsTaskRepeatMode
instance A.FromJSON ModelsTaskRepeatMode where parseJSON :: Value -> Parser ModelsTaskRepeatMode
parseJSON Value
o = (String -> Parser ModelsTaskRepeatMode)
-> (ModelsTaskRepeatMode -> Parser ModelsTaskRepeatMode)
-> Either String ModelsTaskRepeatMode
-> Parser ModelsTaskRepeatMode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either String -> Parser ModelsTaskRepeatMode
forall (m :: * -> *) a. MonadFail m => String -> m a
P.fail (ModelsTaskRepeatMode -> Parser ModelsTaskRepeatMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModelsTaskRepeatMode -> Parser ModelsTaskRepeatMode)
-> (ModelsTaskRepeatMode -> ModelsTaskRepeatMode)
-> ModelsTaskRepeatMode
-> Parser ModelsTaskRepeatMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsTaskRepeatMode -> ModelsTaskRepeatMode
forall a. a -> a
P.id) (Either String ModelsTaskRepeatMode -> Parser ModelsTaskRepeatMode)
-> (Int -> Either String ModelsTaskRepeatMode)
-> Int
-> Parser ModelsTaskRepeatMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsTaskRepeatMode
toModelsTaskRepeatMode (Int -> Parser ModelsTaskRepeatMode)
-> Parser Int -> Parser ModelsTaskRepeatMode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ModelsTaskRepeatMode where toQueryParam :: ModelsTaskRepeatMode -> Text
toQueryParam = Int -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Int -> Text)
-> (ModelsTaskRepeatMode -> Int) -> ModelsTaskRepeatMode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelsTaskRepeatMode -> Int
fromModelsTaskRepeatMode
instance WH.FromHttpApiData ModelsTaskRepeatMode where parseQueryParam :: Text -> Either Text ModelsTaskRepeatMode
parseQueryParam Text
o = Text -> Either Text Int
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Int
-> (Int -> Either Text ModelsTaskRepeatMode)
-> Either Text ModelsTaskRepeatMode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text)
-> Either String ModelsTaskRepeatMode
-> Either Text ModelsTaskRepeatMode
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left String -> Text
T.pack (Either String ModelsTaskRepeatMode
 -> Either Text ModelsTaskRepeatMode)
-> (Int -> Either String ModelsTaskRepeatMode)
-> Int
-> Either Text ModelsTaskRepeatMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String ModelsTaskRepeatMode
toModelsTaskRepeatMode
instance MimeRender MimeMultipartFormData ModelsTaskRepeatMode where mimeRender :: Proxy MimeMultipartFormData -> ModelsTaskRepeatMode -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ModelsTaskRepeatMode -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ModelsTaskRepeatMode' enum
fromModelsTaskRepeatMode :: ModelsTaskRepeatMode -> Int
fromModelsTaskRepeatMode :: ModelsTaskRepeatMode -> Int
fromModelsTaskRepeatMode = \case
  ModelsTaskRepeatMode
ModelsTaskRepeatModeTaskRepeatModeDefault -> Int
0
  ModelsTaskRepeatMode
ModelsTaskRepeatModeTaskRepeatModeMonth -> Int
1
  ModelsTaskRepeatMode
ModelsTaskRepeatModeTaskRepeatModeFromCurrentDate -> Int
2

-- | parse 'ModelsTaskRepeatMode' enum
toModelsTaskRepeatMode :: Int -> P.Either String ModelsTaskRepeatMode
toModelsTaskRepeatMode :: Int -> Either String ModelsTaskRepeatMode
toModelsTaskRepeatMode = \case
  Int
0 -> ModelsTaskRepeatMode -> Either String ModelsTaskRepeatMode
forall a b. b -> Either a b
P.Right ModelsTaskRepeatMode
ModelsTaskRepeatModeTaskRepeatModeDefault
  Int
1 -> ModelsTaskRepeatMode -> Either String ModelsTaskRepeatMode
forall a b. b -> Either a b
P.Right ModelsTaskRepeatMode
ModelsTaskRepeatModeTaskRepeatModeMonth
  Int
2 -> ModelsTaskRepeatMode -> Either String ModelsTaskRepeatMode
forall a b. b -> Either a b
P.Right ModelsTaskRepeatMode
ModelsTaskRepeatModeTaskRepeatModeFromCurrentDate
  Int
s -> String -> Either String ModelsTaskRepeatMode
forall a b. a -> Either a b
P.Left (String -> Either String ModelsTaskRepeatMode)
-> String -> Either String ModelsTaskRepeatMode
forall a b. (a -> b) -> a -> b
$ String
"toModelsTaskRepeatMode: enum parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Int -> String
forall a. Show a => a -> String
P.show Int
s


-- * Auth Methods

-- ** AuthBasicBasicAuth
data AuthBasicBasicAuth =
  AuthBasicBasicAuth B.ByteString B.ByteString -- ^ username password
  deriving (AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
(AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool)
-> (AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool)
-> Eq AuthBasicBasicAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
$c/= :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
== :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
$c== :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
P.Eq, Int -> AuthBasicBasicAuth -> ShowS
[AuthBasicBasicAuth] -> ShowS
AuthBasicBasicAuth -> String
(Int -> AuthBasicBasicAuth -> ShowS)
-> (AuthBasicBasicAuth -> String)
-> ([AuthBasicBasicAuth] -> ShowS)
-> Show AuthBasicBasicAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthBasicBasicAuth] -> ShowS
$cshowList :: [AuthBasicBasicAuth] -> ShowS
show :: AuthBasicBasicAuth -> String
$cshow :: AuthBasicBasicAuth -> String
showsPrec :: Int -> AuthBasicBasicAuth -> ShowS
$cshowsPrec :: Int -> AuthBasicBasicAuth -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthBasicBasicAuth where
  applyAuthMethod :: VikunjaConfig
-> AuthBasicBasicAuth
-> VikunjaRequest req contentType res accept
-> IO (VikunjaRequest req contentType res accept)
applyAuthMethod VikunjaConfig
_ a :: AuthBasicBasicAuth
a@(AuthBasicBasicAuth ByteString
user ByteString
pw) VikunjaRequest req contentType res accept
req =
    VikunjaRequest req contentType res accept
-> IO (VikunjaRequest req contentType res accept)
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (VikunjaRequest req contentType res accept
 -> IO (VikunjaRequest req contentType res accept))
-> VikunjaRequest req contentType res accept
-> IO (VikunjaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthBasicBasicAuth -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBasicAuth
a TypeRep -> [TypeRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` VikunjaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
VikunjaRequest req contentType res accept -> [TypeRep]
rAuthTypes VikunjaRequest req contentType res accept
req)
      then VikunjaRequest req contentType res accept
req VikunjaRequest req contentType res accept
-> [Header] -> VikunjaRequest req contentType res accept
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> [Header] -> VikunjaRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", ByteString -> Text
T.decodeUtf8 ByteString
cred)
           VikunjaRequest req contentType res accept
-> (VikunjaRequest req contentType res accept
    -> VikunjaRequest req contentType res accept)
-> VikunjaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (VikunjaRequest req contentType res accept)
  (VikunjaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> VikunjaRequest req contentType res accept
-> VikunjaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (VikunjaRequest req contentType res accept)
  (VikunjaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept.
Lens_' (VikunjaRequest req contentType res accept) [TypeRep]
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthBasicBasicAuth -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBasicAuth
a))
      else VikunjaRequest req contentType res accept
req
    where cred :: ByteString
cred = ByteString -> ByteString -> ByteString
BC.append ByteString
"Basic " (ByteString -> ByteString
B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BC.concat [ ByteString
user, ByteString
":", ByteString
pw ])

-- ** AuthApiKeyJWTKeyAuth
data AuthApiKeyJWTKeyAuth =
  AuthApiKeyJWTKeyAuth Text -- ^ secret
  deriving (AuthApiKeyJWTKeyAuth -> AuthApiKeyJWTKeyAuth -> Bool
(AuthApiKeyJWTKeyAuth -> AuthApiKeyJWTKeyAuth -> Bool)
-> (AuthApiKeyJWTKeyAuth -> AuthApiKeyJWTKeyAuth -> Bool)
-> Eq AuthApiKeyJWTKeyAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthApiKeyJWTKeyAuth -> AuthApiKeyJWTKeyAuth -> Bool
$c/= :: AuthApiKeyJWTKeyAuth -> AuthApiKeyJWTKeyAuth -> Bool
== :: AuthApiKeyJWTKeyAuth -> AuthApiKeyJWTKeyAuth -> Bool
$c== :: AuthApiKeyJWTKeyAuth -> AuthApiKeyJWTKeyAuth -> Bool
P.Eq, Int -> AuthApiKeyJWTKeyAuth -> ShowS
[AuthApiKeyJWTKeyAuth] -> ShowS
AuthApiKeyJWTKeyAuth -> String
(Int -> AuthApiKeyJWTKeyAuth -> ShowS)
-> (AuthApiKeyJWTKeyAuth -> String)
-> ([AuthApiKeyJWTKeyAuth] -> ShowS)
-> Show AuthApiKeyJWTKeyAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthApiKeyJWTKeyAuth] -> ShowS
$cshowList :: [AuthApiKeyJWTKeyAuth] -> ShowS
show :: AuthApiKeyJWTKeyAuth -> String
$cshow :: AuthApiKeyJWTKeyAuth -> String
showsPrec :: Int -> AuthApiKeyJWTKeyAuth -> ShowS
$cshowsPrec :: Int -> AuthApiKeyJWTKeyAuth -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthApiKeyJWTKeyAuth where
  applyAuthMethod :: VikunjaConfig
-> AuthApiKeyJWTKeyAuth
-> VikunjaRequest req contentType res accept
-> IO (VikunjaRequest req contentType res accept)
applyAuthMethod VikunjaConfig
_ a :: AuthApiKeyJWTKeyAuth
a@(AuthApiKeyJWTKeyAuth Text
secret) VikunjaRequest req contentType res accept
req =
    VikunjaRequest req contentType res accept
-> IO (VikunjaRequest req contentType res accept)
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (VikunjaRequest req contentType res accept
 -> IO (VikunjaRequest req contentType res accept))
-> VikunjaRequest req contentType res accept
-> IO (VikunjaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthApiKeyJWTKeyAuth -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyJWTKeyAuth
a TypeRep -> [TypeRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` VikunjaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
VikunjaRequest req contentType res accept -> [TypeRep]
rAuthTypes VikunjaRequest req contentType res accept
req)
      then VikunjaRequest req contentType res accept
req VikunjaRequest req contentType res accept
-> [Header] -> VikunjaRequest req contentType res accept
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> [Header] -> VikunjaRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", Text
secret)
           VikunjaRequest req contentType res accept
-> (VikunjaRequest req contentType res accept
    -> VikunjaRequest req contentType res accept)
-> VikunjaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (VikunjaRequest req contentType res accept)
  (VikunjaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> VikunjaRequest req contentType res accept
-> VikunjaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (VikunjaRequest req contentType res accept)
  (VikunjaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept.
Lens_' (VikunjaRequest req contentType res accept) [TypeRep]
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthApiKeyJWTKeyAuth -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyJWTKeyAuth
a))
      else VikunjaRequest req contentType res accept
req