module Mensam.API.Data.Space where

import Mensam.API.Aeson
import Mensam.API.Data.Space.Permission
import Mensam.API.Data.User
import Mensam.API.Pretty

import Data.Aeson qualified as A
import Data.Int
import Data.Kind
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Time.Zones.All qualified as T
import Data.Time.Zones.All.OrphanInstances ()
import Deriving.Aeson qualified as A
import GHC.Generics
import Servant.API qualified as Servant

type Space :: Type
data Space = MkSpace
  { Space -> IdentifierSpace
spaceId :: IdentifierSpace
  , Space -> NameSpace
spaceName :: NameSpace
  , Space -> TZLabel
spaceTimezone :: T.TZLabel
  , Space -> IdentifierUser
spaceOwner :: IdentifierUser
  }
  deriving stock (Space -> Space -> Bool
(Space -> Space -> Bool) -> (Space -> Space -> Bool) -> Eq Space
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Space -> Space -> Bool
== :: Space -> Space -> Bool
$c/= :: Space -> Space -> Bool
/= :: Space -> Space -> Bool
Eq, (forall x. Space -> Rep Space x)
-> (forall x. Rep Space x -> Space) -> Generic Space
forall x. Rep Space x -> Space
forall x. Space -> Rep Space x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Space -> Rep Space x
from :: forall x. Space -> Rep Space x
$cto :: forall x. Rep Space x -> Space
to :: forall x. Rep Space x -> Space
Generic, Eq Space
Eq Space =>
(Space -> Space -> Ordering)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Space)
-> (Space -> Space -> Space)
-> Ord Space
Space -> Space -> Bool
Space -> Space -> Ordering
Space -> Space -> Space
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Space -> Space -> Ordering
compare :: Space -> Space -> Ordering
$c< :: Space -> Space -> Bool
< :: Space -> Space -> Bool
$c<= :: Space -> Space -> Bool
<= :: Space -> Space -> Bool
$c> :: Space -> Space -> Bool
> :: Space -> Space -> Bool
$c>= :: Space -> Space -> Bool
>= :: Space -> Space -> Bool
$cmax :: Space -> Space -> Space
max :: Space -> Space -> Space
$cmin :: Space -> Space -> Space
min :: Space -> Space -> Space
Ord, ReadPrec [Space]
ReadPrec Space
Int -> ReadS Space
ReadS [Space]
(Int -> ReadS Space)
-> ReadS [Space]
-> ReadPrec Space
-> ReadPrec [Space]
-> Read Space
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Space
readsPrec :: Int -> ReadS Space
$creadList :: ReadS [Space]
readList :: ReadS [Space]
$creadPrec :: ReadPrec Space
readPrec :: ReadPrec Space
$creadListPrec :: ReadPrec [Space]
readListPrec :: ReadPrec [Space]
Read, Int -> Space -> ShowS
[Space] -> ShowS
Space -> String
(Int -> Space -> ShowS)
-> (Space -> String) -> ([Space] -> ShowS) -> Show Space
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Space -> ShowS
showsPrec :: Int -> Space -> ShowS
$cshow :: Space -> String
show :: Space -> String
$cshowList :: [Space] -> ShowS
showList :: [Space] -> ShowS
Show)
  deriving
    (Value -> Parser [Space]
Value -> Parser Space
(Value -> Parser Space)
-> (Value -> Parser [Space]) -> FromJSON Space
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Space
parseJSON :: Value -> Parser Space
$cparseJSONList :: Value -> Parser [Space]
parseJSONList :: Value -> Parser [Space]
A.FromJSON, [Space] -> Value
[Space] -> Encoding
Space -> Value
Space -> Encoding
(Space -> Value)
-> (Space -> Encoding)
-> ([Space] -> Value)
-> ([Space] -> Encoding)
-> ToJSON Space
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Space -> Value
toJSON :: Space -> Value
$ctoEncoding :: Space -> Encoding
toEncoding :: Space -> Encoding
$ctoJSONList :: [Space] -> Value
toJSONList :: [Space] -> Value
$ctoEncodingList :: [Space] -> Encoding
toEncodingList :: [Space] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "space") Space

type IdentifierSpace :: Type
newtype IdentifierSpace = MkIdentifierSpace {IdentifierSpace -> Int64
unIdentifierSpace :: Int64}
  deriving stock (IdentifierSpace -> IdentifierSpace -> Bool
(IdentifierSpace -> IdentifierSpace -> Bool)
-> (IdentifierSpace -> IdentifierSpace -> Bool)
-> Eq IdentifierSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentifierSpace -> IdentifierSpace -> Bool
== :: IdentifierSpace -> IdentifierSpace -> Bool
$c/= :: IdentifierSpace -> IdentifierSpace -> Bool
/= :: IdentifierSpace -> IdentifierSpace -> Bool
Eq, (forall x. IdentifierSpace -> Rep IdentifierSpace x)
-> (forall x. Rep IdentifierSpace x -> IdentifierSpace)
-> Generic IdentifierSpace
forall x. Rep IdentifierSpace x -> IdentifierSpace
forall x. IdentifierSpace -> Rep IdentifierSpace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IdentifierSpace -> Rep IdentifierSpace x
from :: forall x. IdentifierSpace -> Rep IdentifierSpace x
$cto :: forall x. Rep IdentifierSpace x -> IdentifierSpace
to :: forall x. Rep IdentifierSpace x -> IdentifierSpace
Generic, Eq IdentifierSpace
Eq IdentifierSpace =>
(IdentifierSpace -> IdentifierSpace -> Ordering)
-> (IdentifierSpace -> IdentifierSpace -> Bool)
-> (IdentifierSpace -> IdentifierSpace -> Bool)
-> (IdentifierSpace -> IdentifierSpace -> Bool)
-> (IdentifierSpace -> IdentifierSpace -> Bool)
-> (IdentifierSpace -> IdentifierSpace -> IdentifierSpace)
-> (IdentifierSpace -> IdentifierSpace -> IdentifierSpace)
-> Ord IdentifierSpace
IdentifierSpace -> IdentifierSpace -> Bool
IdentifierSpace -> IdentifierSpace -> Ordering
IdentifierSpace -> IdentifierSpace -> IdentifierSpace
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IdentifierSpace -> IdentifierSpace -> Ordering
compare :: IdentifierSpace -> IdentifierSpace -> Ordering
$c< :: IdentifierSpace -> IdentifierSpace -> Bool
< :: IdentifierSpace -> IdentifierSpace -> Bool
$c<= :: IdentifierSpace -> IdentifierSpace -> Bool
<= :: IdentifierSpace -> IdentifierSpace -> Bool
$c> :: IdentifierSpace -> IdentifierSpace -> Bool
> :: IdentifierSpace -> IdentifierSpace -> Bool
$c>= :: IdentifierSpace -> IdentifierSpace -> Bool
>= :: IdentifierSpace -> IdentifierSpace -> Bool
$cmax :: IdentifierSpace -> IdentifierSpace -> IdentifierSpace
max :: IdentifierSpace -> IdentifierSpace -> IdentifierSpace
$cmin :: IdentifierSpace -> IdentifierSpace -> IdentifierSpace
min :: IdentifierSpace -> IdentifierSpace -> IdentifierSpace
Ord, ReadPrec [IdentifierSpace]
ReadPrec IdentifierSpace
Int -> ReadS IdentifierSpace
ReadS [IdentifierSpace]
(Int -> ReadS IdentifierSpace)
-> ReadS [IdentifierSpace]
-> ReadPrec IdentifierSpace
-> ReadPrec [IdentifierSpace]
-> Read IdentifierSpace
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS IdentifierSpace
readsPrec :: Int -> ReadS IdentifierSpace
$creadList :: ReadS [IdentifierSpace]
readList :: ReadS [IdentifierSpace]
$creadPrec :: ReadPrec IdentifierSpace
readPrec :: ReadPrec IdentifierSpace
$creadListPrec :: ReadPrec [IdentifierSpace]
readListPrec :: ReadPrec [IdentifierSpace]
Read, Int -> IdentifierSpace -> ShowS
[IdentifierSpace] -> ShowS
IdentifierSpace -> String
(Int -> IdentifierSpace -> ShowS)
-> (IdentifierSpace -> String)
-> ([IdentifierSpace] -> ShowS)
-> Show IdentifierSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdentifierSpace -> ShowS
showsPrec :: Int -> IdentifierSpace -> ShowS
$cshow :: IdentifierSpace -> String
show :: IdentifierSpace -> String
$cshowList :: [IdentifierSpace] -> ShowS
showList :: [IdentifierSpace] -> ShowS
Show)
  deriving newtype (Value -> Parser [IdentifierSpace]
Value -> Parser IdentifierSpace
(Value -> Parser IdentifierSpace)
-> (Value -> Parser [IdentifierSpace]) -> FromJSON IdentifierSpace
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser IdentifierSpace
parseJSON :: Value -> Parser IdentifierSpace
$cparseJSONList :: Value -> Parser [IdentifierSpace]
parseJSONList :: Value -> Parser [IdentifierSpace]
A.FromJSON, [IdentifierSpace] -> Value
[IdentifierSpace] -> Encoding
IdentifierSpace -> Value
IdentifierSpace -> Encoding
(IdentifierSpace -> Value)
-> (IdentifierSpace -> Encoding)
-> ([IdentifierSpace] -> Value)
-> ([IdentifierSpace] -> Encoding)
-> ToJSON IdentifierSpace
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: IdentifierSpace -> Value
toJSON :: IdentifierSpace -> Value
$ctoEncoding :: IdentifierSpace -> Encoding
toEncoding :: IdentifierSpace -> Encoding
$ctoJSONList :: [IdentifierSpace] -> Value
toJSONList :: [IdentifierSpace] -> Value
$ctoEncodingList :: [IdentifierSpace] -> Encoding
toEncodingList :: [IdentifierSpace] -> Encoding
A.ToJSON)
  deriving newtype (ByteString -> Either Text IdentifierSpace
Text -> Either Text IdentifierSpace
(Text -> Either Text IdentifierSpace)
-> (ByteString -> Either Text IdentifierSpace)
-> (Text -> Either Text IdentifierSpace)
-> FromHttpApiData IdentifierSpace
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text IdentifierSpace
parseUrlPiece :: Text -> Either Text IdentifierSpace
$cparseHeader :: ByteString -> Either Text IdentifierSpace
parseHeader :: ByteString -> Either Text IdentifierSpace
$cparseQueryParam :: Text -> Either Text IdentifierSpace
parseQueryParam :: Text -> Either Text IdentifierSpace
Servant.FromHttpApiData, IdentifierSpace -> ByteString
IdentifierSpace -> Text
IdentifierSpace -> Builder
(IdentifierSpace -> Text)
-> (IdentifierSpace -> Builder)
-> (IdentifierSpace -> ByteString)
-> (IdentifierSpace -> Text)
-> (IdentifierSpace -> Builder)
-> ToHttpApiData IdentifierSpace
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: IdentifierSpace -> Text
toUrlPiece :: IdentifierSpace -> Text
$ctoEncodedUrlPiece :: IdentifierSpace -> Builder
toEncodedUrlPiece :: IdentifierSpace -> Builder
$ctoHeader :: IdentifierSpace -> ByteString
toHeader :: IdentifierSpace -> ByteString
$ctoQueryParam :: IdentifierSpace -> Text
toQueryParam :: IdentifierSpace -> Text
$ctoEncodedQueryParam :: IdentifierSpace -> Builder
toEncodedQueryParam :: IdentifierSpace -> Builder
Servant.ToHttpApiData)

instance ToPrettyText IdentifierSpace where
  toPrettyText :: IdentifierSpace -> Text
toPrettyText = (Text
"#" <>) (Text -> Text)
-> (IdentifierSpace -> Text) -> IdentifierSpace -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (IdentifierSpace -> String) -> IdentifierSpace -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String)
-> (IdentifierSpace -> Int64) -> IdentifierSpace -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierSpace -> Int64
unIdentifierSpace

deriving via PrettyHtml5ViaPrettyText IdentifierSpace instance ToPrettyHtml5 IdentifierSpace

type NameSpace :: Type
newtype NameSpace = MkNameSpace {NameSpace -> Text
unNameSpace :: T.Text}
  deriving stock (NameSpace -> NameSpace -> Bool
(NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool) -> Eq NameSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameSpace -> NameSpace -> Bool
== :: NameSpace -> NameSpace -> Bool
$c/= :: NameSpace -> NameSpace -> Bool
/= :: NameSpace -> NameSpace -> Bool
Eq, (forall x. NameSpace -> Rep NameSpace x)
-> (forall x. Rep NameSpace x -> NameSpace) -> Generic NameSpace
forall x. Rep NameSpace x -> NameSpace
forall x. NameSpace -> Rep NameSpace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameSpace -> Rep NameSpace x
from :: forall x. NameSpace -> Rep NameSpace x
$cto :: forall x. Rep NameSpace x -> NameSpace
to :: forall x. Rep NameSpace x -> NameSpace
Generic, Eq NameSpace
Eq NameSpace =>
(NameSpace -> NameSpace -> Ordering)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> NameSpace)
-> (NameSpace -> NameSpace -> NameSpace)
-> Ord NameSpace
NameSpace -> NameSpace -> Bool
NameSpace -> NameSpace -> Ordering
NameSpace -> NameSpace -> NameSpace
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NameSpace -> NameSpace -> Ordering
compare :: NameSpace -> NameSpace -> Ordering
$c< :: NameSpace -> NameSpace -> Bool
< :: NameSpace -> NameSpace -> Bool
$c<= :: NameSpace -> NameSpace -> Bool
<= :: NameSpace -> NameSpace -> Bool
$c> :: NameSpace -> NameSpace -> Bool
> :: NameSpace -> NameSpace -> Bool
$c>= :: NameSpace -> NameSpace -> Bool
>= :: NameSpace -> NameSpace -> Bool
$cmax :: NameSpace -> NameSpace -> NameSpace
max :: NameSpace -> NameSpace -> NameSpace
$cmin :: NameSpace -> NameSpace -> NameSpace
min :: NameSpace -> NameSpace -> NameSpace
Ord, ReadPrec [NameSpace]
ReadPrec NameSpace
Int -> ReadS NameSpace
ReadS [NameSpace]
(Int -> ReadS NameSpace)
-> ReadS [NameSpace]
-> ReadPrec NameSpace
-> ReadPrec [NameSpace]
-> Read NameSpace
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NameSpace
readsPrec :: Int -> ReadS NameSpace
$creadList :: ReadS [NameSpace]
readList :: ReadS [NameSpace]
$creadPrec :: ReadPrec NameSpace
readPrec :: ReadPrec NameSpace
$creadListPrec :: ReadPrec [NameSpace]
readListPrec :: ReadPrec [NameSpace]
Read, Int -> NameSpace -> ShowS
[NameSpace] -> ShowS
NameSpace -> String
(Int -> NameSpace -> ShowS)
-> (NameSpace -> String)
-> ([NameSpace] -> ShowS)
-> Show NameSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameSpace -> ShowS
showsPrec :: Int -> NameSpace -> ShowS
$cshow :: NameSpace -> String
show :: NameSpace -> String
$cshowList :: [NameSpace] -> ShowS
showList :: [NameSpace] -> ShowS
Show)
  deriving newtype (Value -> Parser [NameSpace]
Value -> Parser NameSpace
(Value -> Parser NameSpace)
-> (Value -> Parser [NameSpace]) -> FromJSON NameSpace
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NameSpace
parseJSON :: Value -> Parser NameSpace
$cparseJSONList :: Value -> Parser [NameSpace]
parseJSONList :: Value -> Parser [NameSpace]
A.FromJSON, [NameSpace] -> Value
[NameSpace] -> Encoding
NameSpace -> Value
NameSpace -> Encoding
(NameSpace -> Value)
-> (NameSpace -> Encoding)
-> ([NameSpace] -> Value)
-> ([NameSpace] -> Encoding)
-> ToJSON NameSpace
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NameSpace -> Value
toJSON :: NameSpace -> Value
$ctoEncoding :: NameSpace -> Encoding
toEncoding :: NameSpace -> Encoding
$ctoJSONList :: [NameSpace] -> Value
toJSONList :: [NameSpace] -> Value
$ctoEncodingList :: [NameSpace] -> Encoding
toEncodingList :: [NameSpace] -> Encoding
A.ToJSON)

deriving via PrettyTextViaShow T.Text instance ToPrettyText NameSpace
deriving via PrettyHtml5ViaPrettyText NameSpace instance ToPrettyHtml5 NameSpace

type VisibilitySpace :: Type
data VisibilitySpace
  = MkVisibilitySpaceVisible
  | MkVisibilitySpaceHidden
  deriving stock (VisibilitySpace
VisibilitySpace -> VisibilitySpace -> Bounded VisibilitySpace
forall a. a -> a -> Bounded a
$cminBound :: VisibilitySpace
minBound :: VisibilitySpace
$cmaxBound :: VisibilitySpace
maxBound :: VisibilitySpace
Bounded, Int -> VisibilitySpace
VisibilitySpace -> Int
VisibilitySpace -> [VisibilitySpace]
VisibilitySpace -> VisibilitySpace
VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
VisibilitySpace
-> VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
(VisibilitySpace -> VisibilitySpace)
-> (VisibilitySpace -> VisibilitySpace)
-> (Int -> VisibilitySpace)
-> (VisibilitySpace -> Int)
-> (VisibilitySpace -> [VisibilitySpace])
-> (VisibilitySpace -> VisibilitySpace -> [VisibilitySpace])
-> (VisibilitySpace -> VisibilitySpace -> [VisibilitySpace])
-> (VisibilitySpace
    -> VisibilitySpace -> VisibilitySpace -> [VisibilitySpace])
-> Enum VisibilitySpace
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: VisibilitySpace -> VisibilitySpace
succ :: VisibilitySpace -> VisibilitySpace
$cpred :: VisibilitySpace -> VisibilitySpace
pred :: VisibilitySpace -> VisibilitySpace
$ctoEnum :: Int -> VisibilitySpace
toEnum :: Int -> VisibilitySpace
$cfromEnum :: VisibilitySpace -> Int
fromEnum :: VisibilitySpace -> Int
$cenumFrom :: VisibilitySpace -> [VisibilitySpace]
enumFrom :: VisibilitySpace -> [VisibilitySpace]
$cenumFromThen :: VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
enumFromThen :: VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
$cenumFromTo :: VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
enumFromTo :: VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
$cenumFromThenTo :: VisibilitySpace
-> VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
enumFromThenTo :: VisibilitySpace
-> VisibilitySpace -> VisibilitySpace -> [VisibilitySpace]
Enum, VisibilitySpace -> VisibilitySpace -> Bool
(VisibilitySpace -> VisibilitySpace -> Bool)
-> (VisibilitySpace -> VisibilitySpace -> Bool)
-> Eq VisibilitySpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VisibilitySpace -> VisibilitySpace -> Bool
== :: VisibilitySpace -> VisibilitySpace -> Bool
$c/= :: VisibilitySpace -> VisibilitySpace -> Bool
/= :: VisibilitySpace -> VisibilitySpace -> Bool
Eq, (forall x. VisibilitySpace -> Rep VisibilitySpace x)
-> (forall x. Rep VisibilitySpace x -> VisibilitySpace)
-> Generic VisibilitySpace
forall x. Rep VisibilitySpace x -> VisibilitySpace
forall x. VisibilitySpace -> Rep VisibilitySpace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VisibilitySpace -> Rep VisibilitySpace x
from :: forall x. VisibilitySpace -> Rep VisibilitySpace x
$cto :: forall x. Rep VisibilitySpace x -> VisibilitySpace
to :: forall x. Rep VisibilitySpace x -> VisibilitySpace
Generic, Eq VisibilitySpace
Eq VisibilitySpace =>
(VisibilitySpace -> VisibilitySpace -> Ordering)
-> (VisibilitySpace -> VisibilitySpace -> Bool)
-> (VisibilitySpace -> VisibilitySpace -> Bool)
-> (VisibilitySpace -> VisibilitySpace -> Bool)
-> (VisibilitySpace -> VisibilitySpace -> Bool)
-> (VisibilitySpace -> VisibilitySpace -> VisibilitySpace)
-> (VisibilitySpace -> VisibilitySpace -> VisibilitySpace)
-> Ord VisibilitySpace
VisibilitySpace -> VisibilitySpace -> Bool
VisibilitySpace -> VisibilitySpace -> Ordering
VisibilitySpace -> VisibilitySpace -> VisibilitySpace
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VisibilitySpace -> VisibilitySpace -> Ordering
compare :: VisibilitySpace -> VisibilitySpace -> Ordering
$c< :: VisibilitySpace -> VisibilitySpace -> Bool
< :: VisibilitySpace -> VisibilitySpace -> Bool
$c<= :: VisibilitySpace -> VisibilitySpace -> Bool
<= :: VisibilitySpace -> VisibilitySpace -> Bool
$c> :: VisibilitySpace -> VisibilitySpace -> Bool
> :: VisibilitySpace -> VisibilitySpace -> Bool
$c>= :: VisibilitySpace -> VisibilitySpace -> Bool
>= :: VisibilitySpace -> VisibilitySpace -> Bool
$cmax :: VisibilitySpace -> VisibilitySpace -> VisibilitySpace
max :: VisibilitySpace -> VisibilitySpace -> VisibilitySpace
$cmin :: VisibilitySpace -> VisibilitySpace -> VisibilitySpace
min :: VisibilitySpace -> VisibilitySpace -> VisibilitySpace
Ord, ReadPrec [VisibilitySpace]
ReadPrec VisibilitySpace
Int -> ReadS VisibilitySpace
ReadS [VisibilitySpace]
(Int -> ReadS VisibilitySpace)
-> ReadS [VisibilitySpace]
-> ReadPrec VisibilitySpace
-> ReadPrec [VisibilitySpace]
-> Read VisibilitySpace
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS VisibilitySpace
readsPrec :: Int -> ReadS VisibilitySpace
$creadList :: ReadS [VisibilitySpace]
readList :: ReadS [VisibilitySpace]
$creadPrec :: ReadPrec VisibilitySpace
readPrec :: ReadPrec VisibilitySpace
$creadListPrec :: ReadPrec [VisibilitySpace]
readListPrec :: ReadPrec [VisibilitySpace]
Read, Int -> VisibilitySpace -> ShowS
[VisibilitySpace] -> ShowS
VisibilitySpace -> String
(Int -> VisibilitySpace -> ShowS)
-> (VisibilitySpace -> String)
-> ([VisibilitySpace] -> ShowS)
-> Show VisibilitySpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VisibilitySpace -> ShowS
showsPrec :: Int -> VisibilitySpace -> ShowS
$cshow :: VisibilitySpace -> String
show :: VisibilitySpace -> String
$cshowList :: [VisibilitySpace] -> ShowS
showList :: [VisibilitySpace] -> ShowS
Show)
  deriving
    (Value -> Parser [VisibilitySpace]
Value -> Parser VisibilitySpace
(Value -> Parser VisibilitySpace)
-> (Value -> Parser [VisibilitySpace]) -> FromJSON VisibilitySpace
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser VisibilitySpace
parseJSON :: Value -> Parser VisibilitySpace
$cparseJSONList :: Value -> Parser [VisibilitySpace]
parseJSONList :: Value -> Parser [VisibilitySpace]
A.FromJSON, [VisibilitySpace] -> Value
[VisibilitySpace] -> Encoding
VisibilitySpace -> Value
VisibilitySpace -> Encoding
(VisibilitySpace -> Value)
-> (VisibilitySpace -> Encoding)
-> ([VisibilitySpace] -> Value)
-> ([VisibilitySpace] -> Encoding)
-> ToJSON VisibilitySpace
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: VisibilitySpace -> Value
toJSON :: VisibilitySpace -> Value
$ctoEncoding :: VisibilitySpace -> Encoding
toEncoding :: VisibilitySpace -> Encoding
$ctoJSONList :: [VisibilitySpace] -> Value
toJSONList :: [VisibilitySpace] -> Value
$ctoEncodingList :: [VisibilitySpace] -> Encoding
toEncodingList :: [VisibilitySpace] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkVisibilitySpace" "") VisibilitySpace

type Role :: Type
data Role = MkRole
  { Role -> IdentifierRole
roleId :: IdentifierRole
  , Role -> IdentifierSpace
roleSpace :: IdentifierSpace
  , Role -> NameRole
roleName :: NameRole
  , Role -> Set Permission
rolePermissions :: S.Set Permission
  , Role -> AccessibilityRole
roleAccessibility :: AccessibilityRole
  }
  deriving stock (Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, (forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Role -> Rep Role x
from :: forall x. Role -> Rep Role x
$cto :: forall x. Rep Role x -> Role
to :: forall x. Rep Role x -> Role
Generic, Eq Role
Eq Role =>
(Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Role -> Role -> Ordering
compare :: Role -> Role -> Ordering
$c< :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
>= :: Role -> Role -> Bool
$cmax :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
min :: Role -> Role -> Role
Ord, ReadPrec [Role]
ReadPrec Role
Int -> ReadS Role
ReadS [Role]
(Int -> ReadS Role)
-> ReadS [Role] -> ReadPrec Role -> ReadPrec [Role] -> Read Role
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Role
readsPrec :: Int -> ReadS Role
$creadList :: ReadS [Role]
readList :: ReadS [Role]
$creadPrec :: ReadPrec Role
readPrec :: ReadPrec Role
$creadListPrec :: ReadPrec [Role]
readListPrec :: ReadPrec [Role]
Read, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show)
  deriving
    (Value -> Parser [Role]
Value -> Parser Role
(Value -> Parser Role) -> (Value -> Parser [Role]) -> FromJSON Role
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Role
parseJSON :: Value -> Parser Role
$cparseJSONList :: Value -> Parser [Role]
parseJSONList :: Value -> Parser [Role]
A.FromJSON, [Role] -> Value
[Role] -> Encoding
Role -> Value
Role -> Encoding
(Role -> Value)
-> (Role -> Encoding)
-> ([Role] -> Value)
-> ([Role] -> Encoding)
-> ToJSON Role
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Role -> Value
toJSON :: Role -> Value
$ctoEncoding :: Role -> Encoding
toEncoding :: Role -> Encoding
$ctoJSONList :: [Role] -> Value
toJSONList :: [Role] -> Value
$ctoEncodingList :: [Role] -> Encoding
toEncodingList :: [Role] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "role") Role

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

type NameRole :: Type
newtype NameRole = MkNameRole {NameRole -> Text
unNameRole :: T.Text}
  deriving stock (NameRole -> NameRole -> Bool
(NameRole -> NameRole -> Bool)
-> (NameRole -> NameRole -> Bool) -> Eq NameRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameRole -> NameRole -> Bool
== :: NameRole -> NameRole -> Bool
$c/= :: NameRole -> NameRole -> Bool
/= :: NameRole -> NameRole -> Bool
Eq, (forall x. NameRole -> Rep NameRole x)
-> (forall x. Rep NameRole x -> NameRole) -> Generic NameRole
forall x. Rep NameRole x -> NameRole
forall x. NameRole -> Rep NameRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameRole -> Rep NameRole x
from :: forall x. NameRole -> Rep NameRole x
$cto :: forall x. Rep NameRole x -> NameRole
to :: forall x. Rep NameRole x -> NameRole
Generic, Eq NameRole
Eq NameRole =>
(NameRole -> NameRole -> Ordering)
-> (NameRole -> NameRole -> Bool)
-> (NameRole -> NameRole -> Bool)
-> (NameRole -> NameRole -> Bool)
-> (NameRole -> NameRole -> Bool)
-> (NameRole -> NameRole -> NameRole)
-> (NameRole -> NameRole -> NameRole)
-> Ord NameRole
NameRole -> NameRole -> Bool
NameRole -> NameRole -> Ordering
NameRole -> NameRole -> NameRole
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NameRole -> NameRole -> Ordering
compare :: NameRole -> NameRole -> Ordering
$c< :: NameRole -> NameRole -> Bool
< :: NameRole -> NameRole -> Bool
$c<= :: NameRole -> NameRole -> Bool
<= :: NameRole -> NameRole -> Bool
$c> :: NameRole -> NameRole -> Bool
> :: NameRole -> NameRole -> Bool
$c>= :: NameRole -> NameRole -> Bool
>= :: NameRole -> NameRole -> Bool
$cmax :: NameRole -> NameRole -> NameRole
max :: NameRole -> NameRole -> NameRole
$cmin :: NameRole -> NameRole -> NameRole
min :: NameRole -> NameRole -> NameRole
Ord, ReadPrec [NameRole]
ReadPrec NameRole
Int -> ReadS NameRole
ReadS [NameRole]
(Int -> ReadS NameRole)
-> ReadS [NameRole]
-> ReadPrec NameRole
-> ReadPrec [NameRole]
-> Read NameRole
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NameRole
readsPrec :: Int -> ReadS NameRole
$creadList :: ReadS [NameRole]
readList :: ReadS [NameRole]
$creadPrec :: ReadPrec NameRole
readPrec :: ReadPrec NameRole
$creadListPrec :: ReadPrec [NameRole]
readListPrec :: ReadPrec [NameRole]
Read, Int -> NameRole -> ShowS
[NameRole] -> ShowS
NameRole -> String
(Int -> NameRole -> ShowS)
-> (NameRole -> String) -> ([NameRole] -> ShowS) -> Show NameRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameRole -> ShowS
showsPrec :: Int -> NameRole -> ShowS
$cshow :: NameRole -> String
show :: NameRole -> String
$cshowList :: [NameRole] -> ShowS
showList :: [NameRole] -> ShowS
Show)
  deriving newtype (Value -> Parser [NameRole]
Value -> Parser NameRole
(Value -> Parser NameRole)
-> (Value -> Parser [NameRole]) -> FromJSON NameRole
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NameRole
parseJSON :: Value -> Parser NameRole
$cparseJSONList :: Value -> Parser [NameRole]
parseJSONList :: Value -> Parser [NameRole]
A.FromJSON, [NameRole] -> Value
[NameRole] -> Encoding
NameRole -> Value
NameRole -> Encoding
(NameRole -> Value)
-> (NameRole -> Encoding)
-> ([NameRole] -> Value)
-> ([NameRole] -> Encoding)
-> ToJSON NameRole
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NameRole -> Value
toJSON :: NameRole -> Value
$ctoEncoding :: NameRole -> Encoding
toEncoding :: NameRole -> Encoding
$ctoJSONList :: [NameRole] -> Value
toJSONList :: [NameRole] -> Value
$ctoEncodingList :: [NameRole] -> Encoding
toEncodingList :: [NameRole] -> Encoding
A.ToJSON)
  deriving newtype (FromJSONKeyFunction [NameRole]
FromJSONKeyFunction NameRole
FromJSONKeyFunction NameRole
-> FromJSONKeyFunction [NameRole] -> FromJSONKey NameRole
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction NameRole
fromJSONKey :: FromJSONKeyFunction NameRole
$cfromJSONKeyList :: FromJSONKeyFunction [NameRole]
fromJSONKeyList :: FromJSONKeyFunction [NameRole]
A.FromJSONKey, ToJSONKeyFunction [NameRole]
ToJSONKeyFunction NameRole
ToJSONKeyFunction NameRole
-> ToJSONKeyFunction [NameRole] -> ToJSONKey NameRole
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction NameRole
toJSONKey :: ToJSONKeyFunction NameRole
$ctoJSONKeyList :: ToJSONKeyFunction [NameRole]
toJSONKeyList :: ToJSONKeyFunction [NameRole]
A.ToJSONKey)

type AccessibilityRole :: Type
data AccessibilityRole
  = MkAccessibilityRoleJoinable
  | MkAccessibilityRoleJoinableWithPassword
  | MkAccessibilityRoleInaccessible
  deriving stock (AccessibilityRole
AccessibilityRole -> AccessibilityRole -> Bounded AccessibilityRole
forall a. a -> a -> Bounded a
$cminBound :: AccessibilityRole
minBound :: AccessibilityRole
$cmaxBound :: AccessibilityRole
maxBound :: AccessibilityRole
Bounded, Int -> AccessibilityRole
AccessibilityRole -> Int
AccessibilityRole -> [AccessibilityRole]
AccessibilityRole -> AccessibilityRole
AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
AccessibilityRole
-> AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
(AccessibilityRole -> AccessibilityRole)
-> (AccessibilityRole -> AccessibilityRole)
-> (Int -> AccessibilityRole)
-> (AccessibilityRole -> Int)
-> (AccessibilityRole -> [AccessibilityRole])
-> (AccessibilityRole -> AccessibilityRole -> [AccessibilityRole])
-> (AccessibilityRole -> AccessibilityRole -> [AccessibilityRole])
-> (AccessibilityRole
    -> AccessibilityRole -> AccessibilityRole -> [AccessibilityRole])
-> Enum AccessibilityRole
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AccessibilityRole -> AccessibilityRole
succ :: AccessibilityRole -> AccessibilityRole
$cpred :: AccessibilityRole -> AccessibilityRole
pred :: AccessibilityRole -> AccessibilityRole
$ctoEnum :: Int -> AccessibilityRole
toEnum :: Int -> AccessibilityRole
$cfromEnum :: AccessibilityRole -> Int
fromEnum :: AccessibilityRole -> Int
$cenumFrom :: AccessibilityRole -> [AccessibilityRole]
enumFrom :: AccessibilityRole -> [AccessibilityRole]
$cenumFromThen :: AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
enumFromThen :: AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
$cenumFromTo :: AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
enumFromTo :: AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
$cenumFromThenTo :: AccessibilityRole
-> AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
enumFromThenTo :: AccessibilityRole
-> AccessibilityRole -> AccessibilityRole -> [AccessibilityRole]
Enum, AccessibilityRole -> AccessibilityRole -> Bool
(AccessibilityRole -> AccessibilityRole -> Bool)
-> (AccessibilityRole -> AccessibilityRole -> Bool)
-> Eq AccessibilityRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessibilityRole -> AccessibilityRole -> Bool
== :: AccessibilityRole -> AccessibilityRole -> Bool
$c/= :: AccessibilityRole -> AccessibilityRole -> Bool
/= :: AccessibilityRole -> AccessibilityRole -> Bool
Eq, (forall x. AccessibilityRole -> Rep AccessibilityRole x)
-> (forall x. Rep AccessibilityRole x -> AccessibilityRole)
-> Generic AccessibilityRole
forall x. Rep AccessibilityRole x -> AccessibilityRole
forall x. AccessibilityRole -> Rep AccessibilityRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccessibilityRole -> Rep AccessibilityRole x
from :: forall x. AccessibilityRole -> Rep AccessibilityRole x
$cto :: forall x. Rep AccessibilityRole x -> AccessibilityRole
to :: forall x. Rep AccessibilityRole x -> AccessibilityRole
Generic, Eq AccessibilityRole
Eq AccessibilityRole =>
(AccessibilityRole -> AccessibilityRole -> Ordering)
-> (AccessibilityRole -> AccessibilityRole -> Bool)
-> (AccessibilityRole -> AccessibilityRole -> Bool)
-> (AccessibilityRole -> AccessibilityRole -> Bool)
-> (AccessibilityRole -> AccessibilityRole -> Bool)
-> (AccessibilityRole -> AccessibilityRole -> AccessibilityRole)
-> (AccessibilityRole -> AccessibilityRole -> AccessibilityRole)
-> Ord AccessibilityRole
AccessibilityRole -> AccessibilityRole -> Bool
AccessibilityRole -> AccessibilityRole -> Ordering
AccessibilityRole -> AccessibilityRole -> AccessibilityRole
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AccessibilityRole -> AccessibilityRole -> Ordering
compare :: AccessibilityRole -> AccessibilityRole -> Ordering
$c< :: AccessibilityRole -> AccessibilityRole -> Bool
< :: AccessibilityRole -> AccessibilityRole -> Bool
$c<= :: AccessibilityRole -> AccessibilityRole -> Bool
<= :: AccessibilityRole -> AccessibilityRole -> Bool
$c> :: AccessibilityRole -> AccessibilityRole -> Bool
> :: AccessibilityRole -> AccessibilityRole -> Bool
$c>= :: AccessibilityRole -> AccessibilityRole -> Bool
>= :: AccessibilityRole -> AccessibilityRole -> Bool
$cmax :: AccessibilityRole -> AccessibilityRole -> AccessibilityRole
max :: AccessibilityRole -> AccessibilityRole -> AccessibilityRole
$cmin :: AccessibilityRole -> AccessibilityRole -> AccessibilityRole
min :: AccessibilityRole -> AccessibilityRole -> AccessibilityRole
Ord, ReadPrec [AccessibilityRole]
ReadPrec AccessibilityRole
Int -> ReadS AccessibilityRole
ReadS [AccessibilityRole]
(Int -> ReadS AccessibilityRole)
-> ReadS [AccessibilityRole]
-> ReadPrec AccessibilityRole
-> ReadPrec [AccessibilityRole]
-> Read AccessibilityRole
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AccessibilityRole
readsPrec :: Int -> ReadS AccessibilityRole
$creadList :: ReadS [AccessibilityRole]
readList :: ReadS [AccessibilityRole]
$creadPrec :: ReadPrec AccessibilityRole
readPrec :: ReadPrec AccessibilityRole
$creadListPrec :: ReadPrec [AccessibilityRole]
readListPrec :: ReadPrec [AccessibilityRole]
Read, Int -> AccessibilityRole -> ShowS
[AccessibilityRole] -> ShowS
AccessibilityRole -> String
(Int -> AccessibilityRole -> ShowS)
-> (AccessibilityRole -> String)
-> ([AccessibilityRole] -> ShowS)
-> Show AccessibilityRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessibilityRole -> ShowS
showsPrec :: Int -> AccessibilityRole -> ShowS
$cshow :: AccessibilityRole -> String
show :: AccessibilityRole -> String
$cshowList :: [AccessibilityRole] -> ShowS
showList :: [AccessibilityRole] -> ShowS
Show)
  deriving
    (Value -> Parser [AccessibilityRole]
Value -> Parser AccessibilityRole
(Value -> Parser AccessibilityRole)
-> (Value -> Parser [AccessibilityRole])
-> FromJSON AccessibilityRole
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AccessibilityRole
parseJSON :: Value -> Parser AccessibilityRole
$cparseJSONList :: Value -> Parser [AccessibilityRole]
parseJSONList :: Value -> Parser [AccessibilityRole]
A.FromJSON, [AccessibilityRole] -> Value
[AccessibilityRole] -> Encoding
AccessibilityRole -> Value
AccessibilityRole -> Encoding
(AccessibilityRole -> Value)
-> (AccessibilityRole -> Encoding)
-> ([AccessibilityRole] -> Value)
-> ([AccessibilityRole] -> Encoding)
-> ToJSON AccessibilityRole
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AccessibilityRole -> Value
toJSON :: AccessibilityRole -> Value
$ctoEncoding :: AccessibilityRole -> Encoding
toEncoding :: AccessibilityRole -> Encoding
$ctoJSONList :: [AccessibilityRole] -> Value
toJSONList :: [AccessibilityRole] -> Value
$ctoEncodingList :: [AccessibilityRole] -> Encoding
toEncodingList :: [AccessibilityRole] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkAccessibilityRole" "") AccessibilityRole

type SpaceOrderCategory :: Type
data SpaceOrderCategory
  = SpaceOrderCategoryId
  | SpaceOrderCategoryName
  deriving stock (SpaceOrderCategory
SpaceOrderCategory
-> SpaceOrderCategory -> Bounded SpaceOrderCategory
forall a. a -> a -> Bounded a
$cminBound :: SpaceOrderCategory
minBound :: SpaceOrderCategory
$cmaxBound :: SpaceOrderCategory
maxBound :: SpaceOrderCategory
Bounded, Int -> SpaceOrderCategory
SpaceOrderCategory -> Int
SpaceOrderCategory -> [SpaceOrderCategory]
SpaceOrderCategory -> SpaceOrderCategory
SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
SpaceOrderCategory
-> SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
(SpaceOrderCategory -> SpaceOrderCategory)
-> (SpaceOrderCategory -> SpaceOrderCategory)
-> (Int -> SpaceOrderCategory)
-> (SpaceOrderCategory -> Int)
-> (SpaceOrderCategory -> [SpaceOrderCategory])
-> (SpaceOrderCategory
    -> SpaceOrderCategory -> [SpaceOrderCategory])
-> (SpaceOrderCategory
    -> SpaceOrderCategory -> [SpaceOrderCategory])
-> (SpaceOrderCategory
    -> SpaceOrderCategory
    -> SpaceOrderCategory
    -> [SpaceOrderCategory])
-> Enum SpaceOrderCategory
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SpaceOrderCategory -> SpaceOrderCategory
succ :: SpaceOrderCategory -> SpaceOrderCategory
$cpred :: SpaceOrderCategory -> SpaceOrderCategory
pred :: SpaceOrderCategory -> SpaceOrderCategory
$ctoEnum :: Int -> SpaceOrderCategory
toEnum :: Int -> SpaceOrderCategory
$cfromEnum :: SpaceOrderCategory -> Int
fromEnum :: SpaceOrderCategory -> Int
$cenumFrom :: SpaceOrderCategory -> [SpaceOrderCategory]
enumFrom :: SpaceOrderCategory -> [SpaceOrderCategory]
$cenumFromThen :: SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
enumFromThen :: SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
$cenumFromTo :: SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
enumFromTo :: SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
$cenumFromThenTo :: SpaceOrderCategory
-> SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
enumFromThenTo :: SpaceOrderCategory
-> SpaceOrderCategory -> SpaceOrderCategory -> [SpaceOrderCategory]
Enum, SpaceOrderCategory -> SpaceOrderCategory -> Bool
(SpaceOrderCategory -> SpaceOrderCategory -> Bool)
-> (SpaceOrderCategory -> SpaceOrderCategory -> Bool)
-> Eq SpaceOrderCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
== :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
$c/= :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
/= :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
Eq, (forall x. SpaceOrderCategory -> Rep SpaceOrderCategory x)
-> (forall x. Rep SpaceOrderCategory x -> SpaceOrderCategory)
-> Generic SpaceOrderCategory
forall x. Rep SpaceOrderCategory x -> SpaceOrderCategory
forall x. SpaceOrderCategory -> Rep SpaceOrderCategory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpaceOrderCategory -> Rep SpaceOrderCategory x
from :: forall x. SpaceOrderCategory -> Rep SpaceOrderCategory x
$cto :: forall x. Rep SpaceOrderCategory x -> SpaceOrderCategory
to :: forall x. Rep SpaceOrderCategory x -> SpaceOrderCategory
Generic, Eq SpaceOrderCategory
Eq SpaceOrderCategory =>
(SpaceOrderCategory -> SpaceOrderCategory -> Ordering)
-> (SpaceOrderCategory -> SpaceOrderCategory -> Bool)
-> (SpaceOrderCategory -> SpaceOrderCategory -> Bool)
-> (SpaceOrderCategory -> SpaceOrderCategory -> Bool)
-> (SpaceOrderCategory -> SpaceOrderCategory -> Bool)
-> (SpaceOrderCategory -> SpaceOrderCategory -> SpaceOrderCategory)
-> (SpaceOrderCategory -> SpaceOrderCategory -> SpaceOrderCategory)
-> Ord SpaceOrderCategory
SpaceOrderCategory -> SpaceOrderCategory -> Bool
SpaceOrderCategory -> SpaceOrderCategory -> Ordering
SpaceOrderCategory -> SpaceOrderCategory -> SpaceOrderCategory
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SpaceOrderCategory -> SpaceOrderCategory -> Ordering
compare :: SpaceOrderCategory -> SpaceOrderCategory -> Ordering
$c< :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
< :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
$c<= :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
<= :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
$c> :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
> :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
$c>= :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
>= :: SpaceOrderCategory -> SpaceOrderCategory -> Bool
$cmax :: SpaceOrderCategory -> SpaceOrderCategory -> SpaceOrderCategory
max :: SpaceOrderCategory -> SpaceOrderCategory -> SpaceOrderCategory
$cmin :: SpaceOrderCategory -> SpaceOrderCategory -> SpaceOrderCategory
min :: SpaceOrderCategory -> SpaceOrderCategory -> SpaceOrderCategory
Ord, ReadPrec [SpaceOrderCategory]
ReadPrec SpaceOrderCategory
Int -> ReadS SpaceOrderCategory
ReadS [SpaceOrderCategory]
(Int -> ReadS SpaceOrderCategory)
-> ReadS [SpaceOrderCategory]
-> ReadPrec SpaceOrderCategory
-> ReadPrec [SpaceOrderCategory]
-> Read SpaceOrderCategory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SpaceOrderCategory
readsPrec :: Int -> ReadS SpaceOrderCategory
$creadList :: ReadS [SpaceOrderCategory]
readList :: ReadS [SpaceOrderCategory]
$creadPrec :: ReadPrec SpaceOrderCategory
readPrec :: ReadPrec SpaceOrderCategory
$creadListPrec :: ReadPrec [SpaceOrderCategory]
readListPrec :: ReadPrec [SpaceOrderCategory]
Read, Int -> SpaceOrderCategory -> ShowS
[SpaceOrderCategory] -> ShowS
SpaceOrderCategory -> String
(Int -> SpaceOrderCategory -> ShowS)
-> (SpaceOrderCategory -> String)
-> ([SpaceOrderCategory] -> ShowS)
-> Show SpaceOrderCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpaceOrderCategory -> ShowS
showsPrec :: Int -> SpaceOrderCategory -> ShowS
$cshow :: SpaceOrderCategory -> String
show :: SpaceOrderCategory -> String
$cshowList :: [SpaceOrderCategory] -> ShowS
showList :: [SpaceOrderCategory] -> ShowS
Show)
  deriving
    (Value -> Parser [SpaceOrderCategory]
Value -> Parser SpaceOrderCategory
(Value -> Parser SpaceOrderCategory)
-> (Value -> Parser [SpaceOrderCategory])
-> FromJSON SpaceOrderCategory
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SpaceOrderCategory
parseJSON :: Value -> Parser SpaceOrderCategory
$cparseJSONList :: Value -> Parser [SpaceOrderCategory]
parseJSONList :: Value -> Parser [SpaceOrderCategory]
A.FromJSON, [SpaceOrderCategory] -> Value
[SpaceOrderCategory] -> Encoding
SpaceOrderCategory -> Value
SpaceOrderCategory -> Encoding
(SpaceOrderCategory -> Value)
-> (SpaceOrderCategory -> Encoding)
-> ([SpaceOrderCategory] -> Value)
-> ([SpaceOrderCategory] -> Encoding)
-> ToJSON SpaceOrderCategory
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SpaceOrderCategory -> Value
toJSON :: SpaceOrderCategory -> Value
$ctoEncoding :: SpaceOrderCategory -> Encoding
toEncoding :: SpaceOrderCategory -> Encoding
$ctoJSONList :: [SpaceOrderCategory] -> Value
toJSONList :: [SpaceOrderCategory] -> Value
$ctoEncodingList :: [SpaceOrderCategory] -> Encoding
toEncodingList :: [SpaceOrderCategory] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "SpaceOrderCategory" "") SpaceOrderCategory

type SpaceUser :: Type
data SpaceUser = MkSpaceUser
  { SpaceUser -> IdentifierUser
spaceUserUser :: IdentifierUser
  , SpaceUser -> IdentifierRole
spaceUserRole :: IdentifierRole
  }
  deriving stock (SpaceUser -> SpaceUser -> Bool
(SpaceUser -> SpaceUser -> Bool)
-> (SpaceUser -> SpaceUser -> Bool) -> Eq SpaceUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpaceUser -> SpaceUser -> Bool
== :: SpaceUser -> SpaceUser -> Bool
$c/= :: SpaceUser -> SpaceUser -> Bool
/= :: SpaceUser -> SpaceUser -> Bool
Eq, (forall x. SpaceUser -> Rep SpaceUser x)
-> (forall x. Rep SpaceUser x -> SpaceUser) -> Generic SpaceUser
forall x. Rep SpaceUser x -> SpaceUser
forall x. SpaceUser -> Rep SpaceUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpaceUser -> Rep SpaceUser x
from :: forall x. SpaceUser -> Rep SpaceUser x
$cto :: forall x. Rep SpaceUser x -> SpaceUser
to :: forall x. Rep SpaceUser x -> SpaceUser
Generic, Eq SpaceUser
Eq SpaceUser =>
(SpaceUser -> SpaceUser -> Ordering)
-> (SpaceUser -> SpaceUser -> Bool)
-> (SpaceUser -> SpaceUser -> Bool)
-> (SpaceUser -> SpaceUser -> Bool)
-> (SpaceUser -> SpaceUser -> Bool)
-> (SpaceUser -> SpaceUser -> SpaceUser)
-> (SpaceUser -> SpaceUser -> SpaceUser)
-> Ord SpaceUser
SpaceUser -> SpaceUser -> Bool
SpaceUser -> SpaceUser -> Ordering
SpaceUser -> SpaceUser -> SpaceUser
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SpaceUser -> SpaceUser -> Ordering
compare :: SpaceUser -> SpaceUser -> Ordering
$c< :: SpaceUser -> SpaceUser -> Bool
< :: SpaceUser -> SpaceUser -> Bool
$c<= :: SpaceUser -> SpaceUser -> Bool
<= :: SpaceUser -> SpaceUser -> Bool
$c> :: SpaceUser -> SpaceUser -> Bool
> :: SpaceUser -> SpaceUser -> Bool
$c>= :: SpaceUser -> SpaceUser -> Bool
>= :: SpaceUser -> SpaceUser -> Bool
$cmax :: SpaceUser -> SpaceUser -> SpaceUser
max :: SpaceUser -> SpaceUser -> SpaceUser
$cmin :: SpaceUser -> SpaceUser -> SpaceUser
min :: SpaceUser -> SpaceUser -> SpaceUser
Ord, ReadPrec [SpaceUser]
ReadPrec SpaceUser
Int -> ReadS SpaceUser
ReadS [SpaceUser]
(Int -> ReadS SpaceUser)
-> ReadS [SpaceUser]
-> ReadPrec SpaceUser
-> ReadPrec [SpaceUser]
-> Read SpaceUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SpaceUser
readsPrec :: Int -> ReadS SpaceUser
$creadList :: ReadS [SpaceUser]
readList :: ReadS [SpaceUser]
$creadPrec :: ReadPrec SpaceUser
readPrec :: ReadPrec SpaceUser
$creadListPrec :: ReadPrec [SpaceUser]
readListPrec :: ReadPrec [SpaceUser]
Read, Int -> SpaceUser -> ShowS
[SpaceUser] -> ShowS
SpaceUser -> String
(Int -> SpaceUser -> ShowS)
-> (SpaceUser -> String)
-> ([SpaceUser] -> ShowS)
-> Show SpaceUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpaceUser -> ShowS
showsPrec :: Int -> SpaceUser -> ShowS
$cshow :: SpaceUser -> String
show :: SpaceUser -> String
$cshowList :: [SpaceUser] -> ShowS
showList :: [SpaceUser] -> ShowS
Show)
  deriving
    (Value -> Parser [SpaceUser]
Value -> Parser SpaceUser
(Value -> Parser SpaceUser)
-> (Value -> Parser [SpaceUser]) -> FromJSON SpaceUser
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SpaceUser
parseJSON :: Value -> Parser SpaceUser
$cparseJSONList :: Value -> Parser [SpaceUser]
parseJSONList :: Value -> Parser [SpaceUser]
A.FromJSON, [SpaceUser] -> Value
[SpaceUser] -> Encoding
SpaceUser -> Value
SpaceUser -> Encoding
(SpaceUser -> Value)
-> (SpaceUser -> Encoding)
-> ([SpaceUser] -> Value)
-> ([SpaceUser] -> Encoding)
-> ToJSON SpaceUser
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SpaceUser -> Value
toJSON :: SpaceUser -> Value
$ctoEncoding :: SpaceUser -> Encoding
toEncoding :: SpaceUser -> Encoding
$ctoJSONList :: [SpaceUser] -> Value
toJSONList :: [SpaceUser] -> Value
$ctoEncodingList :: [SpaceUser] -> Encoding
toEncodingList :: [SpaceUser] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "spaceUser") SpaceUser