module Network.Mattermost.QuickCheck where

import qualified Data.Sequence as Seq
import qualified Data.Text as T
import           Data.Time.Calendar (Day(..))
import           Data.Time.Clock (UTCTime(..), secondsToDiffTime)
import           Network.Mattermost.Types
import           Test.QuickCheck


genUserText :: Gen UserText
genUserText :: Gen UserText
genUserText = Text -> UserText
UserText (Text -> UserText) -> Gen Text -> Gen UserText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText

genText :: Gen T.Text
genText :: Gen Text
genText = (Int -> Gen Text) -> Gen Text
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Text) -> Gen Text) -> (Int -> Gen Text) -> Gen Text
forall a b. (a -> b) -> a -> b
$ \Int
s ->
          [Gen Text] -> Gen Text
forall a. [Gen a] -> Gen a
oneof [ Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
'a'
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
'1'
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"b2"
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
' '
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
'\n'
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
'\r'
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
'\t'
                 , Text -> Gen Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
" \n\r\t"
                 , String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen String
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
s Gen Char
forall a. Arbitrary a => Gen a
arbitrary
                 ]

genMaybe :: Gen a -> Gen (Maybe a)
genMaybe :: Gen a -> Gen (Maybe a)
genMaybe Gen a
g = [(Int, Gen (Maybe a))] -> Gen (Maybe a)
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
1, Maybe a -> Gen (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
                       , (Int
11, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g)
                       ]

genSeq :: Gen a -> Gen (Seq.Seq a)
genSeq :: Gen a -> Gen (Seq a)
genSeq Gen a
g = (Int -> Gen (Seq a)) -> Gen (Seq a)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (Seq a)) -> Gen (Seq a))
-> (Int -> Gen (Seq a)) -> Gen (Seq a)
forall a b. (a -> b) -> a -> b
$ \Int
s ->
           [(Int, Gen (Seq a))] -> Gen (Seq a)
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
1, Seq a -> Gen (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq a
forall a. Seq a
Seq.empty)
                     , (Int
9, [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Gen [a] -> Gen (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
s Gen a
g)
                     ]

genTime :: Gen ServerTime
genTime :: Gen ServerTime
genTime = UTCTime -> ServerTime
ServerTime (UTCTime -> ServerTime) -> Gen UTCTime -> Gen ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (Day -> DiffTime -> UTCTime
UTCTime
           (Day -> DiffTime -> UTCTime)
-> Gen Day -> Gen (DiffTime -> UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Day
ModifiedJulianDay (Integer -> Day) -> (Integer -> Integer) -> Integer -> Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer
2000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (Integer -> Day) -> Gen Integer -> Gen Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary)
           Gen (DiffTime -> UTCTime) -> Gen DiffTime -> Gen UTCTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Gen Integer -> Gen DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
86400)))

genPostId :: Gen PostId
genPostId :: Gen PostId
genPostId = Id -> PostId
PI (Id -> PostId) -> (Text -> Id) -> Text -> PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id (Text -> PostId) -> Gen Text -> Gen PostId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText

genChannelId :: Gen ChannelId
genChannelId :: Gen ChannelId
genChannelId = Id -> ChannelId
CI (Id -> ChannelId) -> (Text -> Id) -> Text -> ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id (Text -> ChannelId) -> Gen Text -> Gen ChannelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText

genFileId :: Gen FileId
genFileId :: Gen FileId
genFileId = Id -> FileId
FI (Id -> FileId) -> (Text -> Id) -> Text -> FileId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id (Text -> FileId) -> Gen Text -> Gen FileId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText

genUserId :: Gen UserId
genUserId :: Gen UserId
genUserId = Id -> UserId
UI (Id -> UserId) -> (Text -> Id) -> Text -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id (Text -> UserId) -> Gen Text -> Gen UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText

genType :: Gen Type
genType :: Gen Type
genType = [Gen Type] -> Gen Type
forall a. [Gen a] -> Gen a
oneof [ Type -> Gen Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Ordinary
                , Type -> Gen Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Direct
                , Type -> Gen Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Private
                , Type -> Gen Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Group
                , Text -> Type
Unknown (Text -> Type) -> Gen Text -> Gen Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText
                ]

genPostProps :: Gen PostProps
genPostProps :: Gen PostProps
genPostProps = Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe (Seq PostPropAttachment)
-> Maybe Text
-> Maybe Text
-> PostProps
PostProps
               (Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe (Seq PostPropAttachment)
 -> Maybe Text
 -> Maybe Text
 -> PostProps)
-> Gen (Maybe Text)
-> Gen
     (Maybe Text
      -> Maybe Bool
      -> Maybe (Seq PostPropAttachment)
      -> Maybe Text
      -> Maybe Text
      -> PostProps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text -> Gen (Maybe Text)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen Text
genText
               Gen
  (Maybe Text
   -> Maybe Bool
   -> Maybe (Seq PostPropAttachment)
   -> Maybe Text
   -> Maybe Text
   -> PostProps)
-> Gen (Maybe Text)
-> Gen
     (Maybe Bool
      -> Maybe (Seq PostPropAttachment)
      -> Maybe Text
      -> Maybe Text
      -> PostProps)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text -> Gen (Maybe Text)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen Text
genText
               Gen
  (Maybe Bool
   -> Maybe (Seq PostPropAttachment)
   -> Maybe Text
   -> Maybe Text
   -> PostProps)
-> Gen (Maybe Bool)
-> Gen
     (Maybe (Seq PostPropAttachment)
      -> Maybe Text -> Maybe Text -> PostProps)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool -> Gen (Maybe Bool)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
               Gen
  (Maybe (Seq PostPropAttachment)
   -> Maybe Text -> Maybe Text -> PostProps)
-> Gen (Maybe (Seq PostPropAttachment))
-> Gen (Maybe Text -> Maybe Text -> PostProps)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (Seq PostPropAttachment))
attached
               Gen (Maybe Text -> Maybe Text -> PostProps)
-> Gen (Maybe Text) -> Gen (Maybe Text -> PostProps)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text -> Gen (Maybe Text)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen Text
genText
               Gen (Maybe Text -> PostProps) -> Gen (Maybe Text) -> Gen PostProps
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text -> Gen (Maybe Text)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen Text
genText


attached :: Gen (Maybe (Seq.Seq PostPropAttachment))
attached :: Gen (Maybe (Seq PostPropAttachment))
attached = [Gen (Maybe (Seq PostPropAttachment))]
-> Gen (Maybe (Seq PostPropAttachment))
forall a. [Gen a] -> Gen a
oneof [ Maybe (Seq PostPropAttachment)
-> Gen (Maybe (Seq PostPropAttachment))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Seq PostPropAttachment)
forall a. Maybe a
Nothing
                 , Seq PostPropAttachment -> Maybe (Seq PostPropAttachment)
forall a. a -> Maybe a
Just (Seq PostPropAttachment -> Maybe (Seq PostPropAttachment))
-> Gen (Seq PostPropAttachment)
-> Gen (Maybe (Seq PostPropAttachment))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen PostPropAttachment -> Gen (Seq PostPropAttachment)
forall a. Gen a -> Gen (Seq a)
genSeq Gen PostPropAttachment
genPostPropAttachment)
                 ]

genPostPropAttachmentField :: Gen PostPropAttachmentField
genPostPropAttachmentField :: Gen PostPropAttachmentField
genPostPropAttachmentField =
  Text -> Text -> Bool -> PostPropAttachmentField
PostPropAttachmentField (Text -> Text -> Bool -> PostPropAttachmentField)
-> Gen Text -> Gen (Text -> Bool -> PostPropAttachmentField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText
                          Gen (Text -> Bool -> PostPropAttachmentField)
-> Gen Text -> Gen (Bool -> PostPropAttachmentField)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                          Gen (Bool -> PostPropAttachmentField)
-> Gen Bool -> Gen PostPropAttachmentField
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen Bool] -> Gen Bool
forall a. [Gen a] -> Gen a
oneof [ Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True, Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False ]

genPostPropAttachment :: Gen PostPropAttachment
genPostPropAttachment :: Gen PostPropAttachment
genPostPropAttachment = Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Seq PostPropAttachmentField
-> Text
-> Text
-> Text
-> Text
-> PostPropAttachment
PostPropAttachment
                        (Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Seq PostPropAttachmentField
 -> Text
 -> Text
 -> Text
 -> Text
 -> PostPropAttachment)
-> Gen Int
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
                        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Text
      -> Seq PostPropAttachmentField
      -> Text
      -> Text
      -> Text
      -> Text
      -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Text
   -> Seq PostPropAttachmentField
   -> Text
   -> Text
   -> Text
   -> Text
   -> PostPropAttachment)
-> Gen Text
-> Gen
     (Seq PostPropAttachmentField
      -> Text -> Text -> Text -> Text -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen
  (Seq PostPropAttachmentField
   -> Text -> Text -> Text -> Text -> PostPropAttachment)
-> Gen (Seq PostPropAttachmentField)
-> Gen (Text -> Text -> Text -> Text -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PostPropAttachmentField -> Gen (Seq PostPropAttachmentField)
forall a. Gen a -> Gen (Seq a)
genSeq Gen PostPropAttachmentField
genPostPropAttachmentField
                        Gen (Text -> Text -> Text -> Text -> PostPropAttachment)
-> Gen Text -> Gen (Text -> Text -> Text -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen (Text -> Text -> Text -> PostPropAttachment)
-> Gen Text -> Gen (Text -> Text -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen (Text -> Text -> PostPropAttachment)
-> Gen Text -> Gen (Text -> PostPropAttachment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
                        Gen (Text -> PostPropAttachment)
-> Gen Text -> Gen PostPropAttachment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText

genPostType :: Gen PostType
genPostType :: Gen PostType
genPostType = [Gen PostType] -> Gen PostType
forall a. [Gen a] -> Gen a
oneof [ PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeJoinChannel
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeLeaveChannel
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeAddToChannel
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeRemoveFromChannel
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeHeaderChange
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeDisplayNameChange
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypePurposeChange
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeChannelDeleted
                    , PostType -> Gen PostType
forall (m :: * -> *) a. Monad m => a -> m a
return PostType
PostTypeEphemeral
                    , Text -> PostType
PostTypeUnknown (Text -> PostType) -> Gen Text -> Gen PostType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genText
                    ]

genPost :: Gen Post
genPost :: Gen Post
genPost = 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
          (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)
-> Gen (Maybe PostId)
-> Gen
     (Maybe PostId
      -> PostProps
      -> Maybe PostId
      -> Seq FileId
      -> PostId
      -> PostType
      -> UserText
      -> Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PostId -> Gen (Maybe PostId)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen PostId
genPostId
          Gen
  (Maybe PostId
   -> PostProps
   -> Maybe PostId
   -> Seq FileId
   -> PostId
   -> PostType
   -> UserText
   -> Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen (Maybe PostId)
-> Gen
     (PostProps
      -> Maybe PostId
      -> Seq FileId
      -> PostId
      -> PostType
      -> UserText
      -> Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PostId -> Gen (Maybe PostId)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen PostId
genPostId
          Gen
  (PostProps
   -> Maybe PostId
   -> Seq FileId
   -> PostId
   -> PostType
   -> UserText
   -> Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen PostProps
-> Gen
     (Maybe PostId
      -> Seq FileId
      -> PostId
      -> PostType
      -> UserText
      -> Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PostProps
genPostProps
          Gen
  (Maybe PostId
   -> Seq FileId
   -> PostId
   -> PostType
   -> UserText
   -> Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen (Maybe PostId)
-> Gen
     (Seq FileId
      -> PostId
      -> PostType
      -> UserText
      -> Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PostId -> Gen (Maybe PostId)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen PostId
genPostId
          Gen
  (Seq FileId
   -> PostId
   -> PostType
   -> UserText
   -> Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen (Seq FileId)
-> Gen
     (PostId
      -> PostType
      -> UserText
      -> Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FileId -> Gen (Seq FileId)
forall a. Gen a -> Gen (Seq a)
genSeq Gen FileId
genFileId
          Gen
  (PostId
   -> PostType
   -> UserText
   -> Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen PostId
-> Gen
     (PostType
      -> UserText
      -> Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PostId
genPostId
          Gen
  (PostType
   -> UserText
   -> Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen PostType
-> Gen
     (UserText
      -> Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PostType
genPostType
          Gen
  (UserText
   -> Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen UserText
-> Gen
     (Maybe ServerTime
      -> Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UserText
genUserText
          Gen
  (Maybe ServerTime
   -> Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen (Maybe ServerTime)
-> Gen
     (Text
      -> ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ServerTime -> Gen (Maybe ServerTime)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen ServerTime
genTime
          Gen
  (Text
   -> ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen Text
-> Gen
     (ServerTime
      -> ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genText
          Gen
  (ServerTime
   -> ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen ServerTime
-> Gen
     (ServerTime
      -> Maybe UserId
      -> ServerTime
      -> ChannelId
      -> Bool
      -> Maybe Bool
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ServerTime
genTime
          Gen
  (ServerTime
   -> Maybe UserId
   -> ServerTime
   -> ChannelId
   -> Bool
   -> Maybe Bool
   -> Post)
-> Gen ServerTime
-> Gen
     (Maybe UserId
      -> ServerTime -> ChannelId -> Bool -> Maybe Bool -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ServerTime
genTime
          Gen
  (Maybe UserId
   -> ServerTime -> ChannelId -> Bool -> Maybe Bool -> Post)
-> Gen (Maybe UserId)
-> Gen (ServerTime -> ChannelId -> Bool -> Maybe Bool -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UserId -> Gen (Maybe UserId)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen UserId
genUserId
          Gen (ServerTime -> ChannelId -> Bool -> Maybe Bool -> Post)
-> Gen ServerTime -> Gen (ChannelId -> Bool -> Maybe Bool -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ServerTime
genTime
          Gen (ChannelId -> Bool -> Maybe Bool -> Post)
-> Gen ChannelId -> Gen (Bool -> Maybe Bool -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ChannelId
genChannelId
          Gen (Bool -> Maybe Bool -> Post)
-> Gen Bool -> Gen (Maybe Bool -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
          Gen (Maybe Bool -> Post) -> Gen (Maybe Bool) -> Gen Post
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool -> Gen (Maybe Bool)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen Bool
forall a. Arbitrary a => Gen a
arbitrary