{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Network.Mattermost.Types
    ( module Network.Mattermost.Types
    , module Network.Mattermost.Types.Base
    , ConnectionType(..)
    , connectionDataURL
    , ServerBaseURL(..)
    )
    where

import           Control.Applicative
import           Text.Printf ( PrintfArg(..), printf )
import           Data.Hashable ( Hashable )
import qualified Data.Aeson as A
import           Data.Aeson ( (.:), (.=), (.:?), (.!=) )
import           Data.Aeson.Types ( ToJSONKey
                                  , FromJSONKey
                                  , FromJSON
                                  , ToJSON
                                  , Parser
                                  , typeMismatch
                                  )
import qualified Data.HashMap.Strict as HM
import           Data.Maybe (fromMaybe)
import           Data.Monoid ( (<>) )
import qualified Data.Pool as Pool
import           Data.Ratio ( (%) )
import           Data.Sequence (Seq)
import qualified Data.Sequence as S
import           Data.Time (NominalDiffTime)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Time.Clock ( getCurrentTime )
import           Data.Time.Clock.POSIX ( posixSecondsToUTCTime
                                       , utcTimeToPOSIXSeconds )
import           Network.Connection ( ConnectionContext
                                    , initConnectionContext
                                    )
import           Network.Mattermost.Types.Base
import           Network.Mattermost.Types.Internal
import           Network.Mattermost.Util ( mkConnection )

newtype UserText = UserText Text
                 deriving (UserText -> UserText -> Bool
(UserText -> UserText -> Bool)
-> (UserText -> UserText -> Bool) -> Eq UserText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserText -> UserText -> Bool
$c/= :: UserText -> UserText -> Bool
== :: UserText -> UserText -> Bool
$c== :: UserText -> UserText -> Bool
Eq, Int -> UserText -> ShowS
[UserText] -> ShowS
UserText -> String
(Int -> UserText -> ShowS)
-> (UserText -> String) -> ([UserText] -> ShowS) -> Show UserText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserText] -> ShowS
$cshowList :: [UserText] -> ShowS
show :: UserText -> String
$cshow :: UserText -> String
showsPrec :: Int -> UserText -> ShowS
$cshowsPrec :: Int -> UserText -> ShowS
Show, Eq UserText
Eq UserText
-> (UserText -> UserText -> Ordering)
-> (UserText -> UserText -> Bool)
-> (UserText -> UserText -> Bool)
-> (UserText -> UserText -> Bool)
-> (UserText -> UserText -> Bool)
-> (UserText -> UserText -> UserText)
-> (UserText -> UserText -> UserText)
-> Ord UserText
UserText -> UserText -> Bool
UserText -> UserText -> Ordering
UserText -> UserText -> UserText
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 :: UserText -> UserText -> UserText
$cmin :: UserText -> UserText -> UserText
max :: UserText -> UserText -> UserText
$cmax :: UserText -> UserText -> UserText
>= :: UserText -> UserText -> Bool
$c>= :: UserText -> UserText -> Bool
> :: UserText -> UserText -> Bool
$c> :: UserText -> UserText -> Bool
<= :: UserText -> UserText -> Bool
$c<= :: UserText -> UserText -> Bool
< :: UserText -> UserText -> Bool
$c< :: UserText -> UserText -> Bool
compare :: UserText -> UserText -> Ordering
$ccompare :: UserText -> UserText -> Ordering
$cp1Ord :: Eq UserText
Ord, ReadPrec [UserText]
ReadPrec UserText
Int -> ReadS UserText
ReadS [UserText]
(Int -> ReadS UserText)
-> ReadS [UserText]
-> ReadPrec UserText
-> ReadPrec [UserText]
-> Read UserText
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserText]
$creadListPrec :: ReadPrec [UserText]
readPrec :: ReadPrec UserText
$creadPrec :: ReadPrec UserText
readList :: ReadS [UserText]
$creadList :: ReadS [UserText]
readsPrec :: Int -> ReadS UserText
$creadsPrec :: Int -> ReadS UserText
Read)

instance A.ToJSON UserText where
    toJSON :: UserText -> Value
toJSON (UserText Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
t

instance A.FromJSON UserText where
    parseJSON :: Value -> Parser UserText
parseJSON Value
v = Text -> UserText
UserText (Text -> UserText) -> Parser Text -> Parser UserText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v

unsafeUserText :: UserText -> Text
unsafeUserText :: UserText -> Text
unsafeUserText (UserText Text
t) = Text
t

runLogger :: ConnectionData -> String -> LogEventType -> IO ()
runLogger :: ConnectionData -> String -> LogEventType -> IO ()
runLogger ConnectionData { cdLogger :: ConnectionData -> Maybe Logger
cdLogger = Just Logger
l } String
n LogEventType
ev =
  Logger
l (String -> LogEventType -> LogEvent
LogEvent String
n LogEventType
ev)
runLogger ConnectionData
_ String
_ LogEventType
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

runLoggerS :: Session -> String -> LogEventType -> IO ()
runLoggerS :: Session -> String -> LogEventType -> IO ()
runLoggerS (Session ConnectionData
cd Token
_) = ConnectionData -> String -> LogEventType -> IO ()
runLogger ConnectionData
cd

maybeFail :: Parser a -> Parser (Maybe a)
maybeFail :: Parser a -> Parser (Maybe a)
maybeFail Parser a
p = (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p) Parser (Maybe a) -> Parser (Maybe a) -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe a -> Parser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)

-- | Creates a structure representing a connection to the server.
mkConnectionData :: Hostname -> Port -> T.Text -> Pool.Pool MMConn -> ConnectionType -> ConnectionContext -> ConnectionData
mkConnectionData :: Text
-> Int
-> Text
-> Pool MMConn
-> ConnectionType
-> ConnectionContext
-> ConnectionData
mkConnectionData Text
host Int
port Text
path Pool MMConn
pool ConnectionType
connTy ConnectionContext
ctx = ConnectionData :: Text
-> Int
-> Text
-> AutoClose
-> Pool MMConn
-> ConnectionContext
-> Maybe Token
-> Maybe Logger
-> ConnectionType
-> ConnectionData
ConnectionData
  { cdHostname :: Text
cdHostname       = Text
host
  , cdPort :: Int
cdPort           = Int
port
  , cdUrlPath :: Text
cdUrlPath        = Text
path
  , cdConnectionCtx :: ConnectionContext
cdConnectionCtx  = ConnectionContext
ctx
  , cdAutoClose :: AutoClose
cdAutoClose      = AutoClose
No
  , cdConnectionPool :: Pool MMConn
cdConnectionPool = Pool MMConn
pool
  , cdToken :: Maybe Token
cdToken          = Maybe Token
forall a. Maybe a
Nothing
  , cdLogger :: Maybe Logger
cdLogger         = Maybe Logger
forall a. Maybe a
Nothing
  , cdConnectionType :: ConnectionType
cdConnectionType = ConnectionType
connTy
  }

createPool :: Hostname -> Port -> ConnectionContext -> ConnectionPoolConfig -> ConnectionType -> IO (Pool.Pool MMConn)
createPool :: Text
-> Int
-> ConnectionContext
-> ConnectionPoolConfig
-> ConnectionType
-> IO (Pool MMConn)
createPool Text
host Int
port ConnectionContext
ctx ConnectionPoolConfig
cpc ConnectionType
connTy =
  IO MMConn
-> (MMConn -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool MMConn)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
Pool.createPool (ConnectionContext -> Text -> Int -> ConnectionType -> IO Connection
mkConnection ConnectionContext
ctx Text
host Int
port ConnectionType
connTy IO Connection -> (Connection -> IO MMConn) -> IO MMConn
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> IO MMConn
newMMConn) MMConn -> IO ()
closeMMConn
                  (ConnectionPoolConfig -> Int
cpStripesCount ConnectionPoolConfig
cpc) (ConnectionPoolConfig -> NominalDiffTime
cpIdleConnTimeout ConnectionPoolConfig
cpc) (ConnectionPoolConfig -> Int
cpMaxConnCount ConnectionPoolConfig
cpc)

initConnectionData :: Hostname -> Port -> T.Text -> ConnectionType -> ConnectionPoolConfig -> IO ConnectionData
initConnectionData :: Text
-> Int
-> Text
-> ConnectionType
-> ConnectionPoolConfig
-> IO ConnectionData
initConnectionData Text
host Int
port Text
path ConnectionType
connTy ConnectionPoolConfig
cpc = do
  ConnectionContext
ctx  <- IO ConnectionContext
initConnectionContext
  Pool MMConn
pool <- Text
-> Int
-> ConnectionContext
-> ConnectionPoolConfig
-> ConnectionType
-> IO (Pool MMConn)
createPool Text
host Int
port ConnectionContext
ctx ConnectionPoolConfig
cpc ConnectionType
connTy
  ConnectionData -> IO ConnectionData
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> Int
-> Text
-> Pool MMConn
-> ConnectionType
-> ConnectionContext
-> ConnectionData
mkConnectionData Text
host Int
port Text
path Pool MMConn
pool ConnectionType
connTy ConnectionContext
ctx)

destroyConnectionData :: ConnectionData -> IO ()
destroyConnectionData :: ConnectionData -> IO ()
destroyConnectionData = Pool MMConn -> IO ()
forall a. Pool a -> IO ()
Pool.destroyAllResources (Pool MMConn -> IO ())
-> (ConnectionData -> Pool MMConn) -> ConnectionData -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionData -> Pool MMConn
cdConnectionPool

withLogger :: ConnectionData -> Logger -> ConnectionData
withLogger :: ConnectionData -> Logger -> ConnectionData
withLogger ConnectionData
cd Logger
logger = ConnectionData
cd { cdLogger :: Maybe Logger
cdLogger = Logger -> Maybe Logger
forall a. a -> Maybe a
Just Logger
logger }

noLogger :: ConnectionData -> ConnectionData
noLogger :: ConnectionData -> ConnectionData
noLogger ConnectionData
cd = ConnectionData
cd { cdLogger :: Maybe Logger
cdLogger = Maybe Logger
forall a. Maybe a
Nothing }

data ConnectionPoolConfig = ConnectionPoolConfig
  { ConnectionPoolConfig -> Int
cpStripesCount    :: Int
  , ConnectionPoolConfig -> NominalDiffTime
cpIdleConnTimeout :: NominalDiffTime
  , ConnectionPoolConfig -> Int
cpMaxConnCount    :: Int
  }

defaultConnectionPoolConfig :: ConnectionPoolConfig
defaultConnectionPoolConfig :: ConnectionPoolConfig
defaultConnectionPoolConfig = Int -> NominalDiffTime -> Int -> ConnectionPoolConfig
ConnectionPoolConfig Int
1 NominalDiffTime
30 Int
5

data Session = Session
  { Session -> ConnectionData
sessConn :: ConnectionData
  , Session -> Token
sessTok  :: Token
  }

data Login
  = Login
  { Login -> Text
username :: Text
  , Login -> Text
password :: Text
  } deriving (Int -> Login -> ShowS
[Login] -> ShowS
Login -> String
(Int -> Login -> ShowS)
-> (Login -> String) -> ([Login] -> ShowS) -> Show Login
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Login] -> ShowS
$cshowList :: [Login] -> ShowS
show :: Login -> String
$cshow :: Login -> String
showsPrec :: Int -> Login -> ShowS
$cshowsPrec :: Int -> Login -> ShowS
Show)

instance A.ToJSON Login where
  toJSON :: Login -> Value
toJSON Login
l = [Pair] -> Value
A.object [Text
"login_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Login -> Text
username Login
l
                      ,Text
"password" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Login -> Text
password Login
l
                      ]


data SetChannelHeader = SetChannelHeader
  { SetChannelHeader -> ChannelId
setChannelHeaderChanId :: ChannelId
  , SetChannelHeader -> Text
setChannelHeaderString :: Text
  } deriving (Int -> SetChannelHeader -> ShowS
[SetChannelHeader] -> ShowS
SetChannelHeader -> String
(Int -> SetChannelHeader -> ShowS)
-> (SetChannelHeader -> String)
-> ([SetChannelHeader] -> ShowS)
-> Show SetChannelHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetChannelHeader] -> ShowS
$cshowList :: [SetChannelHeader] -> ShowS
show :: SetChannelHeader -> String
$cshow :: SetChannelHeader -> String
showsPrec :: Int -> SetChannelHeader -> ShowS
$cshowsPrec :: Int -> SetChannelHeader -> ShowS
Show)

instance A.ToJSON SetChannelHeader where
  toJSON :: SetChannelHeader -> Value
toJSON (SetChannelHeader ChannelId
cId Text
p) =
      [Pair] -> Value
A.object [Text
"channel_id" Text -> ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ChannelId
cId
               ,Text
"channel_header" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
p
               ]

data SearchPosts = SearchPosts
 { SearchPosts -> Text
searchPostsTerms      :: Text
 , SearchPosts -> Bool
searchPostsIsOrSearch :: Bool
 } deriving (Int -> SearchPosts -> ShowS
[SearchPosts] -> ShowS
SearchPosts -> String
(Int -> SearchPosts -> ShowS)
-> (SearchPosts -> String)
-> ([SearchPosts] -> ShowS)
-> Show SearchPosts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchPosts] -> ShowS
$cshowList :: [SearchPosts] -> ShowS
show :: SearchPosts -> String
$cshow :: SearchPosts -> String
showsPrec :: Int -> SearchPosts -> ShowS
$cshowsPrec :: Int -> SearchPosts -> ShowS
Show)

instance A.ToJSON SearchPosts where
 toJSON :: SearchPosts -> Value
toJSON (SearchPosts Text
t Bool
os) =
     [Pair] -> Value
A.object [Text
"terms" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
t
              ,Text
"is_or_search" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Bool
os
              ]

data Type = Ordinary
          | Direct
          | Private
          | Group
          | Unknown Text
  deriving (ReadPrec [Type]
ReadPrec Type
Int -> ReadS Type
ReadS [Type]
(Int -> ReadS Type)
-> ReadS [Type] -> ReadPrec Type -> ReadPrec [Type] -> Read Type
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type]
$creadListPrec :: ReadPrec [Type]
readPrec :: ReadPrec Type
$creadPrec :: ReadPrec Type
readList :: ReadS [Type]
$creadList :: ReadS [Type]
readsPrec :: Int -> ReadS Type
$creadsPrec :: Int -> ReadS Type
Read, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq)

instance A.FromJSON Type where
  parseJSON :: Value -> Parser Type
parseJSON = String -> (Text -> Parser Type) -> Value -> Parser Type
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"Type" ((Text -> Parser Type) -> Value -> Parser Type)
-> (Text -> Parser Type) -> Value -> Parser Type
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      Type -> Parser Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Parser Type) -> Type -> Parser Type
forall a b. (a -> b) -> a -> b
$ if | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"O"  -> Type
Ordinary   -- public chat channels
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"D"  -> Type
Direct     -- between two users only
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"P"  -> Type
Private    -- like Ordinary but not visible to non-members
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"G"  -> Type
Group      -- between a selected set of users
                  | Bool
otherwise -> Text -> Type
Unknown Text
t

instance A.ToJSON Type where
  toJSON :: Type -> Value
toJSON Type
Direct              = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text
"D"::Text)
  toJSON Type
Ordinary            = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text
"O"::Text)
  toJSON Type
Private             = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text
"P"::Text)
  toJSON Type
Group     = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text
"G"::Text)
  toJSON (Unknown Text
t)         = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
t

--

-- For converting from type specific Id to generic Id
class IsId x where
  toId   :: x  -> Id
  fromId :: Id -> x

class HasId x y | x -> y where
  getId :: x -> y

newtype Id = Id { Id -> Text
unId :: Text }
  deriving (ReadPrec [Id]
ReadPrec Id
Int -> ReadS Id
ReadS [Id]
(Int -> ReadS Id)
-> ReadS [Id] -> ReadPrec Id -> ReadPrec [Id] -> Read Id
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Id]
$creadListPrec :: ReadPrec [Id]
readPrec :: ReadPrec Id
$creadPrec :: ReadPrec Id
readList :: ReadS [Id]
$creadList :: ReadS [Id]
readsPrec :: Int -> ReadS Id
$creadsPrec :: Int -> ReadS Id
Read, 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
Show, 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
Eq, Eq Id
Eq Id
-> (Id -> Id -> Ordering)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Id)
-> (Id -> Id -> Id)
-> Ord Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
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 :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
$cp1Ord :: Eq Id
Ord, Int -> Id -> Int
Id -> Int
(Int -> Id -> Int) -> (Id -> Int) -> Hashable Id
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Id -> Int
$chash :: Id -> Int
hashWithSalt :: Int -> Id -> Int
$chashWithSalt :: Int -> Id -> Int
Hashable, [Id] -> Encoding
[Id] -> Value
Id -> Encoding
Id -> Value
(Id -> Value)
-> (Id -> Encoding)
-> ([Id] -> Value)
-> ([Id] -> Encoding)
-> ToJSON Id
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Id] -> Encoding
$ctoEncodingList :: [Id] -> Encoding
toJSONList :: [Id] -> Value
$ctoJSONList :: [Id] -> Value
toEncoding :: Id -> Encoding
$ctoEncoding :: Id -> Encoding
toJSON :: Id -> Value
$ctoJSON :: Id -> Value
ToJSON, ToJSONKeyFunction [Id]
ToJSONKeyFunction Id
ToJSONKeyFunction Id -> ToJSONKeyFunction [Id] -> ToJSONKey Id
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Id]
$ctoJSONKeyList :: ToJSONKeyFunction [Id]
toJSONKey :: ToJSONKeyFunction Id
$ctoJSONKey :: ToJSONKeyFunction Id
ToJSONKey, FromJSONKeyFunction [Id]
FromJSONKeyFunction Id
FromJSONKeyFunction Id
-> FromJSONKeyFunction [Id] -> FromJSONKey Id
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Id]
$cfromJSONKeyList :: FromJSONKeyFunction [Id]
fromJSONKey :: FromJSONKeyFunction Id
$cfromJSONKey :: FromJSONKeyFunction Id
FromJSONKey)

idString :: IsId x => x -> Text
idString :: x -> Text
idString x
x = Id -> Text
unId Id
i
  where i :: Id
i = x -> Id
forall x. IsId x => x -> Id
toId x
x

instance A.FromJSON Id where
  parseJSON :: Value -> Parser Id
parseJSON = String -> (Text -> Parser Id) -> Value -> Parser Id
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"Id" ((Text -> Parser Id) -> Value -> Parser Id)
-> (Text -> Parser Id) -> Value -> Parser Id
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text -> Bool
T.null Text
t of
          Bool
False -> Id -> Parser Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Parser Id) -> Id -> Parser Id
forall a b. (a -> b) -> a -> b
$ Text -> Id
Id Text
t
          Bool
True -> String -> Parser Id
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty ID"

instance IsId Id where
  toId :: Id -> Id
toId   = Id -> Id
forall a. a -> a
id
  fromId :: Id -> Id
fromId = Id -> Id
forall a. a -> a
id

instance HasId Id Id where
  getId :: Id -> Id
getId  = Id -> Id
forall a. a -> a
id

--

newtype TeamId = TI { TeamId -> Id
unTI :: Id }
  deriving (ReadPrec [TeamId]
ReadPrec TeamId
Int -> ReadS TeamId
ReadS [TeamId]
(Int -> ReadS TeamId)
-> ReadS [TeamId]
-> ReadPrec TeamId
-> ReadPrec [TeamId]
-> Read TeamId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TeamId]
$creadListPrec :: ReadPrec [TeamId]
readPrec :: ReadPrec TeamId
$creadPrec :: ReadPrec TeamId
readList :: ReadS [TeamId]
$creadList :: ReadS [TeamId]
readsPrec :: Int -> ReadS TeamId
$creadsPrec :: Int -> ReadS TeamId
Read, 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
Show, 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
Eq, Eq TeamId
Eq TeamId
-> (TeamId -> TeamId -> Ordering)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> TeamId)
-> (TeamId -> TeamId -> TeamId)
-> Ord TeamId
TeamId -> TeamId -> Bool
TeamId -> TeamId -> Ordering
TeamId -> TeamId -> TeamId
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 :: TeamId -> TeamId -> TeamId
$cmin :: TeamId -> TeamId -> TeamId
max :: TeamId -> TeamId -> TeamId
$cmax :: TeamId -> TeamId -> TeamId
>= :: TeamId -> TeamId -> Bool
$c>= :: TeamId -> TeamId -> Bool
> :: TeamId -> TeamId -> Bool
$c> :: TeamId -> TeamId -> Bool
<= :: TeamId -> TeamId -> Bool
$c<= :: TeamId -> TeamId -> Bool
< :: TeamId -> TeamId -> Bool
$c< :: TeamId -> TeamId -> Bool
compare :: TeamId -> TeamId -> Ordering
$ccompare :: TeamId -> TeamId -> Ordering
$cp1Ord :: Eq TeamId
Ord, Int -> TeamId -> Int
TeamId -> Int
(Int -> TeamId -> Int) -> (TeamId -> Int) -> Hashable TeamId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TeamId -> Int
$chash :: TeamId -> Int
hashWithSalt :: Int -> TeamId -> Int
$chashWithSalt :: Int -> TeamId -> Int
Hashable, [TeamId] -> Encoding
[TeamId] -> Value
TeamId -> Encoding
TeamId -> Value
(TeamId -> Value)
-> (TeamId -> Encoding)
-> ([TeamId] -> Value)
-> ([TeamId] -> Encoding)
-> ToJSON TeamId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TeamId] -> Encoding
$ctoEncodingList :: [TeamId] -> Encoding
toJSONList :: [TeamId] -> Value
$ctoJSONList :: [TeamId] -> Value
toEncoding :: TeamId -> Encoding
$ctoEncoding :: TeamId -> Encoding
toJSON :: TeamId -> Value
$ctoJSON :: TeamId -> Value
ToJSON, ToJSONKeyFunction [TeamId]
ToJSONKeyFunction TeamId
ToJSONKeyFunction TeamId
-> ToJSONKeyFunction [TeamId] -> ToJSONKey TeamId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [TeamId]
$ctoJSONKeyList :: ToJSONKeyFunction [TeamId]
toJSONKey :: ToJSONKeyFunction TeamId
$ctoJSONKey :: ToJSONKeyFunction TeamId
ToJSONKey, FromJSONKeyFunction [TeamId]
FromJSONKeyFunction TeamId
FromJSONKeyFunction TeamId
-> FromJSONKeyFunction [TeamId] -> FromJSONKey TeamId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [TeamId]
$cfromJSONKeyList :: FromJSONKeyFunction [TeamId]
fromJSONKey :: FromJSONKeyFunction TeamId
$cfromJSONKey :: FromJSONKeyFunction TeamId
FromJSONKey, Value -> Parser [TeamId]
Value -> Parser TeamId
(Value -> Parser TeamId)
-> (Value -> Parser [TeamId]) -> FromJSON TeamId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TeamId]
$cparseJSONList :: Value -> Parser [TeamId]
parseJSON :: Value -> Parser TeamId
$cparseJSON :: Value -> Parser TeamId
FromJSON)

instance IsId TeamId where
  toId :: TeamId -> Id
toId   = TeamId -> Id
unTI
  fromId :: Id -> TeamId
fromId = Id -> TeamId
TI

instance PrintfArg TeamId where
  formatArg :: TeamId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (TeamId -> Text) -> TeamId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Text
forall x. IsId x => x -> Text
idString

data Team
  = Team
  { Team -> TeamId
teamId              :: TeamId
  , Team -> ServerTime
teamCreateAt        :: ServerTime
  , Team -> ServerTime
teamUpdateAt        :: ServerTime
  , Team -> ServerTime
teamDeleteAt        :: ServerTime
  , Team -> UserText
teamDisplayName     :: UserText
  , Team -> UserText
teamName            :: UserText
  , Team -> UserText
teamEmail           :: UserText
  , Team -> Type
teamType            :: Type
  , Team -> UserText
teamCompanyName     :: UserText
  , Team -> UserText
teamAllowedDomains  :: UserText
  , Team -> Maybe Id
teamInviteId        :: Maybe Id
  , Team -> Bool
teamAllowOpenInvite :: Bool
  }
  deriving (ReadPrec [Team]
ReadPrec Team
Int -> ReadS Team
ReadS [Team]
(Int -> ReadS Team)
-> ReadS [Team] -> ReadPrec Team -> ReadPrec [Team] -> Read Team
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Team]
$creadListPrec :: ReadPrec [Team]
readPrec :: ReadPrec Team
$creadPrec :: ReadPrec Team
readList :: ReadS [Team]
$creadList :: ReadS [Team]
readsPrec :: Int -> ReadS Team
$creadsPrec :: Int -> ReadS Team
Read, Int -> Team -> ShowS
[Team] -> ShowS
Team -> String
(Int -> Team -> ShowS)
-> (Team -> String) -> ([Team] -> ShowS) -> Show Team
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Team] -> ShowS
$cshowList :: [Team] -> ShowS
show :: Team -> String
$cshow :: Team -> String
showsPrec :: Int -> Team -> ShowS
$cshowsPrec :: Int -> Team -> ShowS
Show, Team -> Team -> Bool
(Team -> Team -> Bool) -> (Team -> Team -> Bool) -> Eq Team
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Team -> Team -> Bool
$c/= :: Team -> Team -> Bool
== :: Team -> Team -> Bool
$c== :: Team -> Team -> Bool
Eq, Eq Team
Eq Team
-> (Team -> Team -> Ordering)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Team)
-> (Team -> Team -> Team)
-> Ord Team
Team -> Team -> Bool
Team -> Team -> Ordering
Team -> Team -> Team
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 :: Team -> Team -> Team
$cmin :: Team -> Team -> Team
max :: Team -> Team -> Team
$cmax :: Team -> Team -> Team
>= :: Team -> Team -> Bool
$c>= :: Team -> Team -> Bool
> :: Team -> Team -> Bool
$c> :: Team -> Team -> Bool
<= :: Team -> Team -> Bool
$c<= :: Team -> Team -> Bool
< :: Team -> Team -> Bool
$c< :: Team -> Team -> Bool
compare :: Team -> Team -> Ordering
$ccompare :: Team -> Team -> Ordering
$cp1Ord :: Eq Team
Ord)

instance HasId Team TeamId where
  getId :: Team -> TeamId
getId = Team -> TeamId
teamId

instance A.FromJSON Team where
  parseJSON :: Value -> Parser Team
parseJSON = String -> (Object -> Parser Team) -> Value -> Parser Team
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Team" ((Object -> Parser Team) -> Value -> Parser Team)
-> (Object -> Parser Team) -> Value -> Parser Team
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    TeamId
teamId              <- Object
v Object -> Text -> Parser TeamId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    ServerTime
teamCreateAt        <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"create_at"
    ServerTime
teamUpdateAt        <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"update_at"
    ServerTime
teamDeleteAt        <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"delete_at"
    UserText
teamDisplayName     <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"display_name"
    UserText
teamName            <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    UserText
teamEmail           <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"email"
    Type
teamType            <- Object
v Object -> Text -> Parser Type
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
    UserText
teamCompanyName     <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"company_name"
    UserText
teamAllowedDomains  <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"allowed_domains"
    Maybe Id
teamInviteId        <- Parser Id -> Parser (Maybe Id)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
v Object -> Text -> Parser Id
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"invite_id")
    Bool
teamAllowOpenInvite <- Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"allow_open_invite"
    Team -> Parser Team
forall (m :: * -> *) a. Monad m => a -> m a
return Team :: TeamId
-> ServerTime
-> ServerTime
-> ServerTime
-> UserText
-> UserText
-> UserText
-> Type
-> UserText
-> UserText
-> Maybe Id
-> Bool
-> Team
Team { Bool
Maybe Id
ServerTime
TeamId
Type
UserText
teamAllowOpenInvite :: Bool
teamInviteId :: Maybe Id
teamAllowedDomains :: UserText
teamCompanyName :: UserText
teamType :: Type
teamEmail :: UserText
teamName :: UserText
teamDisplayName :: UserText
teamDeleteAt :: ServerTime
teamUpdateAt :: ServerTime
teamCreateAt :: ServerTime
teamId :: TeamId
teamAllowOpenInvite :: Bool
teamInviteId :: Maybe Id
teamAllowedDomains :: UserText
teamCompanyName :: UserText
teamType :: Type
teamEmail :: UserText
teamName :: UserText
teamDisplayName :: UserText
teamDeleteAt :: ServerTime
teamUpdateAt :: ServerTime
teamCreateAt :: ServerTime
teamId :: TeamId
.. }

data TeamMember = TeamMember
  { TeamMember -> UserId
teamMemberUserId :: UserId
  , TeamMember -> TeamId
teamMemberTeamId :: TeamId
  , TeamMember -> Text
teamMemberRoles  :: Text
  } deriving (ReadPrec [TeamMember]
ReadPrec TeamMember
Int -> ReadS TeamMember
ReadS [TeamMember]
(Int -> ReadS TeamMember)
-> ReadS [TeamMember]
-> ReadPrec TeamMember
-> ReadPrec [TeamMember]
-> Read TeamMember
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TeamMember]
$creadListPrec :: ReadPrec [TeamMember]
readPrec :: ReadPrec TeamMember
$creadPrec :: ReadPrec TeamMember
readList :: ReadS [TeamMember]
$creadList :: ReadS [TeamMember]
readsPrec :: Int -> ReadS TeamMember
$creadsPrec :: Int -> ReadS TeamMember
Read, Int -> TeamMember -> ShowS
[TeamMember] -> ShowS
TeamMember -> String
(Int -> TeamMember -> ShowS)
-> (TeamMember -> String)
-> ([TeamMember] -> ShowS)
-> Show TeamMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamMember] -> ShowS
$cshowList :: [TeamMember] -> ShowS
show :: TeamMember -> String
$cshow :: TeamMember -> String
showsPrec :: Int -> TeamMember -> ShowS
$cshowsPrec :: Int -> TeamMember -> ShowS
Show, TeamMember -> TeamMember -> Bool
(TeamMember -> TeamMember -> Bool)
-> (TeamMember -> TeamMember -> Bool) -> Eq TeamMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamMember -> TeamMember -> Bool
$c/= :: TeamMember -> TeamMember -> Bool
== :: TeamMember -> TeamMember -> Bool
$c== :: TeamMember -> TeamMember -> Bool
Eq, Eq TeamMember
Eq TeamMember
-> (TeamMember -> TeamMember -> Ordering)
-> (TeamMember -> TeamMember -> Bool)
-> (TeamMember -> TeamMember -> Bool)
-> (TeamMember -> TeamMember -> Bool)
-> (TeamMember -> TeamMember -> Bool)
-> (TeamMember -> TeamMember -> TeamMember)
-> (TeamMember -> TeamMember -> TeamMember)
-> Ord TeamMember
TeamMember -> TeamMember -> Bool
TeamMember -> TeamMember -> Ordering
TeamMember -> TeamMember -> TeamMember
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 :: TeamMember -> TeamMember -> TeamMember
$cmin :: TeamMember -> TeamMember -> TeamMember
max :: TeamMember -> TeamMember -> TeamMember
$cmax :: TeamMember -> TeamMember -> TeamMember
>= :: TeamMember -> TeamMember -> Bool
$c>= :: TeamMember -> TeamMember -> Bool
> :: TeamMember -> TeamMember -> Bool
$c> :: TeamMember -> TeamMember -> Bool
<= :: TeamMember -> TeamMember -> Bool
$c<= :: TeamMember -> TeamMember -> Bool
< :: TeamMember -> TeamMember -> Bool
$c< :: TeamMember -> TeamMember -> Bool
compare :: TeamMember -> TeamMember -> Ordering
$ccompare :: TeamMember -> TeamMember -> Ordering
$cp1Ord :: Eq TeamMember
Ord)

instance A.FromJSON TeamMember where
  parseJSON :: Value -> Parser TeamMember
parseJSON = String
-> (Object -> Parser TeamMember) -> Value -> Parser TeamMember
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TeamMember" ((Object -> Parser TeamMember) -> Value -> Parser TeamMember)
-> (Object -> Parser TeamMember) -> Value -> Parser TeamMember
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    UserId
teamMemberUserId <- Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
    TeamId
teamMemberTeamId <- Object
v Object -> Text -> Parser TeamId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"team_id"
    Text
teamMemberRoles  <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"roles"
    TeamMember -> Parser TeamMember
forall (m :: * -> *) a. Monad m => a -> m a
return TeamMember :: UserId -> TeamId -> Text -> TeamMember
TeamMember { Text
UserId
TeamId
teamMemberRoles :: Text
teamMemberTeamId :: TeamId
teamMemberUserId :: UserId
teamMemberRoles :: Text
teamMemberTeamId :: TeamId
teamMemberUserId :: UserId
.. }

instance A.ToJSON TeamMember where
  toJSON :: TeamMember -> Value
toJSON TeamMember { Text
UserId
TeamId
teamMemberRoles :: Text
teamMemberTeamId :: TeamId
teamMemberUserId :: UserId
teamMemberRoles :: TeamMember -> Text
teamMemberTeamId :: TeamMember -> TeamId
teamMemberUserId :: TeamMember -> UserId
.. } = [Pair] -> Value
A.object
    [ Text
"user_id" Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UserId
teamMemberUserId
    , Text
"team_id" Text -> TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TeamId
teamMemberTeamId
    , Text
"roles"   Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
teamMemberRoles
    ]
--

data WithDefault a
  = IsValue a
  | Default
    deriving (ReadPrec [WithDefault a]
ReadPrec (WithDefault a)
Int -> ReadS (WithDefault a)
ReadS [WithDefault a]
(Int -> ReadS (WithDefault a))
-> ReadS [WithDefault a]
-> ReadPrec (WithDefault a)
-> ReadPrec [WithDefault a]
-> Read (WithDefault a)
forall a. Read a => ReadPrec [WithDefault a]
forall a. Read a => ReadPrec (WithDefault a)
forall a. Read a => Int -> ReadS (WithDefault a)
forall a. Read a => ReadS [WithDefault a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WithDefault a]
$creadListPrec :: forall a. Read a => ReadPrec [WithDefault a]
readPrec :: ReadPrec (WithDefault a)
$creadPrec :: forall a. Read a => ReadPrec (WithDefault a)
readList :: ReadS [WithDefault a]
$creadList :: forall a. Read a => ReadS [WithDefault a]
readsPrec :: Int -> ReadS (WithDefault a)
$creadsPrec :: forall a. Read a => Int -> ReadS (WithDefault a)
Read, Int -> WithDefault a -> ShowS
[WithDefault a] -> ShowS
WithDefault a -> String
(Int -> WithDefault a -> ShowS)
-> (WithDefault a -> String)
-> ([WithDefault a] -> ShowS)
-> Show (WithDefault a)
forall a. Show a => Int -> WithDefault a -> ShowS
forall a. Show a => [WithDefault a] -> ShowS
forall a. Show a => WithDefault a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithDefault a] -> ShowS
$cshowList :: forall a. Show a => [WithDefault a] -> ShowS
show :: WithDefault a -> String
$cshow :: forall a. Show a => WithDefault a -> String
showsPrec :: Int -> WithDefault a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithDefault a -> ShowS
Show, WithDefault a -> WithDefault a -> Bool
(WithDefault a -> WithDefault a -> Bool)
-> (WithDefault a -> WithDefault a -> Bool) -> Eq (WithDefault a)
forall a. Eq a => WithDefault a -> WithDefault a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithDefault a -> WithDefault a -> Bool
$c/= :: forall a. Eq a => WithDefault a -> WithDefault a -> Bool
== :: WithDefault a -> WithDefault a -> Bool
$c== :: forall a. Eq a => WithDefault a -> WithDefault a -> Bool
Eq, Eq (WithDefault a)
Eq (WithDefault a)
-> (WithDefault a -> WithDefault a -> Ordering)
-> (WithDefault a -> WithDefault a -> Bool)
-> (WithDefault a -> WithDefault a -> Bool)
-> (WithDefault a -> WithDefault a -> Bool)
-> (WithDefault a -> WithDefault a -> Bool)
-> (WithDefault a -> WithDefault a -> WithDefault a)
-> (WithDefault a -> WithDefault a -> WithDefault a)
-> Ord (WithDefault a)
WithDefault a -> WithDefault a -> Bool
WithDefault a -> WithDefault a -> Ordering
WithDefault a -> WithDefault a -> WithDefault a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (WithDefault a)
forall a. Ord a => WithDefault a -> WithDefault a -> Bool
forall a. Ord a => WithDefault a -> WithDefault a -> Ordering
forall a. Ord a => WithDefault a -> WithDefault a -> WithDefault a
min :: WithDefault a -> WithDefault a -> WithDefault a
$cmin :: forall a. Ord a => WithDefault a -> WithDefault a -> WithDefault a
max :: WithDefault a -> WithDefault a -> WithDefault a
$cmax :: forall a. Ord a => WithDefault a -> WithDefault a -> WithDefault a
>= :: WithDefault a -> WithDefault a -> Bool
$c>= :: forall a. Ord a => WithDefault a -> WithDefault a -> Bool
> :: WithDefault a -> WithDefault a -> Bool
$c> :: forall a. Ord a => WithDefault a -> WithDefault a -> Bool
<= :: WithDefault a -> WithDefault a -> Bool
$c<= :: forall a. Ord a => WithDefault a -> WithDefault a -> Bool
< :: WithDefault a -> WithDefault a -> Bool
$c< :: forall a. Ord a => WithDefault a -> WithDefault a -> Bool
compare :: WithDefault a -> WithDefault a -> Ordering
$ccompare :: forall a. Ord a => WithDefault a -> WithDefault a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (WithDefault a)
Ord)

instance A.ToJSON t => A.ToJSON (WithDefault t) where
  toJSON :: WithDefault t -> Value
toJSON WithDefault t
Default = Text -> Value
A.String Text
"default"
  toJSON (IsValue t
x) = t -> Value
forall a. ToJSON a => a -> Value
A.toJSON t
x

instance A.FromJSON t => A.FromJSON (WithDefault t) where
  parseJSON :: Value -> Parser (WithDefault t)
parseJSON (A.String Text
"default") = WithDefault t -> Parser (WithDefault t)
forall (m :: * -> *) a. Monad m => a -> m a
return WithDefault t
forall a. WithDefault a
Default
  parseJSON Value
t                    = t -> WithDefault t
forall a. a -> WithDefault a
IsValue (t -> WithDefault t) -> Parser t -> Parser (WithDefault t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser t
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
t

instance Functor WithDefault where
  fmap :: (a -> b) -> WithDefault a -> WithDefault b
fmap a -> b
f (IsValue a
x) = b -> WithDefault b
forall a. a -> WithDefault a
IsValue (a -> b
f a
x)
  fmap a -> b
_ WithDefault a
Default     = WithDefault b
forall a. WithDefault a
Default

data NotifyOption
  = NotifyOptionAll
  | NotifyOptionMention
  | NotifyOptionNone
    deriving (ReadPrec [NotifyOption]
ReadPrec NotifyOption
Int -> ReadS NotifyOption
ReadS [NotifyOption]
(Int -> ReadS NotifyOption)
-> ReadS [NotifyOption]
-> ReadPrec NotifyOption
-> ReadPrec [NotifyOption]
-> Read NotifyOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NotifyOption]
$creadListPrec :: ReadPrec [NotifyOption]
readPrec :: ReadPrec NotifyOption
$creadPrec :: ReadPrec NotifyOption
readList :: ReadS [NotifyOption]
$creadList :: ReadS [NotifyOption]
readsPrec :: Int -> ReadS NotifyOption
$creadsPrec :: Int -> ReadS NotifyOption
Read, Int -> NotifyOption -> ShowS
[NotifyOption] -> ShowS
NotifyOption -> String
(Int -> NotifyOption -> ShowS)
-> (NotifyOption -> String)
-> ([NotifyOption] -> ShowS)
-> Show NotifyOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotifyOption] -> ShowS
$cshowList :: [NotifyOption] -> ShowS
show :: NotifyOption -> String
$cshow :: NotifyOption -> String
showsPrec :: Int -> NotifyOption -> ShowS
$cshowsPrec :: Int -> NotifyOption -> ShowS
Show, NotifyOption -> NotifyOption -> Bool
(NotifyOption -> NotifyOption -> Bool)
-> (NotifyOption -> NotifyOption -> Bool) -> Eq NotifyOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotifyOption -> NotifyOption -> Bool
$c/= :: NotifyOption -> NotifyOption -> Bool
== :: NotifyOption -> NotifyOption -> Bool
$c== :: NotifyOption -> NotifyOption -> Bool
Eq, Eq NotifyOption
Eq NotifyOption
-> (NotifyOption -> NotifyOption -> Ordering)
-> (NotifyOption -> NotifyOption -> Bool)
-> (NotifyOption -> NotifyOption -> Bool)
-> (NotifyOption -> NotifyOption -> Bool)
-> (NotifyOption -> NotifyOption -> Bool)
-> (NotifyOption -> NotifyOption -> NotifyOption)
-> (NotifyOption -> NotifyOption -> NotifyOption)
-> Ord NotifyOption
NotifyOption -> NotifyOption -> Bool
NotifyOption -> NotifyOption -> Ordering
NotifyOption -> NotifyOption -> NotifyOption
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 :: NotifyOption -> NotifyOption -> NotifyOption
$cmin :: NotifyOption -> NotifyOption -> NotifyOption
max :: NotifyOption -> NotifyOption -> NotifyOption
$cmax :: NotifyOption -> NotifyOption -> NotifyOption
>= :: NotifyOption -> NotifyOption -> Bool
$c>= :: NotifyOption -> NotifyOption -> Bool
> :: NotifyOption -> NotifyOption -> Bool
$c> :: NotifyOption -> NotifyOption -> Bool
<= :: NotifyOption -> NotifyOption -> Bool
$c<= :: NotifyOption -> NotifyOption -> Bool
< :: NotifyOption -> NotifyOption -> Bool
$c< :: NotifyOption -> NotifyOption -> Bool
compare :: NotifyOption -> NotifyOption -> Ordering
$ccompare :: NotifyOption -> NotifyOption -> Ordering
$cp1Ord :: Eq NotifyOption
Ord)

instance A.ToJSON NotifyOption where
  toJSON :: NotifyOption -> Value
toJSON NotifyOption
NotifyOptionAll     = Text -> Value
A.String Text
"all"
  toJSON NotifyOption
NotifyOptionMention = Text -> Value
A.String Text
"mention"
  toJSON NotifyOption
NotifyOptionNone    = Text -> Value
A.String Text
"none"

instance A.FromJSON NotifyOption where
  parseJSON :: Value -> Parser NotifyOption
parseJSON (A.String Text
"all")     = NotifyOption -> Parser NotifyOption
forall (m :: * -> *) a. Monad m => a -> m a
return NotifyOption
NotifyOptionAll
  parseJSON (A.String Text
"mention") = NotifyOption -> Parser NotifyOption
forall (m :: * -> *) a. Monad m => a -> m a
return NotifyOption
NotifyOptionMention
  parseJSON (A.String Text
"none")    = NotifyOption -> Parser NotifyOption
forall (m :: * -> *) a. Monad m => a -> m a
return NotifyOption
NotifyOptionNone
  parseJSON Value
xs                   = String -> Parser NotifyOption
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown NotifyOption value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
xs)

data UserNotifyProps = UserNotifyProps
  { UserNotifyProps -> [UserText]
userNotifyPropsMentionKeys  :: [UserText]
  , UserNotifyProps -> Bool
userNotifyPropsEmail        :: Bool
  , UserNotifyProps -> NotifyOption
userNotifyPropsPush         :: NotifyOption
  , UserNotifyProps -> NotifyOption
userNotifyPropsDesktop      :: NotifyOption
  , UserNotifyProps -> Bool
userNotifyPropsDesktopSound :: Bool
  , UserNotifyProps -> Bool
userNotifyPropsChannel      :: Bool
  , UserNotifyProps -> Bool
userNotifyPropsFirstName    :: Bool
  } deriving (UserNotifyProps -> UserNotifyProps -> Bool
(UserNotifyProps -> UserNotifyProps -> Bool)
-> (UserNotifyProps -> UserNotifyProps -> Bool)
-> Eq UserNotifyProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserNotifyProps -> UserNotifyProps -> Bool
$c/= :: UserNotifyProps -> UserNotifyProps -> Bool
== :: UserNotifyProps -> UserNotifyProps -> Bool
$c== :: UserNotifyProps -> UserNotifyProps -> Bool
Eq, Int -> UserNotifyProps -> ShowS
[UserNotifyProps] -> ShowS
UserNotifyProps -> String
(Int -> UserNotifyProps -> ShowS)
-> (UserNotifyProps -> String)
-> ([UserNotifyProps] -> ShowS)
-> Show UserNotifyProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserNotifyProps] -> ShowS
$cshowList :: [UserNotifyProps] -> ShowS
show :: UserNotifyProps -> String
$cshow :: UserNotifyProps -> String
showsPrec :: Int -> UserNotifyProps -> ShowS
$cshowsPrec :: Int -> UserNotifyProps -> ShowS
Show, ReadPrec [UserNotifyProps]
ReadPrec UserNotifyProps
Int -> ReadS UserNotifyProps
ReadS [UserNotifyProps]
(Int -> ReadS UserNotifyProps)
-> ReadS [UserNotifyProps]
-> ReadPrec UserNotifyProps
-> ReadPrec [UserNotifyProps]
-> Read UserNotifyProps
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserNotifyProps]
$creadListPrec :: ReadPrec [UserNotifyProps]
readPrec :: ReadPrec UserNotifyProps
$creadPrec :: ReadPrec UserNotifyProps
readList :: ReadS [UserNotifyProps]
$creadList :: ReadS [UserNotifyProps]
readsPrec :: Int -> ReadS UserNotifyProps
$creadsPrec :: Int -> ReadS UserNotifyProps
Read, Eq UserNotifyProps
Eq UserNotifyProps
-> (UserNotifyProps -> UserNotifyProps -> Ordering)
-> (UserNotifyProps -> UserNotifyProps -> Bool)
-> (UserNotifyProps -> UserNotifyProps -> Bool)
-> (UserNotifyProps -> UserNotifyProps -> Bool)
-> (UserNotifyProps -> UserNotifyProps -> Bool)
-> (UserNotifyProps -> UserNotifyProps -> UserNotifyProps)
-> (UserNotifyProps -> UserNotifyProps -> UserNotifyProps)
-> Ord UserNotifyProps
UserNotifyProps -> UserNotifyProps -> Bool
UserNotifyProps -> UserNotifyProps -> Ordering
UserNotifyProps -> UserNotifyProps -> UserNotifyProps
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 :: UserNotifyProps -> UserNotifyProps -> UserNotifyProps
$cmin :: UserNotifyProps -> UserNotifyProps -> UserNotifyProps
max :: UserNotifyProps -> UserNotifyProps -> UserNotifyProps
$cmax :: UserNotifyProps -> UserNotifyProps -> UserNotifyProps
>= :: UserNotifyProps -> UserNotifyProps -> Bool
$c>= :: UserNotifyProps -> UserNotifyProps -> Bool
> :: UserNotifyProps -> UserNotifyProps -> Bool
$c> :: UserNotifyProps -> UserNotifyProps -> Bool
<= :: UserNotifyProps -> UserNotifyProps -> Bool
$c<= :: UserNotifyProps -> UserNotifyProps -> Bool
< :: UserNotifyProps -> UserNotifyProps -> Bool
$c< :: UserNotifyProps -> UserNotifyProps -> Bool
compare :: UserNotifyProps -> UserNotifyProps -> Ordering
$ccompare :: UserNotifyProps -> UserNotifyProps -> Ordering
$cp1Ord :: Eq UserNotifyProps
Ord)

data ChannelNotifyProps = ChannelNotifyProps
  { ChannelNotifyProps -> WithDefault Bool
channelNotifyPropsEmail                 :: WithDefault Bool
  , ChannelNotifyProps -> WithDefault NotifyOption
channelNotifyPropsDesktop               :: WithDefault NotifyOption
  , ChannelNotifyProps -> WithDefault NotifyOption
channelNotifyPropsPush                  :: WithDefault NotifyOption
  , ChannelNotifyProps -> WithDefault NotifyOption
channelNotifyPropsMarkUnread            :: WithDefault NotifyOption
  , ChannelNotifyProps -> WithDefault Bool
channelNotifyPropsIgnoreChannelMentions :: WithDefault Bool
  } deriving (ChannelNotifyProps -> ChannelNotifyProps -> Bool
(ChannelNotifyProps -> ChannelNotifyProps -> Bool)
-> (ChannelNotifyProps -> ChannelNotifyProps -> Bool)
-> Eq ChannelNotifyProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
$c/= :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
== :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
$c== :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
Eq, Int -> ChannelNotifyProps -> ShowS
[ChannelNotifyProps] -> ShowS
ChannelNotifyProps -> String
(Int -> ChannelNotifyProps -> ShowS)
-> (ChannelNotifyProps -> String)
-> ([ChannelNotifyProps] -> ShowS)
-> Show ChannelNotifyProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelNotifyProps] -> ShowS
$cshowList :: [ChannelNotifyProps] -> ShowS
show :: ChannelNotifyProps -> String
$cshow :: ChannelNotifyProps -> String
showsPrec :: Int -> ChannelNotifyProps -> ShowS
$cshowsPrec :: Int -> ChannelNotifyProps -> ShowS
Show, ReadPrec [ChannelNotifyProps]
ReadPrec ChannelNotifyProps
Int -> ReadS ChannelNotifyProps
ReadS [ChannelNotifyProps]
(Int -> ReadS ChannelNotifyProps)
-> ReadS [ChannelNotifyProps]
-> ReadPrec ChannelNotifyProps
-> ReadPrec [ChannelNotifyProps]
-> Read ChannelNotifyProps
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelNotifyProps]
$creadListPrec :: ReadPrec [ChannelNotifyProps]
readPrec :: ReadPrec ChannelNotifyProps
$creadPrec :: ReadPrec ChannelNotifyProps
readList :: ReadS [ChannelNotifyProps]
$creadList :: ReadS [ChannelNotifyProps]
readsPrec :: Int -> ReadS ChannelNotifyProps
$creadsPrec :: Int -> ReadS ChannelNotifyProps
Read, Eq ChannelNotifyProps
Eq ChannelNotifyProps
-> (ChannelNotifyProps -> ChannelNotifyProps -> Ordering)
-> (ChannelNotifyProps -> ChannelNotifyProps -> Bool)
-> (ChannelNotifyProps -> ChannelNotifyProps -> Bool)
-> (ChannelNotifyProps -> ChannelNotifyProps -> Bool)
-> (ChannelNotifyProps -> ChannelNotifyProps -> Bool)
-> (ChannelNotifyProps -> ChannelNotifyProps -> ChannelNotifyProps)
-> (ChannelNotifyProps -> ChannelNotifyProps -> ChannelNotifyProps)
-> Ord ChannelNotifyProps
ChannelNotifyProps -> ChannelNotifyProps -> Bool
ChannelNotifyProps -> ChannelNotifyProps -> Ordering
ChannelNotifyProps -> ChannelNotifyProps -> ChannelNotifyProps
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 :: ChannelNotifyProps -> ChannelNotifyProps -> ChannelNotifyProps
$cmin :: ChannelNotifyProps -> ChannelNotifyProps -> ChannelNotifyProps
max :: ChannelNotifyProps -> ChannelNotifyProps -> ChannelNotifyProps
$cmax :: ChannelNotifyProps -> ChannelNotifyProps -> ChannelNotifyProps
>= :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
$c>= :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
> :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
$c> :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
<= :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
$c<= :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
< :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
$c< :: ChannelNotifyProps -> ChannelNotifyProps -> Bool
compare :: ChannelNotifyProps -> ChannelNotifyProps -> Ordering
$ccompare :: ChannelNotifyProps -> ChannelNotifyProps -> Ordering
$cp1Ord :: Eq ChannelNotifyProps
Ord)

emptyUserNotifyProps :: UserNotifyProps
emptyUserNotifyProps :: UserNotifyProps
emptyUserNotifyProps = UserNotifyProps :: [UserText]
-> Bool
-> NotifyOption
-> NotifyOption
-> Bool
-> Bool
-> Bool
-> UserNotifyProps
UserNotifyProps
  { userNotifyPropsMentionKeys :: [UserText]
userNotifyPropsMentionKeys  = []
  , userNotifyPropsEmail :: Bool
userNotifyPropsEmail        = Bool
False
  , userNotifyPropsPush :: NotifyOption
userNotifyPropsPush         = NotifyOption
NotifyOptionNone
  , userNotifyPropsDesktop :: NotifyOption
userNotifyPropsDesktop      = NotifyOption
NotifyOptionNone
  , userNotifyPropsDesktopSound :: Bool
userNotifyPropsDesktopSound = Bool
False
  , userNotifyPropsChannel :: Bool
userNotifyPropsChannel      = Bool
False
  , userNotifyPropsFirstName :: Bool
userNotifyPropsFirstName    = Bool
False
  }

emptyChannelNotifyProps :: ChannelNotifyProps
emptyChannelNotifyProps :: ChannelNotifyProps
emptyChannelNotifyProps = ChannelNotifyProps :: WithDefault Bool
-> WithDefault NotifyOption
-> WithDefault NotifyOption
-> WithDefault NotifyOption
-> WithDefault Bool
-> ChannelNotifyProps
ChannelNotifyProps
  { channelNotifyPropsEmail :: WithDefault Bool
channelNotifyPropsEmail                 = WithDefault Bool
forall a. WithDefault a
Default
  , channelNotifyPropsPush :: WithDefault NotifyOption
channelNotifyPropsPush                  = WithDefault NotifyOption
forall a. WithDefault a
Default
  , channelNotifyPropsDesktop :: WithDefault NotifyOption
channelNotifyPropsDesktop               = WithDefault NotifyOption
forall a. WithDefault a
Default
  , channelNotifyPropsMarkUnread :: WithDefault NotifyOption
channelNotifyPropsMarkUnread            = WithDefault NotifyOption
forall a. WithDefault a
Default
  , channelNotifyPropsIgnoreChannelMentions :: WithDefault Bool
channelNotifyPropsIgnoreChannelMentions = WithDefault Bool
forall a. WithDefault a
Default
  }

newtype BoolString = BoolString { BoolString -> Bool
fromBoolString :: Bool }

instance A.FromJSON BoolString where
  parseJSON :: Value -> Parser BoolString
parseJSON = String -> (Text -> Parser BoolString) -> Value -> Parser BoolString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"bool as string" ((Text -> Parser BoolString) -> Value -> Parser BoolString)
-> (Text -> Parser BoolString) -> Value -> Parser BoolString
forall a b. (a -> b) -> a -> b
$ \Text
v ->
    case Text
v of
      Text
"true"  -> BoolString -> Parser BoolString
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> BoolString
BoolString Bool
True)
      Text
"false" -> BoolString -> Parser BoolString
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> BoolString
BoolString Bool
False)
      Text
_       -> String -> Parser BoolString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected \"true\" or \"false\""

instance A.ToJSON BoolString where
  toJSON :: BoolString -> Value
toJSON (BoolString Bool
True) = Text -> Value
A.String Text
"true"
  toJSON (BoolString Bool
False) = Text -> Value
A.String Text
"false"

newtype OnOffString = OnOffString{ OnOffString -> Bool
fromOnOffString :: Bool }

instance A.FromJSON OnOffString where
  parseJSON :: Value -> Parser OnOffString
parseJSON = String
-> (Text -> Parser OnOffString) -> Value -> Parser OnOffString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"on/off setting" ((Text -> Parser OnOffString) -> Value -> Parser OnOffString)
-> (Text -> Parser OnOffString) -> Value -> Parser OnOffString
forall a b. (a -> b) -> a -> b
$ \Text
v ->
    case Text
v of
      Text
"on"  -> OnOffString -> Parser OnOffString
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> OnOffString
OnOffString Bool
True)
      Text
"off" -> OnOffString -> Parser OnOffString
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> OnOffString
OnOffString Bool
False)
      Text
_       -> String -> Parser OnOffString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected \"on\" or \"off\""

instance A.ToJSON OnOffString where
  toJSON :: OnOffString -> Value
toJSON (OnOffString Bool
True) = Text -> Value
A.String Text
"on"
  toJSON (OnOffString Bool
False) = Text -> Value
A.String Text
"off"

instance A.FromJSON UserNotifyProps where
  parseJSON :: Value -> Parser UserNotifyProps
parseJSON = String
-> (Object -> Parser UserNotifyProps)
-> Value
-> Parser UserNotifyProps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"UserNotifyProps" ((Object -> Parser UserNotifyProps)
 -> Value -> Parser UserNotifyProps)
-> (Object -> Parser UserNotifyProps)
-> Value
-> Parser UserNotifyProps
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    [UserText]
userNotifyPropsMentionKeys  <- ((Text -> UserText) -> [Text] -> [UserText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> UserText
UserText) ([Text] -> [UserText]) -> (Text -> [Text]) -> Text -> [UserText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') (Text -> [UserText]) -> Parser Text -> Parser [UserText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                     (Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"mention_keys" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
"")
    NotifyOption
userNotifyPropsPush         <- Object
v Object -> Text -> Parser (Maybe NotifyOption)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"push" Parser (Maybe NotifyOption) -> NotifyOption -> Parser NotifyOption
forall a. Parser (Maybe a) -> a -> Parser a
.!= NotifyOption
NotifyOptionMention
    NotifyOption
userNotifyPropsDesktop      <- Object
v Object -> Text -> Parser (Maybe NotifyOption)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"desktop" Parser (Maybe NotifyOption) -> NotifyOption -> Parser NotifyOption
forall a. Parser (Maybe a) -> a -> Parser a
.!= NotifyOption
NotifyOptionAll
    Bool
userNotifyPropsEmail        <- BoolString -> Bool
fromBoolString (BoolString -> Bool) -> Parser BoolString -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe BoolString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"email"         Parser (Maybe BoolString) -> BoolString -> Parser BoolString
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool -> BoolString
BoolString Bool
True)
    Bool
userNotifyPropsDesktopSound <- BoolString -> Bool
fromBoolString (BoolString -> Bool) -> Parser BoolString -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe BoolString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"desktop_sound" Parser (Maybe BoolString) -> BoolString -> Parser BoolString
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool -> BoolString
BoolString Bool
True)
    Bool
userNotifyPropsChannel      <- BoolString -> Bool
fromBoolString (BoolString -> Bool) -> Parser BoolString -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe BoolString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channel"       Parser (Maybe BoolString) -> BoolString -> Parser BoolString
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool -> BoolString
BoolString Bool
True)
    Bool
userNotifyPropsFirstName    <- BoolString -> Bool
fromBoolString (BoolString -> Bool) -> Parser BoolString -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe BoolString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"first_name"    Parser (Maybe BoolString) -> BoolString -> Parser BoolString
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool -> BoolString
BoolString Bool
False)
    UserNotifyProps -> Parser UserNotifyProps
forall (m :: * -> *) a. Monad m => a -> m a
return UserNotifyProps :: [UserText]
-> Bool
-> NotifyOption
-> NotifyOption
-> Bool
-> Bool
-> Bool
-> UserNotifyProps
UserNotifyProps { Bool
[UserText]
NotifyOption
userNotifyPropsFirstName :: Bool
userNotifyPropsChannel :: Bool
userNotifyPropsDesktopSound :: Bool
userNotifyPropsEmail :: Bool
userNotifyPropsDesktop :: NotifyOption
userNotifyPropsPush :: NotifyOption
userNotifyPropsMentionKeys :: [UserText]
userNotifyPropsFirstName :: Bool
userNotifyPropsChannel :: Bool
userNotifyPropsDesktopSound :: Bool
userNotifyPropsDesktop :: NotifyOption
userNotifyPropsPush :: NotifyOption
userNotifyPropsEmail :: Bool
userNotifyPropsMentionKeys :: [UserText]
.. }

instance A.ToJSON UserNotifyProps where
  toJSON :: UserNotifyProps -> Value
toJSON UserNotifyProps { Bool
[UserText]
NotifyOption
userNotifyPropsFirstName :: Bool
userNotifyPropsChannel :: Bool
userNotifyPropsDesktopSound :: Bool
userNotifyPropsDesktop :: NotifyOption
userNotifyPropsPush :: NotifyOption
userNotifyPropsEmail :: Bool
userNotifyPropsMentionKeys :: [UserText]
userNotifyPropsFirstName :: UserNotifyProps -> Bool
userNotifyPropsChannel :: UserNotifyProps -> Bool
userNotifyPropsDesktopSound :: UserNotifyProps -> Bool
userNotifyPropsDesktop :: UserNotifyProps -> NotifyOption
userNotifyPropsPush :: UserNotifyProps -> NotifyOption
userNotifyPropsEmail :: UserNotifyProps -> Bool
userNotifyPropsMentionKeys :: UserNotifyProps -> [UserText]
.. } = [Pair] -> Value
A.object
    [ Text
"mention_keys"  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> [Text] -> Text
T.intercalate Text
"," (UserText -> Text
unsafeUserText (UserText -> Text) -> [UserText] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserText]
userNotifyPropsMentionKeys)
    , Text
"push"          Text -> NotifyOption -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NotifyOption
userNotifyPropsPush
    , Text
"desktop"       Text -> NotifyOption -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NotifyOption
userNotifyPropsDesktop
    , Text
"email"         Text -> BoolString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool -> BoolString
BoolString Bool
userNotifyPropsEmail
    , Text
"desktop_sound" Text -> BoolString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool -> BoolString
BoolString Bool
userNotifyPropsDesktopSound
    , Text
"channel"       Text -> BoolString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool -> BoolString
BoolString Bool
userNotifyPropsChannel
    , Text
"first_name"    Text -> BoolString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool -> BoolString
BoolString Bool
userNotifyPropsFirstName
    ]

instance A.FromJSON ChannelNotifyProps where
  parseJSON :: Value -> Parser ChannelNotifyProps
parseJSON = String
-> (Object -> Parser ChannelNotifyProps)
-> Value
-> Parser ChannelNotifyProps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ChannelNotifyProps" ((Object -> Parser ChannelNotifyProps)
 -> Value -> Parser ChannelNotifyProps)
-> (Object -> Parser ChannelNotifyProps)
-> Value
-> Parser ChannelNotifyProps
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    WithDefault Bool
channelNotifyPropsEmail      <- (BoolString -> Bool) -> WithDefault BoolString -> WithDefault Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BoolString -> Bool
fromBoolString (WithDefault BoolString -> WithDefault Bool)
-> Parser (WithDefault BoolString) -> Parser (WithDefault Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                    (Object
v Object -> Text -> Parser (Maybe (WithDefault BoolString))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"email" Parser (Maybe (WithDefault BoolString))
-> WithDefault BoolString -> Parser (WithDefault BoolString)
forall a. Parser (Maybe a) -> a -> Parser a
.!= BoolString -> WithDefault BoolString
forall a. a -> WithDefault a
IsValue (Bool -> BoolString
BoolString Bool
True))
    WithDefault NotifyOption
channelNotifyPropsPush       <- Object
v Object -> Text -> Parser (Maybe (WithDefault NotifyOption))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"push" Parser (Maybe (WithDefault NotifyOption))
-> WithDefault NotifyOption -> Parser (WithDefault NotifyOption)
forall a. Parser (Maybe a) -> a -> Parser a
.!= NotifyOption -> WithDefault NotifyOption
forall a. a -> WithDefault a
IsValue NotifyOption
NotifyOptionMention
    WithDefault NotifyOption
channelNotifyPropsDesktop    <- Object
v Object -> Text -> Parser (Maybe (WithDefault NotifyOption))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"desktop" Parser (Maybe (WithDefault NotifyOption))
-> WithDefault NotifyOption -> Parser (WithDefault NotifyOption)
forall a. Parser (Maybe a) -> a -> Parser a
.!= NotifyOption -> WithDefault NotifyOption
forall a. a -> WithDefault a
IsValue NotifyOption
NotifyOptionAll
    WithDefault NotifyOption
channelNotifyPropsMarkUnread <- Object
v Object -> Text -> Parser (Maybe (WithDefault NotifyOption))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"mark_unread" Parser (Maybe (WithDefault NotifyOption))
-> WithDefault NotifyOption -> Parser (WithDefault NotifyOption)
forall a. Parser (Maybe a) -> a -> Parser a
.!= NotifyOption -> WithDefault NotifyOption
forall a. a -> WithDefault a
IsValue NotifyOption
NotifyOptionAll
    WithDefault Bool
channelNotifyPropsIgnoreChannelMentions <- (OnOffString -> Bool)
-> WithDefault OnOffString -> WithDefault Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OnOffString -> Bool
fromOnOffString (WithDefault OnOffString -> WithDefault Bool)
-> Parser (WithDefault OnOffString) -> Parser (WithDefault Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                               (Object
v Object -> Text -> Parser (Maybe (WithDefault OnOffString))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ignore_channel_mentions" Parser (Maybe (WithDefault OnOffString))
-> WithDefault OnOffString -> Parser (WithDefault OnOffString)
forall a. Parser (Maybe a) -> a -> Parser a
.!= WithDefault OnOffString
forall a. WithDefault a
Default)
    ChannelNotifyProps -> Parser ChannelNotifyProps
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelNotifyProps :: WithDefault Bool
-> WithDefault NotifyOption
-> WithDefault NotifyOption
-> WithDefault NotifyOption
-> WithDefault Bool
-> ChannelNotifyProps
ChannelNotifyProps { WithDefault Bool
WithDefault NotifyOption
channelNotifyPropsIgnoreChannelMentions :: WithDefault Bool
channelNotifyPropsMarkUnread :: WithDefault NotifyOption
channelNotifyPropsDesktop :: WithDefault NotifyOption
channelNotifyPropsPush :: WithDefault NotifyOption
channelNotifyPropsEmail :: WithDefault Bool
channelNotifyPropsIgnoreChannelMentions :: WithDefault Bool
channelNotifyPropsMarkUnread :: WithDefault NotifyOption
channelNotifyPropsPush :: WithDefault NotifyOption
channelNotifyPropsDesktop :: WithDefault NotifyOption
channelNotifyPropsEmail :: WithDefault Bool
.. }

instance A.ToJSON ChannelNotifyProps where
  toJSON :: ChannelNotifyProps -> Value
toJSON ChannelNotifyProps { WithDefault Bool
WithDefault NotifyOption
channelNotifyPropsIgnoreChannelMentions :: WithDefault Bool
channelNotifyPropsMarkUnread :: WithDefault NotifyOption
channelNotifyPropsPush :: WithDefault NotifyOption
channelNotifyPropsDesktop :: WithDefault NotifyOption
channelNotifyPropsEmail :: WithDefault Bool
channelNotifyPropsIgnoreChannelMentions :: ChannelNotifyProps -> WithDefault Bool
channelNotifyPropsMarkUnread :: ChannelNotifyProps -> WithDefault NotifyOption
channelNotifyPropsPush :: ChannelNotifyProps -> WithDefault NotifyOption
channelNotifyPropsDesktop :: ChannelNotifyProps -> WithDefault NotifyOption
channelNotifyPropsEmail :: ChannelNotifyProps -> WithDefault Bool
.. } = [Pair] -> Value
A.object
    [ Text
"email"                   Text -> WithDefault BoolString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Bool -> BoolString) -> WithDefault Bool -> WithDefault BoolString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> BoolString
BoolString WithDefault Bool
channelNotifyPropsEmail
    , Text
"push"                    Text -> WithDefault NotifyOption -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WithDefault NotifyOption
channelNotifyPropsPush
    , Text
"desktop"                 Text -> WithDefault NotifyOption -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WithDefault NotifyOption
channelNotifyPropsDesktop
    , Text
"mark_unread"             Text -> WithDefault NotifyOption -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WithDefault NotifyOption
channelNotifyPropsMarkUnread
    , Text
"ignore_channel_mentions" Text -> WithDefault OnOffString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Bool -> OnOffString)
-> WithDefault Bool -> WithDefault OnOffString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> OnOffString
OnOffString WithDefault Bool
channelNotifyPropsIgnoreChannelMentions
    ]

--

newtype ChannelId = CI { ChannelId -> Id
unCI :: Id }
  deriving (ReadPrec [ChannelId]
ReadPrec ChannelId
Int -> ReadS ChannelId
ReadS [ChannelId]
(Int -> ReadS ChannelId)
-> ReadS [ChannelId]
-> ReadPrec ChannelId
-> ReadPrec [ChannelId]
-> Read ChannelId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelId]
$creadListPrec :: ReadPrec [ChannelId]
readPrec :: ReadPrec ChannelId
$creadPrec :: ReadPrec ChannelId
readList :: ReadS [ChannelId]
$creadList :: ReadS [ChannelId]
readsPrec :: Int -> ReadS ChannelId
$creadsPrec :: Int -> ReadS ChannelId
Read, Int -> ChannelId -> ShowS
[ChannelId] -> ShowS
ChannelId -> String
(Int -> ChannelId -> ShowS)
-> (ChannelId -> String)
-> ([ChannelId] -> ShowS)
-> Show ChannelId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelId] -> ShowS
$cshowList :: [ChannelId] -> ShowS
show :: ChannelId -> String
$cshow :: ChannelId -> String
showsPrec :: Int -> ChannelId -> ShowS
$cshowsPrec :: Int -> ChannelId -> ShowS
Show, ChannelId -> ChannelId -> Bool
(ChannelId -> ChannelId -> Bool)
-> (ChannelId -> ChannelId -> Bool) -> Eq ChannelId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelId -> ChannelId -> Bool
$c/= :: ChannelId -> ChannelId -> Bool
== :: ChannelId -> ChannelId -> Bool
$c== :: ChannelId -> ChannelId -> Bool
Eq, Eq ChannelId
Eq ChannelId
-> (ChannelId -> ChannelId -> Ordering)
-> (ChannelId -> ChannelId -> Bool)
-> (ChannelId -> ChannelId -> Bool)
-> (ChannelId -> ChannelId -> Bool)
-> (ChannelId -> ChannelId -> Bool)
-> (ChannelId -> ChannelId -> ChannelId)
-> (ChannelId -> ChannelId -> ChannelId)
-> Ord ChannelId
ChannelId -> ChannelId -> Bool
ChannelId -> ChannelId -> Ordering
ChannelId -> ChannelId -> ChannelId
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 :: ChannelId -> ChannelId -> ChannelId
$cmin :: ChannelId -> ChannelId -> ChannelId
max :: ChannelId -> ChannelId -> ChannelId
$cmax :: ChannelId -> ChannelId -> ChannelId
>= :: ChannelId -> ChannelId -> Bool
$c>= :: ChannelId -> ChannelId -> Bool
> :: ChannelId -> ChannelId -> Bool
$c> :: ChannelId -> ChannelId -> Bool
<= :: ChannelId -> ChannelId -> Bool
$c<= :: ChannelId -> ChannelId -> Bool
< :: ChannelId -> ChannelId -> Bool
$c< :: ChannelId -> ChannelId -> Bool
compare :: ChannelId -> ChannelId -> Ordering
$ccompare :: ChannelId -> ChannelId -> Ordering
$cp1Ord :: Eq ChannelId
Ord, Int -> ChannelId -> Int
ChannelId -> Int
(Int -> ChannelId -> Int)
-> (ChannelId -> Int) -> Hashable ChannelId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ChannelId -> Int
$chash :: ChannelId -> Int
hashWithSalt :: Int -> ChannelId -> Int
$chashWithSalt :: Int -> ChannelId -> Int
Hashable, [ChannelId] -> Encoding
[ChannelId] -> Value
ChannelId -> Encoding
ChannelId -> Value
(ChannelId -> Value)
-> (ChannelId -> Encoding)
-> ([ChannelId] -> Value)
-> ([ChannelId] -> Encoding)
-> ToJSON ChannelId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChannelId] -> Encoding
$ctoEncodingList :: [ChannelId] -> Encoding
toJSONList :: [ChannelId] -> Value
$ctoJSONList :: [ChannelId] -> Value
toEncoding :: ChannelId -> Encoding
$ctoEncoding :: ChannelId -> Encoding
toJSON :: ChannelId -> Value
$ctoJSON :: ChannelId -> Value
ToJSON, ToJSONKeyFunction [ChannelId]
ToJSONKeyFunction ChannelId
ToJSONKeyFunction ChannelId
-> ToJSONKeyFunction [ChannelId] -> ToJSONKey ChannelId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ChannelId]
$ctoJSONKeyList :: ToJSONKeyFunction [ChannelId]
toJSONKey :: ToJSONKeyFunction ChannelId
$ctoJSONKey :: ToJSONKeyFunction ChannelId
ToJSONKey, FromJSONKeyFunction [ChannelId]
FromJSONKeyFunction ChannelId
FromJSONKeyFunction ChannelId
-> FromJSONKeyFunction [ChannelId] -> FromJSONKey ChannelId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ChannelId]
$cfromJSONKeyList :: FromJSONKeyFunction [ChannelId]
fromJSONKey :: FromJSONKeyFunction ChannelId
$cfromJSONKey :: FromJSONKeyFunction ChannelId
FromJSONKey, Value -> Parser [ChannelId]
Value -> Parser ChannelId
(Value -> Parser ChannelId)
-> (Value -> Parser [ChannelId]) -> FromJSON ChannelId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChannelId]
$cparseJSONList :: Value -> Parser [ChannelId]
parseJSON :: Value -> Parser ChannelId
$cparseJSON :: Value -> Parser ChannelId
FromJSON)

instance IsId ChannelId where
  toId :: ChannelId -> Id
toId   = ChannelId -> Id
unCI
  fromId :: Id -> ChannelId
fromId = Id -> ChannelId
CI

instance PrintfArg ChannelId where
  formatArg :: ChannelId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (ChannelId -> Text) -> ChannelId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelId -> Text
forall x. IsId x => x -> Text
idString

data Channel
  = Channel
  { Channel -> ChannelId
channelId            :: ChannelId
  , Channel -> ServerTime
channelCreateAt      :: ServerTime
  , Channel -> ServerTime
channelUpdateAt      :: ServerTime
  , Channel -> ServerTime
channelDeleteAt      :: ServerTime
  , Channel -> Maybe TeamId
channelTeamId        :: Maybe TeamId
  , Channel -> Type
channelType          :: Type
  , Channel -> UserText
channelDisplayName   :: UserText
  , Channel -> UserText
channelName          :: UserText
  , Channel -> UserText
channelHeader        :: UserText
  , Channel -> UserText
channelPurpose       :: UserText
  , Channel -> ServerTime
channelLastPostAt    :: ServerTime
  , Channel -> Int
channelTotalMsgCount :: Int
  , Channel -> Maybe UserId
channelCreatorId     :: Maybe UserId
  } deriving (ReadPrec [Channel]
ReadPrec Channel
Int -> ReadS Channel
ReadS [Channel]
(Int -> ReadS Channel)
-> ReadS [Channel]
-> ReadPrec Channel
-> ReadPrec [Channel]
-> Read Channel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Channel]
$creadListPrec :: ReadPrec [Channel]
readPrec :: ReadPrec Channel
$creadPrec :: ReadPrec Channel
readList :: ReadS [Channel]
$creadList :: ReadS [Channel]
readsPrec :: Int -> ReadS Channel
$creadsPrec :: Int -> ReadS Channel
Read, Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> String
(Int -> Channel -> ShowS)
-> (Channel -> String) -> ([Channel] -> ShowS) -> Show Channel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> String
$cshow :: Channel -> String
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Show, Channel -> Channel -> Bool
(Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool) -> Eq Channel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Eq, Eq Channel
Eq Channel
-> (Channel -> Channel -> Ordering)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Channel)
-> (Channel -> Channel -> Channel)
-> Ord Channel
Channel -> Channel -> Bool
Channel -> Channel -> Ordering
Channel -> Channel -> Channel
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 :: Channel -> Channel -> Channel
$cmin :: Channel -> Channel -> Channel
max :: Channel -> Channel -> Channel
$cmax :: Channel -> Channel -> Channel
>= :: Channel -> Channel -> Bool
$c>= :: Channel -> Channel -> Bool
> :: Channel -> Channel -> Bool
$c> :: Channel -> Channel -> Bool
<= :: Channel -> Channel -> Bool
$c<= :: Channel -> Channel -> Bool
< :: Channel -> Channel -> Bool
$c< :: Channel -> Channel -> Bool
compare :: Channel -> Channel -> Ordering
$ccompare :: Channel -> Channel -> Ordering
$cp1Ord :: Eq Channel
Ord)

instance HasId Channel ChannelId where
  getId :: Channel -> ChannelId
getId = Channel -> ChannelId
channelId

instance A.FromJSON Channel where
  parseJSON :: Value -> Parser Channel
parseJSON = String -> (Object -> Parser Channel) -> Value -> Parser Channel
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Channel" ((Object -> Parser Channel) -> Value -> Parser Channel)
-> (Object -> Parser Channel) -> Value -> Parser Channel
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    ChannelId
channelId              <- Object
v Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    ServerTime
channelCreateAt        <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"create_at"
    ServerTime
channelUpdateAt        <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"update_at"
    ServerTime
channelDeleteAt        <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"delete_at"
    Maybe TeamId
channelTeamId          <- Parser TeamId -> Parser (Maybe TeamId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
v Object -> Text -> Parser TeamId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"team_id")
    Type
channelType            <- Object
v Object -> Text -> Parser Type
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
    UserText
channelDisplayName     <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"display_name"
    UserText
channelName            <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    UserText
channelHeader          <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"header"
    UserText
channelPurpose         <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"purpose"
    ServerTime
channelLastPostAt      <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"last_post_at"
    Int
channelTotalMsgCount   <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"total_msg_count"
    Maybe UserId
channelCreatorId       <- Parser UserId -> Parser (Maybe UserId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"creator_id")
    Channel -> Parser Channel
forall (m :: * -> *) a. Monad m => a -> m a
return Channel :: ChannelId
-> ServerTime
-> ServerTime
-> ServerTime
-> Maybe TeamId
-> Type
-> UserText
-> UserText
-> UserText
-> UserText
-> ServerTime
-> Int
-> Maybe UserId
-> Channel
Channel { Int
Maybe UserId
Maybe TeamId
ServerTime
ChannelId
Type
UserText
channelCreatorId :: Maybe UserId
channelTotalMsgCount :: Int
channelLastPostAt :: ServerTime
channelPurpose :: UserText
channelHeader :: UserText
channelName :: UserText
channelDisplayName :: UserText
channelType :: Type
channelTeamId :: Maybe TeamId
channelDeleteAt :: ServerTime
channelUpdateAt :: ServerTime
channelCreateAt :: ServerTime
channelId :: ChannelId
channelCreatorId :: Maybe UserId
channelTotalMsgCount :: Int
channelLastPostAt :: ServerTime
channelPurpose :: UserText
channelHeader :: UserText
channelName :: UserText
channelDisplayName :: UserText
channelType :: Type
channelTeamId :: Maybe TeamId
channelDeleteAt :: ServerTime
channelUpdateAt :: ServerTime
channelCreateAt :: ServerTime
channelId :: ChannelId
.. }

-- This type only exists so that we can strip off the
-- outer most layer in mmGetChannel. See the
-- FromJSON instance.
newtype SingleChannel = SC Channel
  deriving (ReadPrec [SingleChannel]
ReadPrec SingleChannel
Int -> ReadS SingleChannel
ReadS [SingleChannel]
(Int -> ReadS SingleChannel)
-> ReadS [SingleChannel]
-> ReadPrec SingleChannel
-> ReadPrec [SingleChannel]
-> Read SingleChannel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SingleChannel]
$creadListPrec :: ReadPrec [SingleChannel]
readPrec :: ReadPrec SingleChannel
$creadPrec :: ReadPrec SingleChannel
readList :: ReadS [SingleChannel]
$creadList :: ReadS [SingleChannel]
readsPrec :: Int -> ReadS SingleChannel
$creadsPrec :: Int -> ReadS SingleChannel
Read, Int -> SingleChannel -> ShowS
[SingleChannel] -> ShowS
SingleChannel -> String
(Int -> SingleChannel -> ShowS)
-> (SingleChannel -> String)
-> ([SingleChannel] -> ShowS)
-> Show SingleChannel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingleChannel] -> ShowS
$cshowList :: [SingleChannel] -> ShowS
show :: SingleChannel -> String
$cshow :: SingleChannel -> String
showsPrec :: Int -> SingleChannel -> ShowS
$cshowsPrec :: Int -> SingleChannel -> ShowS
Show, SingleChannel -> SingleChannel -> Bool
(SingleChannel -> SingleChannel -> Bool)
-> (SingleChannel -> SingleChannel -> Bool) -> Eq SingleChannel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingleChannel -> SingleChannel -> Bool
$c/= :: SingleChannel -> SingleChannel -> Bool
== :: SingleChannel -> SingleChannel -> Bool
$c== :: SingleChannel -> SingleChannel -> Bool
Eq, Eq SingleChannel
Eq SingleChannel
-> (SingleChannel -> SingleChannel -> Ordering)
-> (SingleChannel -> SingleChannel -> Bool)
-> (SingleChannel -> SingleChannel -> Bool)
-> (SingleChannel -> SingleChannel -> Bool)
-> (SingleChannel -> SingleChannel -> Bool)
-> (SingleChannel -> SingleChannel -> SingleChannel)
-> (SingleChannel -> SingleChannel -> SingleChannel)
-> Ord SingleChannel
SingleChannel -> SingleChannel -> Bool
SingleChannel -> SingleChannel -> Ordering
SingleChannel -> SingleChannel -> SingleChannel
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 :: SingleChannel -> SingleChannel -> SingleChannel
$cmin :: SingleChannel -> SingleChannel -> SingleChannel
max :: SingleChannel -> SingleChannel -> SingleChannel
$cmax :: SingleChannel -> SingleChannel -> SingleChannel
>= :: SingleChannel -> SingleChannel -> Bool
$c>= :: SingleChannel -> SingleChannel -> Bool
> :: SingleChannel -> SingleChannel -> Bool
$c> :: SingleChannel -> SingleChannel -> Bool
<= :: SingleChannel -> SingleChannel -> Bool
$c<= :: SingleChannel -> SingleChannel -> Bool
< :: SingleChannel -> SingleChannel -> Bool
$c< :: SingleChannel -> SingleChannel -> Bool
compare :: SingleChannel -> SingleChannel -> Ordering
$ccompare :: SingleChannel -> SingleChannel -> Ordering
$cp1Ord :: Eq SingleChannel
Ord)

instance A.FromJSON SingleChannel where
  parseJSON :: Value -> Parser SingleChannel
parseJSON = String
-> (Object -> Parser SingleChannel)
-> Value
-> Parser SingleChannel
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SingleChannel" ((Object -> Parser SingleChannel) -> Value -> Parser SingleChannel)
-> (Object -> Parser SingleChannel)
-> Value
-> Parser SingleChannel
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Channel
channel <- Object
v Object -> Text -> Parser Channel
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel"
    SingleChannel -> Parser SingleChannel
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel -> SingleChannel
SC Channel
channel)

instance HasId ChannelData ChannelId where
  getId :: ChannelData -> ChannelId
getId = ChannelData -> ChannelId
channelDataChannelId

data ChannelData
  = ChannelData
  { ChannelData -> ChannelId
channelDataChannelId    :: ChannelId
  , ChannelData -> UserId
channelDataUserId       :: UserId
  , ChannelData -> Text
channelDataRoles        :: Text
  , ChannelData -> ServerTime
channelDataLastViewedAt :: ServerTime
  , ChannelData -> Int
channelDataMsgCount     :: Int
  , ChannelData -> Int
channelDataMentionCount :: Int
  , ChannelData -> ChannelNotifyProps
channelDataNotifyProps  :: ChannelNotifyProps
  , ChannelData -> ServerTime
channelDataLastUpdateAt :: ServerTime
  } deriving (ReadPrec [ChannelData]
ReadPrec ChannelData
Int -> ReadS ChannelData
ReadS [ChannelData]
(Int -> ReadS ChannelData)
-> ReadS [ChannelData]
-> ReadPrec ChannelData
-> ReadPrec [ChannelData]
-> Read ChannelData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelData]
$creadListPrec :: ReadPrec [ChannelData]
readPrec :: ReadPrec ChannelData
$creadPrec :: ReadPrec ChannelData
readList :: ReadS [ChannelData]
$creadList :: ReadS [ChannelData]
readsPrec :: Int -> ReadS ChannelData
$creadsPrec :: Int -> ReadS ChannelData
Read, Int -> ChannelData -> ShowS
[ChannelData] -> ShowS
ChannelData -> String
(Int -> ChannelData -> ShowS)
-> (ChannelData -> String)
-> ([ChannelData] -> ShowS)
-> Show ChannelData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelData] -> ShowS
$cshowList :: [ChannelData] -> ShowS
show :: ChannelData -> String
$cshow :: ChannelData -> String
showsPrec :: Int -> ChannelData -> ShowS
$cshowsPrec :: Int -> ChannelData -> ShowS
Show, ChannelData -> ChannelData -> Bool
(ChannelData -> ChannelData -> Bool)
-> (ChannelData -> ChannelData -> Bool) -> Eq ChannelData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelData -> ChannelData -> Bool
$c/= :: ChannelData -> ChannelData -> Bool
== :: ChannelData -> ChannelData -> Bool
$c== :: ChannelData -> ChannelData -> Bool
Eq)

instance A.FromJSON ChannelData where
  parseJSON :: Value -> Parser ChannelData
parseJSON = String
-> (Object -> Parser ChannelData) -> Value -> Parser ChannelData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ChannelData" ((Object -> Parser ChannelData) -> Value -> Parser ChannelData)
-> (Object -> Parser ChannelData) -> Value -> Parser ChannelData
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ChannelId
channelDataChannelId <- Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id"
    UserId
channelDataUserId    <- Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
    Text
channelDataRoles     <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"roles"
    ServerTime
channelDataLastViewedAt <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"last_viewed_at"
    Int
channelDataMsgCount     <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"msg_count"
    Int
channelDataMentionCount <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mention_count"
    ChannelNotifyProps
channelDataNotifyProps  <- Object
o Object -> Text -> Parser ChannelNotifyProps
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"notify_props"
    ServerTime
channelDataLastUpdateAt <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"last_update_at"
    ChannelData -> Parser ChannelData
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelData :: ChannelId
-> UserId
-> Text
-> ServerTime
-> Int
-> Int
-> ChannelNotifyProps
-> ServerTime
-> ChannelData
ChannelData { Int
Text
ServerTime
UserId
ChannelId
ChannelNotifyProps
channelDataLastUpdateAt :: ServerTime
channelDataNotifyProps :: ChannelNotifyProps
channelDataMentionCount :: Int
channelDataMsgCount :: Int
channelDataLastViewedAt :: ServerTime
channelDataRoles :: Text
channelDataUserId :: UserId
channelDataChannelId :: ChannelId
channelDataLastUpdateAt :: ServerTime
channelDataNotifyProps :: ChannelNotifyProps
channelDataMentionCount :: Int
channelDataMsgCount :: Int
channelDataLastViewedAt :: ServerTime
channelDataRoles :: Text
channelDataUserId :: UserId
channelDataChannelId :: ChannelId
.. }

data ChannelWithData = ChannelWithData Channel ChannelData
  deriving (ReadPrec [ChannelWithData]
ReadPrec ChannelWithData
Int -> ReadS ChannelWithData
ReadS [ChannelWithData]
(Int -> ReadS ChannelWithData)
-> ReadS [ChannelWithData]
-> ReadPrec ChannelWithData
-> ReadPrec [ChannelWithData]
-> Read ChannelWithData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelWithData]
$creadListPrec :: ReadPrec [ChannelWithData]
readPrec :: ReadPrec ChannelWithData
$creadPrec :: ReadPrec ChannelWithData
readList :: ReadS [ChannelWithData]
$creadList :: ReadS [ChannelWithData]
readsPrec :: Int -> ReadS ChannelWithData
$creadsPrec :: Int -> ReadS ChannelWithData
Read, Int -> ChannelWithData -> ShowS
[ChannelWithData] -> ShowS
ChannelWithData -> String
(Int -> ChannelWithData -> ShowS)
-> (ChannelWithData -> String)
-> ([ChannelWithData] -> ShowS)
-> Show ChannelWithData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelWithData] -> ShowS
$cshowList :: [ChannelWithData] -> ShowS
show :: ChannelWithData -> String
$cshow :: ChannelWithData -> String
showsPrec :: Int -> ChannelWithData -> ShowS
$cshowsPrec :: Int -> ChannelWithData -> ShowS
Show, ChannelWithData -> ChannelWithData -> Bool
(ChannelWithData -> ChannelWithData -> Bool)
-> (ChannelWithData -> ChannelWithData -> Bool)
-> Eq ChannelWithData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelWithData -> ChannelWithData -> Bool
$c/= :: ChannelWithData -> ChannelWithData -> Bool
== :: ChannelWithData -> ChannelWithData -> Bool
$c== :: ChannelWithData -> ChannelWithData -> Bool
Eq)

instance A.FromJSON ChannelWithData where
  parseJSON :: Value -> Parser ChannelWithData
parseJSON (A.Object Object
v) =
      Channel -> ChannelData -> ChannelWithData
ChannelWithData (Channel -> ChannelData -> ChannelWithData)
-> Parser Channel -> Parser (ChannelData -> ChannelWithData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Channel
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel")
                      Parser (ChannelData -> ChannelWithData)
-> Parser ChannelData -> Parser ChannelWithData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser ChannelData
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"member")
  parseJSON Value
v = String -> Value -> Parser ChannelWithData
forall a. String -> Value -> Parser a
typeMismatch String
"Invalid channel/data pair " Value
v

type Channels = Seq Channel

data MinChannel = MinChannel
  { MinChannel -> Text
minChannelName        :: Text
  , MinChannel -> Text
minChannelDisplayName :: Text
  , MinChannel -> Maybe Text
minChannelPurpose     :: Maybe Text
  , MinChannel -> Maybe Text
minChannelHeader      :: Maybe Text
  , MinChannel -> Type
minChannelType        :: Type
  , MinChannel -> TeamId
minChannelTeamId      :: TeamId
  } deriving (ReadPrec [MinChannel]
ReadPrec MinChannel
Int -> ReadS MinChannel
ReadS [MinChannel]
(Int -> ReadS MinChannel)
-> ReadS [MinChannel]
-> ReadPrec MinChannel
-> ReadPrec [MinChannel]
-> Read MinChannel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MinChannel]
$creadListPrec :: ReadPrec [MinChannel]
readPrec :: ReadPrec MinChannel
$creadPrec :: ReadPrec MinChannel
readList :: ReadS [MinChannel]
$creadList :: ReadS [MinChannel]
readsPrec :: Int -> ReadS MinChannel
$creadsPrec :: Int -> ReadS MinChannel
Read, MinChannel -> MinChannel -> Bool
(MinChannel -> MinChannel -> Bool)
-> (MinChannel -> MinChannel -> Bool) -> Eq MinChannel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MinChannel -> MinChannel -> Bool
$c/= :: MinChannel -> MinChannel -> Bool
== :: MinChannel -> MinChannel -> Bool
$c== :: MinChannel -> MinChannel -> Bool
Eq, Int -> MinChannel -> ShowS
[MinChannel] -> ShowS
MinChannel -> String
(Int -> MinChannel -> ShowS)
-> (MinChannel -> String)
-> ([MinChannel] -> ShowS)
-> Show MinChannel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinChannel] -> ShowS
$cshowList :: [MinChannel] -> ShowS
show :: MinChannel -> String
$cshow :: MinChannel -> String
showsPrec :: Int -> MinChannel -> ShowS
$cshowsPrec :: Int -> MinChannel -> ShowS
Show)

instance A.ToJSON MinChannel where
  toJSON :: MinChannel -> Value
toJSON MinChannel { Maybe Text
Text
TeamId
Type
minChannelTeamId :: TeamId
minChannelType :: Type
minChannelHeader :: Maybe Text
minChannelPurpose :: Maybe Text
minChannelDisplayName :: Text
minChannelName :: Text
minChannelTeamId :: MinChannel -> TeamId
minChannelType :: MinChannel -> Type
minChannelHeader :: MinChannel -> Maybe Text
minChannelPurpose :: MinChannel -> Maybe Text
minChannelDisplayName :: MinChannel -> Text
minChannelName :: MinChannel -> Text
.. }  = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Text
"name"         Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
minChannelName
    , Text
"display_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
minChannelDisplayName
    , Text
"type"         Text -> Type -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Type
minChannelType
    , Text
"team_id"      Text -> TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TeamId
minChannelTeamId
    ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"purpose" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
p | Just Text
p <- [Maybe Text
minChannelPurpose] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"header"  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
h | Just Text
h <- [Maybe Text
minChannelHeader] ]
--

newtype UserId = UI { UserId -> Id
unUI :: Id }
  deriving (ReadPrec [UserId]
ReadPrec UserId
Int -> ReadS UserId
ReadS [UserId]
(Int -> ReadS UserId)
-> ReadS [UserId]
-> ReadPrec UserId
-> ReadPrec [UserId]
-> Read UserId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserId]
$creadListPrec :: ReadPrec [UserId]
readPrec :: ReadPrec UserId
$creadPrec :: ReadPrec UserId
readList :: ReadS [UserId]
$creadList :: ReadS [UserId]
readsPrec :: Int -> ReadS UserId
$creadsPrec :: Int -> ReadS UserId
Read, 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
Show, 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
Eq, Eq UserId
Eq UserId
-> (UserId -> UserId -> Ordering)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> UserId)
-> (UserId -> UserId -> UserId)
-> Ord UserId
UserId -> UserId -> Bool
UserId -> UserId -> Ordering
UserId -> UserId -> UserId
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 :: UserId -> UserId -> UserId
$cmin :: UserId -> UserId -> UserId
max :: UserId -> UserId -> UserId
$cmax :: UserId -> UserId -> UserId
>= :: UserId -> UserId -> Bool
$c>= :: UserId -> UserId -> Bool
> :: UserId -> UserId -> Bool
$c> :: UserId -> UserId -> Bool
<= :: UserId -> UserId -> Bool
$c<= :: UserId -> UserId -> Bool
< :: UserId -> UserId -> Bool
$c< :: UserId -> UserId -> Bool
compare :: UserId -> UserId -> Ordering
$ccompare :: UserId -> UserId -> Ordering
$cp1Ord :: Eq UserId
Ord, Int -> UserId -> Int
UserId -> Int
(Int -> UserId -> Int) -> (UserId -> Int) -> Hashable UserId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: UserId -> Int
$chash :: UserId -> Int
hashWithSalt :: Int -> UserId -> Int
$chashWithSalt :: Int -> UserId -> Int
Hashable, [UserId] -> Encoding
[UserId] -> Value
UserId -> Encoding
UserId -> Value
(UserId -> Value)
-> (UserId -> Encoding)
-> ([UserId] -> Value)
-> ([UserId] -> Encoding)
-> ToJSON UserId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserId] -> Encoding
$ctoEncodingList :: [UserId] -> Encoding
toJSONList :: [UserId] -> Value
$ctoJSONList :: [UserId] -> Value
toEncoding :: UserId -> Encoding
$ctoEncoding :: UserId -> Encoding
toJSON :: UserId -> Value
$ctoJSON :: UserId -> Value
ToJSON, ToJSONKeyFunction [UserId]
ToJSONKeyFunction UserId
ToJSONKeyFunction UserId
-> ToJSONKeyFunction [UserId] -> ToJSONKey UserId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [UserId]
$ctoJSONKeyList :: ToJSONKeyFunction [UserId]
toJSONKey :: ToJSONKeyFunction UserId
$ctoJSONKey :: ToJSONKeyFunction UserId
ToJSONKey, FromJSONKeyFunction [UserId]
FromJSONKeyFunction UserId
FromJSONKeyFunction UserId
-> FromJSONKeyFunction [UserId] -> FromJSONKey UserId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [UserId]
$cfromJSONKeyList :: FromJSONKeyFunction [UserId]
fromJSONKey :: FromJSONKeyFunction UserId
$cfromJSONKey :: FromJSONKeyFunction UserId
FromJSONKey, Value -> Parser [UserId]
Value -> Parser UserId
(Value -> Parser UserId)
-> (Value -> Parser [UserId]) -> FromJSON UserId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UserId]
$cparseJSONList :: Value -> Parser [UserId]
parseJSON :: Value -> Parser UserId
$cparseJSON :: Value -> Parser UserId
FromJSON)

instance IsId UserId where
  toId :: UserId -> Id
toId   = UserId -> Id
unUI
  fromId :: Id -> UserId
fromId = Id -> UserId
UI

instance PrintfArg UserId where
  formatArg :: UserId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (UserId -> Text) -> UserId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> Text
forall x. IsId x => x -> Text
idString

data UserParam
  = UserById UserId
  | UserMe
  deriving (ReadPrec [UserParam]
ReadPrec UserParam
Int -> ReadS UserParam
ReadS [UserParam]
(Int -> ReadS UserParam)
-> ReadS [UserParam]
-> ReadPrec UserParam
-> ReadPrec [UserParam]
-> Read UserParam
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserParam]
$creadListPrec :: ReadPrec [UserParam]
readPrec :: ReadPrec UserParam
$creadPrec :: ReadPrec UserParam
readList :: ReadS [UserParam]
$creadList :: ReadS [UserParam]
readsPrec :: Int -> ReadS UserParam
$creadsPrec :: Int -> ReadS UserParam
Read, Int -> UserParam -> ShowS
[UserParam] -> ShowS
UserParam -> String
(Int -> UserParam -> ShowS)
-> (UserParam -> String)
-> ([UserParam] -> ShowS)
-> Show UserParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserParam] -> ShowS
$cshowList :: [UserParam] -> ShowS
show :: UserParam -> String
$cshow :: UserParam -> String
showsPrec :: Int -> UserParam -> ShowS
$cshowsPrec :: Int -> UserParam -> ShowS
Show, UserParam -> UserParam -> Bool
(UserParam -> UserParam -> Bool)
-> (UserParam -> UserParam -> Bool) -> Eq UserParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserParam -> UserParam -> Bool
$c/= :: UserParam -> UserParam -> Bool
== :: UserParam -> UserParam -> Bool
$c== :: UserParam -> UserParam -> Bool
Eq, Eq UserParam
Eq UserParam
-> (UserParam -> UserParam -> Ordering)
-> (UserParam -> UserParam -> Bool)
-> (UserParam -> UserParam -> Bool)
-> (UserParam -> UserParam -> Bool)
-> (UserParam -> UserParam -> Bool)
-> (UserParam -> UserParam -> UserParam)
-> (UserParam -> UserParam -> UserParam)
-> Ord UserParam
UserParam -> UserParam -> Bool
UserParam -> UserParam -> Ordering
UserParam -> UserParam -> UserParam
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 :: UserParam -> UserParam -> UserParam
$cmin :: UserParam -> UserParam -> UserParam
max :: UserParam -> UserParam -> UserParam
$cmax :: UserParam -> UserParam -> UserParam
>= :: UserParam -> UserParam -> Bool
$c>= :: UserParam -> UserParam -> Bool
> :: UserParam -> UserParam -> Bool
$c> :: UserParam -> UserParam -> Bool
<= :: UserParam -> UserParam -> Bool
$c<= :: UserParam -> UserParam -> Bool
< :: UserParam -> UserParam -> Bool
$c< :: UserParam -> UserParam -> Bool
compare :: UserParam -> UserParam -> Ordering
$ccompare :: UserParam -> UserParam -> Ordering
$cp1Ord :: Eq UserParam
Ord)

instance PrintfArg UserParam where
  formatArg :: UserParam -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (UserParam -> Text) -> UserParam -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserParam -> Text
userParamString

userParamString :: UserParam -> Text
userParamString :: UserParam -> Text
userParamString (UserById UserId
uid) = UserId -> Text
forall x. IsId x => x -> Text
idString UserId
uid
userParamString UserParam
UserMe         = Text
"me"

--

-- Note: there's lots of other stuff in an initial_load response but
-- this is what we use for now.
data InitialLoad
  = InitialLoad
  { InitialLoad -> User
initialLoadUser :: User
  , InitialLoad -> Seq Team
initialLoadTeams :: Seq Team
  } deriving (InitialLoad -> InitialLoad -> Bool
(InitialLoad -> InitialLoad -> Bool)
-> (InitialLoad -> InitialLoad -> Bool) -> Eq InitialLoad
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitialLoad -> InitialLoad -> Bool
$c/= :: InitialLoad -> InitialLoad -> Bool
== :: InitialLoad -> InitialLoad -> Bool
$c== :: InitialLoad -> InitialLoad -> Bool
Eq, Int -> InitialLoad -> ShowS
[InitialLoad] -> ShowS
InitialLoad -> String
(Int -> InitialLoad -> ShowS)
-> (InitialLoad -> String)
-> ([InitialLoad] -> ShowS)
-> Show InitialLoad
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitialLoad] -> ShowS
$cshowList :: [InitialLoad] -> ShowS
show :: InitialLoad -> String
$cshow :: InitialLoad -> String
showsPrec :: Int -> InitialLoad -> ShowS
$cshowsPrec :: Int -> InitialLoad -> ShowS
Show)

instance A.FromJSON InitialLoad where
  parseJSON :: Value -> Parser InitialLoad
parseJSON = String
-> (Object -> Parser InitialLoad) -> Value -> Parser InitialLoad
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"InitialLoad" ((Object -> Parser InitialLoad) -> Value -> Parser InitialLoad)
-> (Object -> Parser InitialLoad) -> Value -> Parser InitialLoad
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    User
initialLoadUser        <- Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
    Seq Team
initialLoadTeams       <- Object
o Object -> Text -> Parser (Seq Team)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"teams"
    InitialLoad -> Parser InitialLoad
forall (m :: * -> *) a. Monad m => a -> m a
return InitialLoad :: User -> Seq Team -> InitialLoad
InitialLoad { Seq Team
User
initialLoadTeams :: Seq Team
initialLoadUser :: User
initialLoadTeams :: Seq Team
initialLoadUser :: User
.. }

--

instance HasId User UserId where
  getId :: User -> UserId
getId = User -> UserId
userId

data User
  = User
  { User -> UserId
userId                 :: UserId
  , User -> Maybe ServerTime
userCreateAt           :: Maybe ServerTime
  , User -> Maybe ServerTime
userUpdateAt           :: Maybe ServerTime
  , User -> ServerTime
userDeleteAt           :: ServerTime
  , User -> Text
userUsername           :: Text
  , User -> Maybe Text
userAuthData           :: Maybe Text
  , User -> Text
userAuthService        :: Text
  , User -> UserText
userEmail              :: UserText
  , User -> Bool
userEmailVerified      :: Bool
  , User -> UserText
userNickname           :: UserText
  , User -> UserText
userFirstName          :: UserText
  , User -> UserText
userLastName           :: UserText
  , User -> Text
userRoles              :: Text
  , User -> UserNotifyProps
userNotifyProps        :: UserNotifyProps
  , User -> Maybe ServerTime
userLastPasswordUpdate :: Maybe ServerTime
  , User -> Maybe ServerTime
userLastPictureUpdate  :: Maybe ServerTime
  , User -> Text
userLocale             :: Text
  } deriving (ReadPrec [User]
ReadPrec User
Int -> ReadS User
ReadS [User]
(Int -> ReadS User)
-> ReadS [User] -> ReadPrec User -> ReadPrec [User] -> Read User
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [User]
$creadListPrec :: ReadPrec [User]
readPrec :: ReadPrec User
$creadPrec :: ReadPrec User
readList :: ReadS [User]
$creadList :: ReadS [User]
readsPrec :: Int -> ReadS User
$creadsPrec :: Int -> ReadS User
Read, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq)

instance A.FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON = String -> (Object -> Parser User) -> Value -> Parser User
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"User" ((Object -> Parser User) -> Value -> Parser User)
-> (Object -> Parser User) -> Value -> Parser User
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    UserId
userId                 <- Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    Maybe ServerTime
userCreateAt           <- (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Maybe Integer -> Maybe ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Integer -> Maybe ServerTime)
-> Parser (Maybe Integer) -> Parser (Maybe ServerTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"create_at"
    Maybe ServerTime
userUpdateAt           <- (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Maybe Integer -> Maybe ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Integer -> Maybe ServerTime)
-> Parser (Maybe Integer) -> Parser (Maybe ServerTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"update_at"
    ServerTime
userDeleteAt           <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"delete_at"
    Text
userUsername           <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"username"
    Maybe Text
userAuthData           <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?  Text
"auth_data"
    Text
userAuthService        <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"auth_service"
    UserText
userEmail              <- Object
o Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"email"
    Bool
userEmailVerified      <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"email_verified" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    UserText
userNickname           <- Object
o Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"nickname"
    UserText
userFirstName          <- Object
o Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"first_name"
    UserText
userLastName           <- Object
o Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"last_name"
    Text
userRoles              <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roles"
    UserNotifyProps
userNotifyProps        <- Object
o Object -> Text -> Parser (Maybe UserNotifyProps)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"notify_props" Parser (Maybe UserNotifyProps)
-> UserNotifyProps -> Parser UserNotifyProps
forall a. Parser (Maybe a) -> a -> Parser a
.!= UserNotifyProps
emptyUserNotifyProps
    Maybe ServerTime
userLastPasswordUpdate <- (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Maybe Integer -> Maybe ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Integer -> Maybe ServerTime)
-> Parser (Maybe Integer) -> Parser (Maybe ServerTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"last_password_update")
    Maybe ServerTime
userLastPictureUpdate  <- (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Maybe Integer -> Maybe ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Integer -> Maybe ServerTime)
-> Parser (Maybe Integer) -> Parser (Maybe ServerTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"last_picture_update")
    Text
userLocale             <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"locale"
    User -> Parser User
forall (m :: * -> *) a. Monad m => a -> m a
return User :: UserId
-> Maybe ServerTime
-> Maybe ServerTime
-> ServerTime
-> Text
-> Maybe Text
-> Text
-> UserText
-> Bool
-> UserText
-> UserText
-> UserText
-> Text
-> UserNotifyProps
-> Maybe ServerTime
-> Maybe ServerTime
-> Text
-> User
User { Bool
Maybe Text
Maybe ServerTime
Text
ServerTime
UserId
UserNotifyProps
UserText
userLocale :: Text
userLastPictureUpdate :: Maybe ServerTime
userLastPasswordUpdate :: Maybe ServerTime
userNotifyProps :: UserNotifyProps
userRoles :: Text
userLastName :: UserText
userFirstName :: UserText
userNickname :: UserText
userEmailVerified :: Bool
userEmail :: UserText
userAuthService :: Text
userAuthData :: Maybe Text
userUsername :: Text
userDeleteAt :: ServerTime
userUpdateAt :: Maybe ServerTime
userCreateAt :: Maybe ServerTime
userId :: UserId
userLocale :: Text
userLastPictureUpdate :: Maybe ServerTime
userLastPasswordUpdate :: Maybe ServerTime
userNotifyProps :: UserNotifyProps
userRoles :: Text
userLastName :: UserText
userFirstName :: UserText
userNickname :: UserText
userEmailVerified :: Bool
userEmail :: UserText
userAuthService :: Text
userAuthData :: Maybe Text
userUsername :: Text
userDeleteAt :: ServerTime
userUpdateAt :: Maybe ServerTime
userCreateAt :: Maybe ServerTime
userId :: UserId
.. }


-- The PostPropAttachment and PostPropAttachmentField types are
-- actually defined by Slack, and simply used by Mattermost; the
-- description of these fields can be found in this document:
-- https://api.slack.com/docs/message-attachments

data PostPropAttachmentField = PostPropAttachmentField
  { PostPropAttachmentField -> Text
ppafTitle :: Text
  , PostPropAttachmentField -> Text
ppafValue :: Text
  , PostPropAttachmentField -> Bool
ppafShort :: Bool
  } deriving (ReadPrec [PostPropAttachmentField]
ReadPrec PostPropAttachmentField
Int -> ReadS PostPropAttachmentField
ReadS [PostPropAttachmentField]
(Int -> ReadS PostPropAttachmentField)
-> ReadS [PostPropAttachmentField]
-> ReadPrec PostPropAttachmentField
-> ReadPrec [PostPropAttachmentField]
-> Read PostPropAttachmentField
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostPropAttachmentField]
$creadListPrec :: ReadPrec [PostPropAttachmentField]
readPrec :: ReadPrec PostPropAttachmentField
$creadPrec :: ReadPrec PostPropAttachmentField
readList :: ReadS [PostPropAttachmentField]
$creadList :: ReadS [PostPropAttachmentField]
readsPrec :: Int -> ReadS PostPropAttachmentField
$creadsPrec :: Int -> ReadS PostPropAttachmentField
Read, Int -> PostPropAttachmentField -> ShowS
[PostPropAttachmentField] -> ShowS
PostPropAttachmentField -> String
(Int -> PostPropAttachmentField -> ShowS)
-> (PostPropAttachmentField -> String)
-> ([PostPropAttachmentField] -> ShowS)
-> Show PostPropAttachmentField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPropAttachmentField] -> ShowS
$cshowList :: [PostPropAttachmentField] -> ShowS
show :: PostPropAttachmentField -> String
$cshow :: PostPropAttachmentField -> String
showsPrec :: Int -> PostPropAttachmentField -> ShowS
$cshowsPrec :: Int -> PostPropAttachmentField -> ShowS
Show, PostPropAttachmentField -> PostPropAttachmentField -> Bool
(PostPropAttachmentField -> PostPropAttachmentField -> Bool)
-> (PostPropAttachmentField -> PostPropAttachmentField -> Bool)
-> Eq PostPropAttachmentField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPropAttachmentField -> PostPropAttachmentField -> Bool
$c/= :: PostPropAttachmentField -> PostPropAttachmentField -> Bool
== :: PostPropAttachmentField -> PostPropAttachmentField -> Bool
$c== :: PostPropAttachmentField -> PostPropAttachmentField -> Bool
Eq)

instance A.FromJSON PostPropAttachmentField where
  parseJSON :: Value -> Parser PostPropAttachmentField
parseJSON = String
-> (Object -> Parser PostPropAttachmentField)
-> Value
-> Parser PostPropAttachmentField
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PostPropAttachmentField" ((Object -> Parser PostPropAttachmentField)
 -> Value -> Parser PostPropAttachmentField)
-> (Object -> Parser PostPropAttachmentField)
-> Value
-> Parser PostPropAttachmentField
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
ppafTitle <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"title"
    Text
ppafValue <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
    Bool
ppafShort <- Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"short"
    PostPropAttachmentField -> Parser PostPropAttachmentField
forall (m :: * -> *) a. Monad m => a -> m a
return PostPropAttachmentField :: Text -> Text -> Bool -> PostPropAttachmentField
PostPropAttachmentField { Bool
Text
ppafShort :: Bool
ppafValue :: Text
ppafTitle :: Text
ppafShort :: Bool
ppafValue :: Text
ppafTitle :: Text
.. }

data PostPropAttachment
  = PostPropAttachment
  { PostPropAttachment -> Int
ppaId         :: Int
  , PostPropAttachment -> Text
ppaFallback   :: Text
  , PostPropAttachment -> Text
ppaColor      :: Text
  , PostPropAttachment -> Text
ppaPretext    :: Text
  , PostPropAttachment -> Text
ppaAuthorName :: Text
  , PostPropAttachment -> Text
ppaAuthorLink :: Text
  , PostPropAttachment -> Text
ppaAuthorIcon :: Text
  , PostPropAttachment -> Text
ppaTitle      :: Text
  , PostPropAttachment -> Text
ppaTitleLink  :: Text
  , PostPropAttachment -> Text
ppaText       :: Text
  , PostPropAttachment -> Seq PostPropAttachmentField
ppaFields     :: Seq PostPropAttachmentField
  , PostPropAttachment -> Text
ppaImageURL   :: Text
  , PostPropAttachment -> Text
ppaThumbURL   :: Text
  , PostPropAttachment -> Text
ppaFooter     :: Text
  , PostPropAttachment -> Text
ppaFooterIcon :: Text
  } deriving (ReadPrec [PostPropAttachment]
ReadPrec PostPropAttachment
Int -> ReadS PostPropAttachment
ReadS [PostPropAttachment]
(Int -> ReadS PostPropAttachment)
-> ReadS [PostPropAttachment]
-> ReadPrec PostPropAttachment
-> ReadPrec [PostPropAttachment]
-> Read PostPropAttachment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostPropAttachment]
$creadListPrec :: ReadPrec [PostPropAttachment]
readPrec :: ReadPrec PostPropAttachment
$creadPrec :: ReadPrec PostPropAttachment
readList :: ReadS [PostPropAttachment]
$creadList :: ReadS [PostPropAttachment]
readsPrec :: Int -> ReadS PostPropAttachment
$creadsPrec :: Int -> ReadS PostPropAttachment
Read, Int -> PostPropAttachment -> ShowS
[PostPropAttachment] -> ShowS
PostPropAttachment -> String
(Int -> PostPropAttachment -> ShowS)
-> (PostPropAttachment -> String)
-> ([PostPropAttachment] -> ShowS)
-> Show PostPropAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPropAttachment] -> ShowS
$cshowList :: [PostPropAttachment] -> ShowS
show :: PostPropAttachment -> String
$cshow :: PostPropAttachment -> String
showsPrec :: Int -> PostPropAttachment -> ShowS
$cshowsPrec :: Int -> PostPropAttachment -> ShowS
Show, PostPropAttachment -> PostPropAttachment -> Bool
(PostPropAttachment -> PostPropAttachment -> Bool)
-> (PostPropAttachment -> PostPropAttachment -> Bool)
-> Eq PostPropAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPropAttachment -> PostPropAttachment -> Bool
$c/= :: PostPropAttachment -> PostPropAttachment -> Bool
== :: PostPropAttachment -> PostPropAttachment -> Bool
$c== :: PostPropAttachment -> PostPropAttachment -> Bool
Eq)

instance A.FromJSON PostPropAttachment where
  parseJSON :: Value -> Parser PostPropAttachment
parseJSON = String
-> (Object -> Parser PostPropAttachment)
-> Value
-> Parser PostPropAttachment
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Attachment" ((Object -> Parser PostPropAttachment)
 -> Value -> Parser PostPropAttachment)
-> (Object -> Parser PostPropAttachment)
-> Value
-> Parser PostPropAttachment
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    let Object
x .:?? :: Object -> Text -> Parser a
.:?? Text
f = Object
x Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
f Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
    Int
ppaId         <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id" Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    Text
ppaFallback   <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"fallback"
    Text
ppaColor      <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"color"
    Text
ppaPretext    <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"pretext"
    Text
ppaAuthorName <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"author_name"
    Text
ppaAuthorLink <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"author_link"
    Text
ppaAuthorIcon <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"author_icon"
    Text
ppaTitle      <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"title"
    Text
ppaTitleLink  <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"title_link"
    Text
ppaText       <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"text"
    Seq PostPropAttachmentField
ppaFields     <- Object
v Object -> Text -> Parser (Seq PostPropAttachmentField)
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"fields"
    Text
ppaImageURL   <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"image_url"
    Text
ppaThumbURL   <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"thumb_url"
    Text
ppaFooter     <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"footer"
    Text
ppaFooterIcon <- Object
v Object -> Text -> Parser Text
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?? Text
"footer_icon"
    PostPropAttachment -> Parser PostPropAttachment
forall (m :: * -> *) a. Monad m => a -> m a
return PostPropAttachment :: Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Seq PostPropAttachmentField
-> Text
-> Text
-> Text
-> Text
-> PostPropAttachment
PostPropAttachment { Int
Text
Seq PostPropAttachmentField
ppaFooterIcon :: Text
ppaFooter :: Text
ppaThumbURL :: Text
ppaImageURL :: Text
ppaFields :: Seq PostPropAttachmentField
ppaText :: Text
ppaTitleLink :: Text
ppaTitle :: Text
ppaAuthorIcon :: Text
ppaAuthorLink :: Text
ppaAuthorName :: Text
ppaPretext :: Text
ppaColor :: Text
ppaFallback :: Text
ppaId :: Int
ppaFooterIcon :: Text
ppaFooter :: Text
ppaThumbURL :: Text
ppaImageURL :: Text
ppaFields :: Seq PostPropAttachmentField
ppaText :: Text
ppaTitleLink :: Text
ppaTitle :: Text
ppaAuthorIcon :: Text
ppaAuthorLink :: Text
ppaAuthorName :: Text
ppaPretext :: Text
ppaColor :: Text
ppaFallback :: Text
ppaId :: Int
.. }

instance A.ToJSON PostPropAttachment where
  toJSON :: PostPropAttachment -> Value
toJSON PostPropAttachment { Int
Text
Seq PostPropAttachmentField
ppaFooterIcon :: Text
ppaFooter :: Text
ppaThumbURL :: Text
ppaImageURL :: Text
ppaFields :: Seq PostPropAttachmentField
ppaText :: Text
ppaTitleLink :: Text
ppaTitle :: Text
ppaAuthorIcon :: Text
ppaAuthorLink :: Text
ppaAuthorName :: Text
ppaPretext :: Text
ppaColor :: Text
ppaFallback :: Text
ppaId :: Int
ppaFooterIcon :: PostPropAttachment -> Text
ppaFooter :: PostPropAttachment -> Text
ppaThumbURL :: PostPropAttachment -> Text
ppaImageURL :: PostPropAttachment -> Text
ppaFields :: PostPropAttachment -> Seq PostPropAttachmentField
ppaText :: PostPropAttachment -> Text
ppaTitleLink :: PostPropAttachment -> Text
ppaTitle :: PostPropAttachment -> Text
ppaAuthorIcon :: PostPropAttachment -> Text
ppaAuthorLink :: PostPropAttachment -> Text
ppaAuthorName :: PostPropAttachment -> Text
ppaPretext :: PostPropAttachment -> Text
ppaColor :: PostPropAttachment -> Text
ppaFallback :: PostPropAttachment -> Text
ppaId :: PostPropAttachment -> Int
.. } = [Pair] -> Value
A.object
    [ Text
"color" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
ppaColor
    , Text
"text"  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
ppaText
    ]

data PostProps
  = PostProps
  { PostProps -> Maybe Text
postPropsOverrideIconUrl  :: Maybe Text
  , PostProps -> Maybe Text
postPropsOverrideUsername :: Maybe Text
  , PostProps -> Maybe Bool
postPropsFromWebhook      :: Maybe Bool
  , PostProps -> Maybe (Seq PostPropAttachment)
postPropsAttachments      :: Maybe (Seq PostPropAttachment) -- A.Value
  , PostProps -> Maybe Text
postPropsNewHeader        :: Maybe Text
  , PostProps -> Maybe Text
postPropsOldHeader        :: Maybe Text
  } deriving (ReadPrec [PostProps]
ReadPrec PostProps
Int -> ReadS PostProps
ReadS [PostProps]
(Int -> ReadS PostProps)
-> ReadS [PostProps]
-> ReadPrec PostProps
-> ReadPrec [PostProps]
-> Read PostProps
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostProps]
$creadListPrec :: ReadPrec [PostProps]
readPrec :: ReadPrec PostProps
$creadPrec :: ReadPrec PostProps
readList :: ReadS [PostProps]
$creadList :: ReadS [PostProps]
readsPrec :: Int -> ReadS PostProps
$creadsPrec :: Int -> ReadS PostProps
Read, Int -> PostProps -> ShowS
[PostProps] -> ShowS
PostProps -> String
(Int -> PostProps -> ShowS)
-> (PostProps -> String)
-> ([PostProps] -> ShowS)
-> Show PostProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostProps] -> ShowS
$cshowList :: [PostProps] -> ShowS
show :: PostProps -> String
$cshow :: PostProps -> String
showsPrec :: Int -> PostProps -> ShowS
$cshowsPrec :: Int -> PostProps -> ShowS
Show, PostProps -> PostProps -> Bool
(PostProps -> PostProps -> Bool)
-> (PostProps -> PostProps -> Bool) -> Eq PostProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostProps -> PostProps -> Bool
$c/= :: PostProps -> PostProps -> Bool
== :: PostProps -> PostProps -> Bool
$c== :: PostProps -> PostProps -> Bool
Eq)

emptyPostProps :: PostProps
emptyPostProps :: PostProps
emptyPostProps
  = PostProps :: Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe (Seq PostPropAttachment)
-> Maybe Text
-> Maybe Text
-> PostProps
PostProps
  { postPropsOverrideIconUrl :: Maybe Text
postPropsOverrideIconUrl  = Maybe Text
forall a. Maybe a
Nothing
  , postPropsOverrideUsername :: Maybe Text
postPropsOverrideUsername = Maybe Text
forall a. Maybe a
Nothing
  , postPropsFromWebhook :: Maybe Bool
postPropsFromWebhook      = Maybe Bool
forall a. Maybe a
Nothing
  , postPropsAttachments :: Maybe (Seq PostPropAttachment)
postPropsAttachments      = Maybe (Seq PostPropAttachment)
forall a. Maybe a
Nothing
  , postPropsNewHeader :: Maybe Text
postPropsNewHeader        = Maybe Text
forall a. Maybe a
Nothing
  , postPropsOldHeader :: Maybe Text
postPropsOldHeader        = Maybe Text
forall a. Maybe a
Nothing
  }

instance A.FromJSON PostProps where
  parseJSON :: Value -> Parser PostProps
parseJSON = String -> (Object -> Parser PostProps) -> Value -> Parser PostProps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Props" ((Object -> Parser PostProps) -> Value -> Parser PostProps)
-> (Object -> Parser PostProps) -> Value -> Parser PostProps
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Maybe Text
postPropsOverrideIconUrl  <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"override_icon_url"
    Maybe Text
postPropsOverrideUsername <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"override_username"
    Maybe Text
postPropsFromWebhookStr   <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"from_webhook"
    let postPropsFromWebhook :: Maybe Bool
postPropsFromWebhook = do
            Text
s <- Maybe Text
postPropsFromWebhookStr
            Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"true"::Text)
    Maybe (Seq PostPropAttachment)
postPropsAttachments      <- Object
v Object -> Text -> Parser (Maybe (Seq PostPropAttachment))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"attachments"
    Maybe Text
postPropsNewHeader        <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"new_header"
    Maybe Text
postPropsOldHeader        <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"old_header"
    PostProps -> Parser PostProps
forall (m :: * -> *) a. Monad m => a -> m a
return PostProps :: Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe (Seq PostPropAttachment)
-> Maybe Text
-> Maybe Text
-> PostProps
PostProps { Maybe Bool
Maybe Text
Maybe (Seq PostPropAttachment)
postPropsOldHeader :: Maybe Text
postPropsNewHeader :: Maybe Text
postPropsAttachments :: Maybe (Seq PostPropAttachment)
postPropsFromWebhook :: Maybe Bool
postPropsOverrideUsername :: Maybe Text
postPropsOverrideIconUrl :: Maybe Text
postPropsOldHeader :: Maybe Text
postPropsNewHeader :: Maybe Text
postPropsAttachments :: Maybe (Seq PostPropAttachment)
postPropsFromWebhook :: Maybe Bool
postPropsOverrideUsername :: Maybe Text
postPropsOverrideIconUrl :: Maybe Text
.. }

instance A.ToJSON PostProps where
  toJSON :: PostProps -> Value
toJSON PostProps { Maybe Bool
Maybe Text
Maybe (Seq PostPropAttachment)
postPropsOldHeader :: Maybe Text
postPropsNewHeader :: Maybe Text
postPropsAttachments :: Maybe (Seq PostPropAttachment)
postPropsFromWebhook :: Maybe Bool
postPropsOverrideUsername :: Maybe Text
postPropsOverrideIconUrl :: Maybe Text
postPropsOldHeader :: PostProps -> Maybe Text
postPropsNewHeader :: PostProps -> Maybe Text
postPropsAttachments :: PostProps -> Maybe (Seq PostPropAttachment)
postPropsFromWebhook :: PostProps -> Maybe Bool
postPropsOverrideUsername :: PostProps -> Maybe Text
postPropsOverrideIconUrl :: PostProps -> Maybe Text
.. } = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Text
"override_icon_url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
v | Just Text
v <- [Maybe Text
postPropsOverrideIconUrl ] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"override_username" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
v | Just Text
v <- [Maybe Text
postPropsOverrideUsername] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"from_webhook"      Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
v | Just Bool
v <- [Maybe Bool
postPropsFromWebhook     ] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"attachments"       Text -> Seq PostPropAttachment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq PostPropAttachment
v | Just Seq PostPropAttachment
v <- [Maybe (Seq PostPropAttachment)
postPropsAttachments     ] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"new_header"        Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
v | Just Text
v <- [Maybe Text
postPropsNewHeader       ] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"old_header"        Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
v | Just Text
v <- [Maybe Text
postPropsOldHeader       ] ]

newtype PostId = PI { PostId -> Id
unPI :: Id }
  deriving (ReadPrec [PostId]
ReadPrec PostId
Int -> ReadS PostId
ReadS [PostId]
(Int -> ReadS PostId)
-> ReadS [PostId]
-> ReadPrec PostId
-> ReadPrec [PostId]
-> Read PostId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostId]
$creadListPrec :: ReadPrec [PostId]
readPrec :: ReadPrec PostId
$creadPrec :: ReadPrec PostId
readList :: ReadS [PostId]
$creadList :: ReadS [PostId]
readsPrec :: Int -> ReadS PostId
$creadsPrec :: Int -> ReadS PostId
Read, Int -> PostId -> ShowS
[PostId] -> ShowS
PostId -> String
(Int -> PostId -> ShowS)
-> (PostId -> String) -> ([PostId] -> ShowS) -> Show PostId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostId] -> ShowS
$cshowList :: [PostId] -> ShowS
show :: PostId -> String
$cshow :: PostId -> String
showsPrec :: Int -> PostId -> ShowS
$cshowsPrec :: Int -> PostId -> ShowS
Show, PostId -> PostId -> Bool
(PostId -> PostId -> Bool)
-> (PostId -> PostId -> Bool) -> Eq PostId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostId -> PostId -> Bool
$c/= :: PostId -> PostId -> Bool
== :: PostId -> PostId -> Bool
$c== :: PostId -> PostId -> Bool
Eq, Eq PostId
Eq PostId
-> (PostId -> PostId -> Ordering)
-> (PostId -> PostId -> Bool)
-> (PostId -> PostId -> Bool)
-> (PostId -> PostId -> Bool)
-> (PostId -> PostId -> Bool)
-> (PostId -> PostId -> PostId)
-> (PostId -> PostId -> PostId)
-> Ord PostId
PostId -> PostId -> Bool
PostId -> PostId -> Ordering
PostId -> PostId -> PostId
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 :: PostId -> PostId -> PostId
$cmin :: PostId -> PostId -> PostId
max :: PostId -> PostId -> PostId
$cmax :: PostId -> PostId -> PostId
>= :: PostId -> PostId -> Bool
$c>= :: PostId -> PostId -> Bool
> :: PostId -> PostId -> Bool
$c> :: PostId -> PostId -> Bool
<= :: PostId -> PostId -> Bool
$c<= :: PostId -> PostId -> Bool
< :: PostId -> PostId -> Bool
$c< :: PostId -> PostId -> Bool
compare :: PostId -> PostId -> Ordering
$ccompare :: PostId -> PostId -> Ordering
$cp1Ord :: Eq PostId
Ord, Int -> PostId -> Int
PostId -> Int
(Int -> PostId -> Int) -> (PostId -> Int) -> Hashable PostId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PostId -> Int
$chash :: PostId -> Int
hashWithSalt :: Int -> PostId -> Int
$chashWithSalt :: Int -> PostId -> Int
Hashable, [PostId] -> Encoding
[PostId] -> Value
PostId -> Encoding
PostId -> Value
(PostId -> Value)
-> (PostId -> Encoding)
-> ([PostId] -> Value)
-> ([PostId] -> Encoding)
-> ToJSON PostId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PostId] -> Encoding
$ctoEncodingList :: [PostId] -> Encoding
toJSONList :: [PostId] -> Value
$ctoJSONList :: [PostId] -> Value
toEncoding :: PostId -> Encoding
$ctoEncoding :: PostId -> Encoding
toJSON :: PostId -> Value
$ctoJSON :: PostId -> Value
ToJSON, ToJSONKeyFunction [PostId]
ToJSONKeyFunction PostId
ToJSONKeyFunction PostId
-> ToJSONKeyFunction [PostId] -> ToJSONKey PostId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PostId]
$ctoJSONKeyList :: ToJSONKeyFunction [PostId]
toJSONKey :: ToJSONKeyFunction PostId
$ctoJSONKey :: ToJSONKeyFunction PostId
ToJSONKey, FromJSONKeyFunction [PostId]
FromJSONKeyFunction PostId
FromJSONKeyFunction PostId
-> FromJSONKeyFunction [PostId] -> FromJSONKey PostId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PostId]
$cfromJSONKeyList :: FromJSONKeyFunction [PostId]
fromJSONKey :: FromJSONKeyFunction PostId
$cfromJSONKey :: FromJSONKeyFunction PostId
FromJSONKey, Value -> Parser [PostId]
Value -> Parser PostId
(Value -> Parser PostId)
-> (Value -> Parser [PostId]) -> FromJSON PostId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PostId]
$cparseJSONList :: Value -> Parser [PostId]
parseJSON :: Value -> Parser PostId
$cparseJSON :: Value -> Parser PostId
FromJSON)

instance IsId PostId where
  toId :: PostId -> Id
toId   = PostId -> Id
unPI
  fromId :: Id -> PostId
fromId = Id -> PostId
PI

instance PrintfArg PostId where
  formatArg :: PostId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (PostId -> Text) -> PostId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostId -> Text
forall x. IsId x => x -> Text
idString

newtype FileId = FI { FileId -> Id
unFI :: Id }
  deriving (ReadPrec [FileId]
ReadPrec FileId
Int -> ReadS FileId
ReadS [FileId]
(Int -> ReadS FileId)
-> ReadS [FileId]
-> ReadPrec FileId
-> ReadPrec [FileId]
-> Read FileId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileId]
$creadListPrec :: ReadPrec [FileId]
readPrec :: ReadPrec FileId
$creadPrec :: ReadPrec FileId
readList :: ReadS [FileId]
$creadList :: ReadS [FileId]
readsPrec :: Int -> ReadS FileId
$creadsPrec :: Int -> ReadS FileId
Read, Int -> FileId -> ShowS
[FileId] -> ShowS
FileId -> String
(Int -> FileId -> ShowS)
-> (FileId -> String) -> ([FileId] -> ShowS) -> Show FileId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileId] -> ShowS
$cshowList :: [FileId] -> ShowS
show :: FileId -> String
$cshow :: FileId -> String
showsPrec :: Int -> FileId -> ShowS
$cshowsPrec :: Int -> FileId -> ShowS
Show, FileId -> FileId -> Bool
(FileId -> FileId -> Bool)
-> (FileId -> FileId -> Bool) -> Eq FileId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileId -> FileId -> Bool
$c/= :: FileId -> FileId -> Bool
== :: FileId -> FileId -> Bool
$c== :: FileId -> FileId -> Bool
Eq, Eq FileId
Eq FileId
-> (FileId -> FileId -> Ordering)
-> (FileId -> FileId -> Bool)
-> (FileId -> FileId -> Bool)
-> (FileId -> FileId -> Bool)
-> (FileId -> FileId -> Bool)
-> (FileId -> FileId -> FileId)
-> (FileId -> FileId -> FileId)
-> Ord FileId
FileId -> FileId -> Bool
FileId -> FileId -> Ordering
FileId -> FileId -> FileId
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 :: FileId -> FileId -> FileId
$cmin :: FileId -> FileId -> FileId
max :: FileId -> FileId -> FileId
$cmax :: FileId -> FileId -> FileId
>= :: FileId -> FileId -> Bool
$c>= :: FileId -> FileId -> Bool
> :: FileId -> FileId -> Bool
$c> :: FileId -> FileId -> Bool
<= :: FileId -> FileId -> Bool
$c<= :: FileId -> FileId -> Bool
< :: FileId -> FileId -> Bool
$c< :: FileId -> FileId -> Bool
compare :: FileId -> FileId -> Ordering
$ccompare :: FileId -> FileId -> Ordering
$cp1Ord :: Eq FileId
Ord, Int -> FileId -> Int
FileId -> Int
(Int -> FileId -> Int) -> (FileId -> Int) -> Hashable FileId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FileId -> Int
$chash :: FileId -> Int
hashWithSalt :: Int -> FileId -> Int
$chashWithSalt :: Int -> FileId -> Int
Hashable, [FileId] -> Encoding
[FileId] -> Value
FileId -> Encoding
FileId -> Value
(FileId -> Value)
-> (FileId -> Encoding)
-> ([FileId] -> Value)
-> ([FileId] -> Encoding)
-> ToJSON FileId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FileId] -> Encoding
$ctoEncodingList :: [FileId] -> Encoding
toJSONList :: [FileId] -> Value
$ctoJSONList :: [FileId] -> Value
toEncoding :: FileId -> Encoding
$ctoEncoding :: FileId -> Encoding
toJSON :: FileId -> Value
$ctoJSON :: FileId -> Value
ToJSON, ToJSONKeyFunction [FileId]
ToJSONKeyFunction FileId
ToJSONKeyFunction FileId
-> ToJSONKeyFunction [FileId] -> ToJSONKey FileId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [FileId]
$ctoJSONKeyList :: ToJSONKeyFunction [FileId]
toJSONKey :: ToJSONKeyFunction FileId
$ctoJSONKey :: ToJSONKeyFunction FileId
ToJSONKey, FromJSONKeyFunction [FileId]
FromJSONKeyFunction FileId
FromJSONKeyFunction FileId
-> FromJSONKeyFunction [FileId] -> FromJSONKey FileId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [FileId]
$cfromJSONKeyList :: FromJSONKeyFunction [FileId]
fromJSONKey :: FromJSONKeyFunction FileId
$cfromJSONKey :: FromJSONKeyFunction FileId
FromJSONKey, Value -> Parser [FileId]
Value -> Parser FileId
(Value -> Parser FileId)
-> (Value -> Parser [FileId]) -> FromJSON FileId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileId]
$cparseJSONList :: Value -> Parser [FileId]
parseJSON :: Value -> Parser FileId
$cparseJSON :: Value -> Parser FileId
FromJSON)

instance IsId FileId where
  toId :: FileId -> Id
toId = FileId -> Id
unFI
  fromId :: Id -> FileId
fromId = Id -> FileId
FI

instance PrintfArg FileId where
  formatArg :: FileId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (FileId -> Text) -> FileId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileId -> Text
forall x. IsId x => x -> Text
idString

urlForFile :: FileId -> Text
urlForFile :: FileId -> Text
urlForFile FileId
fId =
  Text
"/api/v4/files/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FileId -> Text
forall x. IsId x => x -> Text
idString FileId
fId

data PostType
  = PostTypeJoinChannel
  | PostTypeLeaveChannel
  | PostTypeAddToChannel
  | PostTypeRemoveFromChannel
  | PostTypeHeaderChange
  | PostTypeDisplayNameChange
  | PostTypePurposeChange
  | PostTypeChannelDeleted
  | PostTypeEphemeral
  | PostTypeUnknown T.Text
    deriving (ReadPrec [PostType]
ReadPrec PostType
Int -> ReadS PostType
ReadS [PostType]
(Int -> ReadS PostType)
-> ReadS [PostType]
-> ReadPrec PostType
-> ReadPrec [PostType]
-> Read PostType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostType]
$creadListPrec :: ReadPrec [PostType]
readPrec :: ReadPrec PostType
$creadPrec :: ReadPrec PostType
readList :: ReadS [PostType]
$creadList :: ReadS [PostType]
readsPrec :: Int -> ReadS PostType
$creadsPrec :: Int -> ReadS PostType
Read, Int -> PostType -> ShowS
[PostType] -> ShowS
PostType -> String
(Int -> PostType -> ShowS)
-> (PostType -> String) -> ([PostType] -> ShowS) -> Show PostType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostType] -> ShowS
$cshowList :: [PostType] -> ShowS
show :: PostType -> String
$cshow :: PostType -> String
showsPrec :: Int -> PostType -> ShowS
$cshowsPrec :: Int -> PostType -> ShowS
Show, PostType -> PostType -> Bool
(PostType -> PostType -> Bool)
-> (PostType -> PostType -> Bool) -> Eq PostType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostType -> PostType -> Bool
$c/= :: PostType -> PostType -> Bool
== :: PostType -> PostType -> Bool
$c== :: PostType -> PostType -> Bool
Eq)

instance A.FromJSON PostType where
  parseJSON :: Value -> Parser PostType
parseJSON = String -> (Text -> Parser PostType) -> Value -> Parser PostType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"Post type" ((Text -> Parser PostType) -> Value -> Parser PostType)
-> (Text -> Parser PostType) -> Value -> Parser PostType
forall a b. (a -> b) -> a -> b
$ \ Text
t -> PostType -> Parser PostType
forall (m :: * -> *) a. Monad m => a -> m a
return (PostType -> Parser PostType) -> PostType -> Parser PostType
forall a b. (a -> b) -> a -> b
$ case Text
t of
    Text
"system_join_channel"        -> PostType
PostTypeJoinChannel
    Text
"system_leave_channel"       -> PostType
PostTypeLeaveChannel
    Text
"system_add_to_channel"      -> PostType
PostTypeAddToChannel
    Text
"system_remove_from_channel" -> PostType
PostTypeRemoveFromChannel
    Text
"system_header_change"       -> PostType
PostTypeHeaderChange
    Text
"system_displayname_change"  -> PostType
PostTypeDisplayNameChange
    Text
"system_purpose_change"      -> PostType
PostTypePurposeChange
    Text
"system_channel_deleted"     -> PostType
PostTypeChannelDeleted
    Text
"system_ephemeral"           -> PostType
PostTypeEphemeral
    Text
_                            -> Text -> PostType
PostTypeUnknown Text
t

instance A.ToJSON PostType where
  toJSON :: PostType -> Value
toJSON PostType
typ = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case PostType
typ of
    PostType
PostTypeJoinChannel       -> Text
"system_join_channel"
    PostType
PostTypeLeaveChannel      -> Text
"system_leave_channel"
    PostType
PostTypeAddToChannel      -> Text
"system_add_to_channel"
    PostType
PostTypeRemoveFromChannel -> Text
"system_remove_from_channel"
    PostType
PostTypeHeaderChange      -> Text
"system_header_change"
    PostType
PostTypeDisplayNameChange -> Text
"system_displayname_change"
    PostType
PostTypePurposeChange     -> Text
"system_purpose_change"
    PostType
PostTypeChannelDeleted    -> Text
"system_channel_deleted"
    PostType
PostTypeEphemeral         -> Text
"system_ephemeral"
    PostTypeUnknown Text
t         -> Text
t

data Post
  = Post
  { Post -> Maybe PostId
postPendingPostId :: Maybe PostId
  , Post -> Maybe PostId
postOriginalId    :: Maybe PostId
  , Post -> PostProps
postProps         :: PostProps
  , Post -> Maybe PostId
postRootId        :: Maybe PostId
  , Post -> Seq FileId
postFileIds       :: Seq FileId
  , Post -> PostId
postId            :: PostId
  , Post -> PostType
postType          :: PostType
  , Post -> UserText
postMessage       :: UserText
  , Post -> Maybe ServerTime
postDeleteAt      :: Maybe ServerTime
  , Post -> Text
postHashtags      :: Text
  , Post -> ServerTime
postUpdateAt      :: ServerTime
  , Post -> ServerTime
postEditAt        :: ServerTime
  , Post -> Maybe UserId
postUserId        :: Maybe UserId
  , Post -> ServerTime
postCreateAt      :: ServerTime
  , Post -> ChannelId
postChannelId     :: ChannelId
  , Post -> Bool
postHasReactions  :: Bool
  , Post -> Maybe Bool
postPinned        :: Maybe Bool
  } deriving (ReadPrec [Post]
ReadPrec Post
Int -> ReadS Post
ReadS [Post]
(Int -> ReadS Post)
-> ReadS [Post] -> ReadPrec Post -> ReadPrec [Post] -> Read Post
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Post]
$creadListPrec :: ReadPrec [Post]
readPrec :: ReadPrec Post
$creadPrec :: ReadPrec Post
readList :: ReadS [Post]
$creadList :: ReadS [Post]
readsPrec :: Int -> ReadS Post
$creadsPrec :: Int -> ReadS Post
Read, Int -> Post -> ShowS
[Post] -> ShowS
Post -> String
(Int -> Post -> ShowS)
-> (Post -> String) -> ([Post] -> ShowS) -> Show Post
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Post] -> ShowS
$cshowList :: [Post] -> ShowS
show :: Post -> String
$cshow :: Post -> String
showsPrec :: Int -> Post -> ShowS
$cshowsPrec :: Int -> Post -> ShowS
Show, Post -> Post -> Bool
(Post -> Post -> Bool) -> (Post -> Post -> Bool) -> Eq Post
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Post -> Post -> Bool
$c/= :: Post -> Post -> Bool
== :: Post -> Post -> Bool
$c== :: Post -> Post -> Bool
Eq)

instance HasId Post PostId where
  getId :: Post -> PostId
getId = Post -> PostId
postId

instance A.FromJSON Post where
  parseJSON :: Value -> Parser Post
parseJSON = String -> (Object -> Parser Post) -> Value -> Parser Post
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Post" ((Object -> Parser Post) -> Value -> Parser Post)
-> (Object -> Parser Post) -> Value -> Parser Post
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Maybe PostId
postPendingPostId <- Parser PostId -> Parser (Maybe PostId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
v Object -> Text -> Parser PostId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"pending_post_id")
    Maybe PostId
postOriginalId    <- Parser PostId -> Parser (Maybe PostId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
v Object -> Text -> Parser PostId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"original_id")
    PostProps
postProps         <- PostProps -> Maybe PostProps -> PostProps
forall a. a -> Maybe a -> a
fromMaybe PostProps
emptyPostProps (Maybe PostProps -> PostProps)
-> Parser (Maybe PostProps) -> Parser PostProps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe PostProps)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"props"
    Maybe PostId
postRootId        <- Parser PostId -> Parser (Maybe PostId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
v Object -> Text -> Parser PostId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"root_id")
    Seq FileId
postFileIds       <- Object
v Object -> Text -> Parser (Maybe (Seq FileId))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"file_ids" Parser (Maybe (Seq FileId)) -> Seq FileId -> Parser (Seq FileId)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Seq FileId
forall a. Monoid a => a
mempty
    PostId
postId            <- Object
v Object -> Text -> Parser PostId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    PostType
postType          <- Object
v Object -> Text -> Parser PostType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
    UserText
postMessage       <- Object
v Object -> Text -> Parser UserText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"message"
    Maybe ServerTime
postDeleteAt      <- (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Maybe Integer -> Maybe ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Integer -> Maybe ServerTime)
-> Parser (Maybe Integer) -> Parser (Maybe ServerTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"delete_at"
    Text
postHashtags      <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"hashtags"
    ServerTime
postUpdateAt      <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"update_at"
    ServerTime
postEditAt        <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"edit_at"
    Maybe UserId
postUserId        <- Parser UserId -> Parser (Maybe UserId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id")
    ServerTime
postCreateAt      <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"create_at"
    ChannelId
postChannelId     <- Object
v Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id"
    Bool
postHasReactions  <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"has_reactions" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Maybe Bool
postPinned        <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"is_pinned"
    Post -> Parser Post
forall (m :: * -> *) a. Monad m => a -> m a
return Post :: Maybe PostId
-> Maybe PostId
-> PostProps
-> Maybe PostId
-> Seq FileId
-> PostId
-> PostType
-> UserText
-> Maybe ServerTime
-> Text
-> ServerTime
-> ServerTime
-> Maybe UserId
-> ServerTime
-> ChannelId
-> Bool
-> Maybe Bool
-> Post
Post { Bool
Maybe Bool
Maybe ServerTime
Maybe PostId
Maybe UserId
Text
Seq FileId
ServerTime
PostType
PostId
PostProps
ChannelId
UserText
postPinned :: Maybe Bool
postHasReactions :: Bool
postChannelId :: ChannelId
postCreateAt :: ServerTime
postUserId :: Maybe UserId
postEditAt :: ServerTime
postUpdateAt :: ServerTime
postHashtags :: Text
postDeleteAt :: Maybe ServerTime
postMessage :: UserText
postType :: PostType
postId :: PostId
postFileIds :: Seq FileId
postRootId :: Maybe PostId
postProps :: PostProps
postOriginalId :: Maybe PostId
postPendingPostId :: Maybe PostId
postPinned :: Maybe Bool
postHasReactions :: Bool
postChannelId :: ChannelId
postCreateAt :: ServerTime
postUserId :: Maybe UserId
postEditAt :: ServerTime
postUpdateAt :: ServerTime
postHashtags :: Text
postDeleteAt :: Maybe ServerTime
postMessage :: UserText
postType :: PostType
postId :: PostId
postFileIds :: Seq FileId
postRootId :: Maybe PostId
postProps :: PostProps
postOriginalId :: Maybe PostId
postPendingPostId :: Maybe PostId
.. }

instance A.ToJSON Post where
  toJSON :: Post -> Value
toJSON Post { Bool
Maybe Bool
Maybe ServerTime
Maybe PostId
Maybe UserId
Text
Seq FileId
ServerTime
PostType
PostId
PostProps
ChannelId
UserText
postPinned :: Maybe Bool
postHasReactions :: Bool
postChannelId :: ChannelId
postCreateAt :: ServerTime
postUserId :: Maybe UserId
postEditAt :: ServerTime
postUpdateAt :: ServerTime
postHashtags :: Text
postDeleteAt :: Maybe ServerTime
postMessage :: UserText
postType :: PostType
postId :: PostId
postFileIds :: Seq FileId
postRootId :: Maybe PostId
postProps :: PostProps
postOriginalId :: Maybe PostId
postPendingPostId :: Maybe PostId
postPinned :: Post -> Maybe Bool
postHasReactions :: Post -> Bool
postChannelId :: Post -> ChannelId
postCreateAt :: Post -> ServerTime
postUserId :: Post -> Maybe UserId
postEditAt :: Post -> ServerTime
postUpdateAt :: Post -> ServerTime
postHashtags :: Post -> Text
postDeleteAt :: Post -> Maybe ServerTime
postMessage :: Post -> UserText
postType :: Post -> PostType
postId :: Post -> PostId
postFileIds :: Post -> Seq FileId
postRootId :: Post -> Maybe PostId
postProps :: Post -> PostProps
postOriginalId :: Post -> Maybe PostId
postPendingPostId :: Post -> Maybe PostId
.. } = [Pair] -> Value
A.object
    [ Text
"pending_post_id" Text -> Maybe PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe PostId
postPendingPostId
    , Text
"original_id"     Text -> Maybe PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe PostId
postOriginalId
    , Text
"props"           Text -> PostProps -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PostProps
postProps
    , Text
"root_id"         Text -> Maybe PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe PostId
postRootId
    , Text
"file_ids"        Text -> Seq FileId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq FileId
postFileIds
    , Text
"id"              Text -> PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PostId
postId
    , Text
"type"            Text -> PostType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PostType
postType
    , Text
"message"         Text -> UserText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UserText
postMessage
    , Text
"delete_at"       Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ServerTime -> Int
timeToServer (ServerTime -> Int) -> Maybe ServerTime -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ServerTime
postDeleteAt)
    , Text
"hashtags"        Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
postHashtags
    , Text
"update_at"       Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ServerTime -> Int
timeToServer ServerTime
postUpdateAt
    , Text
"user_id"         Text -> Maybe UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe UserId
postUserId
    , Text
"create_at"       Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ServerTime -> Int
timeToServer ServerTime
postCreateAt
    , Text
"channel_id"      Text -> ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChannelId
postChannelId
    , Text
"has_reactions"   Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
postHasReactions
    , Text
"is_pinned"       Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
postPinned
    ]

data PendingPost
  = PendingPost
  { PendingPost -> ChannelId
pendingPostChannelId :: ChannelId
  , PendingPost -> Maybe ServerTime
pendingPostCreateAt  :: Maybe ServerTime
  , PendingPost -> Seq String
pendingPostFilenames :: Seq FilePath
  , PendingPost -> Text
pendingPostMessage   :: Text
  , PendingPost -> PendingPostId
pendingPostId        :: PendingPostId
  , PendingPost -> UserId
pendingPostUserId    :: UserId
  , PendingPost -> Maybe PostId
pendingPostRootId    :: Maybe PostId
  } deriving (ReadPrec [PendingPost]
ReadPrec PendingPost
Int -> ReadS PendingPost
ReadS [PendingPost]
(Int -> ReadS PendingPost)
-> ReadS [PendingPost]
-> ReadPrec PendingPost
-> ReadPrec [PendingPost]
-> Read PendingPost
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PendingPost]
$creadListPrec :: ReadPrec [PendingPost]
readPrec :: ReadPrec PendingPost
$creadPrec :: ReadPrec PendingPost
readList :: ReadS [PendingPost]
$creadList :: ReadS [PendingPost]
readsPrec :: Int -> ReadS PendingPost
$creadsPrec :: Int -> ReadS PendingPost
Read, Int -> PendingPost -> ShowS
[PendingPost] -> ShowS
PendingPost -> String
(Int -> PendingPost -> ShowS)
-> (PendingPost -> String)
-> ([PendingPost] -> ShowS)
-> Show PendingPost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PendingPost] -> ShowS
$cshowList :: [PendingPost] -> ShowS
show :: PendingPost -> String
$cshow :: PendingPost -> String
showsPrec :: Int -> PendingPost -> ShowS
$cshowsPrec :: Int -> PendingPost -> ShowS
Show, PendingPost -> PendingPost -> Bool
(PendingPost -> PendingPost -> Bool)
-> (PendingPost -> PendingPost -> Bool) -> Eq PendingPost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PendingPost -> PendingPost -> Bool
$c/= :: PendingPost -> PendingPost -> Bool
== :: PendingPost -> PendingPost -> Bool
$c== :: PendingPost -> PendingPost -> Bool
Eq)

instance A.ToJSON PendingPost where
  toJSON :: PendingPost -> Value
toJSON PendingPost
post = [Pair] -> Value
A.object
    [ Text
"channel_id"      Text -> ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PendingPost -> ChannelId
pendingPostChannelId PendingPost
post
    , Text
"create_at"       Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int -> (ServerTime -> Int) -> Maybe ServerTime -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ServerTime -> Int
timeToServer (PendingPost -> Maybe ServerTime
pendingPostCreateAt PendingPost
post)
    , Text
"filenames"       Text -> Seq String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PendingPost -> Seq String
pendingPostFilenames PendingPost
post
    , Text
"message"         Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PendingPost -> Text
pendingPostMessage   PendingPost
post
    , Text
"pending_post_id" Text -> PendingPostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PendingPost -> PendingPostId
pendingPostId        PendingPost
post
    , Text
"user_id"         Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PendingPost -> UserId
pendingPostUserId    PendingPost
post
    , Text
"root_id"         Text -> Maybe PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PendingPost -> Maybe PostId
pendingPostRootId    PendingPost
post
    ]

newtype PendingPostId = PPI { PendingPostId -> Id
unPPI :: Id }
  deriving (ReadPrec [PendingPostId]
ReadPrec PendingPostId
Int -> ReadS PendingPostId
ReadS [PendingPostId]
(Int -> ReadS PendingPostId)
-> ReadS [PendingPostId]
-> ReadPrec PendingPostId
-> ReadPrec [PendingPostId]
-> Read PendingPostId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PendingPostId]
$creadListPrec :: ReadPrec [PendingPostId]
readPrec :: ReadPrec PendingPostId
$creadPrec :: ReadPrec PendingPostId
readList :: ReadS [PendingPostId]
$creadList :: ReadS [PendingPostId]
readsPrec :: Int -> ReadS PendingPostId
$creadsPrec :: Int -> ReadS PendingPostId
Read, Int -> PendingPostId -> ShowS
[PendingPostId] -> ShowS
PendingPostId -> String
(Int -> PendingPostId -> ShowS)
-> (PendingPostId -> String)
-> ([PendingPostId] -> ShowS)
-> Show PendingPostId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PendingPostId] -> ShowS
$cshowList :: [PendingPostId] -> ShowS
show :: PendingPostId -> String
$cshow :: PendingPostId -> String
showsPrec :: Int -> PendingPostId -> ShowS
$cshowsPrec :: Int -> PendingPostId -> ShowS
Show, PendingPostId -> PendingPostId -> Bool
(PendingPostId -> PendingPostId -> Bool)
-> (PendingPostId -> PendingPostId -> Bool) -> Eq PendingPostId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PendingPostId -> PendingPostId -> Bool
$c/= :: PendingPostId -> PendingPostId -> Bool
== :: PendingPostId -> PendingPostId -> Bool
$c== :: PendingPostId -> PendingPostId -> Bool
Eq, Eq PendingPostId
Eq PendingPostId
-> (PendingPostId -> PendingPostId -> Ordering)
-> (PendingPostId -> PendingPostId -> Bool)
-> (PendingPostId -> PendingPostId -> Bool)
-> (PendingPostId -> PendingPostId -> Bool)
-> (PendingPostId -> PendingPostId -> Bool)
-> (PendingPostId -> PendingPostId -> PendingPostId)
-> (PendingPostId -> PendingPostId -> PendingPostId)
-> Ord PendingPostId
PendingPostId -> PendingPostId -> Bool
PendingPostId -> PendingPostId -> Ordering
PendingPostId -> PendingPostId -> PendingPostId
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 :: PendingPostId -> PendingPostId -> PendingPostId
$cmin :: PendingPostId -> PendingPostId -> PendingPostId
max :: PendingPostId -> PendingPostId -> PendingPostId
$cmax :: PendingPostId -> PendingPostId -> PendingPostId
>= :: PendingPostId -> PendingPostId -> Bool
$c>= :: PendingPostId -> PendingPostId -> Bool
> :: PendingPostId -> PendingPostId -> Bool
$c> :: PendingPostId -> PendingPostId -> Bool
<= :: PendingPostId -> PendingPostId -> Bool
$c<= :: PendingPostId -> PendingPostId -> Bool
< :: PendingPostId -> PendingPostId -> Bool
$c< :: PendingPostId -> PendingPostId -> Bool
compare :: PendingPostId -> PendingPostId -> Ordering
$ccompare :: PendingPostId -> PendingPostId -> Ordering
$cp1Ord :: Eq PendingPostId
Ord, Int -> PendingPostId -> Int
PendingPostId -> Int
(Int -> PendingPostId -> Int)
-> (PendingPostId -> Int) -> Hashable PendingPostId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PendingPostId -> Int
$chash :: PendingPostId -> Int
hashWithSalt :: Int -> PendingPostId -> Int
$chashWithSalt :: Int -> PendingPostId -> Int
Hashable, [PendingPostId] -> Encoding
[PendingPostId] -> Value
PendingPostId -> Encoding
PendingPostId -> Value
(PendingPostId -> Value)
-> (PendingPostId -> Encoding)
-> ([PendingPostId] -> Value)
-> ([PendingPostId] -> Encoding)
-> ToJSON PendingPostId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PendingPostId] -> Encoding
$ctoEncodingList :: [PendingPostId] -> Encoding
toJSONList :: [PendingPostId] -> Value
$ctoJSONList :: [PendingPostId] -> Value
toEncoding :: PendingPostId -> Encoding
$ctoEncoding :: PendingPostId -> Encoding
toJSON :: PendingPostId -> Value
$ctoJSON :: PendingPostId -> Value
ToJSON, ToJSONKeyFunction [PendingPostId]
ToJSONKeyFunction PendingPostId
ToJSONKeyFunction PendingPostId
-> ToJSONKeyFunction [PendingPostId] -> ToJSONKey PendingPostId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PendingPostId]
$ctoJSONKeyList :: ToJSONKeyFunction [PendingPostId]
toJSONKey :: ToJSONKeyFunction PendingPostId
$ctoJSONKey :: ToJSONKeyFunction PendingPostId
ToJSONKey, FromJSONKeyFunction [PendingPostId]
FromJSONKeyFunction PendingPostId
FromJSONKeyFunction PendingPostId
-> FromJSONKeyFunction [PendingPostId] -> FromJSONKey PendingPostId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PendingPostId]
$cfromJSONKeyList :: FromJSONKeyFunction [PendingPostId]
fromJSONKey :: FromJSONKeyFunction PendingPostId
$cfromJSONKey :: FromJSONKeyFunction PendingPostId
FromJSONKey, Value -> Parser [PendingPostId]
Value -> Parser PendingPostId
(Value -> Parser PendingPostId)
-> (Value -> Parser [PendingPostId]) -> FromJSON PendingPostId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PendingPostId]
$cparseJSONList :: Value -> Parser [PendingPostId]
parseJSON :: Value -> Parser PendingPostId
$cparseJSON :: Value -> Parser PendingPostId
FromJSON)

instance IsId PendingPostId where
  toId :: PendingPostId -> Id
toId   = PendingPostId -> Id
unPPI
  fromId :: Id -> PendingPostId
fromId = Id -> PendingPostId
PPI

instance HasId PendingPost PendingPostId where
  getId :: PendingPost -> PendingPostId
getId = PendingPost -> PendingPostId
pendingPostId

mkPendingPost :: Text -> UserId -> ChannelId -> IO PendingPost
mkPendingPost :: Text -> UserId -> ChannelId -> IO PendingPost
mkPendingPost Text
msg UserId
userid ChannelId
channelid = do
  -- locally generating a ServerTime: ok because it's just used for an
  -- initial string ID for this post and not an actual time value.
  UTCTime
now <- IO UTCTime
getCurrentTime
  let ms :: Int
ms  = ServerTime -> Int
timeToServer (UTCTime -> ServerTime
ServerTime UTCTime
now) :: Int
      pid :: Text
pid = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%s:%d" (UserId -> Text
forall x. IsId x => x -> Text
idString UserId
userid) Int
ms
  PendingPost -> IO PendingPost
forall (m :: * -> *) a. Monad m => a -> m a
return PendingPost :: ChannelId
-> Maybe ServerTime
-> Seq String
-> Text
-> PendingPostId
-> UserId
-> Maybe PostId
-> PendingPost
PendingPost
    { pendingPostId :: PendingPostId
pendingPostId        = Id -> PendingPostId
PPI (Text -> Id
Id Text
pid)
    , pendingPostChannelId :: ChannelId
pendingPostChannelId = ChannelId
channelid
    , pendingPostCreateAt :: Maybe ServerTime
pendingPostCreateAt  = Maybe ServerTime
forall a. Maybe a
Nothing
    , pendingPostFilenames :: Seq String
pendingPostFilenames = Seq String
forall a. Seq a
S.empty
    , pendingPostMessage :: Text
pendingPostMessage   = Text
msg
    , pendingPostUserId :: UserId
pendingPostUserId    = UserId
userid
    , pendingPostRootId :: Maybe PostId
pendingPostRootId    = Maybe PostId
forall a. Maybe a
Nothing
    }

data FileInfo
  = FileInfo
  { FileInfo -> FileId
fileInfoId         :: FileId
  , FileInfo -> UserId
fileInfoUserId     :: UserId
  , FileInfo -> Maybe PostId
fileInfoPostId     :: Maybe PostId
  , FileInfo -> ServerTime
fileInfoCreateAt   :: ServerTime
  , FileInfo -> ServerTime
fileInfoUpdateAt   :: ServerTime
  , FileInfo -> ServerTime
fileInfoDeleteAt   :: ServerTime
  , FileInfo -> Text
fileInfoName       :: Text
  , FileInfo -> Text
fileInfoExtension  :: Text
  , FileInfo -> Int
fileInfoSize       :: Int
  , FileInfo -> Text
fileInfoMimeType   :: Text
  , FileInfo -> Maybe Int
fileInfoWidth      :: Maybe Int
  , FileInfo -> Maybe Int
fileInfoHeight     :: Maybe Int
  , FileInfo -> Bool
fileInfoHasPreview :: Bool
  } deriving (ReadPrec [FileInfo]
ReadPrec FileInfo
Int -> ReadS FileInfo
ReadS [FileInfo]
(Int -> ReadS FileInfo)
-> ReadS [FileInfo]
-> ReadPrec FileInfo
-> ReadPrec [FileInfo]
-> Read FileInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileInfo]
$creadListPrec :: ReadPrec [FileInfo]
readPrec :: ReadPrec FileInfo
$creadPrec :: ReadPrec FileInfo
readList :: ReadS [FileInfo]
$creadList :: ReadS [FileInfo]
readsPrec :: Int -> ReadS FileInfo
$creadsPrec :: Int -> ReadS FileInfo
Read, Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> String
(Int -> FileInfo -> ShowS)
-> (FileInfo -> String) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> String
$cshow :: FileInfo -> String
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> FileInfo -> ShowS
Show, FileInfo -> FileInfo -> Bool
(FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool) -> Eq FileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c== :: FileInfo -> FileInfo -> Bool
Eq)

instance ToJSON FileInfo where
  toJSON :: FileInfo -> Value
toJSON = String -> FileInfo -> Value
forall a. HasCallStack => String -> a
error String
"file info"

instance FromJSON FileInfo where
  parseJSON :: Value -> Parser FileInfo
parseJSON = String -> (Object -> Parser FileInfo) -> Value -> Parser FileInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"file_info" ((Object -> Parser FileInfo) -> Value -> Parser FileInfo)
-> (Object -> Parser FileInfo) -> Value -> Parser FileInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    FileId
fileInfoId         <- Object
o Object -> Text -> Parser FileId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    UserId
fileInfoUserId     <- Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
    Maybe PostId
fileInfoPostId     <- Object
o Object -> Text -> Parser (Maybe PostId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"post_id"
    ServerTime
fileInfoCreateAt   <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"create_at"
    ServerTime
fileInfoUpdateAt   <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"update_at"
    ServerTime
fileInfoDeleteAt   <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"delete_at"
    Text
fileInfoName       <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    Text
fileInfoExtension  <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"extension"
    Int
fileInfoSize       <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"size"
    Text
fileInfoMimeType   <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mime_type"
    Maybe Int
fileInfoWidth      <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"width"
    Maybe Int
fileInfoHeight     <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"height"
    Bool
fileInfoHasPreview <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"has_preview_image" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    FileInfo -> Parser FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo :: FileId
-> UserId
-> Maybe PostId
-> ServerTime
-> ServerTime
-> ServerTime
-> Text
-> Text
-> Int
-> Text
-> Maybe Int
-> Maybe Int
-> Bool
-> FileInfo
FileInfo { Bool
Int
Maybe Int
Maybe PostId
Text
ServerTime
FileId
UserId
fileInfoHasPreview :: Bool
fileInfoHeight :: Maybe Int
fileInfoWidth :: Maybe Int
fileInfoMimeType :: Text
fileInfoSize :: Int
fileInfoExtension :: Text
fileInfoName :: Text
fileInfoDeleteAt :: ServerTime
fileInfoUpdateAt :: ServerTime
fileInfoCreateAt :: ServerTime
fileInfoPostId :: Maybe PostId
fileInfoUserId :: UserId
fileInfoId :: FileId
fileInfoHasPreview :: Bool
fileInfoHeight :: Maybe Int
fileInfoWidth :: Maybe Int
fileInfoMimeType :: Text
fileInfoSize :: Int
fileInfoExtension :: Text
fileInfoName :: Text
fileInfoDeleteAt :: ServerTime
fileInfoUpdateAt :: ServerTime
fileInfoCreateAt :: ServerTime
fileInfoPostId :: Maybe PostId
fileInfoUserId :: UserId
fileInfoId :: FileId
.. }

--

data Posts
  = Posts
  { Posts -> HashMap PostId Post
postsPosts :: HM.HashMap PostId Post
  , Posts -> Seq PostId
postsOrder :: Seq PostId
  } deriving (ReadPrec [Posts]
ReadPrec Posts
Int -> ReadS Posts
ReadS [Posts]
(Int -> ReadS Posts)
-> ReadS [Posts]
-> ReadPrec Posts
-> ReadPrec [Posts]
-> Read Posts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Posts]
$creadListPrec :: ReadPrec [Posts]
readPrec :: ReadPrec Posts
$creadPrec :: ReadPrec Posts
readList :: ReadS [Posts]
$creadList :: ReadS [Posts]
readsPrec :: Int -> ReadS Posts
$creadsPrec :: Int -> ReadS Posts
Read, Int -> Posts -> ShowS
[Posts] -> ShowS
Posts -> String
(Int -> Posts -> ShowS)
-> (Posts -> String) -> ([Posts] -> ShowS) -> Show Posts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Posts] -> ShowS
$cshowList :: [Posts] -> ShowS
show :: Posts -> String
$cshow :: Posts -> String
showsPrec :: Int -> Posts -> ShowS
$cshowsPrec :: Int -> Posts -> ShowS
Show, Posts -> Posts -> Bool
(Posts -> Posts -> Bool) -> (Posts -> Posts -> Bool) -> Eq Posts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Posts -> Posts -> Bool
$c/= :: Posts -> Posts -> Bool
== :: Posts -> Posts -> Bool
$c== :: Posts -> Posts -> Bool
Eq)

instance A.FromJSON Posts where
  parseJSON :: Value -> Parser Posts
parseJSON = String -> (Object -> Parser Posts) -> Value -> Parser Posts
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Posts" ((Object -> Parser Posts) -> Value -> Parser Posts)
-> (Object -> Parser Posts) -> Value -> Parser Posts
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    HashMap PostId Post
postsPosts <- Object
v Object -> Text -> Parser (Maybe (HashMap PostId Post))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"posts" Parser (Maybe (HashMap PostId Post))
-> HashMap PostId Post -> Parser (HashMap PostId Post)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap PostId Post
forall k v. HashMap k v
HM.empty
    Seq PostId
postsOrder <- Object
v Object -> Text -> Parser (Seq PostId)
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"order"
    Posts -> Parser Posts
forall (m :: * -> *) a. Monad m => a -> m a
return Posts :: HashMap PostId Post -> Seq PostId -> Posts
Posts { HashMap PostId Post
Seq PostId
postsOrder :: Seq PostId
postsPosts :: HashMap PostId Post
postsOrder :: Seq PostId
postsPosts :: HashMap PostId Post
.. }

--

-- The JSON specification of times exchanged with the server are in
-- integer milliSeconds; convert to and from the local ServerTime
-- internal value.

timeFromServer :: Integer -> ServerTime
timeFromServer :: Integer -> ServerTime
timeFromServer Integer
ms = UTCTime -> ServerTime
ServerTime (UTCTime -> ServerTime) -> UTCTime -> ServerTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime
posixSecondsToUTCTime (Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Integer
msInteger -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
1000))

timeToServer :: ServerTime -> Int
timeToServer :: ServerTime -> Int
timeToServer ServerTime
time = NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate ((UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds (UTCTime -> NominalDiffTime) -> UTCTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ServerTime -> UTCTime
withServerTime ServerTime
time)NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
1000)

--

data MinCommand
  = MinCommand
  { MinCommand -> ChannelId
minComChannelId :: ChannelId
  , MinCommand -> Text
minComCommand   :: Text
  , MinCommand -> Maybe PostId
minComParentId  :: Maybe PostId
  , MinCommand -> Maybe PostId
minComRootId    :: Maybe PostId
  , MinCommand -> TeamId
minComTeamId    :: TeamId
  } deriving (ReadPrec [MinCommand]
ReadPrec MinCommand
Int -> ReadS MinCommand
ReadS [MinCommand]
(Int -> ReadS MinCommand)
-> ReadS [MinCommand]
-> ReadPrec MinCommand
-> ReadPrec [MinCommand]
-> Read MinCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MinCommand]
$creadListPrec :: ReadPrec [MinCommand]
readPrec :: ReadPrec MinCommand
$creadPrec :: ReadPrec MinCommand
readList :: ReadS [MinCommand]
$creadList :: ReadS [MinCommand]
readsPrec :: Int -> ReadS MinCommand
$creadsPrec :: Int -> ReadS MinCommand
Read, Int -> MinCommand -> ShowS
[MinCommand] -> ShowS
MinCommand -> String
(Int -> MinCommand -> ShowS)
-> (MinCommand -> String)
-> ([MinCommand] -> ShowS)
-> Show MinCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinCommand] -> ShowS
$cshowList :: [MinCommand] -> ShowS
show :: MinCommand -> String
$cshow :: MinCommand -> String
showsPrec :: Int -> MinCommand -> ShowS
$cshowsPrec :: Int -> MinCommand -> ShowS
Show, MinCommand -> MinCommand -> Bool
(MinCommand -> MinCommand -> Bool)
-> (MinCommand -> MinCommand -> Bool) -> Eq MinCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MinCommand -> MinCommand -> Bool
$c/= :: MinCommand -> MinCommand -> Bool
== :: MinCommand -> MinCommand -> Bool
$c== :: MinCommand -> MinCommand -> Bool
Eq)

instance A.ToJSON MinCommand where
  toJSON :: MinCommand -> Value
toJSON MinCommand { Maybe PostId
Text
ChannelId
TeamId
minComTeamId :: TeamId
minComRootId :: Maybe PostId
minComParentId :: Maybe PostId
minComCommand :: Text
minComChannelId :: ChannelId
minComTeamId :: MinCommand -> TeamId
minComRootId :: MinCommand -> Maybe PostId
minComParentId :: MinCommand -> Maybe PostId
minComCommand :: MinCommand -> Text
minComChannelId :: MinCommand -> ChannelId
.. } = [Pair] -> Value
A.object
    [ Text
"channel_id" Text -> ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChannelId
minComChannelId
    , Text
"command"   Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
minComCommand
    , Text
"parent_id" Text -> Maybe PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe PostId
minComParentId
    , Text
"root_id" Text -> Maybe PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe PostId
minComRootId
    , Text
"team_id" Text -> TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TeamId
minComTeamId
    ]

--

data Command
  = Command
  { Command -> Maybe CommandId
commandId               :: Maybe CommandId
  , Command -> Text
commandToken            :: Text
  , Command -> ServerTime
commandCreateAt         :: ServerTime
  , Command -> ServerTime
commandUpdateAt         :: ServerTime
  , Command -> ServerTime
commandDeleteAt         :: ServerTime
  , Command -> Maybe UserId
commandCreatorId        :: Maybe UserId
  , Command -> Maybe TeamId
commandTeamId           :: Maybe TeamId
  , Command -> Text
commandTrigger          :: Text
  , Command -> Text
commandMethod           :: Text
  , Command -> Text
commandUsername         :: Text
  , Command -> Text
commandIconURL          :: Text
  , Command -> Bool
commandAutoComplete     :: Bool
  , Command -> Text
commandAutoCompleteDesc :: Text
  , Command -> Text
commandAutoCompleteHint :: Text
  , Command -> Text
commandDisplayName      :: Text
  , Command -> Text
commandDescription      :: Text
  , Command -> Text
commandURL              :: Text
  } deriving (ReadPrec [Command]
ReadPrec Command
Int -> ReadS Command
ReadS [Command]
(Int -> ReadS Command)
-> ReadS [Command]
-> ReadPrec Command
-> ReadPrec [Command]
-> Read Command
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Command]
$creadListPrec :: ReadPrec [Command]
readPrec :: ReadPrec Command
$creadPrec :: ReadPrec Command
readList :: ReadS [Command]
$creadList :: ReadS [Command]
readsPrec :: Int -> ReadS Command
$creadsPrec :: Int -> ReadS Command
Read, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq)

instance A.FromJSON Command where
    parseJSON :: Value -> Parser Command
parseJSON = String -> (Object -> Parser Command) -> Value -> Parser Command
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"command" ((Object -> Parser Command) -> Value -> Parser Command)
-> (Object -> Parser Command) -> Value -> Parser Command
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Maybe CommandId
-> Text
-> ServerTime
-> ServerTime
-> ServerTime
-> Maybe UserId
-> Maybe TeamId
-> Text
-> Text
-> Text
-> Text
-> Bool
-> Text
-> Text
-> Text
-> Text
-> Text
-> Command
Command (Maybe CommandId
 -> Text
 -> ServerTime
 -> ServerTime
 -> ServerTime
 -> Maybe UserId
 -> Maybe TeamId
 -> Text
 -> Text
 -> Text
 -> Text
 -> Bool
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Command)
-> Parser (Maybe CommandId)
-> Parser
     (Text
      -> ServerTime
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> Maybe TeamId
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser CommandId -> Parser (Maybe CommandId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Parser CommandId -> Parser (Maybe CommandId))
-> Parser CommandId -> Parser (Maybe CommandId)
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Text -> Parser CommandId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id")
                Parser
  (Text
   -> ServerTime
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> Maybe TeamId
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser Text
-> Parser
     (ServerTime
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> Maybe TeamId
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"token"
                Parser
  (ServerTime
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> Maybe TeamId
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser ServerTime
-> Parser
     (ServerTime
      -> ServerTime
      -> Maybe UserId
      -> Maybe TeamId
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"create_at"))
                Parser
  (ServerTime
   -> ServerTime
   -> Maybe UserId
   -> Maybe TeamId
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser ServerTime
-> Parser
     (ServerTime
      -> Maybe UserId
      -> Maybe TeamId
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"update_at"))
                Parser
  (ServerTime
   -> Maybe UserId
   -> Maybe TeamId
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser ServerTime
-> Parser
     (Maybe UserId
      -> Maybe TeamId
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"delete_at"))
                Parser
  (Maybe UserId
   -> Maybe TeamId
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser (Maybe UserId)
-> Parser
     (Maybe TeamId
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser UserId -> Parser (Maybe UserId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Parser UserId -> Parser (Maybe UserId))
-> Parser UserId -> Parser (Maybe UserId)
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"creator_id")
                Parser
  (Maybe TeamId
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser (Maybe TeamId)
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser TeamId -> Parser (Maybe TeamId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Parser TeamId -> Parser (Maybe TeamId))
-> Parser TeamId -> Parser (Maybe TeamId)
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Text -> Parser TeamId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"team_id")
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"trigger"
                Parser
  (Text
   -> Text
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Command)
-> Parser Text
-> Parser
     (Text
      -> Text -> Bool -> Text -> Text -> Text -> Text -> Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"method"
                Parser
  (Text
   -> Text -> Bool -> Text -> Text -> Text -> Text -> Text -> Command)
-> Parser Text
-> Parser
     (Text -> Bool -> Text -> Text -> Text -> Text -> Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"username"
                Parser
  (Text -> Bool -> Text -> Text -> Text -> Text -> Text -> Command)
-> Parser Text
-> Parser (Bool -> Text -> Text -> Text -> Text -> Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"icon_url"
                Parser (Bool -> Text -> Text -> Text -> Text -> Text -> Command)
-> Parser Bool
-> Parser (Text -> Text -> Text -> Text -> Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"auto_complete"
                Parser (Text -> Text -> Text -> Text -> Text -> Command)
-> Parser Text -> Parser (Text -> Text -> Text -> Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"auto_complete_desc"
                Parser (Text -> Text -> Text -> Text -> Command)
-> Parser Text -> Parser (Text -> Text -> Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"auto_complete_hint"
                Parser (Text -> Text -> Text -> Command)
-> Parser Text -> Parser (Text -> Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"display_name"
                Parser (Text -> Text -> Command)
-> Parser Text -> Parser (Text -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"description"
                Parser (Text -> Command) -> Parser Text -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"url"

instance A.ToJSON Command where toJSON :: Command -> Value
toJSON = String -> Command -> Value
forall a. HasCallStack => String -> a
error String
"to command"

newtype CommandId = CmdI { CommandId -> Id
unCmdI :: Id }
  deriving (ReadPrec [CommandId]
ReadPrec CommandId
Int -> ReadS CommandId
ReadS [CommandId]
(Int -> ReadS CommandId)
-> ReadS [CommandId]
-> ReadPrec CommandId
-> ReadPrec [CommandId]
-> Read CommandId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandId]
$creadListPrec :: ReadPrec [CommandId]
readPrec :: ReadPrec CommandId
$creadPrec :: ReadPrec CommandId
readList :: ReadS [CommandId]
$creadList :: ReadS [CommandId]
readsPrec :: Int -> ReadS CommandId
$creadsPrec :: Int -> ReadS CommandId
Read, Int -> CommandId -> ShowS
[CommandId] -> ShowS
CommandId -> String
(Int -> CommandId -> ShowS)
-> (CommandId -> String)
-> ([CommandId] -> ShowS)
-> Show CommandId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandId] -> ShowS
$cshowList :: [CommandId] -> ShowS
show :: CommandId -> String
$cshow :: CommandId -> String
showsPrec :: Int -> CommandId -> ShowS
$cshowsPrec :: Int -> CommandId -> ShowS
Show, CommandId -> CommandId -> Bool
(CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool) -> Eq CommandId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandId -> CommandId -> Bool
$c/= :: CommandId -> CommandId -> Bool
== :: CommandId -> CommandId -> Bool
$c== :: CommandId -> CommandId -> Bool
Eq, Eq CommandId
Eq CommandId
-> (CommandId -> CommandId -> Ordering)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> CommandId)
-> (CommandId -> CommandId -> CommandId)
-> Ord CommandId
CommandId -> CommandId -> Bool
CommandId -> CommandId -> Ordering
CommandId -> CommandId -> CommandId
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 :: CommandId -> CommandId -> CommandId
$cmin :: CommandId -> CommandId -> CommandId
max :: CommandId -> CommandId -> CommandId
$cmax :: CommandId -> CommandId -> CommandId
>= :: CommandId -> CommandId -> Bool
$c>= :: CommandId -> CommandId -> Bool
> :: CommandId -> CommandId -> Bool
$c> :: CommandId -> CommandId -> Bool
<= :: CommandId -> CommandId -> Bool
$c<= :: CommandId -> CommandId -> Bool
< :: CommandId -> CommandId -> Bool
$c< :: CommandId -> CommandId -> Bool
compare :: CommandId -> CommandId -> Ordering
$ccompare :: CommandId -> CommandId -> Ordering
$cp1Ord :: Eq CommandId
Ord, Int -> CommandId -> Int
CommandId -> Int
(Int -> CommandId -> Int)
-> (CommandId -> Int) -> Hashable CommandId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: CommandId -> Int
$chash :: CommandId -> Int
hashWithSalt :: Int -> CommandId -> Int
$chashWithSalt :: Int -> CommandId -> Int
Hashable, [CommandId] -> Encoding
[CommandId] -> Value
CommandId -> Encoding
CommandId -> Value
(CommandId -> Value)
-> (CommandId -> Encoding)
-> ([CommandId] -> Value)
-> ([CommandId] -> Encoding)
-> ToJSON CommandId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CommandId] -> Encoding
$ctoEncodingList :: [CommandId] -> Encoding
toJSONList :: [CommandId] -> Value
$ctoJSONList :: [CommandId] -> Value
toEncoding :: CommandId -> Encoding
$ctoEncoding :: CommandId -> Encoding
toJSON :: CommandId -> Value
$ctoJSON :: CommandId -> Value
ToJSON, ToJSONKeyFunction [CommandId]
ToJSONKeyFunction CommandId
ToJSONKeyFunction CommandId
-> ToJSONKeyFunction [CommandId] -> ToJSONKey CommandId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [CommandId]
$ctoJSONKeyList :: ToJSONKeyFunction [CommandId]
toJSONKey :: ToJSONKeyFunction CommandId
$ctoJSONKey :: ToJSONKeyFunction CommandId
ToJSONKey, FromJSONKeyFunction [CommandId]
FromJSONKeyFunction CommandId
FromJSONKeyFunction CommandId
-> FromJSONKeyFunction [CommandId] -> FromJSONKey CommandId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [CommandId]
$cfromJSONKeyList :: FromJSONKeyFunction [CommandId]
fromJSONKey :: FromJSONKeyFunction CommandId
$cfromJSONKey :: FromJSONKeyFunction CommandId
FromJSONKey, Value -> Parser [CommandId]
Value -> Parser CommandId
(Value -> Parser CommandId)
-> (Value -> Parser [CommandId]) -> FromJSON CommandId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CommandId]
$cparseJSONList :: Value -> Parser [CommandId]
parseJSON :: Value -> Parser CommandId
$cparseJSON :: Value -> Parser CommandId
FromJSON)

instance IsId CommandId where
  toId :: CommandId -> Id
toId   = CommandId -> Id
unCmdI
  fromId :: Id -> CommandId
fromId = Id -> CommandId
CmdI

instance PrintfArg CommandId where
  formatArg :: CommandId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (CommandId -> Text) -> CommandId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandId -> Text
forall x. IsId x => x -> Text
idString

data CommandResponseType
  = CommandResponseInChannel
  | CommandResponseEphemeral
    deriving (ReadPrec [CommandResponseType]
ReadPrec CommandResponseType
Int -> ReadS CommandResponseType
ReadS [CommandResponseType]
(Int -> ReadS CommandResponseType)
-> ReadS [CommandResponseType]
-> ReadPrec CommandResponseType
-> ReadPrec [CommandResponseType]
-> Read CommandResponseType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandResponseType]
$creadListPrec :: ReadPrec [CommandResponseType]
readPrec :: ReadPrec CommandResponseType
$creadPrec :: ReadPrec CommandResponseType
readList :: ReadS [CommandResponseType]
$creadList :: ReadS [CommandResponseType]
readsPrec :: Int -> ReadS CommandResponseType
$creadsPrec :: Int -> ReadS CommandResponseType
Read, Int -> CommandResponseType -> ShowS
[CommandResponseType] -> ShowS
CommandResponseType -> String
(Int -> CommandResponseType -> ShowS)
-> (CommandResponseType -> String)
-> ([CommandResponseType] -> ShowS)
-> Show CommandResponseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandResponseType] -> ShowS
$cshowList :: [CommandResponseType] -> ShowS
show :: CommandResponseType -> String
$cshow :: CommandResponseType -> String
showsPrec :: Int -> CommandResponseType -> ShowS
$cshowsPrec :: Int -> CommandResponseType -> ShowS
Show, CommandResponseType -> CommandResponseType -> Bool
(CommandResponseType -> CommandResponseType -> Bool)
-> (CommandResponseType -> CommandResponseType -> Bool)
-> Eq CommandResponseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandResponseType -> CommandResponseType -> Bool
$c/= :: CommandResponseType -> CommandResponseType -> Bool
== :: CommandResponseType -> CommandResponseType -> Bool
$c== :: CommandResponseType -> CommandResponseType -> Bool
Eq)

instance A.FromJSON CommandResponseType where
  parseJSON :: Value -> Parser CommandResponseType
parseJSON (A.String Text
"in_channel") = CommandResponseType -> Parser CommandResponseType
forall (m :: * -> *) a. Monad m => a -> m a
return CommandResponseType
CommandResponseInChannel
  parseJSON (A.String Text
"ephemeral")  = CommandResponseType -> Parser CommandResponseType
forall (m :: * -> *) a. Monad m => a -> m a
return CommandResponseType
CommandResponseEphemeral
  parseJSON Value
_ = String -> Parser CommandResponseType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown command response type: expected `in_channel` or `ephemeral`"

data CommandResponse
  = CommandResponse
  { CommandResponse -> Maybe CommandResponseType
commandResponseType         :: Maybe CommandResponseType
  , CommandResponse -> Text
commandResponseText         :: Text
  , CommandResponse -> Text
commandResponseUsername     :: Text
  , CommandResponse -> Text
commandResponseIconURL      :: Text
  , CommandResponse -> Text
commandResponseGotoLocation :: Text
  , CommandResponse -> Seq PostPropAttachment
commandResponseAttachments  :: Seq PostPropAttachment
  } deriving (ReadPrec [CommandResponse]
ReadPrec CommandResponse
Int -> ReadS CommandResponse
ReadS [CommandResponse]
(Int -> ReadS CommandResponse)
-> ReadS [CommandResponse]
-> ReadPrec CommandResponse
-> ReadPrec [CommandResponse]
-> Read CommandResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandResponse]
$creadListPrec :: ReadPrec [CommandResponse]
readPrec :: ReadPrec CommandResponse
$creadPrec :: ReadPrec CommandResponse
readList :: ReadS [CommandResponse]
$creadList :: ReadS [CommandResponse]
readsPrec :: Int -> ReadS CommandResponse
$creadsPrec :: Int -> ReadS CommandResponse
Read, Int -> CommandResponse -> ShowS
[CommandResponse] -> ShowS
CommandResponse -> String
(Int -> CommandResponse -> ShowS)
-> (CommandResponse -> String)
-> ([CommandResponse] -> ShowS)
-> Show CommandResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandResponse] -> ShowS
$cshowList :: [CommandResponse] -> ShowS
show :: CommandResponse -> String
$cshow :: CommandResponse -> String
showsPrec :: Int -> CommandResponse -> ShowS
$cshowsPrec :: Int -> CommandResponse -> ShowS
Show, CommandResponse -> CommandResponse -> Bool
(CommandResponse -> CommandResponse -> Bool)
-> (CommandResponse -> CommandResponse -> Bool)
-> Eq CommandResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandResponse -> CommandResponse -> Bool
$c/= :: CommandResponse -> CommandResponse -> Bool
== :: CommandResponse -> CommandResponse -> Bool
$c== :: CommandResponse -> CommandResponse -> Bool
Eq)

instance A.FromJSON CommandResponse where
  parseJSON :: Value -> Parser CommandResponse
parseJSON = String
-> (Object -> Parser CommandResponse)
-> Value
-> Parser CommandResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CommandResponse" ((Object -> Parser CommandResponse)
 -> Value -> Parser CommandResponse)
-> (Object -> Parser CommandResponse)
-> Value
-> Parser CommandResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe CommandResponseType
commandResponseType         <- Parser CommandResponseType -> Parser (Maybe CommandResponseType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Object
o Object -> Text -> Parser CommandResponseType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"response_type")
    Text
commandResponseText         <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"text"
    Text
commandResponseUsername     <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
    Text
commandResponseIconURL      <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"icon_url"
    Text
commandResponseGotoLocation <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"goto_location"
    Seq PostPropAttachment
commandResponseAttachments  <- Object
o Object -> Text -> Parser (Maybe (Seq PostPropAttachment))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"attachments" Parser (Maybe (Seq PostPropAttachment))
-> Seq PostPropAttachment -> Parser (Seq PostPropAttachment)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Seq PostPropAttachment
forall a. Seq a
S.empty
    CommandResponse -> Parser CommandResponse
forall (m :: * -> *) a. Monad m => a -> m a
return CommandResponse :: Maybe CommandResponseType
-> Text
-> Text
-> Text
-> Text
-> Seq PostPropAttachment
-> CommandResponse
CommandResponse { Maybe CommandResponseType
Text
Seq PostPropAttachment
commandResponseAttachments :: Seq PostPropAttachment
commandResponseGotoLocation :: Text
commandResponseIconURL :: Text
commandResponseUsername :: Text
commandResponseText :: Text
commandResponseType :: Maybe CommandResponseType
commandResponseAttachments :: Seq PostPropAttachment
commandResponseGotoLocation :: Text
commandResponseIconURL :: Text
commandResponseUsername :: Text
commandResponseText :: Text
commandResponseType :: Maybe CommandResponseType
.. }

--

data UsersCreate
  = UsersCreate
  { UsersCreate -> Text
usersCreateEmail          :: Text
  , UsersCreate -> Text
usersCreatePassword       :: Text
  , UsersCreate -> Text
usersCreateUsername       :: Text
  , UsersCreate -> Bool
usersCreateAllowMarketing :: Bool
  } deriving (ReadPrec [UsersCreate]
ReadPrec UsersCreate
Int -> ReadS UsersCreate
ReadS [UsersCreate]
(Int -> ReadS UsersCreate)
-> ReadS [UsersCreate]
-> ReadPrec UsersCreate
-> ReadPrec [UsersCreate]
-> Read UsersCreate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UsersCreate]
$creadListPrec :: ReadPrec [UsersCreate]
readPrec :: ReadPrec UsersCreate
$creadPrec :: ReadPrec UsersCreate
readList :: ReadS [UsersCreate]
$creadList :: ReadS [UsersCreate]
readsPrec :: Int -> ReadS UsersCreate
$creadsPrec :: Int -> ReadS UsersCreate
Read, Int -> UsersCreate -> ShowS
[UsersCreate] -> ShowS
UsersCreate -> String
(Int -> UsersCreate -> ShowS)
-> (UsersCreate -> String)
-> ([UsersCreate] -> ShowS)
-> Show UsersCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsersCreate] -> ShowS
$cshowList :: [UsersCreate] -> ShowS
show :: UsersCreate -> String
$cshow :: UsersCreate -> String
showsPrec :: Int -> UsersCreate -> ShowS
$cshowsPrec :: Int -> UsersCreate -> ShowS
Show, UsersCreate -> UsersCreate -> Bool
(UsersCreate -> UsersCreate -> Bool)
-> (UsersCreate -> UsersCreate -> Bool) -> Eq UsersCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsersCreate -> UsersCreate -> Bool
$c/= :: UsersCreate -> UsersCreate -> Bool
== :: UsersCreate -> UsersCreate -> Bool
$c== :: UsersCreate -> UsersCreate -> Bool
Eq)

instance A.ToJSON UsersCreate where
  toJSON :: UsersCreate -> Value
toJSON UsersCreate { Bool
Text
usersCreateAllowMarketing :: Bool
usersCreateUsername :: Text
usersCreatePassword :: Text
usersCreateEmail :: Text
usersCreateAllowMarketing :: UsersCreate -> Bool
usersCreateUsername :: UsersCreate -> Text
usersCreatePassword :: UsersCreate -> Text
usersCreateEmail :: UsersCreate -> Text
.. } = [Pair] -> Value
A.object
    [ Text
"email"           Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
usersCreateEmail
    , Text
"allow_marketing" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
usersCreateAllowMarketing
    , Text
"password"        Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
usersCreatePassword
    , Text
"username"        Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
usersCreateUsername
    ]

--

data TeamsCreate
  = TeamsCreate
  { TeamsCreate -> Text
teamsCreateDisplayName :: Text
  , TeamsCreate -> Text
teamsCreateName        :: Text
  , TeamsCreate -> Type
teamsCreateType        :: Type
  } deriving (ReadPrec [TeamsCreate]
ReadPrec TeamsCreate
Int -> ReadS TeamsCreate
ReadS [TeamsCreate]
(Int -> ReadS TeamsCreate)
-> ReadS [TeamsCreate]
-> ReadPrec TeamsCreate
-> ReadPrec [TeamsCreate]
-> Read TeamsCreate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TeamsCreate]
$creadListPrec :: ReadPrec [TeamsCreate]
readPrec :: ReadPrec TeamsCreate
$creadPrec :: ReadPrec TeamsCreate
readList :: ReadS [TeamsCreate]
$creadList :: ReadS [TeamsCreate]
readsPrec :: Int -> ReadS TeamsCreate
$creadsPrec :: Int -> ReadS TeamsCreate
Read, Int -> TeamsCreate -> ShowS
[TeamsCreate] -> ShowS
TeamsCreate -> String
(Int -> TeamsCreate -> ShowS)
-> (TeamsCreate -> String)
-> ([TeamsCreate] -> ShowS)
-> Show TeamsCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamsCreate] -> ShowS
$cshowList :: [TeamsCreate] -> ShowS
show :: TeamsCreate -> String
$cshow :: TeamsCreate -> String
showsPrec :: Int -> TeamsCreate -> ShowS
$cshowsPrec :: Int -> TeamsCreate -> ShowS
Show, TeamsCreate -> TeamsCreate -> Bool
(TeamsCreate -> TeamsCreate -> Bool)
-> (TeamsCreate -> TeamsCreate -> Bool) -> Eq TeamsCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamsCreate -> TeamsCreate -> Bool
$c/= :: TeamsCreate -> TeamsCreate -> Bool
== :: TeamsCreate -> TeamsCreate -> Bool
$c== :: TeamsCreate -> TeamsCreate -> Bool
Eq)

instance A.ToJSON TeamsCreate where
  toJSON :: TeamsCreate -> Value
toJSON TeamsCreate { Text
Type
teamsCreateType :: Type
teamsCreateName :: Text
teamsCreateDisplayName :: Text
teamsCreateType :: TeamsCreate -> Type
teamsCreateName :: TeamsCreate -> Text
teamsCreateDisplayName :: TeamsCreate -> Text
.. } = [Pair] -> Value
A.object
    [ Text
"display_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
teamsCreateDisplayName
    , Text
"name"         Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
teamsCreateName
    , Text
"type"         Text -> Type -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Type
teamsCreateType
    ]

--

data Reaction
  = Reaction
  { Reaction -> UserId
reactionUserId    :: UserId
  , Reaction -> PostId
reactionPostId    :: PostId
  , Reaction -> Text
reactionEmojiName :: Text
  , Reaction -> ServerTime
reactionCreateAt  :: ServerTime
  } deriving (ReadPrec [Reaction]
ReadPrec Reaction
Int -> ReadS Reaction
ReadS [Reaction]
(Int -> ReadS Reaction)
-> ReadS [Reaction]
-> ReadPrec Reaction
-> ReadPrec [Reaction]
-> Read Reaction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reaction]
$creadListPrec :: ReadPrec [Reaction]
readPrec :: ReadPrec Reaction
$creadPrec :: ReadPrec Reaction
readList :: ReadS [Reaction]
$creadList :: ReadS [Reaction]
readsPrec :: Int -> ReadS Reaction
$creadsPrec :: Int -> ReadS Reaction
Read, Int -> Reaction -> ShowS
[Reaction] -> ShowS
Reaction -> String
(Int -> Reaction -> ShowS)
-> (Reaction -> String) -> ([Reaction] -> ShowS) -> Show Reaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reaction] -> ShowS
$cshowList :: [Reaction] -> ShowS
show :: Reaction -> String
$cshow :: Reaction -> String
showsPrec :: Int -> Reaction -> ShowS
$cshowsPrec :: Int -> Reaction -> ShowS
Show, Reaction -> Reaction -> Bool
(Reaction -> Reaction -> Bool)
-> (Reaction -> Reaction -> Bool) -> Eq Reaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reaction -> Reaction -> Bool
$c/= :: Reaction -> Reaction -> Bool
== :: Reaction -> Reaction -> Bool
$c== :: Reaction -> Reaction -> Bool
Eq)

instance A.FromJSON Reaction where
  parseJSON :: Value -> Parser Reaction
parseJSON = String -> (Object -> Parser Reaction) -> Value -> Parser Reaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Reaction" ((Object -> Parser Reaction) -> Value -> Parser Reaction)
-> (Object -> Parser Reaction) -> Value -> Parser Reaction
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    UserId
reactionUserId    <- Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
    PostId
reactionPostId    <- Object
v Object -> Text -> Parser PostId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"post_id"
    Text
reactionEmojiName <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"emoji_name"
    ServerTime
reactionCreateAt  <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"create_at"
    Reaction -> Parser Reaction
forall (m :: * -> *) a. Monad m => a -> m a
return Reaction :: UserId -> PostId -> Text -> ServerTime -> Reaction
Reaction { Text
ServerTime
PostId
UserId
reactionCreateAt :: ServerTime
reactionEmojiName :: Text
reactionPostId :: PostId
reactionUserId :: UserId
reactionCreateAt :: ServerTime
reactionEmojiName :: Text
reactionPostId :: PostId
reactionUserId :: UserId
.. }

instance A.ToJSON Reaction where
  toJSON :: Reaction -> Value
toJSON Reaction {Text
ServerTime
PostId
UserId
reactionCreateAt :: ServerTime
reactionEmojiName :: Text
reactionPostId :: PostId
reactionUserId :: UserId
reactionCreateAt :: Reaction -> ServerTime
reactionEmojiName :: Reaction -> Text
reactionPostId :: Reaction -> PostId
reactionUserId :: Reaction -> UserId
.. } = [Pair] -> Value
A.object
    [ Text
"user_id"    Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UserId
reactionUserId
    , Text
"post_id"    Text -> PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PostId
reactionPostId
    , Text
"emoji_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
reactionEmojiName
    , Text
"create_at"  Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ServerTime -> Int
timeToServer ServerTime
reactionCreateAt
    ]

-- * Preferences

data PreferenceCategory
  = PreferenceCategoryDirectChannelShow
  | PreferenceCategoryGroupChannelShow
  | PreferenceCategoryFavoriteChannel
  | PreferenceCategoryTutorialStep
  | PreferenceCategoryAdvancedSettings
  | PreferenceCategoryFlaggedPost
  | PreferenceCategoryDisplaySettings
  | PreferenceCategoryTheme
  | PreferenceCategoryAuthorizedOAuthApp
  | PreferenceCategoryNotifications
  | PreferenceCategoryLast
  | PreferenceCategoryTeamsOrder
  | PreferenceCategoryOther Text
    deriving (ReadPrec [PreferenceCategory]
ReadPrec PreferenceCategory
Int -> ReadS PreferenceCategory
ReadS [PreferenceCategory]
(Int -> ReadS PreferenceCategory)
-> ReadS [PreferenceCategory]
-> ReadPrec PreferenceCategory
-> ReadPrec [PreferenceCategory]
-> Read PreferenceCategory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PreferenceCategory]
$creadListPrec :: ReadPrec [PreferenceCategory]
readPrec :: ReadPrec PreferenceCategory
$creadPrec :: ReadPrec PreferenceCategory
readList :: ReadS [PreferenceCategory]
$creadList :: ReadS [PreferenceCategory]
readsPrec :: Int -> ReadS PreferenceCategory
$creadsPrec :: Int -> ReadS PreferenceCategory
Read, Int -> PreferenceCategory -> ShowS
[PreferenceCategory] -> ShowS
PreferenceCategory -> String
(Int -> PreferenceCategory -> ShowS)
-> (PreferenceCategory -> String)
-> ([PreferenceCategory] -> ShowS)
-> Show PreferenceCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreferenceCategory] -> ShowS
$cshowList :: [PreferenceCategory] -> ShowS
show :: PreferenceCategory -> String
$cshow :: PreferenceCategory -> String
showsPrec :: Int -> PreferenceCategory -> ShowS
$cshowsPrec :: Int -> PreferenceCategory -> ShowS
Show, PreferenceCategory -> PreferenceCategory -> Bool
(PreferenceCategory -> PreferenceCategory -> Bool)
-> (PreferenceCategory -> PreferenceCategory -> Bool)
-> Eq PreferenceCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferenceCategory -> PreferenceCategory -> Bool
$c/= :: PreferenceCategory -> PreferenceCategory -> Bool
== :: PreferenceCategory -> PreferenceCategory -> Bool
$c== :: PreferenceCategory -> PreferenceCategory -> Bool
Eq)

instance A.FromJSON PreferenceCategory where
  parseJSON :: Value -> Parser PreferenceCategory
parseJSON = String
-> (Text -> Parser PreferenceCategory)
-> Value
-> Parser PreferenceCategory
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"PreferenceCategory" ((Text -> Parser PreferenceCategory)
 -> Value -> Parser PreferenceCategory)
-> (Text -> Parser PreferenceCategory)
-> Value
-> Parser PreferenceCategory
forall a b. (a -> b) -> a -> b
$ \Text
t -> PreferenceCategory -> Parser PreferenceCategory
forall (m :: * -> *) a. Monad m => a -> m a
return (PreferenceCategory -> Parser PreferenceCategory)
-> PreferenceCategory -> Parser PreferenceCategory
forall a b. (a -> b) -> a -> b
$ case Text
t of
    Text
"direct_channel_show"   -> PreferenceCategory
PreferenceCategoryDirectChannelShow
    Text
"group_channel_show"    -> PreferenceCategory
PreferenceCategoryGroupChannelShow
    Text
"favorite_channel"      -> PreferenceCategory
PreferenceCategoryFavoriteChannel
    Text
"tutorial_step"         -> PreferenceCategory
PreferenceCategoryTutorialStep
    Text
"advanced_settings"     -> PreferenceCategory
PreferenceCategoryAdvancedSettings
    Text
"flagged_post"          -> PreferenceCategory
PreferenceCategoryFlaggedPost
    Text
"display_settings"      -> PreferenceCategory
PreferenceCategoryDisplaySettings
    Text
"theme"                 -> PreferenceCategory
PreferenceCategoryTheme
    Text
"oauth_app"             -> PreferenceCategory
PreferenceCategoryAuthorizedOAuthApp
    Text
"notifications"         -> PreferenceCategory
PreferenceCategoryNotifications
    Text
"last"                  -> PreferenceCategory
PreferenceCategoryLast
    Text
"teams_order"           -> PreferenceCategory
PreferenceCategoryTeamsOrder
    Text
_                       -> Text -> PreferenceCategory
PreferenceCategoryOther Text
t

instance A.ToJSON PreferenceCategory where
  toJSON :: PreferenceCategory -> Value
toJSON PreferenceCategory
cat = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case PreferenceCategory
cat of
    PreferenceCategory
PreferenceCategoryDirectChannelShow   -> Text
"direct_channel_show"
    PreferenceCategory
PreferenceCategoryGroupChannelShow    -> Text
"group_channel_show"
    PreferenceCategory
PreferenceCategoryFavoriteChannel     -> Text
"favorite_channel"
    PreferenceCategory
PreferenceCategoryTutorialStep        -> Text
"tutorial_step"
    PreferenceCategory
PreferenceCategoryAdvancedSettings    -> Text
"advanced_settings"
    PreferenceCategory
PreferenceCategoryFlaggedPost         -> Text
"flagged_post"
    PreferenceCategory
PreferenceCategoryDisplaySettings     -> Text
"display_settings"
    PreferenceCategory
PreferenceCategoryTheme               -> Text
"theme"
    PreferenceCategory
PreferenceCategoryAuthorizedOAuthApp  -> Text
"oauth_app"
    PreferenceCategory
PreferenceCategoryNotifications       -> Text
"notifications"
    PreferenceCategory
PreferenceCategoryLast                -> Text
"last"
    PreferenceCategory
PreferenceCategoryTeamsOrder          -> Text
"teams_order"
    PreferenceCategoryOther Text
t             -> Text
t

data PreferenceName
  = PreferenceName { PreferenceName -> Text
fromRawPreferenceName :: Text }
    deriving (ReadPrec [PreferenceName]
ReadPrec PreferenceName
Int -> ReadS PreferenceName
ReadS [PreferenceName]
(Int -> ReadS PreferenceName)
-> ReadS [PreferenceName]
-> ReadPrec PreferenceName
-> ReadPrec [PreferenceName]
-> Read PreferenceName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PreferenceName]
$creadListPrec :: ReadPrec [PreferenceName]
readPrec :: ReadPrec PreferenceName
$creadPrec :: ReadPrec PreferenceName
readList :: ReadS [PreferenceName]
$creadList :: ReadS [PreferenceName]
readsPrec :: Int -> ReadS PreferenceName
$creadsPrec :: Int -> ReadS PreferenceName
Read, Int -> PreferenceName -> ShowS
[PreferenceName] -> ShowS
PreferenceName -> String
(Int -> PreferenceName -> ShowS)
-> (PreferenceName -> String)
-> ([PreferenceName] -> ShowS)
-> Show PreferenceName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreferenceName] -> ShowS
$cshowList :: [PreferenceName] -> ShowS
show :: PreferenceName -> String
$cshow :: PreferenceName -> String
showsPrec :: Int -> PreferenceName -> ShowS
$cshowsPrec :: Int -> PreferenceName -> ShowS
Show, PreferenceName -> PreferenceName -> Bool
(PreferenceName -> PreferenceName -> Bool)
-> (PreferenceName -> PreferenceName -> Bool) -> Eq PreferenceName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferenceName -> PreferenceName -> Bool
$c/= :: PreferenceName -> PreferenceName -> Bool
== :: PreferenceName -> PreferenceName -> Bool
$c== :: PreferenceName -> PreferenceName -> Bool
Eq)

instance A.FromJSON PreferenceName where
  parseJSON :: Value -> Parser PreferenceName
parseJSON = String
-> (Text -> Parser PreferenceName)
-> Value
-> Parser PreferenceName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"PreferenceName" (PreferenceName -> Parser PreferenceName
forall (m :: * -> *) a. Monad m => a -> m a
return (PreferenceName -> Parser PreferenceName)
-> (Text -> PreferenceName) -> Text -> Parser PreferenceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PreferenceName
PreferenceName)

instance A.ToJSON PreferenceName where
  toJSON :: PreferenceName -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (PreferenceName -> Text) -> PreferenceName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreferenceName -> Text
fromRawPreferenceName

data PreferenceValue
  = PreferenceValue { PreferenceValue -> Text
fromRawPreferenceValue :: Text }
    deriving (ReadPrec [PreferenceValue]
ReadPrec PreferenceValue
Int -> ReadS PreferenceValue
ReadS [PreferenceValue]
(Int -> ReadS PreferenceValue)
-> ReadS [PreferenceValue]
-> ReadPrec PreferenceValue
-> ReadPrec [PreferenceValue]
-> Read PreferenceValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PreferenceValue]
$creadListPrec :: ReadPrec [PreferenceValue]
readPrec :: ReadPrec PreferenceValue
$creadPrec :: ReadPrec PreferenceValue
readList :: ReadS [PreferenceValue]
$creadList :: ReadS [PreferenceValue]
readsPrec :: Int -> ReadS PreferenceValue
$creadsPrec :: Int -> ReadS PreferenceValue
Read, Int -> PreferenceValue -> ShowS
[PreferenceValue] -> ShowS
PreferenceValue -> String
(Int -> PreferenceValue -> ShowS)
-> (PreferenceValue -> String)
-> ([PreferenceValue] -> ShowS)
-> Show PreferenceValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreferenceValue] -> ShowS
$cshowList :: [PreferenceValue] -> ShowS
show :: PreferenceValue -> String
$cshow :: PreferenceValue -> String
showsPrec :: Int -> PreferenceValue -> ShowS
$cshowsPrec :: Int -> PreferenceValue -> ShowS
Show, PreferenceValue -> PreferenceValue -> Bool
(PreferenceValue -> PreferenceValue -> Bool)
-> (PreferenceValue -> PreferenceValue -> Bool)
-> Eq PreferenceValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferenceValue -> PreferenceValue -> Bool
$c/= :: PreferenceValue -> PreferenceValue -> Bool
== :: PreferenceValue -> PreferenceValue -> Bool
$c== :: PreferenceValue -> PreferenceValue -> Bool
Eq)

instance A.FromJSON PreferenceValue where
  parseJSON :: Value -> Parser PreferenceValue
parseJSON = String
-> (Text -> Parser PreferenceValue)
-> Value
-> Parser PreferenceValue
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"PreferenceValue" (PreferenceValue -> Parser PreferenceValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PreferenceValue -> Parser PreferenceValue)
-> (Text -> PreferenceValue) -> Text -> Parser PreferenceValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PreferenceValue
PreferenceValue)

instance A.ToJSON PreferenceValue where
  toJSON :: PreferenceValue -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (PreferenceValue -> Text) -> PreferenceValue -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreferenceValue -> Text
fromRawPreferenceValue

data Preference
  = Preference
  { Preference -> UserId
preferenceUserId   :: UserId
  , Preference -> PreferenceCategory
preferenceCategory :: PreferenceCategory
  , Preference -> PreferenceName
preferenceName     :: PreferenceName
  , Preference -> PreferenceValue
preferenceValue    :: PreferenceValue
  } deriving (ReadPrec [Preference]
ReadPrec Preference
Int -> ReadS Preference
ReadS [Preference]
(Int -> ReadS Preference)
-> ReadS [Preference]
-> ReadPrec Preference
-> ReadPrec [Preference]
-> Read Preference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Preference]
$creadListPrec :: ReadPrec [Preference]
readPrec :: ReadPrec Preference
$creadPrec :: ReadPrec Preference
readList :: ReadS [Preference]
$creadList :: ReadS [Preference]
readsPrec :: Int -> ReadS Preference
$creadsPrec :: Int -> ReadS Preference
Read, Int -> Preference -> ShowS
[Preference] -> ShowS
Preference -> String
(Int -> Preference -> ShowS)
-> (Preference -> String)
-> ([Preference] -> ShowS)
-> Show Preference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Preference] -> ShowS
$cshowList :: [Preference] -> ShowS
show :: Preference -> String
$cshow :: Preference -> String
showsPrec :: Int -> Preference -> ShowS
$cshowsPrec :: Int -> Preference -> ShowS
Show, Preference -> Preference -> Bool
(Preference -> Preference -> Bool)
-> (Preference -> Preference -> Bool) -> Eq Preference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Preference -> Preference -> Bool
$c/= :: Preference -> Preference -> Bool
== :: Preference -> Preference -> Bool
$c== :: Preference -> Preference -> Bool
Eq)

instance A.FromJSON Preference where
  parseJSON :: Value -> Parser Preference
parseJSON = String
-> (Object -> Parser Preference) -> Value -> Parser Preference
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Preference" ((Object -> Parser Preference) -> Value -> Parser Preference)
-> (Object -> Parser Preference) -> Value -> Parser Preference
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    UserId
preferenceUserId   <- Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
    PreferenceCategory
preferenceCategory <- Object
v Object -> Text -> Parser PreferenceCategory
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"category"
    PreferenceName
preferenceName     <- Object
v Object -> Text -> Parser PreferenceName
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    PreferenceValue
preferenceValue    <- Object
v Object -> Text -> Parser PreferenceValue
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
    Preference -> Parser Preference
forall (m :: * -> *) a. Monad m => a -> m a
return Preference :: UserId
-> PreferenceCategory
-> PreferenceName
-> PreferenceValue
-> Preference
Preference { PreferenceValue
PreferenceName
PreferenceCategory
UserId
preferenceValue :: PreferenceValue
preferenceName :: PreferenceName
preferenceCategory :: PreferenceCategory
preferenceUserId :: UserId
preferenceValue :: PreferenceValue
preferenceName :: PreferenceName
preferenceCategory :: PreferenceCategory
preferenceUserId :: UserId
.. }

instance A.ToJSON Preference where
  toJSON :: Preference -> Value
toJSON Preference { PreferenceValue
PreferenceName
PreferenceCategory
UserId
preferenceValue :: PreferenceValue
preferenceName :: PreferenceName
preferenceCategory :: PreferenceCategory
preferenceUserId :: UserId
preferenceValue :: Preference -> PreferenceValue
preferenceName :: Preference -> PreferenceName
preferenceCategory :: Preference -> PreferenceCategory
preferenceUserId :: Preference -> UserId
.. } = [Pair] -> Value
A.object
    [ Text
"user_id"  Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UserId
preferenceUserId
    , Text
"category" Text -> PreferenceCategory -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PreferenceCategory
preferenceCategory
    , Text
"name"     Text -> PreferenceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PreferenceName
preferenceName
    , Text
"value"    Text -> PreferenceValue -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PreferenceValue
preferenceValue
    ]

data FavoriteChannelPreference =
    FavoriteChannelPreference { FavoriteChannelPreference -> ChannelId
favoriteChannelId :: ChannelId
                              , FavoriteChannelPreference -> Bool
favoriteChannelShow :: Bool
                              } deriving (ReadPrec [FavoriteChannelPreference]
ReadPrec FavoriteChannelPreference
Int -> ReadS FavoriteChannelPreference
ReadS [FavoriteChannelPreference]
(Int -> ReadS FavoriteChannelPreference)
-> ReadS [FavoriteChannelPreference]
-> ReadPrec FavoriteChannelPreference
-> ReadPrec [FavoriteChannelPreference]
-> Read FavoriteChannelPreference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FavoriteChannelPreference]
$creadListPrec :: ReadPrec [FavoriteChannelPreference]
readPrec :: ReadPrec FavoriteChannelPreference
$creadPrec :: ReadPrec FavoriteChannelPreference
readList :: ReadS [FavoriteChannelPreference]
$creadList :: ReadS [FavoriteChannelPreference]
readsPrec :: Int -> ReadS FavoriteChannelPreference
$creadsPrec :: Int -> ReadS FavoriteChannelPreference
Read, Int -> FavoriteChannelPreference -> ShowS
[FavoriteChannelPreference] -> ShowS
FavoriteChannelPreference -> String
(Int -> FavoriteChannelPreference -> ShowS)
-> (FavoriteChannelPreference -> String)
-> ([FavoriteChannelPreference] -> ShowS)
-> Show FavoriteChannelPreference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FavoriteChannelPreference] -> ShowS
$cshowList :: [FavoriteChannelPreference] -> ShowS
show :: FavoriteChannelPreference -> String
$cshow :: FavoriteChannelPreference -> String
showsPrec :: Int -> FavoriteChannelPreference -> ShowS
$cshowsPrec :: Int -> FavoriteChannelPreference -> ShowS
Show, FavoriteChannelPreference -> FavoriteChannelPreference -> Bool
(FavoriteChannelPreference -> FavoriteChannelPreference -> Bool)
-> (FavoriteChannelPreference -> FavoriteChannelPreference -> Bool)
-> Eq FavoriteChannelPreference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FavoriteChannelPreference -> FavoriteChannelPreference -> Bool
$c/= :: FavoriteChannelPreference -> FavoriteChannelPreference -> Bool
== :: FavoriteChannelPreference -> FavoriteChannelPreference -> Bool
$c== :: FavoriteChannelPreference -> FavoriteChannelPreference -> Bool
Eq)

-- | Attempt to expose a 'Preference' as a 'FavoriteChannelPreference'
preferenceToFavoriteChannelPreference :: Preference -> Maybe FavoriteChannelPreference
preferenceToFavoriteChannelPreference :: Preference -> Maybe FavoriteChannelPreference
preferenceToFavoriteChannelPreference
  Preference
    { preferenceCategory :: Preference -> PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryFavoriteChannel
    , preferenceName :: Preference -> PreferenceName
preferenceName     = PreferenceName Text
name
    , preferenceValue :: Preference -> PreferenceValue
preferenceValue    = PreferenceValue Text
value
    } = FavoriteChannelPreference -> Maybe FavoriteChannelPreference
forall a. a -> Maybe a
Just FavoriteChannelPreference :: ChannelId -> Bool -> FavoriteChannelPreference
FavoriteChannelPreference
          { favoriteChannelId :: ChannelId
favoriteChannelId = Id -> ChannelId
CI (Text -> Id
Id Text
name)
          , favoriteChannelShow :: Bool
favoriteChannelShow = Text
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true"
          }
preferenceToFavoriteChannelPreference Preference
_ = Maybe FavoriteChannelPreference
forall a. Maybe a
Nothing

data GroupChannelPreference =
    GroupChannelPreference { GroupChannelPreference -> ChannelId
groupChannelId :: ChannelId
                           , GroupChannelPreference -> Bool
groupChannelShow :: Bool
                           } deriving (ReadPrec [GroupChannelPreference]
ReadPrec GroupChannelPreference
Int -> ReadS GroupChannelPreference
ReadS [GroupChannelPreference]
(Int -> ReadS GroupChannelPreference)
-> ReadS [GroupChannelPreference]
-> ReadPrec GroupChannelPreference
-> ReadPrec [GroupChannelPreference]
-> Read GroupChannelPreference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GroupChannelPreference]
$creadListPrec :: ReadPrec [GroupChannelPreference]
readPrec :: ReadPrec GroupChannelPreference
$creadPrec :: ReadPrec GroupChannelPreference
readList :: ReadS [GroupChannelPreference]
$creadList :: ReadS [GroupChannelPreference]
readsPrec :: Int -> ReadS GroupChannelPreference
$creadsPrec :: Int -> ReadS GroupChannelPreference
Read, Int -> GroupChannelPreference -> ShowS
[GroupChannelPreference] -> ShowS
GroupChannelPreference -> String
(Int -> GroupChannelPreference -> ShowS)
-> (GroupChannelPreference -> String)
-> ([GroupChannelPreference] -> ShowS)
-> Show GroupChannelPreference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupChannelPreference] -> ShowS
$cshowList :: [GroupChannelPreference] -> ShowS
show :: GroupChannelPreference -> String
$cshow :: GroupChannelPreference -> String
showsPrec :: Int -> GroupChannelPreference -> ShowS
$cshowsPrec :: Int -> GroupChannelPreference -> ShowS
Show, GroupChannelPreference -> GroupChannelPreference -> Bool
(GroupChannelPreference -> GroupChannelPreference -> Bool)
-> (GroupChannelPreference -> GroupChannelPreference -> Bool)
-> Eq GroupChannelPreference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupChannelPreference -> GroupChannelPreference -> Bool
$c/= :: GroupChannelPreference -> GroupChannelPreference -> Bool
== :: GroupChannelPreference -> GroupChannelPreference -> Bool
$c== :: GroupChannelPreference -> GroupChannelPreference -> Bool
Eq)

-- | Attempt to expose a 'Preference' as a 'GroupChannelPreference'
preferenceToGroupChannelPreference :: Preference -> Maybe GroupChannelPreference
preferenceToGroupChannelPreference :: Preference -> Maybe GroupChannelPreference
preferenceToGroupChannelPreference
  Preference
    { preferenceCategory :: Preference -> PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryGroupChannelShow
    , preferenceName :: Preference -> PreferenceName
preferenceName     = PreferenceName Text
name
    , preferenceValue :: Preference -> PreferenceValue
preferenceValue    = PreferenceValue Text
value
    } = GroupChannelPreference -> Maybe GroupChannelPreference
forall a. a -> Maybe a
Just GroupChannelPreference :: ChannelId -> Bool -> GroupChannelPreference
GroupChannelPreference
          { groupChannelId :: ChannelId
groupChannelId = Id -> ChannelId
CI (Text -> Id
Id Text
name)
          , groupChannelShow :: Bool
groupChannelShow = Text
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true"
          }
preferenceToGroupChannelPreference Preference
_ = Maybe GroupChannelPreference
forall a. Maybe a
Nothing

data FlaggedPost = FlaggedPost
  { FlaggedPost -> UserId
flaggedPostUserId :: UserId
  , FlaggedPost -> PostId
flaggedPostId     :: PostId
  , FlaggedPost -> Bool
flaggedPostStatus :: Bool
  } deriving (ReadPrec [FlaggedPost]
ReadPrec FlaggedPost
Int -> ReadS FlaggedPost
ReadS [FlaggedPost]
(Int -> ReadS FlaggedPost)
-> ReadS [FlaggedPost]
-> ReadPrec FlaggedPost
-> ReadPrec [FlaggedPost]
-> Read FlaggedPost
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FlaggedPost]
$creadListPrec :: ReadPrec [FlaggedPost]
readPrec :: ReadPrec FlaggedPost
$creadPrec :: ReadPrec FlaggedPost
readList :: ReadS [FlaggedPost]
$creadList :: ReadS [FlaggedPost]
readsPrec :: Int -> ReadS FlaggedPost
$creadsPrec :: Int -> ReadS FlaggedPost
Read, Int -> FlaggedPost -> ShowS
[FlaggedPost] -> ShowS
FlaggedPost -> String
(Int -> FlaggedPost -> ShowS)
-> (FlaggedPost -> String)
-> ([FlaggedPost] -> ShowS)
-> Show FlaggedPost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlaggedPost] -> ShowS
$cshowList :: [FlaggedPost] -> ShowS
show :: FlaggedPost -> String
$cshow :: FlaggedPost -> String
showsPrec :: Int -> FlaggedPost -> ShowS
$cshowsPrec :: Int -> FlaggedPost -> ShowS
Show, FlaggedPost -> FlaggedPost -> Bool
(FlaggedPost -> FlaggedPost -> Bool)
-> (FlaggedPost -> FlaggedPost -> Bool) -> Eq FlaggedPost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlaggedPost -> FlaggedPost -> Bool
$c/= :: FlaggedPost -> FlaggedPost -> Bool
== :: FlaggedPost -> FlaggedPost -> Bool
$c== :: FlaggedPost -> FlaggedPost -> Bool
Eq)

data DirectChannelShowStatus =
    DirectChannelShowStatus { DirectChannelShowStatus -> UserId
directChannelShowUserId :: UserId
                            , DirectChannelShowStatus -> Bool
directChannelShowValue :: Bool
                            }

hideGroupChannelPref :: ChannelId -> UserId -> Preference
hideGroupChannelPref :: ChannelId -> UserId -> Preference
hideGroupChannelPref ChannelId
cId UserId
uId =
    Preference :: UserId
-> PreferenceCategory
-> PreferenceName
-> PreferenceValue
-> Preference
Preference { preferenceCategory :: PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryGroupChannelShow
               , preferenceValue :: PreferenceValue
preferenceValue = Text -> PreferenceValue
PreferenceValue Text
"false"
               , preferenceName :: PreferenceName
preferenceName = Text -> PreferenceName
PreferenceName (Text -> PreferenceName) -> Text -> PreferenceName
forall a b. (a -> b) -> a -> b
$ ChannelId -> Text
forall x. IsId x => x -> Text
idString ChannelId
cId
               , preferenceUserId :: UserId
preferenceUserId = UserId
uId
               }

showGroupChannelPref :: ChannelId -> UserId -> Preference
showGroupChannelPref :: ChannelId -> UserId -> Preference
showGroupChannelPref ChannelId
cId UserId
uId =
    Preference :: UserId
-> PreferenceCategory
-> PreferenceName
-> PreferenceValue
-> Preference
Preference { preferenceCategory :: PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryGroupChannelShow
               , preferenceValue :: PreferenceValue
preferenceValue = Text -> PreferenceValue
PreferenceValue Text
"true"
               , preferenceName :: PreferenceName
preferenceName = Text -> PreferenceName
PreferenceName (Text -> PreferenceName) -> Text -> PreferenceName
forall a b. (a -> b) -> a -> b
$ ChannelId -> Text
forall x. IsId x => x -> Text
idString ChannelId
cId
               , preferenceUserId :: UserId
preferenceUserId = UserId
uId
               }

showDirectChannelPref :: UserId -> UserId -> Bool -> Preference
showDirectChannelPref :: UserId -> UserId -> Bool -> Preference
showDirectChannelPref UserId
myId UserId
otherId Bool
s =
    Preference :: UserId
-> PreferenceCategory
-> PreferenceName
-> PreferenceValue
-> Preference
Preference { preferenceCategory :: PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryDirectChannelShow
               , preferenceValue :: PreferenceValue
preferenceValue = if Bool
s then Text -> PreferenceValue
PreferenceValue Text
"true"
                                        else Text -> PreferenceValue
PreferenceValue Text
"false"
               , preferenceName :: PreferenceName
preferenceName = Text -> PreferenceName
PreferenceName (Text -> PreferenceName) -> Text -> PreferenceName
forall a b. (a -> b) -> a -> b
$ UserId -> Text
forall x. IsId x => x -> Text
idString UserId
otherId
               , preferenceUserId :: UserId
preferenceUserId = UserId
myId
               }

preferenceToTeamOrder :: Preference -> Maybe [TeamId]
preferenceToTeamOrder :: Preference -> Maybe [TeamId]
preferenceToTeamOrder
  Preference
    { preferenceCategory :: Preference -> PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryTeamsOrder
    , preferenceName :: Preference -> PreferenceName
preferenceName     = PreferenceName Text
""
    , preferenceValue :: Preference -> PreferenceValue
preferenceValue    = PreferenceValue Text
value
    } = [TeamId] -> Maybe [TeamId]
forall a. a -> Maybe a
Just ([TeamId] -> Maybe [TeamId]) -> [TeamId] -> Maybe [TeamId]
forall a b. (a -> b) -> a -> b
$ (Id -> TeamId
TI (Id -> TeamId) -> (Text -> Id) -> Text -> TeamId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id) (Text -> TeamId) -> [Text] -> [TeamId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
"," Text
value
preferenceToTeamOrder Preference
_ = Maybe [TeamId]
forall a. Maybe a
Nothing

teamOrderPref :: UserId -> [TeamId] -> Preference
teamOrderPref :: UserId -> [TeamId] -> Preference
teamOrderPref UserId
myId [TeamId]
tIds =
    Preference :: UserId
-> PreferenceCategory
-> PreferenceName
-> PreferenceValue
-> Preference
Preference { preferenceCategory :: PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryTeamsOrder
               , preferenceValue :: PreferenceValue
preferenceValue = Text -> PreferenceValue
PreferenceValue (Text -> PreferenceValue) -> Text -> PreferenceValue
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Id -> Text
unId (Id -> Text) -> (TeamId -> Id) -> TeamId -> Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> Id
unTI (TeamId -> Text) -> [TeamId] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TeamId]
tIds)
               , preferenceName :: PreferenceName
preferenceName = Text -> PreferenceName
PreferenceName Text
""
               , preferenceUserId :: UserId
preferenceUserId = UserId
myId
               }


preferenceToDirectChannelShowStatus :: Preference -> Maybe DirectChannelShowStatus
preferenceToDirectChannelShowStatus :: Preference -> Maybe DirectChannelShowStatus
preferenceToDirectChannelShowStatus
  Preference
    { preferenceCategory :: Preference -> PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryDirectChannelShow
    , preferenceName :: Preference -> PreferenceName
preferenceName     = PreferenceName Text
name
    , preferenceValue :: Preference -> PreferenceValue
preferenceValue    = PreferenceValue Text
value
    } = DirectChannelShowStatus -> Maybe DirectChannelShowStatus
forall a. a -> Maybe a
Just DirectChannelShowStatus :: UserId -> Bool -> DirectChannelShowStatus
DirectChannelShowStatus
          { directChannelShowUserId :: UserId
directChannelShowUserId = Id -> UserId
UI (Text -> Id
Id Text
name)
          , directChannelShowValue :: Bool
directChannelShowValue = Text
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true"
          }
preferenceToDirectChannelShowStatus Preference
_ = Maybe DirectChannelShowStatus
forall a. Maybe a
Nothing

-- | Attempt to expose a 'Preference' as a 'FlaggedPost'
preferenceToFlaggedPost :: Preference -> Maybe FlaggedPost
preferenceToFlaggedPost :: Preference -> Maybe FlaggedPost
preferenceToFlaggedPost
  Preference
    { preferenceCategory :: Preference -> PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryFlaggedPost
    , preferenceName :: Preference -> PreferenceName
preferenceName     = PreferenceName Text
name
    , preferenceValue :: Preference -> PreferenceValue
preferenceValue    = PreferenceValue Text
value
    , preferenceUserId :: Preference -> UserId
preferenceUserId   = UserId
userId
    } = FlaggedPost -> Maybe FlaggedPost
forall a. a -> Maybe a
Just FlaggedPost :: UserId -> PostId -> Bool -> FlaggedPost
FlaggedPost
          { flaggedPostUserId :: UserId
flaggedPostUserId = UserId
userId
          , flaggedPostId :: PostId
flaggedPostId     = Id -> PostId
PI (Text -> Id
Id Text
name)
          , flaggedPostStatus :: Bool
flaggedPostStatus = Text
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true"
          }
preferenceToFlaggedPost Preference
_ = Maybe FlaggedPost
forall a. Maybe a
Nothing

instance A.ToJSON FlaggedPost where
  toJSON :: FlaggedPost -> Value
toJSON FlaggedPost
    { flaggedPostUserId :: FlaggedPost -> UserId
flaggedPostUserId = UserId
userId
    , flaggedPostId :: FlaggedPost -> PostId
flaggedPostId     = PI (Id Text
name)
    , flaggedPostStatus :: FlaggedPost -> Bool
flaggedPostStatus = Bool
status
    } = Preference -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Preference -> Value) -> Preference -> Value
forall a b. (a -> b) -> a -> b
$ Preference :: UserId
-> PreferenceCategory
-> PreferenceName
-> PreferenceValue
-> Preference
Preference
          { preferenceCategory :: PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryFlaggedPost
          , preferenceName :: PreferenceName
preferenceName     = Text -> PreferenceName
PreferenceName Text
name
          , preferenceValue :: PreferenceValue
preferenceValue    = Text -> PreferenceValue
PreferenceValue (if Bool
status then Text
"true" else Text
"false")
          , preferenceUserId :: UserId
preferenceUserId   = UserId
userId
          }

--

newtype HookId = HI { HookId -> Id
unHI :: Id }
  deriving (ReadPrec [HookId]
ReadPrec HookId
Int -> ReadS HookId
ReadS [HookId]
(Int -> ReadS HookId)
-> ReadS [HookId]
-> ReadPrec HookId
-> ReadPrec [HookId]
-> Read HookId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HookId]
$creadListPrec :: ReadPrec [HookId]
readPrec :: ReadPrec HookId
$creadPrec :: ReadPrec HookId
readList :: ReadS [HookId]
$creadList :: ReadS [HookId]
readsPrec :: Int -> ReadS HookId
$creadsPrec :: Int -> ReadS HookId
Read, Int -> HookId -> ShowS
[HookId] -> ShowS
HookId -> String
(Int -> HookId -> ShowS)
-> (HookId -> String) -> ([HookId] -> ShowS) -> Show HookId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HookId] -> ShowS
$cshowList :: [HookId] -> ShowS
show :: HookId -> String
$cshow :: HookId -> String
showsPrec :: Int -> HookId -> ShowS
$cshowsPrec :: Int -> HookId -> ShowS
Show, HookId -> HookId -> Bool
(HookId -> HookId -> Bool)
-> (HookId -> HookId -> Bool) -> Eq HookId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookId -> HookId -> Bool
$c/= :: HookId -> HookId -> Bool
== :: HookId -> HookId -> Bool
$c== :: HookId -> HookId -> Bool
Eq, Eq HookId
Eq HookId
-> (HookId -> HookId -> Ordering)
-> (HookId -> HookId -> Bool)
-> (HookId -> HookId -> Bool)
-> (HookId -> HookId -> Bool)
-> (HookId -> HookId -> Bool)
-> (HookId -> HookId -> HookId)
-> (HookId -> HookId -> HookId)
-> Ord HookId
HookId -> HookId -> Bool
HookId -> HookId -> Ordering
HookId -> HookId -> HookId
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 :: HookId -> HookId -> HookId
$cmin :: HookId -> HookId -> HookId
max :: HookId -> HookId -> HookId
$cmax :: HookId -> HookId -> HookId
>= :: HookId -> HookId -> Bool
$c>= :: HookId -> HookId -> Bool
> :: HookId -> HookId -> Bool
$c> :: HookId -> HookId -> Bool
<= :: HookId -> HookId -> Bool
$c<= :: HookId -> HookId -> Bool
< :: HookId -> HookId -> Bool
$c< :: HookId -> HookId -> Bool
compare :: HookId -> HookId -> Ordering
$ccompare :: HookId -> HookId -> Ordering
$cp1Ord :: Eq HookId
Ord, Int -> HookId -> Int
HookId -> Int
(Int -> HookId -> Int) -> (HookId -> Int) -> Hashable HookId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HookId -> Int
$chash :: HookId -> Int
hashWithSalt :: Int -> HookId -> Int
$chashWithSalt :: Int -> HookId -> Int
Hashable, [HookId] -> Encoding
[HookId] -> Value
HookId -> Encoding
HookId -> Value
(HookId -> Value)
-> (HookId -> Encoding)
-> ([HookId] -> Value)
-> ([HookId] -> Encoding)
-> ToJSON HookId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HookId] -> Encoding
$ctoEncodingList :: [HookId] -> Encoding
toJSONList :: [HookId] -> Value
$ctoJSONList :: [HookId] -> Value
toEncoding :: HookId -> Encoding
$ctoEncoding :: HookId -> Encoding
toJSON :: HookId -> Value
$ctoJSON :: HookId -> Value
ToJSON, ToJSONKeyFunction [HookId]
ToJSONKeyFunction HookId
ToJSONKeyFunction HookId
-> ToJSONKeyFunction [HookId] -> ToJSONKey HookId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [HookId]
$ctoJSONKeyList :: ToJSONKeyFunction [HookId]
toJSONKey :: ToJSONKeyFunction HookId
$ctoJSONKey :: ToJSONKeyFunction HookId
ToJSONKey, FromJSONKeyFunction [HookId]
FromJSONKeyFunction HookId
FromJSONKeyFunction HookId
-> FromJSONKeyFunction [HookId] -> FromJSONKey HookId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [HookId]
$cfromJSONKeyList :: FromJSONKeyFunction [HookId]
fromJSONKey :: FromJSONKeyFunction HookId
$cfromJSONKey :: FromJSONKeyFunction HookId
FromJSONKey, Value -> Parser [HookId]
Value -> Parser HookId
(Value -> Parser HookId)
-> (Value -> Parser [HookId]) -> FromJSON HookId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HookId]
$cparseJSONList :: Value -> Parser [HookId]
parseJSON :: Value -> Parser HookId
$cparseJSON :: Value -> Parser HookId
FromJSON)

instance IsId HookId where
  toId :: HookId -> Id
toId   = HookId -> Id
unHI
  fromId :: Id -> HookId
fromId = Id -> HookId
HI

instance PrintfArg HookId where
  formatArg :: HookId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (HookId -> Text) -> HookId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HookId -> Text
forall x. IsId x => x -> Text
idString

--

newtype InviteId = II { InviteId -> Id
unII :: Id }
  deriving (ReadPrec [InviteId]
ReadPrec InviteId
Int -> ReadS InviteId
ReadS [InviteId]
(Int -> ReadS InviteId)
-> ReadS [InviteId]
-> ReadPrec InviteId
-> ReadPrec [InviteId]
-> Read InviteId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InviteId]
$creadListPrec :: ReadPrec [InviteId]
readPrec :: ReadPrec InviteId
$creadPrec :: ReadPrec InviteId
readList :: ReadS [InviteId]
$creadList :: ReadS [InviteId]
readsPrec :: Int -> ReadS InviteId
$creadsPrec :: Int -> ReadS InviteId
Read, Int -> InviteId -> ShowS
[InviteId] -> ShowS
InviteId -> String
(Int -> InviteId -> ShowS)
-> (InviteId -> String) -> ([InviteId] -> ShowS) -> Show InviteId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InviteId] -> ShowS
$cshowList :: [InviteId] -> ShowS
show :: InviteId -> String
$cshow :: InviteId -> String
showsPrec :: Int -> InviteId -> ShowS
$cshowsPrec :: Int -> InviteId -> ShowS
Show, InviteId -> InviteId -> Bool
(InviteId -> InviteId -> Bool)
-> (InviteId -> InviteId -> Bool) -> Eq InviteId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InviteId -> InviteId -> Bool
$c/= :: InviteId -> InviteId -> Bool
== :: InviteId -> InviteId -> Bool
$c== :: InviteId -> InviteId -> Bool
Eq, Eq InviteId
Eq InviteId
-> (InviteId -> InviteId -> Ordering)
-> (InviteId -> InviteId -> Bool)
-> (InviteId -> InviteId -> Bool)
-> (InviteId -> InviteId -> Bool)
-> (InviteId -> InviteId -> Bool)
-> (InviteId -> InviteId -> InviteId)
-> (InviteId -> InviteId -> InviteId)
-> Ord InviteId
InviteId -> InviteId -> Bool
InviteId -> InviteId -> Ordering
InviteId -> InviteId -> InviteId
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 :: InviteId -> InviteId -> InviteId
$cmin :: InviteId -> InviteId -> InviteId
max :: InviteId -> InviteId -> InviteId
$cmax :: InviteId -> InviteId -> InviteId
>= :: InviteId -> InviteId -> Bool
$c>= :: InviteId -> InviteId -> Bool
> :: InviteId -> InviteId -> Bool
$c> :: InviteId -> InviteId -> Bool
<= :: InviteId -> InviteId -> Bool
$c<= :: InviteId -> InviteId -> Bool
< :: InviteId -> InviteId -> Bool
$c< :: InviteId -> InviteId -> Bool
compare :: InviteId -> InviteId -> Ordering
$ccompare :: InviteId -> InviteId -> Ordering
$cp1Ord :: Eq InviteId
Ord, Int -> InviteId -> Int
InviteId -> Int
(Int -> InviteId -> Int) -> (InviteId -> Int) -> Hashable InviteId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InviteId -> Int
$chash :: InviteId -> Int
hashWithSalt :: Int -> InviteId -> Int
$chashWithSalt :: Int -> InviteId -> Int
Hashable, [InviteId] -> Encoding
[InviteId] -> Value
InviteId -> Encoding
InviteId -> Value
(InviteId -> Value)
-> (InviteId -> Encoding)
-> ([InviteId] -> Value)
-> ([InviteId] -> Encoding)
-> ToJSON InviteId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InviteId] -> Encoding
$ctoEncodingList :: [InviteId] -> Encoding
toJSONList :: [InviteId] -> Value
$ctoJSONList :: [InviteId] -> Value
toEncoding :: InviteId -> Encoding
$ctoEncoding :: InviteId -> Encoding
toJSON :: InviteId -> Value
$ctoJSON :: InviteId -> Value
ToJSON, ToJSONKeyFunction [InviteId]
ToJSONKeyFunction InviteId
ToJSONKeyFunction InviteId
-> ToJSONKeyFunction [InviteId] -> ToJSONKey InviteId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [InviteId]
$ctoJSONKeyList :: ToJSONKeyFunction [InviteId]
toJSONKey :: ToJSONKeyFunction InviteId
$ctoJSONKey :: ToJSONKeyFunction InviteId
ToJSONKey, FromJSONKeyFunction [InviteId]
FromJSONKeyFunction InviteId
FromJSONKeyFunction InviteId
-> FromJSONKeyFunction [InviteId] -> FromJSONKey InviteId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [InviteId]
$cfromJSONKeyList :: FromJSONKeyFunction [InviteId]
fromJSONKey :: FromJSONKeyFunction InviteId
$cfromJSONKey :: FromJSONKeyFunction InviteId
FromJSONKey, Value -> Parser [InviteId]
Value -> Parser InviteId
(Value -> Parser InviteId)
-> (Value -> Parser [InviteId]) -> FromJSON InviteId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InviteId]
$cparseJSONList :: Value -> Parser [InviteId]
parseJSON :: Value -> Parser InviteId
$cparseJSON :: Value -> Parser InviteId
FromJSON)

instance IsId InviteId where
  toId :: InviteId -> Id
toId   = InviteId -> Id
unII
  fromId :: Id -> InviteId
fromId = Id -> InviteId
II

instance PrintfArg InviteId where
  formatArg :: InviteId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (InviteId -> Text) -> InviteId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InviteId -> Text
forall x. IsId x => x -> Text
idString

--

newtype TokenId = TkI { TokenId -> Id
unTkI :: Id }
  deriving (ReadPrec [TokenId]
ReadPrec TokenId
Int -> ReadS TokenId
ReadS [TokenId]
(Int -> ReadS TokenId)
-> ReadS [TokenId]
-> ReadPrec TokenId
-> ReadPrec [TokenId]
-> Read TokenId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TokenId]
$creadListPrec :: ReadPrec [TokenId]
readPrec :: ReadPrec TokenId
$creadPrec :: ReadPrec TokenId
readList :: ReadS [TokenId]
$creadList :: ReadS [TokenId]
readsPrec :: Int -> ReadS TokenId
$creadsPrec :: Int -> ReadS TokenId
Read, 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
Show, 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
Eq, Eq TokenId
Eq TokenId
-> (TokenId -> TokenId -> Ordering)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> TokenId)
-> (TokenId -> TokenId -> TokenId)
-> Ord TokenId
TokenId -> TokenId -> Bool
TokenId -> TokenId -> Ordering
TokenId -> TokenId -> TokenId
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 :: TokenId -> TokenId -> TokenId
$cmin :: TokenId -> TokenId -> TokenId
max :: TokenId -> TokenId -> TokenId
$cmax :: TokenId -> TokenId -> TokenId
>= :: TokenId -> TokenId -> Bool
$c>= :: TokenId -> TokenId -> Bool
> :: TokenId -> TokenId -> Bool
$c> :: TokenId -> TokenId -> Bool
<= :: TokenId -> TokenId -> Bool
$c<= :: TokenId -> TokenId -> Bool
< :: TokenId -> TokenId -> Bool
$c< :: TokenId -> TokenId -> Bool
compare :: TokenId -> TokenId -> Ordering
$ccompare :: TokenId -> TokenId -> Ordering
$cp1Ord :: Eq TokenId
Ord, Int -> TokenId -> Int
TokenId -> Int
(Int -> TokenId -> Int) -> (TokenId -> Int) -> Hashable TokenId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TokenId -> Int
$chash :: TokenId -> Int
hashWithSalt :: Int -> TokenId -> Int
$chashWithSalt :: Int -> TokenId -> Int
Hashable, [TokenId] -> Encoding
[TokenId] -> Value
TokenId -> Encoding
TokenId -> Value
(TokenId -> Value)
-> (TokenId -> Encoding)
-> ([TokenId] -> Value)
-> ([TokenId] -> Encoding)
-> ToJSON TokenId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TokenId] -> Encoding
$ctoEncodingList :: [TokenId] -> Encoding
toJSONList :: [TokenId] -> Value
$ctoJSONList :: [TokenId] -> Value
toEncoding :: TokenId -> Encoding
$ctoEncoding :: TokenId -> Encoding
toJSON :: TokenId -> Value
$ctoJSON :: TokenId -> Value
ToJSON, ToJSONKeyFunction [TokenId]
ToJSONKeyFunction TokenId
ToJSONKeyFunction TokenId
-> ToJSONKeyFunction [TokenId] -> ToJSONKey TokenId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [TokenId]
$ctoJSONKeyList :: ToJSONKeyFunction [TokenId]
toJSONKey :: ToJSONKeyFunction TokenId
$ctoJSONKey :: ToJSONKeyFunction TokenId
ToJSONKey, FromJSONKeyFunction [TokenId]
FromJSONKeyFunction TokenId
FromJSONKeyFunction TokenId
-> FromJSONKeyFunction [TokenId] -> FromJSONKey TokenId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [TokenId]
$cfromJSONKeyList :: FromJSONKeyFunction [TokenId]
fromJSONKey :: FromJSONKeyFunction TokenId
$cfromJSONKey :: FromJSONKeyFunction TokenId
FromJSONKey, Value -> Parser [TokenId]
Value -> Parser TokenId
(Value -> Parser TokenId)
-> (Value -> Parser [TokenId]) -> FromJSON TokenId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TokenId]
$cparseJSONList :: Value -> Parser [TokenId]
parseJSON :: Value -> Parser TokenId
$cparseJSON :: Value -> Parser TokenId
FromJSON)

instance IsId TokenId where
  toId :: TokenId -> Id
toId   = TokenId -> Id
unTkI
  fromId :: Id -> TokenId
fromId = Id -> TokenId
TkI

instance PrintfArg TokenId where
  formatArg :: TokenId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (TokenId -> Text) -> TokenId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenId -> Text
forall x. IsId x => x -> Text
idString

--

newtype AppId = AI { AppId -> Id
unAI :: Id }
  deriving (ReadPrec [AppId]
ReadPrec AppId
Int -> ReadS AppId
ReadS [AppId]
(Int -> ReadS AppId)
-> ReadS [AppId]
-> ReadPrec AppId
-> ReadPrec [AppId]
-> Read AppId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AppId]
$creadListPrec :: ReadPrec [AppId]
readPrec :: ReadPrec AppId
$creadPrec :: ReadPrec AppId
readList :: ReadS [AppId]
$creadList :: ReadS [AppId]
readsPrec :: Int -> ReadS AppId
$creadsPrec :: Int -> ReadS AppId
Read, Int -> AppId -> ShowS
[AppId] -> ShowS
AppId -> String
(Int -> AppId -> ShowS)
-> (AppId -> String) -> ([AppId] -> ShowS) -> Show AppId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppId] -> ShowS
$cshowList :: [AppId] -> ShowS
show :: AppId -> String
$cshow :: AppId -> String
showsPrec :: Int -> AppId -> ShowS
$cshowsPrec :: Int -> AppId -> ShowS
Show, AppId -> AppId -> Bool
(AppId -> AppId -> Bool) -> (AppId -> AppId -> Bool) -> Eq AppId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppId -> AppId -> Bool
$c/= :: AppId -> AppId -> Bool
== :: AppId -> AppId -> Bool
$c== :: AppId -> AppId -> Bool
Eq, Eq AppId
Eq AppId
-> (AppId -> AppId -> Ordering)
-> (AppId -> AppId -> Bool)
-> (AppId -> AppId -> Bool)
-> (AppId -> AppId -> Bool)
-> (AppId -> AppId -> Bool)
-> (AppId -> AppId -> AppId)
-> (AppId -> AppId -> AppId)
-> Ord AppId
AppId -> AppId -> Bool
AppId -> AppId -> Ordering
AppId -> AppId -> AppId
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 :: AppId -> AppId -> AppId
$cmin :: AppId -> AppId -> AppId
max :: AppId -> AppId -> AppId
$cmax :: AppId -> AppId -> AppId
>= :: AppId -> AppId -> Bool
$c>= :: AppId -> AppId -> Bool
> :: AppId -> AppId -> Bool
$c> :: AppId -> AppId -> Bool
<= :: AppId -> AppId -> Bool
$c<= :: AppId -> AppId -> Bool
< :: AppId -> AppId -> Bool
$c< :: AppId -> AppId -> Bool
compare :: AppId -> AppId -> Ordering
$ccompare :: AppId -> AppId -> Ordering
$cp1Ord :: Eq AppId
Ord, Int -> AppId -> Int
AppId -> Int
(Int -> AppId -> Int) -> (AppId -> Int) -> Hashable AppId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AppId -> Int
$chash :: AppId -> Int
hashWithSalt :: Int -> AppId -> Int
$chashWithSalt :: Int -> AppId -> Int
Hashable, [AppId] -> Encoding
[AppId] -> Value
AppId -> Encoding
AppId -> Value
(AppId -> Value)
-> (AppId -> Encoding)
-> ([AppId] -> Value)
-> ([AppId] -> Encoding)
-> ToJSON AppId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AppId] -> Encoding
$ctoEncodingList :: [AppId] -> Encoding
toJSONList :: [AppId] -> Value
$ctoJSONList :: [AppId] -> Value
toEncoding :: AppId -> Encoding
$ctoEncoding :: AppId -> Encoding
toJSON :: AppId -> Value
$ctoJSON :: AppId -> Value
ToJSON, ToJSONKeyFunction [AppId]
ToJSONKeyFunction AppId
ToJSONKeyFunction AppId
-> ToJSONKeyFunction [AppId] -> ToJSONKey AppId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [AppId]
$ctoJSONKeyList :: ToJSONKeyFunction [AppId]
toJSONKey :: ToJSONKeyFunction AppId
$ctoJSONKey :: ToJSONKeyFunction AppId
ToJSONKey, FromJSONKeyFunction [AppId]
FromJSONKeyFunction AppId
FromJSONKeyFunction AppId
-> FromJSONKeyFunction [AppId] -> FromJSONKey AppId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [AppId]
$cfromJSONKeyList :: FromJSONKeyFunction [AppId]
fromJSONKey :: FromJSONKeyFunction AppId
$cfromJSONKey :: FromJSONKeyFunction AppId
FromJSONKey, Value -> Parser [AppId]
Value -> Parser AppId
(Value -> Parser AppId)
-> (Value -> Parser [AppId]) -> FromJSON AppId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AppId]
$cparseJSONList :: Value -> Parser [AppId]
parseJSON :: Value -> Parser AppId
$cparseJSON :: Value -> Parser AppId
FromJSON)

instance IsId AppId where
  toId :: AppId -> Id
toId   = AppId -> Id
unAI
  fromId :: Id -> AppId
fromId = Id -> AppId
AI

instance PrintfArg AppId where
  formatArg :: AppId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (AppId -> Text) -> AppId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppId -> Text
forall x. IsId x => x -> Text
idString

--

newtype JobId = JI { JobId -> Id
unJI :: Id }
  deriving (ReadPrec [JobId]
ReadPrec JobId
Int -> ReadS JobId
ReadS [JobId]
(Int -> ReadS JobId)
-> ReadS [JobId]
-> ReadPrec JobId
-> ReadPrec [JobId]
-> Read JobId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JobId]
$creadListPrec :: ReadPrec [JobId]
readPrec :: ReadPrec JobId
$creadPrec :: ReadPrec JobId
readList :: ReadS [JobId]
$creadList :: ReadS [JobId]
readsPrec :: Int -> ReadS JobId
$creadsPrec :: Int -> ReadS JobId
Read, Int -> JobId -> ShowS
[JobId] -> ShowS
JobId -> String
(Int -> JobId -> ShowS)
-> (JobId -> String) -> ([JobId] -> ShowS) -> Show JobId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobId] -> ShowS
$cshowList :: [JobId] -> ShowS
show :: JobId -> String
$cshow :: JobId -> String
showsPrec :: Int -> JobId -> ShowS
$cshowsPrec :: Int -> JobId -> ShowS
Show, JobId -> JobId -> Bool
(JobId -> JobId -> Bool) -> (JobId -> JobId -> Bool) -> Eq JobId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobId -> JobId -> Bool
$c/= :: JobId -> JobId -> Bool
== :: JobId -> JobId -> Bool
$c== :: JobId -> JobId -> Bool
Eq, Eq JobId
Eq JobId
-> (JobId -> JobId -> Ordering)
-> (JobId -> JobId -> Bool)
-> (JobId -> JobId -> Bool)
-> (JobId -> JobId -> Bool)
-> (JobId -> JobId -> Bool)
-> (JobId -> JobId -> JobId)
-> (JobId -> JobId -> JobId)
-> Ord JobId
JobId -> JobId -> Bool
JobId -> JobId -> Ordering
JobId -> JobId -> JobId
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 :: JobId -> JobId -> JobId
$cmin :: JobId -> JobId -> JobId
max :: JobId -> JobId -> JobId
$cmax :: JobId -> JobId -> JobId
>= :: JobId -> JobId -> Bool
$c>= :: JobId -> JobId -> Bool
> :: JobId -> JobId -> Bool
$c> :: JobId -> JobId -> Bool
<= :: JobId -> JobId -> Bool
$c<= :: JobId -> JobId -> Bool
< :: JobId -> JobId -> Bool
$c< :: JobId -> JobId -> Bool
compare :: JobId -> JobId -> Ordering
$ccompare :: JobId -> JobId -> Ordering
$cp1Ord :: Eq JobId
Ord, Int -> JobId -> Int
JobId -> Int
(Int -> JobId -> Int) -> (JobId -> Int) -> Hashable JobId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: JobId -> Int
$chash :: JobId -> Int
hashWithSalt :: Int -> JobId -> Int
$chashWithSalt :: Int -> JobId -> Int
Hashable, [JobId] -> Encoding
[JobId] -> Value
JobId -> Encoding
JobId -> Value
(JobId -> Value)
-> (JobId -> Encoding)
-> ([JobId] -> Value)
-> ([JobId] -> Encoding)
-> ToJSON JobId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JobId] -> Encoding
$ctoEncodingList :: [JobId] -> Encoding
toJSONList :: [JobId] -> Value
$ctoJSONList :: [JobId] -> Value
toEncoding :: JobId -> Encoding
$ctoEncoding :: JobId -> Encoding
toJSON :: JobId -> Value
$ctoJSON :: JobId -> Value
ToJSON, ToJSONKeyFunction [JobId]
ToJSONKeyFunction JobId
ToJSONKeyFunction JobId
-> ToJSONKeyFunction [JobId] -> ToJSONKey JobId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [JobId]
$ctoJSONKeyList :: ToJSONKeyFunction [JobId]
toJSONKey :: ToJSONKeyFunction JobId
$ctoJSONKey :: ToJSONKeyFunction JobId
ToJSONKey, FromJSONKeyFunction [JobId]
FromJSONKeyFunction JobId
FromJSONKeyFunction JobId
-> FromJSONKeyFunction [JobId] -> FromJSONKey JobId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [JobId]
$cfromJSONKeyList :: FromJSONKeyFunction [JobId]
fromJSONKey :: FromJSONKeyFunction JobId
$cfromJSONKey :: FromJSONKeyFunction JobId
FromJSONKey, Value -> Parser [JobId]
Value -> Parser JobId
(Value -> Parser JobId)
-> (Value -> Parser [JobId]) -> FromJSON JobId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JobId]
$cparseJSONList :: Value -> Parser [JobId]
parseJSON :: Value -> Parser JobId
$cparseJSON :: Value -> Parser JobId
FromJSON)

instance IsId JobId where
  toId :: JobId -> Id
toId   = JobId -> Id
unJI
  fromId :: Id -> JobId
fromId = Id -> JobId
JI

instance PrintfArg JobId where
  formatArg :: JobId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (JobId -> Text) -> JobId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobId -> Text
forall x. IsId x => x -> Text
idString

--

newtype EmojiId = EI { EmojiId -> Id
unEI :: Id }
  deriving (ReadPrec [EmojiId]
ReadPrec EmojiId
Int -> ReadS EmojiId
ReadS [EmojiId]
(Int -> ReadS EmojiId)
-> ReadS [EmojiId]
-> ReadPrec EmojiId
-> ReadPrec [EmojiId]
-> Read EmojiId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmojiId]
$creadListPrec :: ReadPrec [EmojiId]
readPrec :: ReadPrec EmojiId
$creadPrec :: ReadPrec EmojiId
readList :: ReadS [EmojiId]
$creadList :: ReadS [EmojiId]
readsPrec :: Int -> ReadS EmojiId
$creadsPrec :: Int -> ReadS EmojiId
Read, Int -> EmojiId -> ShowS
[EmojiId] -> ShowS
EmojiId -> String
(Int -> EmojiId -> ShowS)
-> (EmojiId -> String) -> ([EmojiId] -> ShowS) -> Show EmojiId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmojiId] -> ShowS
$cshowList :: [EmojiId] -> ShowS
show :: EmojiId -> String
$cshow :: EmojiId -> String
showsPrec :: Int -> EmojiId -> ShowS
$cshowsPrec :: Int -> EmojiId -> ShowS
Show, EmojiId -> EmojiId -> Bool
(EmojiId -> EmojiId -> Bool)
-> (EmojiId -> EmojiId -> Bool) -> Eq EmojiId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmojiId -> EmojiId -> Bool
$c/= :: EmojiId -> EmojiId -> Bool
== :: EmojiId -> EmojiId -> Bool
$c== :: EmojiId -> EmojiId -> Bool
Eq, Eq EmojiId
Eq EmojiId
-> (EmojiId -> EmojiId -> Ordering)
-> (EmojiId -> EmojiId -> Bool)
-> (EmojiId -> EmojiId -> Bool)
-> (EmojiId -> EmojiId -> Bool)
-> (EmojiId -> EmojiId -> Bool)
-> (EmojiId -> EmojiId -> EmojiId)
-> (EmojiId -> EmojiId -> EmojiId)
-> Ord EmojiId
EmojiId -> EmojiId -> Bool
EmojiId -> EmojiId -> Ordering
EmojiId -> EmojiId -> EmojiId
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 :: EmojiId -> EmojiId -> EmojiId
$cmin :: EmojiId -> EmojiId -> EmojiId
max :: EmojiId -> EmojiId -> EmojiId
$cmax :: EmojiId -> EmojiId -> EmojiId
>= :: EmojiId -> EmojiId -> Bool
$c>= :: EmojiId -> EmojiId -> Bool
> :: EmojiId -> EmojiId -> Bool
$c> :: EmojiId -> EmojiId -> Bool
<= :: EmojiId -> EmojiId -> Bool
$c<= :: EmojiId -> EmojiId -> Bool
< :: EmojiId -> EmojiId -> Bool
$c< :: EmojiId -> EmojiId -> Bool
compare :: EmojiId -> EmojiId -> Ordering
$ccompare :: EmojiId -> EmojiId -> Ordering
$cp1Ord :: Eq EmojiId
Ord, Int -> EmojiId -> Int
EmojiId -> Int
(Int -> EmojiId -> Int) -> (EmojiId -> Int) -> Hashable EmojiId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: EmojiId -> Int
$chash :: EmojiId -> Int
hashWithSalt :: Int -> EmojiId -> Int
$chashWithSalt :: Int -> EmojiId -> Int
Hashable, [EmojiId] -> Encoding
[EmojiId] -> Value
EmojiId -> Encoding
EmojiId -> Value
(EmojiId -> Value)
-> (EmojiId -> Encoding)
-> ([EmojiId] -> Value)
-> ([EmojiId] -> Encoding)
-> ToJSON EmojiId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EmojiId] -> Encoding
$ctoEncodingList :: [EmojiId] -> Encoding
toJSONList :: [EmojiId] -> Value
$ctoJSONList :: [EmojiId] -> Value
toEncoding :: EmojiId -> Encoding
$ctoEncoding :: EmojiId -> Encoding
toJSON :: EmojiId -> Value
$ctoJSON :: EmojiId -> Value
ToJSON, ToJSONKeyFunction [EmojiId]
ToJSONKeyFunction EmojiId
ToJSONKeyFunction EmojiId
-> ToJSONKeyFunction [EmojiId] -> ToJSONKey EmojiId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [EmojiId]
$ctoJSONKeyList :: ToJSONKeyFunction [EmojiId]
toJSONKey :: ToJSONKeyFunction EmojiId
$ctoJSONKey :: ToJSONKeyFunction EmojiId
ToJSONKey, FromJSONKeyFunction [EmojiId]
FromJSONKeyFunction EmojiId
FromJSONKeyFunction EmojiId
-> FromJSONKeyFunction [EmojiId] -> FromJSONKey EmojiId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [EmojiId]
$cfromJSONKeyList :: FromJSONKeyFunction [EmojiId]
fromJSONKey :: FromJSONKeyFunction EmojiId
$cfromJSONKey :: FromJSONKeyFunction EmojiId
FromJSONKey, Value -> Parser [EmojiId]
Value -> Parser EmojiId
(Value -> Parser EmojiId)
-> (Value -> Parser [EmojiId]) -> FromJSON EmojiId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EmojiId]
$cparseJSONList :: Value -> Parser [EmojiId]
parseJSON :: Value -> Parser EmojiId
$cparseJSON :: Value -> Parser EmojiId
FromJSON)

instance IsId EmojiId where
  toId :: EmojiId -> Id
toId   = EmojiId -> Id
unEI
  fromId :: Id -> EmojiId
fromId = Id -> EmojiId
EI

instance PrintfArg EmojiId where
  formatArg :: EmojiId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (EmojiId -> Text) -> EmojiId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmojiId -> Text
forall x. IsId x => x -> Text
idString

--

newtype ReportId = RI { ReportId -> Id
unRI :: Id }
  deriving (ReadPrec [ReportId]
ReadPrec ReportId
Int -> ReadS ReportId
ReadS [ReportId]
(Int -> ReadS ReportId)
-> ReadS [ReportId]
-> ReadPrec ReportId
-> ReadPrec [ReportId]
-> Read ReportId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReportId]
$creadListPrec :: ReadPrec [ReportId]
readPrec :: ReadPrec ReportId
$creadPrec :: ReadPrec ReportId
readList :: ReadS [ReportId]
$creadList :: ReadS [ReportId]
readsPrec :: Int -> ReadS ReportId
$creadsPrec :: Int -> ReadS ReportId
Read, Int -> ReportId -> ShowS
[ReportId] -> ShowS
ReportId -> String
(Int -> ReportId -> ShowS)
-> (ReportId -> String) -> ([ReportId] -> ShowS) -> Show ReportId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportId] -> ShowS
$cshowList :: [ReportId] -> ShowS
show :: ReportId -> String
$cshow :: ReportId -> String
showsPrec :: Int -> ReportId -> ShowS
$cshowsPrec :: Int -> ReportId -> ShowS
Show, ReportId -> ReportId -> Bool
(ReportId -> ReportId -> Bool)
-> (ReportId -> ReportId -> Bool) -> Eq ReportId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportId -> ReportId -> Bool
$c/= :: ReportId -> ReportId -> Bool
== :: ReportId -> ReportId -> Bool
$c== :: ReportId -> ReportId -> Bool
Eq, Eq ReportId
Eq ReportId
-> (ReportId -> ReportId -> Ordering)
-> (ReportId -> ReportId -> Bool)
-> (ReportId -> ReportId -> Bool)
-> (ReportId -> ReportId -> Bool)
-> (ReportId -> ReportId -> Bool)
-> (ReportId -> ReportId -> ReportId)
-> (ReportId -> ReportId -> ReportId)
-> Ord ReportId
ReportId -> ReportId -> Bool
ReportId -> ReportId -> Ordering
ReportId -> ReportId -> ReportId
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 :: ReportId -> ReportId -> ReportId
$cmin :: ReportId -> ReportId -> ReportId
max :: ReportId -> ReportId -> ReportId
$cmax :: ReportId -> ReportId -> ReportId
>= :: ReportId -> ReportId -> Bool
$c>= :: ReportId -> ReportId -> Bool
> :: ReportId -> ReportId -> Bool
$c> :: ReportId -> ReportId -> Bool
<= :: ReportId -> ReportId -> Bool
$c<= :: ReportId -> ReportId -> Bool
< :: ReportId -> ReportId -> Bool
$c< :: ReportId -> ReportId -> Bool
compare :: ReportId -> ReportId -> Ordering
$ccompare :: ReportId -> ReportId -> Ordering
$cp1Ord :: Eq ReportId
Ord, Int -> ReportId -> Int
ReportId -> Int
(Int -> ReportId -> Int) -> (ReportId -> Int) -> Hashable ReportId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ReportId -> Int
$chash :: ReportId -> Int
hashWithSalt :: Int -> ReportId -> Int
$chashWithSalt :: Int -> ReportId -> Int
Hashable, [ReportId] -> Encoding
[ReportId] -> Value
ReportId -> Encoding
ReportId -> Value
(ReportId -> Value)
-> (ReportId -> Encoding)
-> ([ReportId] -> Value)
-> ([ReportId] -> Encoding)
-> ToJSON ReportId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ReportId] -> Encoding
$ctoEncodingList :: [ReportId] -> Encoding
toJSONList :: [ReportId] -> Value
$ctoJSONList :: [ReportId] -> Value
toEncoding :: ReportId -> Encoding
$ctoEncoding :: ReportId -> Encoding
toJSON :: ReportId -> Value
$ctoJSON :: ReportId -> Value
ToJSON, ToJSONKeyFunction [ReportId]
ToJSONKeyFunction ReportId
ToJSONKeyFunction ReportId
-> ToJSONKeyFunction [ReportId] -> ToJSONKey ReportId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ReportId]
$ctoJSONKeyList :: ToJSONKeyFunction [ReportId]
toJSONKey :: ToJSONKeyFunction ReportId
$ctoJSONKey :: ToJSONKeyFunction ReportId
ToJSONKey, FromJSONKeyFunction [ReportId]
FromJSONKeyFunction ReportId
FromJSONKeyFunction ReportId
-> FromJSONKeyFunction [ReportId] -> FromJSONKey ReportId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ReportId]
$cfromJSONKeyList :: FromJSONKeyFunction [ReportId]
fromJSONKey :: FromJSONKeyFunction ReportId
$cfromJSONKey :: FromJSONKeyFunction ReportId
FromJSONKey, Value -> Parser [ReportId]
Value -> Parser ReportId
(Value -> Parser ReportId)
-> (Value -> Parser [ReportId]) -> FromJSON ReportId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ReportId]
$cparseJSONList :: Value -> Parser [ReportId]
parseJSON :: Value -> Parser ReportId
$cparseJSON :: Value -> Parser ReportId
FromJSON)

instance IsId ReportId where
  toId :: ReportId -> Id
toId   = ReportId -> Id
unRI
  fromId :: Id -> ReportId
fromId = Id -> ReportId
RI

instance PrintfArg ReportId where
  formatArg :: ReportId -> FieldFormatter
formatArg = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Text -> FieldFormatter)
-> (ReportId -> Text) -> ReportId -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportId -> Text
forall x. IsId x => x -> Text
idString

-- FIXMES

instance A.ToJSON User where toJSON :: User -> Value
toJSON = String -> User -> Value
forall a. HasCallStack => String -> a
error String
"to user"
instance A.ToJSON Team where toJSON :: Team -> Value
toJSON = String -> Team -> Value
forall a. HasCallStack => String -> a
error String
"to team"

-- --

data MinChannelMember = MinChannelMember
  { MinChannelMember -> UserId
minChannelMemberUserId :: UserId
  , MinChannelMember -> ChannelId
minChannelMemberChannelId :: ChannelId
  } deriving (ReadPrec [MinChannelMember]
ReadPrec MinChannelMember
Int -> ReadS MinChannelMember
ReadS [MinChannelMember]
(Int -> ReadS MinChannelMember)
-> ReadS [MinChannelMember]
-> ReadPrec MinChannelMember
-> ReadPrec [MinChannelMember]
-> Read MinChannelMember
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MinChannelMember]
$creadListPrec :: ReadPrec [MinChannelMember]
readPrec :: ReadPrec MinChannelMember
$creadPrec :: ReadPrec MinChannelMember
readList :: ReadS [MinChannelMember]
$creadList :: ReadS [MinChannelMember]
readsPrec :: Int -> ReadS MinChannelMember
$creadsPrec :: Int -> ReadS MinChannelMember
Read, Int -> MinChannelMember -> ShowS
[MinChannelMember] -> ShowS
MinChannelMember -> String
(Int -> MinChannelMember -> ShowS)
-> (MinChannelMember -> String)
-> ([MinChannelMember] -> ShowS)
-> Show MinChannelMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinChannelMember] -> ShowS
$cshowList :: [MinChannelMember] -> ShowS
show :: MinChannelMember -> String
$cshow :: MinChannelMember -> String
showsPrec :: Int -> MinChannelMember -> ShowS
$cshowsPrec :: Int -> MinChannelMember -> ShowS
Show, MinChannelMember -> MinChannelMember -> Bool
(MinChannelMember -> MinChannelMember -> Bool)
-> (MinChannelMember -> MinChannelMember -> Bool)
-> Eq MinChannelMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MinChannelMember -> MinChannelMember -> Bool
$c/= :: MinChannelMember -> MinChannelMember -> Bool
== :: MinChannelMember -> MinChannelMember -> Bool
$c== :: MinChannelMember -> MinChannelMember -> Bool
Eq)

instance A.FromJSON MinChannelMember where
  parseJSON :: Value -> Parser MinChannelMember
parseJSON = String
-> (Object -> Parser MinChannelMember)
-> Value
-> Parser MinChannelMember
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"channelMember" ((Object -> Parser MinChannelMember)
 -> Value -> Parser MinChannelMember)
-> (Object -> Parser MinChannelMember)
-> Value
-> Parser MinChannelMember
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    UserId
minChannelMemberUserId <- Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"user_id"
    ChannelId
minChannelMemberChannelId <- Object
v Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"channel_id"
    MinChannelMember -> Parser MinChannelMember
forall (m :: * -> *) a. Monad m => a -> m a
return MinChannelMember :: UserId -> ChannelId -> MinChannelMember
MinChannelMember { UserId
ChannelId
minChannelMemberChannelId :: ChannelId
minChannelMemberUserId :: UserId
minChannelMemberChannelId :: ChannelId
minChannelMemberUserId :: UserId
.. }

instance A.ToJSON MinChannelMember where
  toJSON :: MinChannelMember -> Value
toJSON MinChannelMember { UserId
ChannelId
minChannelMemberChannelId :: ChannelId
minChannelMemberUserId :: UserId
minChannelMemberChannelId :: MinChannelMember -> ChannelId
minChannelMemberUserId :: MinChannelMember -> UserId
.. } = [Pair] -> Value
A.object
    [ Text
"user_id"    Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= UserId
minChannelMemberUserId
    , Text
"channel_id" Text -> ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ChannelId
minChannelMemberChannelId
    ]

data ChannelMember = ChannelMember
  { ChannelMember -> Integer
channelMemberMsgCount :: Integer
  , ChannelMember -> UserId
channelMemberUserId :: UserId
  , ChannelMember -> Text
channelMemberRoles :: Text
  , ChannelMember -> Int
channelMemberMentionCount :: Int
  , ChannelMember -> ServerTime
channelMemberLastViewedAt :: ServerTime
  , ChannelMember -> ChannelId
channelMemberChannelId :: ChannelId
  , ChannelMember -> ServerTime
channelMemberLastUpdateAt :: ServerTime
  , ChannelMember -> ChannelNotifyProps
channelMemberNotifyProps :: ChannelNotifyProps
  } deriving (ReadPrec [ChannelMember]
ReadPrec ChannelMember
Int -> ReadS ChannelMember
ReadS [ChannelMember]
(Int -> ReadS ChannelMember)
-> ReadS [ChannelMember]
-> ReadPrec ChannelMember
-> ReadPrec [ChannelMember]
-> Read ChannelMember
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelMember]
$creadListPrec :: ReadPrec [ChannelMember]
readPrec :: ReadPrec ChannelMember
$creadPrec :: ReadPrec ChannelMember
readList :: ReadS [ChannelMember]
$creadList :: ReadS [ChannelMember]
readsPrec :: Int -> ReadS ChannelMember
$creadsPrec :: Int -> ReadS ChannelMember
Read, Int -> ChannelMember -> ShowS
[ChannelMember] -> ShowS
ChannelMember -> String
(Int -> ChannelMember -> ShowS)
-> (ChannelMember -> String)
-> ([ChannelMember] -> ShowS)
-> Show ChannelMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelMember] -> ShowS
$cshowList :: [ChannelMember] -> ShowS
show :: ChannelMember -> String
$cshow :: ChannelMember -> String
showsPrec :: Int -> ChannelMember -> ShowS
$cshowsPrec :: Int -> ChannelMember -> ShowS
Show, ChannelMember -> ChannelMember -> Bool
(ChannelMember -> ChannelMember -> Bool)
-> (ChannelMember -> ChannelMember -> Bool) -> Eq ChannelMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelMember -> ChannelMember -> Bool
$c/= :: ChannelMember -> ChannelMember -> Bool
== :: ChannelMember -> ChannelMember -> Bool
$c== :: ChannelMember -> ChannelMember -> Bool
Eq)

instance A.FromJSON ChannelMember where
  parseJSON :: Value -> Parser ChannelMember
parseJSON = String
-> (Object -> Parser ChannelMember)
-> Value
-> Parser ChannelMember
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"channelMember" ((Object -> Parser ChannelMember) -> Value -> Parser ChannelMember)
-> (Object -> Parser ChannelMember)
-> Value
-> Parser ChannelMember
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Integer
channelMemberMsgCount <- Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"msg_count"
    UserId
channelMemberUserId <- Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"user_id"
    Text
channelMemberRoles <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"roles"
    Int
channelMemberMentionCount <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"mention_count"
    ServerTime
channelMemberLastViewedAt <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"last_viewed_at"
    ChannelId
channelMemberChannelId <- Object
v Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"channel_id"
    ServerTime
channelMemberLastUpdateAt <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"last_update_at"
    ChannelNotifyProps
channelMemberNotifyProps <- Object
v Object -> Text -> Parser ChannelNotifyProps
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"notify_props"
    ChannelMember -> Parser ChannelMember
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelMember :: Integer
-> UserId
-> Text
-> Int
-> ServerTime
-> ChannelId
-> ServerTime
-> ChannelNotifyProps
-> ChannelMember
ChannelMember { Int
Integer
Text
ServerTime
UserId
ChannelId
ChannelNotifyProps
channelMemberNotifyProps :: ChannelNotifyProps
channelMemberLastUpdateAt :: ServerTime
channelMemberChannelId :: ChannelId
channelMemberLastViewedAt :: ServerTime
channelMemberMentionCount :: Int
channelMemberRoles :: Text
channelMemberUserId :: UserId
channelMemberMsgCount :: Integer
channelMemberNotifyProps :: ChannelNotifyProps
channelMemberLastUpdateAt :: ServerTime
channelMemberChannelId :: ChannelId
channelMemberLastViewedAt :: ServerTime
channelMemberMentionCount :: Int
channelMemberRoles :: Text
channelMemberUserId :: UserId
channelMemberMsgCount :: Integer
.. }

instance A.ToJSON ChannelMember where
  toJSON :: ChannelMember -> Value
toJSON ChannelMember { Int
Integer
Text
ServerTime
UserId
ChannelId
ChannelNotifyProps
channelMemberNotifyProps :: ChannelNotifyProps
channelMemberLastUpdateAt :: ServerTime
channelMemberChannelId :: ChannelId
channelMemberLastViewedAt :: ServerTime
channelMemberMentionCount :: Int
channelMemberRoles :: Text
channelMemberUserId :: UserId
channelMemberMsgCount :: Integer
channelMemberNotifyProps :: ChannelMember -> ChannelNotifyProps
channelMemberLastUpdateAt :: ChannelMember -> ServerTime
channelMemberChannelId :: ChannelMember -> ChannelId
channelMemberLastViewedAt :: ChannelMember -> ServerTime
channelMemberMentionCount :: ChannelMember -> Int
channelMemberRoles :: ChannelMember -> Text
channelMemberUserId :: ChannelMember -> UserId
channelMemberMsgCount :: ChannelMember -> Integer
.. } = [Pair] -> Value
A.object
    [ Text
"msg_count" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Integer
channelMemberMsgCount
    , Text
"user_id" Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= UserId
channelMemberUserId
    , Text
"roles" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
channelMemberRoles
    , Text
"mention_count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Int
channelMemberMentionCount
    , Text
"last_viewed_at" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ServerTime -> Int
timeToServer ServerTime
channelMemberLastViewedAt
    , Text
"channel_id" Text -> ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ChannelId
channelMemberChannelId
    , Text
"last_update_at" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ServerTime -> Int
timeToServer ServerTime
channelMemberLastUpdateAt
    , Text
"notify_props" Text -> ChannelNotifyProps -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ChannelNotifyProps
channelMemberNotifyProps
    ]


data Status = Status
  { Status -> UserId
statusUserId :: UserId
  , Status -> Text
statusStatus :: T.Text
  , Status -> Bool
statusManual :: Bool
  , Status -> ServerTime
statusLastActivityAt :: ServerTime
  }

instance A.FromJSON Status where
  parseJSON :: Value -> Parser Status
parseJSON = String -> (Object -> Parser Status) -> Value -> Parser Status
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Status" ((Object -> Parser Status) -> Value -> Parser Status)
-> (Object -> Parser Status) -> Value -> Parser Status
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    UserId
statusUserId <- Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"user_id"
    Text
statusStatus <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"status"
    Bool
statusManual <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"manual"
    ServerTime
statusLastActivityAt <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"last_activity_at"
    Status -> Parser Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status :: UserId -> Text -> Bool -> ServerTime -> Status
Status { Bool
Text
ServerTime
UserId
statusLastActivityAt :: ServerTime
statusManual :: Bool
statusStatus :: Text
statusUserId :: UserId
statusLastActivityAt :: ServerTime
statusManual :: Bool
statusStatus :: Text
statusUserId :: UserId
.. }

instance A.ToJSON Status where
  toJSON :: Status -> Value
toJSON Status { Bool
Text
ServerTime
UserId
statusLastActivityAt :: ServerTime
statusManual :: Bool
statusStatus :: Text
statusUserId :: UserId
statusLastActivityAt :: Status -> ServerTime
statusManual :: Status -> Bool
statusStatus :: Status -> Text
statusUserId :: Status -> UserId
.. } = [Pair] -> Value
A.object
    [ Text
"user_id" Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= UserId
statusUserId
    , Text
"status"  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
statusStatus
    , Text
"manual"  Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Bool
statusManual
    , Text
"last_activity_at" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ServerTime -> Int
timeToServer ServerTime
statusLastActivityAt
    ]


data UserSearch = UserSearch
  { UserSearch -> Text
userSearchTerm :: Text
  , UserSearch -> Bool
userSearchAllowInactive :: Bool
    -- ^ When `true`, include deactivated users in the results
  , UserSearch -> Bool
userSearchWithoutTeam :: Bool
    -- ^ Set this to `true` if you would like to search for users that are not on a team. This option takes precendence over `team_id`, `in_channel_id`, and `not_in_channel_id`.
  , UserSearch -> Maybe ChannelId
userSearchInChannelId :: Maybe ChannelId
    -- ^ If provided, only search users in this channel
  , UserSearch -> Maybe TeamId
userSearchNotInTeamId :: Maybe TeamId
    -- ^ If provided, only search users not on this team
  , UserSearch -> Maybe ChannelId
userSearchNotInChannelId :: Maybe ChannelId
    -- ^ If provided, only search users not in this channel. Must specifiy `team_id` when using this option
  , UserSearch -> Maybe TeamId
userSearchTeamId :: Maybe TeamId
    -- ^ If provided, only search users on this team
  } deriving (ReadPrec [UserSearch]
ReadPrec UserSearch
Int -> ReadS UserSearch
ReadS [UserSearch]
(Int -> ReadS UserSearch)
-> ReadS [UserSearch]
-> ReadPrec UserSearch
-> ReadPrec [UserSearch]
-> Read UserSearch
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserSearch]
$creadListPrec :: ReadPrec [UserSearch]
readPrec :: ReadPrec UserSearch
$creadPrec :: ReadPrec UserSearch
readList :: ReadS [UserSearch]
$creadList :: ReadS [UserSearch]
readsPrec :: Int -> ReadS UserSearch
$creadsPrec :: Int -> ReadS UserSearch
Read, Int -> UserSearch -> ShowS
[UserSearch] -> ShowS
UserSearch -> String
(Int -> UserSearch -> ShowS)
-> (UserSearch -> String)
-> ([UserSearch] -> ShowS)
-> Show UserSearch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserSearch] -> ShowS
$cshowList :: [UserSearch] -> ShowS
show :: UserSearch -> String
$cshow :: UserSearch -> String
showsPrec :: Int -> UserSearch -> ShowS
$cshowsPrec :: Int -> UserSearch -> ShowS
Show, UserSearch -> UserSearch -> Bool
(UserSearch -> UserSearch -> Bool)
-> (UserSearch -> UserSearch -> Bool) -> Eq UserSearch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserSearch -> UserSearch -> Bool
$c/= :: UserSearch -> UserSearch -> Bool
== :: UserSearch -> UserSearch -> Bool
$c== :: UserSearch -> UserSearch -> Bool
Eq)

instance A.FromJSON UserSearch where
  parseJSON :: Value -> Parser UserSearch
parseJSON = String
-> (Object -> Parser UserSearch) -> Value -> Parser UserSearch
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"userSearch" ((Object -> Parser UserSearch) -> Value -> Parser UserSearch)
-> (Object -> Parser UserSearch) -> Value -> Parser UserSearch
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
userSearchTerm <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"term"
    Bool
userSearchAllowInactive <- Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"allow_inactive"
    Bool
userSearchWithoutTeam <- Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"without_team"
    Maybe ChannelId
userSearchInChannelId <- Object
v Object -> Text -> Parser (Maybe ChannelId)
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"in_channel_id"
    Maybe TeamId
userSearchNotInTeamId <- Object
v Object -> Text -> Parser (Maybe TeamId)
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"not_in_team_id"
    Maybe ChannelId
userSearchNotInChannelId <- Object
v Object -> Text -> Parser (Maybe ChannelId)
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"not_in_channel_id"
    Maybe TeamId
userSearchTeamId <- Object
v Object -> Text -> Parser (Maybe TeamId)
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"team_id"
    UserSearch -> Parser UserSearch
forall (m :: * -> *) a. Monad m => a -> m a
return UserSearch :: Text
-> Bool
-> Bool
-> Maybe ChannelId
-> Maybe TeamId
-> Maybe ChannelId
-> Maybe TeamId
-> UserSearch
UserSearch { Bool
Maybe ChannelId
Maybe TeamId
Text
userSearchTeamId :: Maybe TeamId
userSearchNotInChannelId :: Maybe ChannelId
userSearchNotInTeamId :: Maybe TeamId
userSearchInChannelId :: Maybe ChannelId
userSearchWithoutTeam :: Bool
userSearchAllowInactive :: Bool
userSearchTerm :: Text
userSearchTeamId :: Maybe TeamId
userSearchNotInChannelId :: Maybe ChannelId
userSearchNotInTeamId :: Maybe TeamId
userSearchInChannelId :: Maybe ChannelId
userSearchWithoutTeam :: Bool
userSearchAllowInactive :: Bool
userSearchTerm :: Text
.. }

instance A.ToJSON UserSearch where
  toJSON :: UserSearch -> Value
toJSON UserSearch { Bool
Maybe ChannelId
Maybe TeamId
Text
userSearchTeamId :: Maybe TeamId
userSearchNotInChannelId :: Maybe ChannelId
userSearchNotInTeamId :: Maybe TeamId
userSearchInChannelId :: Maybe ChannelId
userSearchWithoutTeam :: Bool
userSearchAllowInactive :: Bool
userSearchTerm :: Text
userSearchTeamId :: UserSearch -> Maybe TeamId
userSearchNotInChannelId :: UserSearch -> Maybe ChannelId
userSearchNotInTeamId :: UserSearch -> Maybe TeamId
userSearchInChannelId :: UserSearch -> Maybe ChannelId
userSearchWithoutTeam :: UserSearch -> Bool
userSearchAllowInactive :: UserSearch -> Bool
userSearchTerm :: UserSearch -> Text
.. } = [Pair] -> Value
A.object
    [ Text
"term" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
userSearchTerm
    , Text
"allow_inactive" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Bool
userSearchAllowInactive
    , Text
"without_team" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Bool
userSearchWithoutTeam
    , Text
"in_channel_id" Text -> Maybe ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Maybe ChannelId
userSearchInChannelId
    , Text
"not_in_team_id" Text -> Maybe TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Maybe TeamId
userSearchNotInTeamId
    , Text
"not_in_channel_id" Text -> Maybe ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Maybe ChannelId
userSearchNotInChannelId
    , Text
"team_id" Text -> Maybe TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Maybe TeamId
userSearchTeamId
    ]

-- --

data RawPost = RawPost
  { RawPost -> ChannelId
rawPostChannelId :: ChannelId
  , RawPost -> Text
rawPostMessage :: Text
    -- ^ The message contents, can be formatted with Markdown
  , RawPost -> Seq FileId
rawPostFileIds :: Seq FileId
    -- ^ A list of file IDs to associate with the post
  , RawPost -> Maybe PostId
rawPostRootId :: Maybe PostId
    -- ^ The post ID to comment on
  } deriving (ReadPrec [RawPost]
ReadPrec RawPost
Int -> ReadS RawPost
ReadS [RawPost]
(Int -> ReadS RawPost)
-> ReadS [RawPost]
-> ReadPrec RawPost
-> ReadPrec [RawPost]
-> Read RawPost
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RawPost]
$creadListPrec :: ReadPrec [RawPost]
readPrec :: ReadPrec RawPost
$creadPrec :: ReadPrec RawPost
readList :: ReadS [RawPost]
$creadList :: ReadS [RawPost]
readsPrec :: Int -> ReadS RawPost
$creadsPrec :: Int -> ReadS RawPost
Read, Int -> RawPost -> ShowS
[RawPost] -> ShowS
RawPost -> String
(Int -> RawPost -> ShowS)
-> (RawPost -> String) -> ([RawPost] -> ShowS) -> Show RawPost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawPost] -> ShowS
$cshowList :: [RawPost] -> ShowS
show :: RawPost -> String
$cshow :: RawPost -> String
showsPrec :: Int -> RawPost -> ShowS
$cshowsPrec :: Int -> RawPost -> ShowS
Show, RawPost -> RawPost -> Bool
(RawPost -> RawPost -> Bool)
-> (RawPost -> RawPost -> Bool) -> Eq RawPost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawPost -> RawPost -> Bool
$c/= :: RawPost -> RawPost -> Bool
== :: RawPost -> RawPost -> Bool
$c== :: RawPost -> RawPost -> Bool
Eq)

instance A.FromJSON RawPost where
  parseJSON :: Value -> Parser RawPost
parseJSON = String -> (Object -> Parser RawPost) -> Value -> Parser RawPost
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"rawPost" ((Object -> Parser RawPost) -> Value -> Parser RawPost)
-> (Object -> Parser RawPost) -> Value -> Parser RawPost
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    ChannelId
rawPostChannelId <- Object
v Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"channel_id"
    Text
rawPostMessage <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"message"
    Seq FileId
rawPostFileIds <- Object
v Object -> Text -> Parser (Seq FileId)
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"file_ids"
    Maybe PostId
rawPostRootId <- Object
v Object -> Text -> Parser (Maybe PostId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"root_id"
    RawPost -> Parser RawPost
forall (m :: * -> *) a. Monad m => a -> m a
return RawPost :: ChannelId -> Text -> Seq FileId -> Maybe PostId -> RawPost
RawPost { Maybe PostId
Text
Seq FileId
ChannelId
rawPostRootId :: Maybe PostId
rawPostFileIds :: Seq FileId
rawPostMessage :: Text
rawPostChannelId :: ChannelId
rawPostRootId :: Maybe PostId
rawPostFileIds :: Seq FileId
rawPostMessage :: Text
rawPostChannelId :: ChannelId
.. }

instance A.ToJSON RawPost where
  toJSON :: RawPost -> Value
toJSON RawPost { Maybe PostId
Text
Seq FileId
ChannelId
rawPostRootId :: Maybe PostId
rawPostFileIds :: Seq FileId
rawPostMessage :: Text
rawPostChannelId :: ChannelId
rawPostRootId :: RawPost -> Maybe PostId
rawPostFileIds :: RawPost -> Seq FileId
rawPostMessage :: RawPost -> Text
rawPostChannelId :: RawPost -> ChannelId
.. } = [Pair] -> Value
A.object
    ( Text
"channel_id" Text -> ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= ChannelId
rawPostChannelId
    Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
rawPostMessage
    Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"file_ids" Text -> Seq FileId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Seq FileId
rawPostFileIds
    Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: case Maybe PostId
rawPostRootId of
        Maybe PostId
Nothing -> []
        Just PostId
rId -> [(Text
"root_id" Text -> PostId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= PostId
rId)]
    )

rawPost :: Text -> ChannelId -> RawPost
rawPost :: Text -> ChannelId -> RawPost
rawPost Text
message ChannelId
channelId = RawPost :: ChannelId -> Text -> Seq FileId -> Maybe PostId -> RawPost
RawPost
  { rawPostChannelId :: ChannelId
rawPostChannelId = ChannelId
channelId
  , rawPostMessage :: Text
rawPostMessage   = Text
message
  , rawPostFileIds :: Seq FileId
rawPostFileIds   = Seq FileId
forall a. Monoid a => a
mempty
  , rawPostRootId :: Maybe PostId
rawPostRootId    = Maybe PostId
forall a. Maybe a
Nothing
  }


data PostUpdate = PostUpdate
  { PostUpdate -> Maybe Bool
postUpdateIsPinned :: Maybe Bool
  , PostUpdate -> Text
postUpdateMessage :: Text
    -- ^ The message text of the post
  , PostUpdate -> Maybe Bool
postUpdateHasReactions :: Maybe Bool
    -- ^ Set to `true` if the post has reactions to it
  , PostUpdate -> Maybe (Seq FileId)
postUpdateFileIds :: Maybe (Seq FileId)
    -- ^ The list of files attached to this post
  , PostUpdate -> Maybe Text
postUpdateProps :: Maybe Text
    -- ^ A general JSON property bag to attach to the post
  } deriving (ReadPrec [PostUpdate]
ReadPrec PostUpdate
Int -> ReadS PostUpdate
ReadS [PostUpdate]
(Int -> ReadS PostUpdate)
-> ReadS [PostUpdate]
-> ReadPrec PostUpdate
-> ReadPrec [PostUpdate]
-> Read PostUpdate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostUpdate]
$creadListPrec :: ReadPrec [PostUpdate]
readPrec :: ReadPrec PostUpdate
$creadPrec :: ReadPrec PostUpdate
readList :: ReadS [PostUpdate]
$creadList :: ReadS [PostUpdate]
readsPrec :: Int -> ReadS PostUpdate
$creadsPrec :: Int -> ReadS PostUpdate
Read, Int -> PostUpdate -> ShowS
[PostUpdate] -> ShowS
PostUpdate -> String
(Int -> PostUpdate -> ShowS)
-> (PostUpdate -> String)
-> ([PostUpdate] -> ShowS)
-> Show PostUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostUpdate] -> ShowS
$cshowList :: [PostUpdate] -> ShowS
show :: PostUpdate -> String
$cshow :: PostUpdate -> String
showsPrec :: Int -> PostUpdate -> ShowS
$cshowsPrec :: Int -> PostUpdate -> ShowS
Show, PostUpdate -> PostUpdate -> Bool
(PostUpdate -> PostUpdate -> Bool)
-> (PostUpdate -> PostUpdate -> Bool) -> Eq PostUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostUpdate -> PostUpdate -> Bool
$c/= :: PostUpdate -> PostUpdate -> Bool
== :: PostUpdate -> PostUpdate -> Bool
$c== :: PostUpdate -> PostUpdate -> Bool
Eq)

instance A.FromJSON PostUpdate where
  parseJSON :: Value -> Parser PostUpdate
parseJSON = String
-> (Object -> Parser PostUpdate) -> Value -> Parser PostUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"postUpdate" ((Object -> Parser PostUpdate) -> Value -> Parser PostUpdate)
-> (Object -> Parser PostUpdate) -> Value -> Parser PostUpdate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Maybe Bool
postUpdateIsPinned <- Object
v Object -> Text -> Parser (Maybe (Maybe Bool))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"is_pinned" Parser (Maybe (Maybe Bool)) -> Maybe Bool -> Parser (Maybe Bool)
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Maybe Bool
forall a. Maybe a
Nothing
    Text
postUpdateMessage <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"message"
    Maybe Bool
postUpdateHasReactions <- Object
v Object -> Text -> Parser (Maybe (Maybe Bool))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"has_reactions" Parser (Maybe (Maybe Bool)) -> Maybe Bool -> Parser (Maybe Bool)
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Maybe Bool
forall a. Maybe a
Nothing
    Maybe (Seq FileId)
postUpdateFileIds <- Object
v Object -> Text -> Parser (Maybe (Maybe (Seq FileId)))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"file_ids" Parser (Maybe (Maybe (Seq FileId)))
-> Maybe (Seq FileId) -> Parser (Maybe (Seq FileId))
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Maybe (Seq FileId)
forall a. Maybe a
Nothing
    Maybe Text
postUpdateProps <- Object
v Object -> Text -> Parser (Maybe (Maybe Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"props" Parser (Maybe (Maybe Text)) -> Maybe Text -> Parser (Maybe Text)
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Maybe Text
forall a. Maybe a
Nothing
    PostUpdate -> Parser PostUpdate
forall (m :: * -> *) a. Monad m => a -> m a
return PostUpdate :: Maybe Bool
-> Text
-> Maybe Bool
-> Maybe (Seq FileId)
-> Maybe Text
-> PostUpdate
PostUpdate { Maybe Bool
Maybe Text
Maybe (Seq FileId)
Text
postUpdateProps :: Maybe Text
postUpdateFileIds :: Maybe (Seq FileId)
postUpdateHasReactions :: Maybe Bool
postUpdateMessage :: Text
postUpdateIsPinned :: Maybe Bool
postUpdateProps :: Maybe Text
postUpdateFileIds :: Maybe (Seq FileId)
postUpdateHasReactions :: Maybe Bool
postUpdateMessage :: Text
postUpdateIsPinned :: Maybe Bool
.. }

instance A.ToJSON PostUpdate where
  toJSON :: PostUpdate -> Value
toJSON PostUpdate { Maybe Bool
Maybe Text
Maybe (Seq FileId)
Text
postUpdateProps :: Maybe Text
postUpdateFileIds :: Maybe (Seq FileId)
postUpdateHasReactions :: Maybe Bool
postUpdateMessage :: Text
postUpdateIsPinned :: Maybe Bool
postUpdateProps :: PostUpdate -> Maybe Text
postUpdateFileIds :: PostUpdate -> Maybe (Seq FileId)
postUpdateHasReactions :: PostUpdate -> Maybe Bool
postUpdateMessage :: PostUpdate -> Text
postUpdateIsPinned :: PostUpdate -> Maybe Bool
.. } = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Text
"is_pinned" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Bool
p | Just Bool
p <- [Maybe Bool
postUpdateIsPinned] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
postUpdateMessage ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"has_reactions" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Bool
p | Just Bool
p <- [Maybe Bool
postUpdateHasReactions] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"file_ids" Text -> Seq FileId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Seq FileId
p | Just Seq FileId
p <- [Maybe (Seq FileId)
postUpdateFileIds] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"props" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
p | Just Text
p <- [Maybe Text
postUpdateProps] ]

postUpdateBody :: Text -> PostUpdate
postUpdateBody :: Text -> PostUpdate
postUpdateBody Text
message =
    PostUpdate :: Maybe Bool
-> Text
-> Maybe Bool
-> Maybe (Seq FileId)
-> Maybe Text
-> PostUpdate
PostUpdate { postUpdateIsPinned :: Maybe Bool
postUpdateIsPinned = Maybe Bool
forall a. Maybe a
Nothing
               , postUpdateMessage :: Text
postUpdateMessage = Text
message
               , postUpdateHasReactions :: Maybe Bool
postUpdateHasReactions = Maybe Bool
forall a. Maybe a
Nothing
               , postUpdateFileIds :: Maybe (Seq FileId)
postUpdateFileIds = Maybe (Seq FileId)
forall a. Maybe a
Nothing
               , postUpdateProps :: Maybe Text
postUpdateProps = Maybe Text
forall a. Maybe a
Nothing
               }

data ChannelPatch = ChannelPatch
  { ChannelPatch -> Maybe Text
channelPatchHeader :: Maybe Text
  , ChannelPatch -> Maybe Text
channelPatchDisplayName :: Maybe Text
    -- ^ The non-unique UI name for the channel
  , ChannelPatch -> Maybe Text
channelPatchName :: Maybe Text
    -- ^ The unique handle for the channel, will be present in the channel URL
  , ChannelPatch -> Maybe Text
channelPatchPurpose :: Maybe Text
    -- ^ A short description of the purpose of the channel
  } deriving (ReadPrec [ChannelPatch]
ReadPrec ChannelPatch
Int -> ReadS ChannelPatch
ReadS [ChannelPatch]
(Int -> ReadS ChannelPatch)
-> ReadS [ChannelPatch]
-> ReadPrec ChannelPatch
-> ReadPrec [ChannelPatch]
-> Read ChannelPatch
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelPatch]
$creadListPrec :: ReadPrec [ChannelPatch]
readPrec :: ReadPrec ChannelPatch
$creadPrec :: ReadPrec ChannelPatch
readList :: ReadS [ChannelPatch]
$creadList :: ReadS [ChannelPatch]
readsPrec :: Int -> ReadS ChannelPatch
$creadsPrec :: Int -> ReadS ChannelPatch
Read, Int -> ChannelPatch -> ShowS
[ChannelPatch] -> ShowS
ChannelPatch -> String
(Int -> ChannelPatch -> ShowS)
-> (ChannelPatch -> String)
-> ([ChannelPatch] -> ShowS)
-> Show ChannelPatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelPatch] -> ShowS
$cshowList :: [ChannelPatch] -> ShowS
show :: ChannelPatch -> String
$cshow :: ChannelPatch -> String
showsPrec :: Int -> ChannelPatch -> ShowS
$cshowsPrec :: Int -> ChannelPatch -> ShowS
Show, ChannelPatch -> ChannelPatch -> Bool
(ChannelPatch -> ChannelPatch -> Bool)
-> (ChannelPatch -> ChannelPatch -> Bool) -> Eq ChannelPatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelPatch -> ChannelPatch -> Bool
$c/= :: ChannelPatch -> ChannelPatch -> Bool
== :: ChannelPatch -> ChannelPatch -> Bool
$c== :: ChannelPatch -> ChannelPatch -> Bool
Eq)

instance A.FromJSON ChannelPatch where
  parseJSON :: Value -> Parser ChannelPatch
parseJSON = String
-> (Object -> Parser ChannelPatch) -> Value -> Parser ChannelPatch
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"channelPatch" ((Object -> Parser ChannelPatch) -> Value -> Parser ChannelPatch)
-> (Object -> Parser ChannelPatch) -> Value -> Parser ChannelPatch
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Maybe Text
channelPatchHeader <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"header"
    Maybe Text
channelPatchDisplayName <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"display_name"
    Maybe Text
channelPatchName <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"name"
    Maybe Text
channelPatchPurpose <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"purpose"
    ChannelPatch -> Parser ChannelPatch
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelPatch :: Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> ChannelPatch
ChannelPatch { Maybe Text
channelPatchPurpose :: Maybe Text
channelPatchName :: Maybe Text
channelPatchDisplayName :: Maybe Text
channelPatchHeader :: Maybe Text
channelPatchPurpose :: Maybe Text
channelPatchName :: Maybe Text
channelPatchDisplayName :: Maybe Text
channelPatchHeader :: Maybe Text
.. }

instance A.ToJSON ChannelPatch where
  toJSON :: ChannelPatch -> Value
toJSON ChannelPatch { Maybe Text
channelPatchPurpose :: Maybe Text
channelPatchName :: Maybe Text
channelPatchDisplayName :: Maybe Text
channelPatchHeader :: Maybe Text
channelPatchPurpose :: ChannelPatch -> Maybe Text
channelPatchName :: ChannelPatch -> Maybe Text
channelPatchDisplayName :: ChannelPatch -> Maybe Text
channelPatchHeader :: ChannelPatch -> Maybe Text
.. } = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Text
"header" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
x | Just Text
x <- [ Maybe Text
channelPatchHeader] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"display_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
x | Just Text
x <- [Maybe Text
channelPatchDisplayName] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
x | Just Text
x <- [Maybe Text
channelPatchName] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [ Text
"purpose" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
x | Just Text
x <- [Maybe Text
channelPatchPurpose] ]

defaultChannelPatch :: ChannelPatch
defaultChannelPatch :: ChannelPatch
defaultChannelPatch = ChannelPatch :: Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> ChannelPatch
ChannelPatch
  { channelPatchHeader :: Maybe Text
channelPatchHeader = Maybe Text
forall a. Maybe a
Nothing
  , channelPatchDisplayName :: Maybe Text
channelPatchDisplayName = Maybe Text
forall a. Maybe a
Nothing
  , channelPatchName :: Maybe Text
channelPatchName = Maybe Text
forall a. Maybe a
Nothing
  , channelPatchPurpose :: Maybe Text
channelPatchPurpose = Maybe Text
forall a. Maybe a
Nothing
  }


data InitialTeamData = InitialTeamData
  { InitialTeamData -> Text
initialTeamDataDisplayName :: Text
  , InitialTeamData -> Text
initialTeamDataType :: Text
    -- ^ `'O'` for open, `'I'` for invite only
  , InitialTeamData -> Text
initialTeamDataName :: Text
    -- ^ Unique handler for a team, will be present in the team URL
  } deriving (ReadPrec [InitialTeamData]
ReadPrec InitialTeamData
Int -> ReadS InitialTeamData
ReadS [InitialTeamData]
(Int -> ReadS InitialTeamData)
-> ReadS [InitialTeamData]
-> ReadPrec InitialTeamData
-> ReadPrec [InitialTeamData]
-> Read InitialTeamData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitialTeamData]
$creadListPrec :: ReadPrec [InitialTeamData]
readPrec :: ReadPrec InitialTeamData
$creadPrec :: ReadPrec InitialTeamData
readList :: ReadS [InitialTeamData]
$creadList :: ReadS [InitialTeamData]
readsPrec :: Int -> ReadS InitialTeamData
$creadsPrec :: Int -> ReadS InitialTeamData
Read, Int -> InitialTeamData -> ShowS
[InitialTeamData] -> ShowS
InitialTeamData -> String
(Int -> InitialTeamData -> ShowS)
-> (InitialTeamData -> String)
-> ([InitialTeamData] -> ShowS)
-> Show InitialTeamData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitialTeamData] -> ShowS
$cshowList :: [InitialTeamData] -> ShowS
show :: InitialTeamData -> String
$cshow :: InitialTeamData -> String
showsPrec :: Int -> InitialTeamData -> ShowS
$cshowsPrec :: Int -> InitialTeamData -> ShowS
Show, InitialTeamData -> InitialTeamData -> Bool
(InitialTeamData -> InitialTeamData -> Bool)
-> (InitialTeamData -> InitialTeamData -> Bool)
-> Eq InitialTeamData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitialTeamData -> InitialTeamData -> Bool
$c/= :: InitialTeamData -> InitialTeamData -> Bool
== :: InitialTeamData -> InitialTeamData -> Bool
$c== :: InitialTeamData -> InitialTeamData -> Bool
Eq)

instance A.FromJSON InitialTeamData where
  parseJSON :: Value -> Parser InitialTeamData
parseJSON = String
-> (Object -> Parser InitialTeamData)
-> Value
-> Parser InitialTeamData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"initialTeamData" ((Object -> Parser InitialTeamData)
 -> Value -> Parser InitialTeamData)
-> (Object -> Parser InitialTeamData)
-> Value
-> Parser InitialTeamData
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
initialTeamDataDisplayName <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"display_name"
    Text
initialTeamDataType <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Text
initialTeamDataName <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    InitialTeamData -> Parser InitialTeamData
forall (m :: * -> *) a. Monad m => a -> m a
return InitialTeamData :: Text -> Text -> Text -> InitialTeamData
InitialTeamData { Text
initialTeamDataName :: Text
initialTeamDataType :: Text
initialTeamDataDisplayName :: Text
initialTeamDataName :: Text
initialTeamDataType :: Text
initialTeamDataDisplayName :: Text
.. }

instance A.ToJSON InitialTeamData where
  toJSON :: InitialTeamData -> Value
toJSON InitialTeamData { Text
initialTeamDataName :: Text
initialTeamDataType :: Text
initialTeamDataDisplayName :: Text
initialTeamDataName :: InitialTeamData -> Text
initialTeamDataType :: InitialTeamData -> Text
initialTeamDataDisplayName :: InitialTeamData -> Text
.. } = [Pair] -> Value
A.object
    [ Text
"display_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
initialTeamDataDisplayName
    , Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
initialTeamDataType
    , Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
initialTeamDataName
    ]

data ChannelStats = ChannelStats
  { ChannelStats -> Text
channelStatsChannelId   :: Text
  , ChannelStats -> Int
channelStatsMemberCount :: Int
  } deriving (ReadPrec [ChannelStats]
ReadPrec ChannelStats
Int -> ReadS ChannelStats
ReadS [ChannelStats]
(Int -> ReadS ChannelStats)
-> ReadS [ChannelStats]
-> ReadPrec ChannelStats
-> ReadPrec [ChannelStats]
-> Read ChannelStats
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelStats]
$creadListPrec :: ReadPrec [ChannelStats]
readPrec :: ReadPrec ChannelStats
$creadPrec :: ReadPrec ChannelStats
readList :: ReadS [ChannelStats]
$creadList :: ReadS [ChannelStats]
readsPrec :: Int -> ReadS ChannelStats
$creadsPrec :: Int -> ReadS ChannelStats
Read, Int -> ChannelStats -> ShowS
[ChannelStats] -> ShowS
ChannelStats -> String
(Int -> ChannelStats -> ShowS)
-> (ChannelStats -> String)
-> ([ChannelStats] -> ShowS)
-> Show ChannelStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelStats] -> ShowS
$cshowList :: [ChannelStats] -> ShowS
show :: ChannelStats -> String
$cshow :: ChannelStats -> String
showsPrec :: Int -> ChannelStats -> ShowS
$cshowsPrec :: Int -> ChannelStats -> ShowS
Show, ChannelStats -> ChannelStats -> Bool
(ChannelStats -> ChannelStats -> Bool)
-> (ChannelStats -> ChannelStats -> Bool) -> Eq ChannelStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelStats -> ChannelStats -> Bool
$c/= :: ChannelStats -> ChannelStats -> Bool
== :: ChannelStats -> ChannelStats -> Bool
$c== :: ChannelStats -> ChannelStats -> Bool
Eq)

instance A.FromJSON ChannelStats where
  parseJSON :: Value -> Parser ChannelStats
parseJSON = String
-> (Object -> Parser ChannelStats) -> Value -> Parser ChannelStats
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"channelStats" ((Object -> Parser ChannelStats) -> Value -> Parser ChannelStats)
-> (Object -> Parser ChannelStats) -> Value -> Parser ChannelStats
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
channelStatsChannelId   <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"channel_id"
    Int
channelStatsMemberCount <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"member_count"
    ChannelStats -> Parser ChannelStats
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelStats :: Text -> Int -> ChannelStats
ChannelStats { Int
Text
channelStatsMemberCount :: Int
channelStatsChannelId :: Text
channelStatsMemberCount :: Int
channelStatsChannelId :: Text
.. }

instance A.ToJSON ChannelStats where
  toJSON :: ChannelStats -> Value
toJSON ChannelStats { Int
Text
channelStatsMemberCount :: Int
channelStatsChannelId :: Text
channelStatsMemberCount :: ChannelStats -> Int
channelStatsChannelId :: ChannelStats -> Text
.. } = [Pair] -> Value
A.object
    [ Text
"channel_id"   Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
channelStatsChannelId
    , Text
"member_count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Int
channelStatsMemberCount
    ]

-- --

data ChannelUnread = ChannelUnread
  { ChannelUnread -> Text
channelUnreadChannelId :: Text
  , ChannelUnread -> Text
channelUnreadTeamId :: Text
  , ChannelUnread -> Int
channelUnreadMsgCount :: Int
  , ChannelUnread -> Int
channelUnreadMentionCount :: Int
  } deriving (ReadPrec [ChannelUnread]
ReadPrec ChannelUnread
Int -> ReadS ChannelUnread
ReadS [ChannelUnread]
(Int -> ReadS ChannelUnread)
-> ReadS [ChannelUnread]
-> ReadPrec ChannelUnread
-> ReadPrec [ChannelUnread]
-> Read ChannelUnread
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelUnread]
$creadListPrec :: ReadPrec [ChannelUnread]
readPrec :: ReadPrec ChannelUnread
$creadPrec :: ReadPrec ChannelUnread
readList :: ReadS [ChannelUnread]
$creadList :: ReadS [ChannelUnread]
readsPrec :: Int -> ReadS ChannelUnread
$creadsPrec :: Int -> ReadS ChannelUnread
Read, Int -> ChannelUnread -> ShowS
[ChannelUnread] -> ShowS
ChannelUnread -> String
(Int -> ChannelUnread -> ShowS)
-> (ChannelUnread -> String)
-> ([ChannelUnread] -> ShowS)
-> Show ChannelUnread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelUnread] -> ShowS
$cshowList :: [ChannelUnread] -> ShowS
show :: ChannelUnread -> String
$cshow :: ChannelUnread -> String
showsPrec :: Int -> ChannelUnread -> ShowS
$cshowsPrec :: Int -> ChannelUnread -> ShowS
Show, ChannelUnread -> ChannelUnread -> Bool
(ChannelUnread -> ChannelUnread -> Bool)
-> (ChannelUnread -> ChannelUnread -> Bool) -> Eq ChannelUnread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelUnread -> ChannelUnread -> Bool
$c/= :: ChannelUnread -> ChannelUnread -> Bool
== :: ChannelUnread -> ChannelUnread -> Bool
$c== :: ChannelUnread -> ChannelUnread -> Bool
Eq)

instance A.FromJSON ChannelUnread where
  parseJSON :: Value -> Parser ChannelUnread
parseJSON = String
-> (Object -> Parser ChannelUnread)
-> Value
-> Parser ChannelUnread
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"channelUnread" ((Object -> Parser ChannelUnread) -> Value -> Parser ChannelUnread)
-> (Object -> Parser ChannelUnread)
-> Value
-> Parser ChannelUnread
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
channelUnreadChannelId <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"channel_id"
    Text
channelUnreadTeamId <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"team_id"
    Int
channelUnreadMsgCount <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"msg_count"
    Int
channelUnreadMentionCount <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"mention_count"
    ChannelUnread -> Parser ChannelUnread
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelUnread :: Text -> Text -> Int -> Int -> ChannelUnread
ChannelUnread { Int
Text
channelUnreadMentionCount :: Int
channelUnreadMsgCount :: Int
channelUnreadTeamId :: Text
channelUnreadChannelId :: Text
channelUnreadMentionCount :: Int
channelUnreadMsgCount :: Int
channelUnreadTeamId :: Text
channelUnreadChannelId :: Text
.. }

instance A.ToJSON ChannelUnread where
  toJSON :: ChannelUnread -> Value
toJSON ChannelUnread { Int
Text
channelUnreadMentionCount :: Int
channelUnreadMsgCount :: Int
channelUnreadTeamId :: Text
channelUnreadChannelId :: Text
channelUnreadMentionCount :: ChannelUnread -> Int
channelUnreadMsgCount :: ChannelUnread -> Int
channelUnreadTeamId :: ChannelUnread -> Text
channelUnreadChannelId :: ChannelUnread -> Text
.. } = [Pair] -> Value
A.object
    [ Text
"channel_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
channelUnreadChannelId
    , Text
"team_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Text
channelUnreadTeamId
    , Text
"msg_count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Int
channelUnreadMsgCount
    , Text
"mention_count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Int
channelUnreadMentionCount
    ]