{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : GitLab.SystemHooks.Types
-- Description : Haskell records corresponding to JSON data from GitLab system hook events
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.SystemHooks.Types
  ( Rule (..),
    SystemHook (..),
    ProjectCreate (..),
    ProjectDestroy (..),
    ProjectRename (..),
    ProjectTransfer (..),
    ProjectUpdate (..),
    ProjectChanges (..),
    UserAddToTeam (..),
    UserUpdateForTeam (..),
    UserRemoveFromTeam (..),
    UserCreate (..),
    UserRemove (..),
    UserFailedLogin (..),
    UserRename (..),
    KeyCreate (..),
    KeyRemove (..),
    GroupCreate (..),
    GroupRemove (..),
    GroupRename (..),
    NewGroupMember (..),
    GroupMemberRemove (..),
    GroupMemberUpdate (..),
    Push (..),
    TagPush (..),
    ProjectEvent (..),
    RepositoryEvent (..),
    RepositoryUpdate (..),
    CommitEvent (..),
    CommitAuthorEvent (..),
    Visibility (..),
    MergeRequestEvent (..),
    MergeRequestChanges (..),
    MergeRequestChange (..),
    ObjectAttributes (..),
    MergeParams (..),
    UserEvent (..),
    parseEvent,
  )
where

import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Text (Text)
import Data.Typeable
import GHC.Generics
import GitLab.Types

-- | Pattern matching rules on GitLab hook events.
data Rule where
  Match :: (Typeable a, SystemHook a) => String -> (a -> GitLab ()) -> Rule
  MatchIf :: (Typeable a, SystemHook a) => String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule

-- | A typeclass for GitLab hook events.
class (FromJSON a) => SystemHook a where
  match :: String -> (a -> GitLab ()) -> Rule
  matchIf :: String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule

-- | Parse JSON data into GitLab events.
parseEvent :: (FromJSON a) => String -> Maybe a
parseEvent :: String -> Maybe a
parseEvent String
string =
  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (String -> ByteString
BSL.pack String
string) of
    Left String
_error -> Maybe a
forall a. Maybe a
Nothing
    Right a
event -> a -> Maybe a
forall a. a -> Maybe a
Just a
event

instance SystemHook ProjectCreate where
  match :: String -> (ProjectCreate -> GitLab ()) -> Rule
match = String -> (ProjectCreate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectCreate -> GitLab Bool)
-> (ProjectCreate -> GitLab ())
-> Rule
matchIf = String
-> (ProjectCreate -> GitLab Bool)
-> (ProjectCreate -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | GitLab project creation.
data ProjectCreate = ProjectCreate
  { ProjectCreate -> Text
projectCreate_created_at :: Text,
    ProjectCreate -> Text
projectCreate_updated_at :: Text,
    ProjectCreate -> Text
projectCreate_action :: Text,
    ProjectCreate -> Text
projectCreate_name :: Text,
    ProjectCreate -> Text
projectCreate_owner_email :: Text,
    ProjectCreate -> Text
projectCreate_owner_name :: Text,
    ProjectCreate -> Text
projectCreate_path :: Text,
    ProjectCreate -> Text
projectCreate_path_with_namespace :: Text,
    ProjectCreate -> Int
projectCreate_project_id :: Int,
    ProjectCreate -> Visibility
projectCreate_project_visibility :: Visibility
  }
  deriving (Typeable, Int -> ProjectCreate -> ShowS
[ProjectCreate] -> ShowS
ProjectCreate -> String
(Int -> ProjectCreate -> ShowS)
-> (ProjectCreate -> String)
-> ([ProjectCreate] -> ShowS)
-> Show ProjectCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectCreate] -> ShowS
$cshowList :: [ProjectCreate] -> ShowS
show :: ProjectCreate -> String
$cshow :: ProjectCreate -> String
showsPrec :: Int -> ProjectCreate -> ShowS
$cshowsPrec :: Int -> ProjectCreate -> ShowS
Show, ProjectCreate -> ProjectCreate -> Bool
(ProjectCreate -> ProjectCreate -> Bool)
-> (ProjectCreate -> ProjectCreate -> Bool) -> Eq ProjectCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectCreate -> ProjectCreate -> Bool
$c/= :: ProjectCreate -> ProjectCreate -> Bool
== :: ProjectCreate -> ProjectCreate -> Bool
$c== :: ProjectCreate -> ProjectCreate -> Bool
Eq)

instance SystemHook ProjectDestroy where
  match :: String -> (ProjectDestroy -> GitLab ()) -> Rule
match = String -> (ProjectDestroy -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectDestroy -> GitLab Bool)
-> (ProjectDestroy -> GitLab ())
-> Rule
matchIf = String
-> (ProjectDestroy -> GitLab Bool)
-> (ProjectDestroy -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | Removal of a GitLab removal.
data ProjectDestroy = ProjectDestroy
  { ProjectDestroy -> Text
projectDestroy_created_at :: Text,
    ProjectDestroy -> Text
projectDestroy_updated_at :: Text,
    ProjectDestroy -> Text
projectDestroy_action :: Text,
    ProjectDestroy -> Text
projectDestroy_name :: Text,
    ProjectDestroy -> Text
projectDestroy_owner_email :: Text,
    ProjectDestroy -> Text
projectDestroy_owner_name :: Text,
    ProjectDestroy -> Text
projectDestroy_path :: Text,
    ProjectDestroy -> Text
projectDestroy_path_with_namespace :: Text,
    ProjectDestroy -> Int
projectDestroy_project_id :: Int,
    ProjectDestroy -> Visibility
projectDestroy_project_visibility :: Visibility
  }
  deriving (Typeable, Int -> ProjectDestroy -> ShowS
[ProjectDestroy] -> ShowS
ProjectDestroy -> String
(Int -> ProjectDestroy -> ShowS)
-> (ProjectDestroy -> String)
-> ([ProjectDestroy] -> ShowS)
-> Show ProjectDestroy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectDestroy] -> ShowS
$cshowList :: [ProjectDestroy] -> ShowS
show :: ProjectDestroy -> String
$cshow :: ProjectDestroy -> String
showsPrec :: Int -> ProjectDestroy -> ShowS
$cshowsPrec :: Int -> ProjectDestroy -> ShowS
Show, ProjectDestroy -> ProjectDestroy -> Bool
(ProjectDestroy -> ProjectDestroy -> Bool)
-> (ProjectDestroy -> ProjectDestroy -> Bool) -> Eq ProjectDestroy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectDestroy -> ProjectDestroy -> Bool
$c/= :: ProjectDestroy -> ProjectDestroy -> Bool
== :: ProjectDestroy -> ProjectDestroy -> Bool
$c== :: ProjectDestroy -> ProjectDestroy -> Bool
Eq)

instance SystemHook ProjectRename where
  match :: String -> (ProjectRename -> GitLab ()) -> Rule
match = String -> (ProjectRename -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectRename -> GitLab Bool)
-> (ProjectRename -> GitLab ())
-> Rule
matchIf = String
-> (ProjectRename -> GitLab Bool)
-> (ProjectRename -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | Renaming of a GitLab project.
data ProjectRename = ProjectRename
  { ProjectRename -> Text
projectRename_created_at :: Text,
    ProjectRename -> Text
projectRename_updated_at :: Text,
    ProjectRename -> Text
projectRename_event_name :: Text,
    ProjectRename -> Text
projectRename_name :: Text,
    ProjectRename -> Text
projectRename_path :: Text,
    ProjectRename -> Text
projectRename_path_with_namespace :: Text,
    ProjectRename -> Int
projectRename_project_id :: Int,
    ProjectRename -> Text
projectRename_owner_name :: Text,
    ProjectRename -> Text
projectRename_owner_email :: Text,
    ProjectRename -> Visibility
projectRename_project_visibility :: Visibility,
    ProjectRename -> Text
projectRename_old_path_with_namespace :: Text
  }
  deriving (Typeable, Int -> ProjectRename -> ShowS
[ProjectRename] -> ShowS
ProjectRename -> String
(Int -> ProjectRename -> ShowS)
-> (ProjectRename -> String)
-> ([ProjectRename] -> ShowS)
-> Show ProjectRename
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectRename] -> ShowS
$cshowList :: [ProjectRename] -> ShowS
show :: ProjectRename -> String
$cshow :: ProjectRename -> String
showsPrec :: Int -> ProjectRename -> ShowS
$cshowsPrec :: Int -> ProjectRename -> ShowS
Show, ProjectRename -> ProjectRename -> Bool
(ProjectRename -> ProjectRename -> Bool)
-> (ProjectRename -> ProjectRename -> Bool) -> Eq ProjectRename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectRename -> ProjectRename -> Bool
$c/= :: ProjectRename -> ProjectRename -> Bool
== :: ProjectRename -> ProjectRename -> Bool
$c== :: ProjectRename -> ProjectRename -> Bool
Eq)

instance SystemHook ProjectTransfer where
  match :: String -> (ProjectTransfer -> GitLab ()) -> Rule
match = String -> (ProjectTransfer -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectTransfer -> GitLab Bool)
-> (ProjectTransfer -> GitLab ())
-> Rule
matchIf = String
-> (ProjectTransfer -> GitLab Bool)
-> (ProjectTransfer -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A project has been transferred.
data ProjectTransfer = ProjectTransfer
  { ProjectTransfer -> Text
projectTransfer_created_at :: Text,
    ProjectTransfer -> Text
projectTransfer_updated_at :: Text,
    ProjectTransfer -> Text
projectTransfer_event_name :: Text,
    ProjectTransfer -> Text
projectTransfer_name :: Text,
    ProjectTransfer -> Text
projectTransfer_path :: Text,
    ProjectTransfer -> Text
projectTransfer_path_with_namespace :: Text,
    ProjectTransfer -> Int
projectTransfer_project_id :: Int,
    ProjectTransfer -> Text
projectTransfer_owner_name :: Text,
    ProjectTransfer -> Text
projectTransfer_owner_email :: Text,
    ProjectTransfer -> Visibility
projectTransfer_project_visibility :: Visibility,
    ProjectTransfer -> Text
projectTransfer_old_path_with_namespace :: Text
  }
  deriving (Typeable, Int -> ProjectTransfer -> ShowS
[ProjectTransfer] -> ShowS
ProjectTransfer -> String
(Int -> ProjectTransfer -> ShowS)
-> (ProjectTransfer -> String)
-> ([ProjectTransfer] -> ShowS)
-> Show ProjectTransfer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectTransfer] -> ShowS
$cshowList :: [ProjectTransfer] -> ShowS
show :: ProjectTransfer -> String
$cshow :: ProjectTransfer -> String
showsPrec :: Int -> ProjectTransfer -> ShowS
$cshowsPrec :: Int -> ProjectTransfer -> ShowS
Show, ProjectTransfer -> ProjectTransfer -> Bool
(ProjectTransfer -> ProjectTransfer -> Bool)
-> (ProjectTransfer -> ProjectTransfer -> Bool)
-> Eq ProjectTransfer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectTransfer -> ProjectTransfer -> Bool
$c/= :: ProjectTransfer -> ProjectTransfer -> Bool
== :: ProjectTransfer -> ProjectTransfer -> Bool
$c== :: ProjectTransfer -> ProjectTransfer -> Bool
Eq)

instance SystemHook ProjectUpdate where
  match :: String -> (ProjectUpdate -> GitLab ()) -> Rule
match = String -> (ProjectUpdate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectUpdate -> GitLab Bool)
-> (ProjectUpdate -> GitLab ())
-> Rule
matchIf = String
-> (ProjectUpdate -> GitLab Bool)
-> (ProjectUpdate -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A project has been updated.
data ProjectUpdate = ProjectUpdate
  { ProjectUpdate -> Text
projectUpdate_created_at :: Text,
    ProjectUpdate -> Text
projectUpdate_updated_at :: Text,
    ProjectUpdate -> Text
projectUpdate_event_name :: Text,
    ProjectUpdate -> Text
projectUpdate_name :: Text,
    ProjectUpdate -> Text
projectUpdate_owner_email :: Text,
    ProjectUpdate -> Text
projectUpdate_owner_name :: Text,
    ProjectUpdate -> Text
projectUpdate_path :: Text,
    ProjectUpdate -> Text
projectUpdate_path_with_namespace :: Text,
    ProjectUpdate -> Int
projectUpdate_project_id :: Int,
    ProjectUpdate -> Visibility
projectUpdate_project_visibility :: Visibility
  }
  deriving (Typeable, Int -> ProjectUpdate -> ShowS
[ProjectUpdate] -> ShowS
ProjectUpdate -> String
(Int -> ProjectUpdate -> ShowS)
-> (ProjectUpdate -> String)
-> ([ProjectUpdate] -> ShowS)
-> Show ProjectUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectUpdate] -> ShowS
$cshowList :: [ProjectUpdate] -> ShowS
show :: ProjectUpdate -> String
$cshow :: ProjectUpdate -> String
showsPrec :: Int -> ProjectUpdate -> ShowS
$cshowsPrec :: Int -> ProjectUpdate -> ShowS
Show, ProjectUpdate -> ProjectUpdate -> Bool
(ProjectUpdate -> ProjectUpdate -> Bool)
-> (ProjectUpdate -> ProjectUpdate -> Bool) -> Eq ProjectUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectUpdate -> ProjectUpdate -> Bool
$c/= :: ProjectUpdate -> ProjectUpdate -> Bool
== :: ProjectUpdate -> ProjectUpdate -> Bool
$c== :: ProjectUpdate -> ProjectUpdate -> Bool
Eq)

instance SystemHook UserAddToTeam where
  match :: String -> (UserAddToTeam -> GitLab ()) -> Rule
match = String -> (UserAddToTeam -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserAddToTeam -> GitLab Bool)
-> (UserAddToTeam -> GitLab ())
-> Rule
matchIf = String
-> (UserAddToTeam -> GitLab Bool)
-> (UserAddToTeam -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has been added to a team.
data UserAddToTeam = UserAddToTeam
  { UserAddToTeam -> Text
userAddTeam_created_at :: Text, -- todo improve: date
    UserAddToTeam -> Text
userAddTeam_updated_at :: Text, -- todo improve: date
    UserAddToTeam -> Text
userAddTeam_event_name :: Text,
    UserAddToTeam -> Text
userAddTeam_access_level :: Text, -- todo improve: Maintainer/...
    UserAddToTeam -> Int
userAddTeam_project_id :: Int,
    UserAddToTeam -> Text
userAddTeam_project_name :: Text,
    UserAddToTeam -> Text
userAddTeam_project_path :: Text,
    UserAddToTeam -> Text
userAddTeam_project_path_with_namespace :: Text,
    UserAddToTeam -> Text
userAddTeam_user_email :: Text,
    UserAddToTeam -> Text
userAddTeam_user_name :: Text,
    UserAddToTeam -> Text
userAddTeam_user_username :: Text,
    UserAddToTeam -> Int
userAddTeam_user_id :: Int,
    UserAddToTeam -> Visibility
userAddTeam_project_visibility :: Visibility
  }
  deriving (Typeable, Int -> UserAddToTeam -> ShowS
[UserAddToTeam] -> ShowS
UserAddToTeam -> String
(Int -> UserAddToTeam -> ShowS)
-> (UserAddToTeam -> String)
-> ([UserAddToTeam] -> ShowS)
-> Show UserAddToTeam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserAddToTeam] -> ShowS
$cshowList :: [UserAddToTeam] -> ShowS
show :: UserAddToTeam -> String
$cshow :: UserAddToTeam -> String
showsPrec :: Int -> UserAddToTeam -> ShowS
$cshowsPrec :: Int -> UserAddToTeam -> ShowS
Show, UserAddToTeam -> UserAddToTeam -> Bool
(UserAddToTeam -> UserAddToTeam -> Bool)
-> (UserAddToTeam -> UserAddToTeam -> Bool) -> Eq UserAddToTeam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserAddToTeam -> UserAddToTeam -> Bool
$c/= :: UserAddToTeam -> UserAddToTeam -> Bool
== :: UserAddToTeam -> UserAddToTeam -> Bool
$c== :: UserAddToTeam -> UserAddToTeam -> Bool
Eq)

instance SystemHook UserUpdateForTeam where
  match :: String -> (UserUpdateForTeam -> GitLab ()) -> Rule
match = String -> (UserUpdateForTeam -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserUpdateForTeam -> GitLab Bool)
-> (UserUpdateForTeam -> GitLab ())
-> Rule
matchIf = String
-> (UserUpdateForTeam -> GitLab Bool)
-> (UserUpdateForTeam -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user in a team has been updated.
data UserUpdateForTeam = UserUpdateForTeam
  { UserUpdateForTeam -> Text
userUpdateTeam_created_at :: Text, -- todo improve: date
    UserUpdateForTeam -> Text
userUpdateTeam_updated_at :: Text, -- todo improve: date
    UserUpdateForTeam -> Text
userUpdateTeam_event_name :: Text,
    UserUpdateForTeam -> Text
userUpdateTeam_access_level :: Text, -- todo improve: Maintainer/...
    UserUpdateForTeam -> Int
userUpdateTeam_project_id :: Int,
    UserUpdateForTeam -> Text
userUpdateTeam_project_name :: Text,
    UserUpdateForTeam -> Text
userUpdateTeam_project_path :: Text,
    UserUpdateForTeam -> Text
userUpdateTeam_project_path_with_namespace :: Text,
    UserUpdateForTeam -> Text
userUpdateTeam_user_email :: Text,
    UserUpdateForTeam -> Text
userUpdateTeam_user_name :: Text,
    UserUpdateForTeam -> Text
userUpdateTeam_user_username :: Text,
    UserUpdateForTeam -> Int
userUpdateTeam_user_id :: Int,
    UserUpdateForTeam -> Visibility
userUpdateTeam_project_visibility :: Visibility
  }
  deriving (Typeable, Int -> UserUpdateForTeam -> ShowS
[UserUpdateForTeam] -> ShowS
UserUpdateForTeam -> String
(Int -> UserUpdateForTeam -> ShowS)
-> (UserUpdateForTeam -> String)
-> ([UserUpdateForTeam] -> ShowS)
-> Show UserUpdateForTeam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserUpdateForTeam] -> ShowS
$cshowList :: [UserUpdateForTeam] -> ShowS
show :: UserUpdateForTeam -> String
$cshow :: UserUpdateForTeam -> String
showsPrec :: Int -> UserUpdateForTeam -> ShowS
$cshowsPrec :: Int -> UserUpdateForTeam -> ShowS
Show, UserUpdateForTeam -> UserUpdateForTeam -> Bool
(UserUpdateForTeam -> UserUpdateForTeam -> Bool)
-> (UserUpdateForTeam -> UserUpdateForTeam -> Bool)
-> Eq UserUpdateForTeam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserUpdateForTeam -> UserUpdateForTeam -> Bool
$c/= :: UserUpdateForTeam -> UserUpdateForTeam -> Bool
== :: UserUpdateForTeam -> UserUpdateForTeam -> Bool
$c== :: UserUpdateForTeam -> UserUpdateForTeam -> Bool
Eq)

instance SystemHook UserRemoveFromTeam where
  match :: String -> (UserRemoveFromTeam -> GitLab ()) -> Rule
match = String -> (UserRemoveFromTeam -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserRemoveFromTeam -> GitLab Bool)
-> (UserRemoveFromTeam -> GitLab ())
-> Rule
matchIf = String
-> (UserRemoveFromTeam -> GitLab Bool)
-> (UserRemoveFromTeam -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has been removed from a team.
data UserRemoveFromTeam = UserRemoveFromTeam
  { UserRemoveFromTeam -> Text
userRemoveTeam_created_at :: Text, -- todo improve: date
    UserRemoveFromTeam -> Text
userRemoveTeam_updated_at :: Text, -- todo improve: date
    UserRemoveFromTeam -> Text
userRemoveTeam_event_name :: Text,
    UserRemoveFromTeam -> Text
userRemoveTeam_access_level :: Text, -- todo improve: Maintainer/...
    UserRemoveFromTeam -> Int
userRemoveTeam_project_id :: Int,
    UserRemoveFromTeam -> Text
userRemoveTeam_project_name :: Text,
    UserRemoveFromTeam -> Text
userRemoveTeam_project_path :: Text,
    UserRemoveFromTeam -> Text
userRemoveTeam_project_path_with_namespace :: Text,
    UserRemoveFromTeam -> Text
userRemoveTeam_user_email :: Text,
    UserRemoveFromTeam -> Text
userRemoveTeam_user_name :: Text,
    UserRemoveFromTeam -> Text
userRemoveTeam_user_username :: Text,
    UserRemoveFromTeam -> Int
userRemoveTeam_user_id :: Int,
    UserRemoveFromTeam -> Visibility
userRemoveTeam_project_visibility :: Visibility
  }
  deriving (Typeable, Int -> UserRemoveFromTeam -> ShowS
[UserRemoveFromTeam] -> ShowS
UserRemoveFromTeam -> String
(Int -> UserRemoveFromTeam -> ShowS)
-> (UserRemoveFromTeam -> String)
-> ([UserRemoveFromTeam] -> ShowS)
-> Show UserRemoveFromTeam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserRemoveFromTeam] -> ShowS
$cshowList :: [UserRemoveFromTeam] -> ShowS
show :: UserRemoveFromTeam -> String
$cshow :: UserRemoveFromTeam -> String
showsPrec :: Int -> UserRemoveFromTeam -> ShowS
$cshowsPrec :: Int -> UserRemoveFromTeam -> ShowS
Show, UserRemoveFromTeam -> UserRemoveFromTeam -> Bool
(UserRemoveFromTeam -> UserRemoveFromTeam -> Bool)
-> (UserRemoveFromTeam -> UserRemoveFromTeam -> Bool)
-> Eq UserRemoveFromTeam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserRemoveFromTeam -> UserRemoveFromTeam -> Bool
$c/= :: UserRemoveFromTeam -> UserRemoveFromTeam -> Bool
== :: UserRemoveFromTeam -> UserRemoveFromTeam -> Bool
$c== :: UserRemoveFromTeam -> UserRemoveFromTeam -> Bool
Eq)

instance SystemHook UserCreate where
  match :: String -> (UserCreate -> GitLab ()) -> Rule
match = String -> (UserCreate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserCreate -> GitLab Bool) -> (UserCreate -> GitLab ()) -> Rule
matchIf = String
-> (UserCreate -> GitLab Bool) -> (UserCreate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has been created.
data UserCreate = UserCreate
  { UserCreate -> Text
userCreate_created_at :: Text, -- todo improve: date
    UserCreate -> Text
userCreate_updated_at :: Text, -- todo improve: date
    UserCreate -> Text
userCreate_email :: Text,
    UserCreate -> Text
userCreate_event_name :: Text,
    UserCreate -> Text
userCreate_name :: Text,
    UserCreate -> Text
userCreate_username :: Text,
    UserCreate -> Int
userCreate_user_id :: Int
  }
  deriving (Typeable, Int -> UserCreate -> ShowS
[UserCreate] -> ShowS
UserCreate -> String
(Int -> UserCreate -> ShowS)
-> (UserCreate -> String)
-> ([UserCreate] -> ShowS)
-> Show UserCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserCreate] -> ShowS
$cshowList :: [UserCreate] -> ShowS
show :: UserCreate -> String
$cshow :: UserCreate -> String
showsPrec :: Int -> UserCreate -> ShowS
$cshowsPrec :: Int -> UserCreate -> ShowS
Show, UserCreate -> UserCreate -> Bool
(UserCreate -> UserCreate -> Bool)
-> (UserCreate -> UserCreate -> Bool) -> Eq UserCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserCreate -> UserCreate -> Bool
$c/= :: UserCreate -> UserCreate -> Bool
== :: UserCreate -> UserCreate -> Bool
$c== :: UserCreate -> UserCreate -> Bool
Eq)

instance SystemHook UserRemove where
  match :: String -> (UserRemove -> GitLab ()) -> Rule
match = String -> (UserRemove -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserRemove -> GitLab Bool) -> (UserRemove -> GitLab ()) -> Rule
matchIf = String
-> (UserRemove -> GitLab Bool) -> (UserRemove -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has been removed.
data UserRemove = UserRemove
  { UserRemove -> Text
userRemove_created_at :: Text, -- todo improve: date
    UserRemove -> Text
userRemove_updated_at :: Text, -- todo improve: date
    UserRemove -> Text
userRemove_email :: Text,
    UserRemove -> Text
userRemove_event_name :: Text,
    UserRemove -> Text
userRemove_name :: Text,
    UserRemove -> Text
userRemove_username :: Text,
    UserRemove -> Int
userRemove_user_id :: Int
  }
  deriving (Typeable, Int -> UserRemove -> ShowS
[UserRemove] -> ShowS
UserRemove -> String
(Int -> UserRemove -> ShowS)
-> (UserRemove -> String)
-> ([UserRemove] -> ShowS)
-> Show UserRemove
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserRemove] -> ShowS
$cshowList :: [UserRemove] -> ShowS
show :: UserRemove -> String
$cshow :: UserRemove -> String
showsPrec :: Int -> UserRemove -> ShowS
$cshowsPrec :: Int -> UserRemove -> ShowS
Show, UserRemove -> UserRemove -> Bool
(UserRemove -> UserRemove -> Bool)
-> (UserRemove -> UserRemove -> Bool) -> Eq UserRemove
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserRemove -> UserRemove -> Bool
$c/= :: UserRemove -> UserRemove -> Bool
== :: UserRemove -> UserRemove -> Bool
$c== :: UserRemove -> UserRemove -> Bool
Eq)

instance SystemHook UserFailedLogin where
  match :: String -> (UserFailedLogin -> GitLab ()) -> Rule
match = String -> (UserFailedLogin -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserFailedLogin -> GitLab Bool)
-> (UserFailedLogin -> GitLab ())
-> Rule
matchIf = String
-> (UserFailedLogin -> GitLab Bool)
-> (UserFailedLogin -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has failed to log in.
data UserFailedLogin = UserFailedLogin
  { UserFailedLogin -> Text
userFailedLogin_event_name :: Text,
    UserFailedLogin -> Text
userFailedLogin_created_at :: Text, -- todo improve: date
    UserFailedLogin -> Text
userFailedLogin_updated_at :: Text, -- todo improve: date
    UserFailedLogin -> Text
userFailedLogin_name :: Text,
    UserFailedLogin -> Text
userFailedLogin_email :: Text,
    UserFailedLogin -> Int
userFailedLogin_user_id :: Int,
    UserFailedLogin -> Text
userFailedLogin_username :: Text,
    -- create Haskell sum type for this
    UserFailedLogin -> Text
userFailedLogin_state :: Text
  }
  deriving (Typeable, Int -> UserFailedLogin -> ShowS
[UserFailedLogin] -> ShowS
UserFailedLogin -> String
(Int -> UserFailedLogin -> ShowS)
-> (UserFailedLogin -> String)
-> ([UserFailedLogin] -> ShowS)
-> Show UserFailedLogin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserFailedLogin] -> ShowS
$cshowList :: [UserFailedLogin] -> ShowS
show :: UserFailedLogin -> String
$cshow :: UserFailedLogin -> String
showsPrec :: Int -> UserFailedLogin -> ShowS
$cshowsPrec :: Int -> UserFailedLogin -> ShowS
Show, UserFailedLogin -> UserFailedLogin -> Bool
(UserFailedLogin -> UserFailedLogin -> Bool)
-> (UserFailedLogin -> UserFailedLogin -> Bool)
-> Eq UserFailedLogin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserFailedLogin -> UserFailedLogin -> Bool
$c/= :: UserFailedLogin -> UserFailedLogin -> Bool
== :: UserFailedLogin -> UserFailedLogin -> Bool
$c== :: UserFailedLogin -> UserFailedLogin -> Bool
Eq)

instance SystemHook UserRename where
  match :: String -> (UserRename -> GitLab ()) -> Rule
match = String -> (UserRename -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserRename -> GitLab Bool) -> (UserRename -> GitLab ()) -> Rule
matchIf = String
-> (UserRename -> GitLab Bool) -> (UserRename -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has been renamed.
data UserRename = UserRename
  { UserRename -> Text
userRename_event_name :: Text,
    UserRename -> Text
userRename_created_at :: Text, -- todo improve: date
    UserRename -> Text
userRename_updated_at :: Text, -- todo improve: date
    UserRename -> Text
userRename_name :: Text,
    UserRename -> Text
userRename_email :: Text,
    UserRename -> Int
userRename_user_id :: Int,
    UserRename -> Text
userRename_username :: Text,
    UserRename -> Text
userRename_old_username :: Text
  }
  deriving (Typeable, Int -> UserRename -> ShowS
[UserRename] -> ShowS
UserRename -> String
(Int -> UserRename -> ShowS)
-> (UserRename -> String)
-> ([UserRename] -> ShowS)
-> Show UserRename
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserRename] -> ShowS
$cshowList :: [UserRename] -> ShowS
show :: UserRename -> String
$cshow :: UserRename -> String
showsPrec :: Int -> UserRename -> ShowS
$cshowsPrec :: Int -> UserRename -> ShowS
Show, UserRename -> UserRename -> Bool
(UserRename -> UserRename -> Bool)
-> (UserRename -> UserRename -> Bool) -> Eq UserRename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserRename -> UserRename -> Bool
$c/= :: UserRename -> UserRename -> Bool
== :: UserRename -> UserRename -> Bool
$c== :: UserRename -> UserRename -> Bool
Eq)

instance SystemHook KeyCreate where
  match :: String -> (KeyCreate -> GitLab ()) -> Rule
match = String -> (KeyCreate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (KeyCreate -> GitLab Bool) -> (KeyCreate -> GitLab ()) -> Rule
matchIf = String
-> (KeyCreate -> GitLab Bool) -> (KeyCreate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A key has been created.
data KeyCreate = KeyCreate
  { KeyCreate -> Text
keyCreate_event_name :: Text,
    KeyCreate -> Text
keyCreate_created_at :: Text, -- todo improve: date
    KeyCreate -> Text
keyCreate_updated_at :: Text, -- todo improve: date
    KeyCreate -> Text
keyCreate_username :: Text,
    KeyCreate -> Text
keyCreate_key :: Text,
    KeyCreate -> Int
keyCreate_id :: Int
  }
  deriving (Typeable, Int -> KeyCreate -> ShowS
[KeyCreate] -> ShowS
KeyCreate -> String
(Int -> KeyCreate -> ShowS)
-> (KeyCreate -> String)
-> ([KeyCreate] -> ShowS)
-> Show KeyCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyCreate] -> ShowS
$cshowList :: [KeyCreate] -> ShowS
show :: KeyCreate -> String
$cshow :: KeyCreate -> String
showsPrec :: Int -> KeyCreate -> ShowS
$cshowsPrec :: Int -> KeyCreate -> ShowS
Show, KeyCreate -> KeyCreate -> Bool
(KeyCreate -> KeyCreate -> Bool)
-> (KeyCreate -> KeyCreate -> Bool) -> Eq KeyCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyCreate -> KeyCreate -> Bool
$c/= :: KeyCreate -> KeyCreate -> Bool
== :: KeyCreate -> KeyCreate -> Bool
$c== :: KeyCreate -> KeyCreate -> Bool
Eq)

instance SystemHook KeyRemove where
  match :: String -> (KeyRemove -> GitLab ()) -> Rule
match = String -> (KeyRemove -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (KeyRemove -> GitLab Bool) -> (KeyRemove -> GitLab ()) -> Rule
matchIf = String
-> (KeyRemove -> GitLab Bool) -> (KeyRemove -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A key has been removed.
data KeyRemove = KeyRemove
  { KeyRemove -> Text
keyRemove_event_name :: Text,
    KeyRemove -> Text
keyRemove_created_at :: Text, -- todo improve: date
    KeyRemove -> Text
keyRemove_updated_at :: Text, -- todo improve: date
    KeyRemove -> Text
keyRemove_username :: Text,
    KeyRemove -> Text
keyRemove_key :: Text,
    KeyRemove -> Int
keyRemove_id :: Int
  }
  deriving (Typeable, Int -> KeyRemove -> ShowS
[KeyRemove] -> ShowS
KeyRemove -> String
(Int -> KeyRemove -> ShowS)
-> (KeyRemove -> String)
-> ([KeyRemove] -> ShowS)
-> Show KeyRemove
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyRemove] -> ShowS
$cshowList :: [KeyRemove] -> ShowS
show :: KeyRemove -> String
$cshow :: KeyRemove -> String
showsPrec :: Int -> KeyRemove -> ShowS
$cshowsPrec :: Int -> KeyRemove -> ShowS
Show, KeyRemove -> KeyRemove -> Bool
(KeyRemove -> KeyRemove -> Bool)
-> (KeyRemove -> KeyRemove -> Bool) -> Eq KeyRemove
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyRemove -> KeyRemove -> Bool
$c/= :: KeyRemove -> KeyRemove -> Bool
== :: KeyRemove -> KeyRemove -> Bool
$c== :: KeyRemove -> KeyRemove -> Bool
Eq)

instance SystemHook GroupCreate where
  match :: String -> (GroupCreate -> GitLab ()) -> Rule
match = String -> (GroupCreate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupCreate -> GitLab Bool)
-> (GroupCreate -> GitLab ())
-> Rule
matchIf = String
-> (GroupCreate -> GitLab Bool)
-> (GroupCreate -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A group has been created.
data GroupCreate = GroupCreate
  { GroupCreate -> Text
groupCreate_created_at :: Text, -- todo improve: date
    GroupCreate -> Text
groupCreate_updated_at :: Text, -- todo improve: date
    GroupCreate -> Text
groupCreate_event_name :: Text,
    GroupCreate -> Text
groupCreate_name :: Text,
    GroupCreate -> Maybe Text
groupCreate_owner_email :: Maybe Text,
    GroupCreate -> Maybe Text
groupCreate_owner_name :: Maybe Text,
    GroupCreate -> Text
groupCreate_path :: Text,
    GroupCreate -> Int
groupCreate_group_id :: Int
  }
  deriving (Typeable, Int -> GroupCreate -> ShowS
[GroupCreate] -> ShowS
GroupCreate -> String
(Int -> GroupCreate -> ShowS)
-> (GroupCreate -> String)
-> ([GroupCreate] -> ShowS)
-> Show GroupCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupCreate] -> ShowS
$cshowList :: [GroupCreate] -> ShowS
show :: GroupCreate -> String
$cshow :: GroupCreate -> String
showsPrec :: Int -> GroupCreate -> ShowS
$cshowsPrec :: Int -> GroupCreate -> ShowS
Show, GroupCreate -> GroupCreate -> Bool
(GroupCreate -> GroupCreate -> Bool)
-> (GroupCreate -> GroupCreate -> Bool) -> Eq GroupCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupCreate -> GroupCreate -> Bool
$c/= :: GroupCreate -> GroupCreate -> Bool
== :: GroupCreate -> GroupCreate -> Bool
$c== :: GroupCreate -> GroupCreate -> Bool
Eq)

instance SystemHook GroupRemove where
  match :: String -> (GroupRemove -> GitLab ()) -> Rule
match = String -> (GroupRemove -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupRemove -> GitLab Bool)
-> (GroupRemove -> GitLab ())
-> Rule
matchIf = String
-> (GroupRemove -> GitLab Bool)
-> (GroupRemove -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A group has been removed.
data GroupRemove = GroupRemove
  { GroupRemove -> Text
groupRemove_created_at :: Text, -- todo improve: date
    GroupRemove -> Text
groupRemove_updated_at :: Text, -- todo improve: date
    GroupRemove -> Text
groupRemove_event_name :: Text,
    GroupRemove -> Text
groupRemove_name :: Text,
    GroupRemove -> Maybe Text
groupRemove_owner_email :: Maybe Text,
    GroupRemove -> Maybe Text
groupRemove_owner_name :: Maybe Text,
    GroupRemove -> Text
groupRemove_path :: Text,
    GroupRemove -> Int
groupRemove_group_id :: Int
  }
  deriving (Typeable, Int -> GroupRemove -> ShowS
[GroupRemove] -> ShowS
GroupRemove -> String
(Int -> GroupRemove -> ShowS)
-> (GroupRemove -> String)
-> ([GroupRemove] -> ShowS)
-> Show GroupRemove
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupRemove] -> ShowS
$cshowList :: [GroupRemove] -> ShowS
show :: GroupRemove -> String
$cshow :: GroupRemove -> String
showsPrec :: Int -> GroupRemove -> ShowS
$cshowsPrec :: Int -> GroupRemove -> ShowS
Show, GroupRemove -> GroupRemove -> Bool
(GroupRemove -> GroupRemove -> Bool)
-> (GroupRemove -> GroupRemove -> Bool) -> Eq GroupRemove
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupRemove -> GroupRemove -> Bool
$c/= :: GroupRemove -> GroupRemove -> Bool
== :: GroupRemove -> GroupRemove -> Bool
$c== :: GroupRemove -> GroupRemove -> Bool
Eq)

instance SystemHook GroupRename where
  match :: String -> (GroupRename -> GitLab ()) -> Rule
match = String -> (GroupRename -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupRename -> GitLab Bool)
-> (GroupRename -> GitLab ())
-> Rule
matchIf = String
-> (GroupRename -> GitLab Bool)
-> (GroupRename -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A group has been renamed.
data GroupRename = GroupRename
  { GroupRename -> Text
groupRename_event_name :: Text,
    GroupRename -> Text
groupRename_created_at :: Text, -- todo improve: date
    GroupRename -> Text
groupRename_updated_at :: Text, -- todo improve: date
    GroupRename -> Text
groupRename_name :: Text,
    GroupRename -> Text
groupRename_path :: Text,
    GroupRename -> Text
groupRename_full_path :: Text,
    GroupRename -> Int
groupRename_group_id :: Int,
    GroupRename -> Maybe Text
groupRename_owner_name :: Maybe Text,
    GroupRename -> Maybe Text
groupRename_owner_email :: Maybe Text,
    GroupRename -> Text
groupRename_old_path :: Text,
    GroupRename -> Text
groupRename_old_full_path :: Text
  }
  deriving (Typeable, Int -> GroupRename -> ShowS
[GroupRename] -> ShowS
GroupRename -> String
(Int -> GroupRename -> ShowS)
-> (GroupRename -> String)
-> ([GroupRename] -> ShowS)
-> Show GroupRename
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupRename] -> ShowS
$cshowList :: [GroupRename] -> ShowS
show :: GroupRename -> String
$cshow :: GroupRename -> String
showsPrec :: Int -> GroupRename -> ShowS
$cshowsPrec :: Int -> GroupRename -> ShowS
Show, GroupRename -> GroupRename -> Bool
(GroupRename -> GroupRename -> Bool)
-> (GroupRename -> GroupRename -> Bool) -> Eq GroupRename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupRename -> GroupRename -> Bool
$c/= :: GroupRename -> GroupRename -> Bool
== :: GroupRename -> GroupRename -> Bool
$c== :: GroupRename -> GroupRename -> Bool
Eq)

instance SystemHook NewGroupMember where
  match :: String -> (NewGroupMember -> GitLab ()) -> Rule
match = String -> (NewGroupMember -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (NewGroupMember -> GitLab Bool)
-> (NewGroupMember -> GitLab ())
-> Rule
matchIf = String
-> (NewGroupMember -> GitLab Bool)
-> (NewGroupMember -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has been added to a group.
data NewGroupMember = NewGroupMember
  { NewGroupMember -> Text
newGroupMember_created_at :: Text, -- todo improve: date
    NewGroupMember -> Text
newGroupMember_updated_at :: Text, -- todo improve: date
    NewGroupMember -> Text
newGroupMember_event_name :: Text,
    NewGroupMember -> Text
newGroupMember_group_access :: Text, -- todo Haskell type for this
    NewGroupMember -> Int
newGroupMember_group_id :: Int,
    NewGroupMember -> Text
newGroupMember_group_name :: Text,
    NewGroupMember -> Text
newGroupMember_group_path :: Text,
    NewGroupMember -> Text
newGroupMember_user_email :: Text,
    NewGroupMember -> Text
newGroupMember_user_name :: Text,
    NewGroupMember -> Text
newGroupMember_user_username :: Text,
    NewGroupMember -> Int
newGroupMember_user_id :: Int
  }
  deriving (Typeable, Int -> NewGroupMember -> ShowS
[NewGroupMember] -> ShowS
NewGroupMember -> String
(Int -> NewGroupMember -> ShowS)
-> (NewGroupMember -> String)
-> ([NewGroupMember] -> ShowS)
-> Show NewGroupMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewGroupMember] -> ShowS
$cshowList :: [NewGroupMember] -> ShowS
show :: NewGroupMember -> String
$cshow :: NewGroupMember -> String
showsPrec :: Int -> NewGroupMember -> ShowS
$cshowsPrec :: Int -> NewGroupMember -> ShowS
Show, NewGroupMember -> NewGroupMember -> Bool
(NewGroupMember -> NewGroupMember -> Bool)
-> (NewGroupMember -> NewGroupMember -> Bool) -> Eq NewGroupMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewGroupMember -> NewGroupMember -> Bool
$c/= :: NewGroupMember -> NewGroupMember -> Bool
== :: NewGroupMember -> NewGroupMember -> Bool
$c== :: NewGroupMember -> NewGroupMember -> Bool
Eq)

instance SystemHook GroupMemberRemove where
  match :: String -> (GroupMemberRemove -> GitLab ()) -> Rule
match = String -> (GroupMemberRemove -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupMemberRemove -> GitLab Bool)
-> (GroupMemberRemove -> GitLab ())
-> Rule
matchIf = String
-> (GroupMemberRemove -> GitLab Bool)
-> (GroupMemberRemove -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A user has been removed from a group.
data GroupMemberRemove = GroupMemberRemove
  { GroupMemberRemove -> Text
groupMemberRemove_created_at :: Text, -- todo improve: date
    GroupMemberRemove -> Text
groupMemberRemove_updated_at :: Text, -- todo improve: date
    GroupMemberRemove -> Text
groupMemberRemove_event_name :: Text,
    GroupMemberRemove -> Text
groupMemberRemove_group_access :: Text, -- todo Haskell type for this
    GroupMemberRemove -> Int
groupMemberRemove_group_id :: Int,
    GroupMemberRemove -> Text
groupMemberRemove_group_name :: Text,
    GroupMemberRemove -> Text
groupMemberRemove_group_path :: Text,
    GroupMemberRemove -> Text
groupMemberRemove_user_email :: Text,
    GroupMemberRemove -> Text
groupMemberRemove_user_name :: Text,
    GroupMemberRemove -> Text
groupMemberRemove_user_username :: Text,
    GroupMemberRemove -> Int
groupMemberRemove_user_id :: Int
  }
  deriving (Typeable, Int -> GroupMemberRemove -> ShowS
[GroupMemberRemove] -> ShowS
GroupMemberRemove -> String
(Int -> GroupMemberRemove -> ShowS)
-> (GroupMemberRemove -> String)
-> ([GroupMemberRemove] -> ShowS)
-> Show GroupMemberRemove
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupMemberRemove] -> ShowS
$cshowList :: [GroupMemberRemove] -> ShowS
show :: GroupMemberRemove -> String
$cshow :: GroupMemberRemove -> String
showsPrec :: Int -> GroupMemberRemove -> ShowS
$cshowsPrec :: Int -> GroupMemberRemove -> ShowS
Show, GroupMemberRemove -> GroupMemberRemove -> Bool
(GroupMemberRemove -> GroupMemberRemove -> Bool)
-> (GroupMemberRemove -> GroupMemberRemove -> Bool)
-> Eq GroupMemberRemove
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupMemberRemove -> GroupMemberRemove -> Bool
$c/= :: GroupMemberRemove -> GroupMemberRemove -> Bool
== :: GroupMemberRemove -> GroupMemberRemove -> Bool
$c== :: GroupMemberRemove -> GroupMemberRemove -> Bool
Eq)

instance SystemHook GroupMemberUpdate where
  match :: String -> (GroupMemberUpdate -> GitLab ()) -> Rule
match = String -> (GroupMemberUpdate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupMemberUpdate -> GitLab Bool)
-> (GroupMemberUpdate -> GitLab ())
-> Rule
matchIf = String
-> (GroupMemberUpdate -> GitLab Bool)
-> (GroupMemberUpdate -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | A group member has been updated.
data GroupMemberUpdate = GroupMemberUpdate
  { GroupMemberUpdate -> Text
groupMemberUpdate_created_at :: Text, -- todo improve: date
    GroupMemberUpdate -> Text
groupMemberUpdate_updated_at :: Text, -- todo improve: date
    GroupMemberUpdate -> Text
groupMemberUpdate_event_name :: Text,
    GroupMemberUpdate -> Text
groupMemberUpdate_group_access :: Text, -- todo Haskell type for this
    GroupMemberUpdate -> Int
groupMemberUpdate_group_id :: Int,
    GroupMemberUpdate -> Text
groupMemberUpdate_group_name :: Text,
    GroupMemberUpdate -> Text
groupMemberUpdate_group_path :: Text,
    GroupMemberUpdate -> Text
groupMemberUpdate_user_email :: Text,
    GroupMemberUpdate -> Text
groupMemberUpdate_user_name :: Text,
    GroupMemberUpdate -> Text
groupMemberUpdate_user_username :: Text,
    GroupMemberUpdate -> Int
groupMemberUpdate_user_id :: Int
  }
  deriving (Typeable, Int -> GroupMemberUpdate -> ShowS
[GroupMemberUpdate] -> ShowS
GroupMemberUpdate -> String
(Int -> GroupMemberUpdate -> ShowS)
-> (GroupMemberUpdate -> String)
-> ([GroupMemberUpdate] -> ShowS)
-> Show GroupMemberUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupMemberUpdate] -> ShowS
$cshowList :: [GroupMemberUpdate] -> ShowS
show :: GroupMemberUpdate -> String
$cshow :: GroupMemberUpdate -> String
showsPrec :: Int -> GroupMemberUpdate -> ShowS
$cshowsPrec :: Int -> GroupMemberUpdate -> ShowS
Show, GroupMemberUpdate -> GroupMemberUpdate -> Bool
(GroupMemberUpdate -> GroupMemberUpdate -> Bool)
-> (GroupMemberUpdate -> GroupMemberUpdate -> Bool)
-> Eq GroupMemberUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupMemberUpdate -> GroupMemberUpdate -> Bool
$c/= :: GroupMemberUpdate -> GroupMemberUpdate -> Bool
== :: GroupMemberUpdate -> GroupMemberUpdate -> Bool
$c== :: GroupMemberUpdate -> GroupMemberUpdate -> Bool
Eq)

instance SystemHook Push where
  match :: String -> (Push -> GitLab ()) -> Rule
match = String -> (Push -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String -> (Push -> GitLab Bool) -> (Push -> GitLab ()) -> Rule
matchIf = String -> (Push -> GitLab Bool) -> (Push -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | Commits have been pushed to the server.
data Push = Push
  { Push -> Text
push_event_name :: Text,
    Push -> Text
push_before :: Text,
    Push -> Text
push_after :: Text,
    Push -> Text
push_ref :: Text,
    Push -> Text
push_checkout_sha :: Text,
    Push -> Int
push_user_id :: Int,
    Push -> Text
push_user_name :: Text,
    Push -> Text
push_user_email :: Text,
    Push -> Text
push_user_avatar :: Text,
    Push -> Int
push_project_id :: Int,
    Push -> ProjectEvent
push_project :: ProjectEvent,
    Push -> RepositoryEvent
push_repository :: RepositoryEvent,
    Push -> [CommitEvent]
push_commits :: [CommitEvent],
    Push -> Int
push_total_commits_count :: Int
  }
  deriving (Typeable, Int -> Push -> ShowS
[Push] -> ShowS
Push -> String
(Int -> Push -> ShowS)
-> (Push -> String) -> ([Push] -> ShowS) -> Show Push
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Push] -> ShowS
$cshowList :: [Push] -> ShowS
show :: Push -> String
$cshow :: Push -> String
showsPrec :: Int -> Push -> ShowS
$cshowsPrec :: Int -> Push -> ShowS
Show, Push -> Push -> Bool
(Push -> Push -> Bool) -> (Push -> Push -> Bool) -> Eq Push
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Push -> Push -> Bool
$c/= :: Push -> Push -> Bool
== :: Push -> Push -> Bool
$c== :: Push -> Push -> Bool
Eq)

instance SystemHook TagPush where
  match :: String -> (TagPush -> GitLab ()) -> Rule
match = String -> (TagPush -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (TagPush -> GitLab Bool) -> (TagPush -> GitLab ()) -> Rule
matchIf = String
-> (TagPush -> GitLab Bool) -> (TagPush -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | Tags have been pushed to the server.
data TagPush = TagPush
  { TagPush -> Text
tagPush_event_name :: Text,
    TagPush -> Text
tagPush_before :: Text,
    TagPush -> Text
tagPush_after :: Text,
    TagPush -> Text
tagPush_ref :: Text,
    TagPush -> Text
tagPush_checkout_sha :: Text,
    TagPush -> Int
tagPush_user_id :: Int,
    TagPush -> Text
tagPush_user_name :: Text,
    TagPush -> Text
tagPush_user_avatar :: Text,
    TagPush -> Int
tagPush_project_id :: Int,
    TagPush -> ProjectEvent
tagPush_project :: ProjectEvent,
    TagPush -> RepositoryEvent
tagPush_repository :: RepositoryEvent,
    TagPush -> [CommitEvent]
tagPush_commits :: [CommitEvent],
    TagPush -> Int
tagPush_total_commits_count :: Int
  }
  deriving (Typeable, Int -> TagPush -> ShowS
[TagPush] -> ShowS
TagPush -> String
(Int -> TagPush -> ShowS)
-> (TagPush -> String) -> ([TagPush] -> ShowS) -> Show TagPush
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagPush] -> ShowS
$cshowList :: [TagPush] -> ShowS
show :: TagPush -> String
$cshow :: TagPush -> String
showsPrec :: Int -> TagPush -> ShowS
$cshowsPrec :: Int -> TagPush -> ShowS
Show, TagPush -> TagPush -> Bool
(TagPush -> TagPush -> Bool)
-> (TagPush -> TagPush -> Bool) -> Eq TagPush
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagPush -> TagPush -> Bool
$c/= :: TagPush -> TagPush -> Bool
== :: TagPush -> TagPush -> Bool
$c== :: TagPush -> TagPush -> Bool
Eq)

instance SystemHook RepositoryUpdate where
  match :: String -> (RepositoryUpdate -> GitLab ()) -> Rule
match = String -> (RepositoryUpdate -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (RepositoryUpdate -> GitLab Bool)
-> (RepositoryUpdate -> GitLab ())
-> Rule
matchIf = String
-> (RepositoryUpdate -> GitLab Bool)
-> (RepositoryUpdate -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | Tags have been pushed to the server.
data RepositoryUpdate = RepositoryUpdate
  { RepositoryUpdate -> Text
repositoryUpdate_event_name :: Text,
    RepositoryUpdate -> Int
repositoryUpdate_user_id :: Int,
    RepositoryUpdate -> Text
repositoryUpdate_user_name :: Text,
    RepositoryUpdate -> Text
repositoryUpdate_user_email :: Text,
    RepositoryUpdate -> Text
repositoryUpdate_user_avatar :: Text,
    RepositoryUpdate -> Int
repositoryUpdate_project_id :: Int,
    RepositoryUpdate -> ProjectEvent
repositoryUpdate_project :: ProjectEvent,
    RepositoryUpdate -> [ProjectChanges]
repositoryUpdate_changes :: [ProjectChanges],
    RepositoryUpdate -> [Text]
repositoryUpdate_refs :: [Text]
  }
  deriving (Typeable, Int -> RepositoryUpdate -> ShowS
[RepositoryUpdate] -> ShowS
RepositoryUpdate -> String
(Int -> RepositoryUpdate -> ShowS)
-> (RepositoryUpdate -> String)
-> ([RepositoryUpdate] -> ShowS)
-> Show RepositoryUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryUpdate] -> ShowS
$cshowList :: [RepositoryUpdate] -> ShowS
show :: RepositoryUpdate -> String
$cshow :: RepositoryUpdate -> String
showsPrec :: Int -> RepositoryUpdate -> ShowS
$cshowsPrec :: Int -> RepositoryUpdate -> ShowS
Show, RepositoryUpdate -> RepositoryUpdate -> Bool
(RepositoryUpdate -> RepositoryUpdate -> Bool)
-> (RepositoryUpdate -> RepositoryUpdate -> Bool)
-> Eq RepositoryUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepositoryUpdate -> RepositoryUpdate -> Bool
$c/= :: RepositoryUpdate -> RepositoryUpdate -> Bool
== :: RepositoryUpdate -> RepositoryUpdate -> Bool
$c== :: RepositoryUpdate -> RepositoryUpdate -> Bool
Eq)

-- | A project event.
data ProjectEvent = ProjectEvent
  { ProjectEvent -> Text
projectEvent_name :: Text,
    ProjectEvent -> Text
projectEvent_description :: Text,
    ProjectEvent -> Text
projectEvent_web_url :: Text,
    ProjectEvent -> Maybe Text
projectEvent_avatar_url :: Maybe Text,
    ProjectEvent -> Text
projectEvent_git_ssh_url :: Text,
    ProjectEvent -> Text
projectEvent_git_http_url :: Text,
    ProjectEvent -> Text
projectEvent_namespace :: Text,
    ProjectEvent -> Visibility
projectEvent_visibility_level :: Visibility,
    ProjectEvent -> Text
projectEvent_path_with_namespace :: Text,
    ProjectEvent -> Text
projectEvent_default_branch :: Text,
    -- projectEvent_ci_config_path :: Maybe Text,
    ProjectEvent -> Maybe Text
projectEvent_homepage :: Maybe Text,
    ProjectEvent -> Text
projectEvent_url :: Text,
    ProjectEvent -> Text
projectEvent_ssh_url :: Text,
    ProjectEvent -> Text
projectEvent_http_url :: Text
  }
  deriving (Typeable, Int -> ProjectEvent -> ShowS
[ProjectEvent] -> ShowS
ProjectEvent -> String
(Int -> ProjectEvent -> ShowS)
-> (ProjectEvent -> String)
-> ([ProjectEvent] -> ShowS)
-> Show ProjectEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectEvent] -> ShowS
$cshowList :: [ProjectEvent] -> ShowS
show :: ProjectEvent -> String
$cshow :: ProjectEvent -> String
showsPrec :: Int -> ProjectEvent -> ShowS
$cshowsPrec :: Int -> ProjectEvent -> ShowS
Show, ProjectEvent -> ProjectEvent -> Bool
(ProjectEvent -> ProjectEvent -> Bool)
-> (ProjectEvent -> ProjectEvent -> Bool) -> Eq ProjectEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectEvent -> ProjectEvent -> Bool
$c/= :: ProjectEvent -> ProjectEvent -> Bool
== :: ProjectEvent -> ProjectEvent -> Bool
$c== :: ProjectEvent -> ProjectEvent -> Bool
Eq, (forall x. ProjectEvent -> Rep ProjectEvent x)
-> (forall x. Rep ProjectEvent x -> ProjectEvent)
-> Generic ProjectEvent
forall x. Rep ProjectEvent x -> ProjectEvent
forall x. ProjectEvent -> Rep ProjectEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectEvent x -> ProjectEvent
$cfrom :: forall x. ProjectEvent -> Rep ProjectEvent x
Generic)

-- | A project event.
data ProjectChanges = ProjectChanges
  { ProjectChanges -> Text
projectChanges_before :: Text,
    ProjectChanges -> Text
projectChanges_after :: Text,
    ProjectChanges -> Text
projectChanges_ref :: Text
  }
  deriving (Typeable, Int -> ProjectChanges -> ShowS
[ProjectChanges] -> ShowS
ProjectChanges -> String
(Int -> ProjectChanges -> ShowS)
-> (ProjectChanges -> String)
-> ([ProjectChanges] -> ShowS)
-> Show ProjectChanges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectChanges] -> ShowS
$cshowList :: [ProjectChanges] -> ShowS
show :: ProjectChanges -> String
$cshow :: ProjectChanges -> String
showsPrec :: Int -> ProjectChanges -> ShowS
$cshowsPrec :: Int -> ProjectChanges -> ShowS
Show, ProjectChanges -> ProjectChanges -> Bool
(ProjectChanges -> ProjectChanges -> Bool)
-> (ProjectChanges -> ProjectChanges -> Bool) -> Eq ProjectChanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectChanges -> ProjectChanges -> Bool
$c/= :: ProjectChanges -> ProjectChanges -> Bool
== :: ProjectChanges -> ProjectChanges -> Bool
$c== :: ProjectChanges -> ProjectChanges -> Bool
Eq, (forall x. ProjectChanges -> Rep ProjectChanges x)
-> (forall x. Rep ProjectChanges x -> ProjectChanges)
-> Generic ProjectChanges
forall x. Rep ProjectChanges x -> ProjectChanges
forall x. ProjectChanges -> Rep ProjectChanges x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectChanges x -> ProjectChanges
$cfrom :: forall x. ProjectChanges -> Rep ProjectChanges x
Generic)

-- | A repository event.
data RepositoryEvent = RepositoryEvent
  { RepositoryEvent -> Text
repositoryEvent_name :: Text,
    RepositoryEvent -> Text
repositoryEvent_url :: Text,
    RepositoryEvent -> Text
repositoryEvent_description :: Text,
    RepositoryEvent -> Maybe Text
repositoryEvent_homepage :: Maybe Text,
    -- these three not in the merge_request event example
    -- in the GitLab documentation. Is the merge_request documentation
    -- out dated?
    RepositoryEvent -> Maybe Text
repositoryEvent_git_http_url :: Maybe Text,
    RepositoryEvent -> Maybe Text
repositoryEvent_git_ssh_url :: Maybe Text,
    RepositoryEvent -> Maybe Visibility
repositoryEvent_visibility_level :: Maybe Visibility
  }
  deriving (Typeable, Int -> RepositoryEvent -> ShowS
[RepositoryEvent] -> ShowS
RepositoryEvent -> String
(Int -> RepositoryEvent -> ShowS)
-> (RepositoryEvent -> String)
-> ([RepositoryEvent] -> ShowS)
-> Show RepositoryEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryEvent] -> ShowS
$cshowList :: [RepositoryEvent] -> ShowS
show :: RepositoryEvent -> String
$cshow :: RepositoryEvent -> String
showsPrec :: Int -> RepositoryEvent -> ShowS
$cshowsPrec :: Int -> RepositoryEvent -> ShowS
Show, RepositoryEvent -> RepositoryEvent -> Bool
(RepositoryEvent -> RepositoryEvent -> Bool)
-> (RepositoryEvent -> RepositoryEvent -> Bool)
-> Eq RepositoryEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepositoryEvent -> RepositoryEvent -> Bool
$c/= :: RepositoryEvent -> RepositoryEvent -> Bool
== :: RepositoryEvent -> RepositoryEvent -> Bool
$c== :: RepositoryEvent -> RepositoryEvent -> Bool
Eq, (forall x. RepositoryEvent -> Rep RepositoryEvent x)
-> (forall x. Rep RepositoryEvent x -> RepositoryEvent)
-> Generic RepositoryEvent
forall x. Rep RepositoryEvent x -> RepositoryEvent
forall x. RepositoryEvent -> Rep RepositoryEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepositoryEvent x -> RepositoryEvent
$cfrom :: forall x. RepositoryEvent -> Rep RepositoryEvent x
Generic)

-- | A commit event.
data CommitEvent = CommitEvent
  { CommitEvent -> Text
commitEvent_id :: Text,
    CommitEvent -> Text
commitEvent_message :: Text,
    CommitEvent -> Text
commitEvent_timestamp :: Text, -- TODO improve.
    CommitEvent -> Text
commitEvent_url :: Text,
    CommitEvent -> CommitAuthorEvent
commitEvent_author :: CommitAuthorEvent
  }
  deriving (Typeable, Int -> CommitEvent -> ShowS
[CommitEvent] -> ShowS
CommitEvent -> String
(Int -> CommitEvent -> ShowS)
-> (CommitEvent -> String)
-> ([CommitEvent] -> ShowS)
-> Show CommitEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitEvent] -> ShowS
$cshowList :: [CommitEvent] -> ShowS
show :: CommitEvent -> String
$cshow :: CommitEvent -> String
showsPrec :: Int -> CommitEvent -> ShowS
$cshowsPrec :: Int -> CommitEvent -> ShowS
Show, CommitEvent -> CommitEvent -> Bool
(CommitEvent -> CommitEvent -> Bool)
-> (CommitEvent -> CommitEvent -> Bool) -> Eq CommitEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitEvent -> CommitEvent -> Bool
$c/= :: CommitEvent -> CommitEvent -> Bool
== :: CommitEvent -> CommitEvent -> Bool
$c== :: CommitEvent -> CommitEvent -> Bool
Eq, (forall x. CommitEvent -> Rep CommitEvent x)
-> (forall x. Rep CommitEvent x -> CommitEvent)
-> Generic CommitEvent
forall x. Rep CommitEvent x -> CommitEvent
forall x. CommitEvent -> Rep CommitEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommitEvent x -> CommitEvent
$cfrom :: forall x. CommitEvent -> Rep CommitEvent x
Generic)

-- | Commit author information.
data CommitAuthorEvent = CommitAuthorEvent
  { CommitAuthorEvent -> Text
commitAuthorEvent_name :: Text,
    CommitAuthorEvent -> Text
commitAuthorEvent_email :: Text
  }
  deriving (Typeable, Int -> CommitAuthorEvent -> ShowS
[CommitAuthorEvent] -> ShowS
CommitAuthorEvent -> String
(Int -> CommitAuthorEvent -> ShowS)
-> (CommitAuthorEvent -> String)
-> ([CommitAuthorEvent] -> ShowS)
-> Show CommitAuthorEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitAuthorEvent] -> ShowS
$cshowList :: [CommitAuthorEvent] -> ShowS
show :: CommitAuthorEvent -> String
$cshow :: CommitAuthorEvent -> String
showsPrec :: Int -> CommitAuthorEvent -> ShowS
$cshowsPrec :: Int -> CommitAuthorEvent -> ShowS
Show, CommitAuthorEvent -> CommitAuthorEvent -> Bool
(CommitAuthorEvent -> CommitAuthorEvent -> Bool)
-> (CommitAuthorEvent -> CommitAuthorEvent -> Bool)
-> Eq CommitAuthorEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitAuthorEvent -> CommitAuthorEvent -> Bool
$c/= :: CommitAuthorEvent -> CommitAuthorEvent -> Bool
== :: CommitAuthorEvent -> CommitAuthorEvent -> Bool
$c== :: CommitAuthorEvent -> CommitAuthorEvent -> Bool
Eq, (forall x. CommitAuthorEvent -> Rep CommitAuthorEvent x)
-> (forall x. Rep CommitAuthorEvent x -> CommitAuthorEvent)
-> Generic CommitAuthorEvent
forall x. Rep CommitAuthorEvent x -> CommitAuthorEvent
forall x. CommitAuthorEvent -> Rep CommitAuthorEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommitAuthorEvent x -> CommitAuthorEvent
$cfrom :: forall x. CommitAuthorEvent -> Rep CommitAuthorEvent x
Generic)

instance SystemHook MergeRequestEvent where
  match :: String -> (MergeRequestEvent -> GitLab ()) -> Rule
match = String -> (MergeRequestEvent -> GitLab ()) -> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (MergeRequestEvent -> GitLab Bool)
-> (MergeRequestEvent -> GitLab ())
-> Rule
matchIf = String
-> (MergeRequestEvent -> GitLab Bool)
-> (MergeRequestEvent -> GitLab ())
-> Rule
forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
MatchIf

-- | Merge request (named so, since 'MergeRequest' type already used
-- in GitLab.Types.
data MergeRequestEvent = MergeRequestEvent
  { MergeRequestEvent -> Text
mergeRequest_object_kind :: Text,
    MergeRequestEvent -> Text
mergeRequest_event_type :: Text,
    MergeRequestEvent -> UserEvent
mergeRequest_user :: UserEvent,
    MergeRequestEvent -> ProjectEvent
mergeRequest_project :: ProjectEvent,
    MergeRequestEvent -> ObjectAttributes
mergeRequest_object_attributes :: ObjectAttributes,
    MergeRequestEvent -> Maybe [Text]
mergeRequest_labels :: Maybe [Text],
    MergeRequestEvent -> MergeRequestChanges
mergeRequest_changes :: MergeRequestChanges,
    MergeRequestEvent -> RepositoryEvent
mergeRequest_repository :: RepositoryEvent
  }
  deriving (Typeable, Int -> MergeRequestEvent -> ShowS
[MergeRequestEvent] -> ShowS
MergeRequestEvent -> String
(Int -> MergeRequestEvent -> ShowS)
-> (MergeRequestEvent -> String)
-> ([MergeRequestEvent] -> ShowS)
-> Show MergeRequestEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeRequestEvent] -> ShowS
$cshowList :: [MergeRequestEvent] -> ShowS
show :: MergeRequestEvent -> String
$cshow :: MergeRequestEvent -> String
showsPrec :: Int -> MergeRequestEvent -> ShowS
$cshowsPrec :: Int -> MergeRequestEvent -> ShowS
Show, MergeRequestEvent -> MergeRequestEvent -> Bool
(MergeRequestEvent -> MergeRequestEvent -> Bool)
-> (MergeRequestEvent -> MergeRequestEvent -> Bool)
-> Eq MergeRequestEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeRequestEvent -> MergeRequestEvent -> Bool
$c/= :: MergeRequestEvent -> MergeRequestEvent -> Bool
== :: MergeRequestEvent -> MergeRequestEvent -> Bool
$c== :: MergeRequestEvent -> MergeRequestEvent -> Bool
Eq, (forall x. MergeRequestEvent -> Rep MergeRequestEvent x)
-> (forall x. Rep MergeRequestEvent x -> MergeRequestEvent)
-> Generic MergeRequestEvent
forall x. Rep MergeRequestEvent x -> MergeRequestEvent
forall x. MergeRequestEvent -> Rep MergeRequestEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MergeRequestEvent x -> MergeRequestEvent
$cfrom :: forall x. MergeRequestEvent -> Rep MergeRequestEvent x
Generic)

data MergeRequestChanges = MergeRequestChanges
  { MergeRequestChanges -> MergeRequestChange Int
mergeRequestChanges_author_id :: MergeRequestChange Int,
    MergeRequestChanges -> MergeRequestChange Text
mergeRequestChanges_created_at :: MergeRequestChange Text,
    MergeRequestChanges -> MergeRequestChange Text
mergeRequestChanges_description :: MergeRequestChange Text,
    MergeRequestChanges -> MergeRequestChange Int
mergeRequestChanges_id :: MergeRequestChange Int,
    MergeRequestChanges -> MergeRequestChange Int
mergeRequestChanges_iid :: MergeRequestChange Int,
    MergeRequestChanges -> MergeRequestChange Text
mergeRequestChanges_source_branch :: MergeRequestChange Text,
    MergeRequestChanges -> MergeRequestChange Int
mergeRequestChanges_source_project_id :: MergeRequestChange Int,
    MergeRequestChanges -> MergeRequestChange Text
mergeRequestChanges_target_branch :: MergeRequestChange Text,
    MergeRequestChanges -> MergeRequestChange Int
mergeRequestChanges_target_project_id :: MergeRequestChange Int,
    MergeRequestChanges -> MergeRequestChange Text
mergeRequestChanges_title :: MergeRequestChange Text,
    MergeRequestChanges -> MergeRequestChange Text
mergeRequestChanges_updated_at :: MergeRequestChange Text
  }
  deriving (Typeable, Int -> MergeRequestChanges -> ShowS
[MergeRequestChanges] -> ShowS
MergeRequestChanges -> String
(Int -> MergeRequestChanges -> ShowS)
-> (MergeRequestChanges -> String)
-> ([MergeRequestChanges] -> ShowS)
-> Show MergeRequestChanges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeRequestChanges] -> ShowS
$cshowList :: [MergeRequestChanges] -> ShowS
show :: MergeRequestChanges -> String
$cshow :: MergeRequestChanges -> String
showsPrec :: Int -> MergeRequestChanges -> ShowS
$cshowsPrec :: Int -> MergeRequestChanges -> ShowS
Show, MergeRequestChanges -> MergeRequestChanges -> Bool
(MergeRequestChanges -> MergeRequestChanges -> Bool)
-> (MergeRequestChanges -> MergeRequestChanges -> Bool)
-> Eq MergeRequestChanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeRequestChanges -> MergeRequestChanges -> Bool
$c/= :: MergeRequestChanges -> MergeRequestChanges -> Bool
== :: MergeRequestChanges -> MergeRequestChanges -> Bool
$c== :: MergeRequestChanges -> MergeRequestChanges -> Bool
Eq, (forall x. MergeRequestChanges -> Rep MergeRequestChanges x)
-> (forall x. Rep MergeRequestChanges x -> MergeRequestChanges)
-> Generic MergeRequestChanges
forall x. Rep MergeRequestChanges x -> MergeRequestChanges
forall x. MergeRequestChanges -> Rep MergeRequestChanges x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MergeRequestChanges x -> MergeRequestChanges
$cfrom :: forall x. MergeRequestChanges -> Rep MergeRequestChanges x
Generic)

data MergeRequestChange a = MergeRequestChange
  { MergeRequestChange a -> Maybe a
mergeRequestChange_previous :: Maybe a,
    MergeRequestChange a -> Maybe a
mergeRequestChange_current :: Maybe a
  }
  deriving (Typeable, Int -> MergeRequestChange a -> ShowS
[MergeRequestChange a] -> ShowS
MergeRequestChange a -> String
(Int -> MergeRequestChange a -> ShowS)
-> (MergeRequestChange a -> String)
-> ([MergeRequestChange a] -> ShowS)
-> Show (MergeRequestChange a)
forall a. Show a => Int -> MergeRequestChange a -> ShowS
forall a. Show a => [MergeRequestChange a] -> ShowS
forall a. Show a => MergeRequestChange a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeRequestChange a] -> ShowS
$cshowList :: forall a. Show a => [MergeRequestChange a] -> ShowS
show :: MergeRequestChange a -> String
$cshow :: forall a. Show a => MergeRequestChange a -> String
showsPrec :: Int -> MergeRequestChange a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MergeRequestChange a -> ShowS
Show, MergeRequestChange a -> MergeRequestChange a -> Bool
(MergeRequestChange a -> MergeRequestChange a -> Bool)
-> (MergeRequestChange a -> MergeRequestChange a -> Bool)
-> Eq (MergeRequestChange a)
forall a.
Eq a =>
MergeRequestChange a -> MergeRequestChange a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeRequestChange a -> MergeRequestChange a -> Bool
$c/= :: forall a.
Eq a =>
MergeRequestChange a -> MergeRequestChange a -> Bool
== :: MergeRequestChange a -> MergeRequestChange a -> Bool
$c== :: forall a.
Eq a =>
MergeRequestChange a -> MergeRequestChange a -> Bool
Eq, (forall x. MergeRequestChange a -> Rep (MergeRequestChange a) x)
-> (forall x. Rep (MergeRequestChange a) x -> MergeRequestChange a)
-> Generic (MergeRequestChange a)
forall x. Rep (MergeRequestChange a) x -> MergeRequestChange a
forall x. MergeRequestChange a -> Rep (MergeRequestChange a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MergeRequestChange a) x -> MergeRequestChange a
forall a x. MergeRequestChange a -> Rep (MergeRequestChange a) x
$cto :: forall a x. Rep (MergeRequestChange a) x -> MergeRequestChange a
$cfrom :: forall a x. MergeRequestChange a -> Rep (MergeRequestChange a) x
Generic)

data ObjectAttributes = ObjectAttributes
  { ObjectAttributes -> Int
objectAttributes_id :: Int,
    ObjectAttributes -> Text
objectAttributes_target_branch :: Text,
    ObjectAttributes -> Text
objectAttributes_source_branch :: Text,
    ObjectAttributes -> Int
objectAttributes_source_project_id :: Int,
    ObjectAttributes -> Int
objectAttributes_author_id :: Int,
    ObjectAttributes -> Maybe Int
objectAttributes_assignee_id :: Maybe Int,
    ObjectAttributes -> Maybe [Int]
objectAttributes_assignee_ids :: Maybe [Int],
    ObjectAttributes -> Text
objectAttributes_title :: Text,
    ObjectAttributes -> Text
objectAttributes_created_at :: Text,
    ObjectAttributes -> Text
objectAttributes_updated_at :: Text,
    ObjectAttributes -> Maybe Int
objectAttributes_milestone_id :: Maybe Int,
    ObjectAttributes -> Text
objectAttributes_state :: Text,
    ObjectAttributes -> Maybe Int
objectAttributes_state_id :: Maybe Int,
    ObjectAttributes -> Text
objectAttributes_merge_status :: Text,
    ObjectAttributes -> Int
objectAttributes_target_project_id :: Int,
    ObjectAttributes -> Int
objectAttributes_iid :: Int,
    ObjectAttributes -> Text
objectAttributes_description :: Text,
    ObjectAttributes -> Maybe Int
objectAttributes_updated_by_id :: Maybe Int,
    ObjectAttributes -> Maybe Text
objectAttributes_merge_error :: Maybe Text,
    ObjectAttributes -> MergeParams
objectAttributes_merge_params :: MergeParams,
    ObjectAttributes -> Bool
objectAttributes_merge_when_pipeline_succeeds :: Bool,
    ObjectAttributes -> Maybe Int
objectAttributes_merge_user_id :: Maybe Int,
    ObjectAttributes -> Maybe Text
objectAttributes_merge_commit_sha :: Maybe Text,
    ObjectAttributes -> Maybe Text
objectAttributes_deleted_at :: Maybe Text,
    ObjectAttributes -> Maybe Text
objectAttributes_in_progress_merge_commit_sha :: Maybe Text,
    ObjectAttributes -> Maybe Int
objectAttributes_lock_version :: Maybe Int,
    ObjectAttributes -> Int
objectAttributes_time_estimate :: Int,
    ObjectAttributes -> Maybe Text
objectAttributes_last_edited_at :: Maybe Text,
    ObjectAttributes -> Maybe Int
objectAttributes_last_edited_by_id :: Maybe Int,
    ObjectAttributes -> Maybe Int
objectAttributes_head_pipeline_id :: Maybe Int,
    ObjectAttributes -> Maybe Bool
objectAttributes_ref_fetched :: Maybe Bool,
    ObjectAttributes -> Maybe Int
objectAttributes_merge_jid :: Maybe Int,
    ObjectAttributes -> ProjectEvent
objectAttributes_source :: ProjectEvent,
    ObjectAttributes -> ProjectEvent
objectAttributes_target :: ProjectEvent,
    ObjectAttributes -> CommitEvent
objectAttributes_last_commit :: CommitEvent,
    ObjectAttributes -> Bool
objectAttributes_work_in_progress :: Bool,
    ObjectAttributes -> Int
objectAttributes_total_time_spent :: Int,
    ObjectAttributes -> Maybe Int
objectAttributes_human_total_time_spent :: Maybe Int,
    ObjectAttributes -> Maybe Int
objectAttributes_human_time_estimate :: Maybe Int,
    ObjectAttributes -> Maybe Text
objectAttributes_action :: Maybe Text
  }
  deriving (Typeable, Int -> ObjectAttributes -> ShowS
[ObjectAttributes] -> ShowS
ObjectAttributes -> String
(Int -> ObjectAttributes -> ShowS)
-> (ObjectAttributes -> String)
-> ([ObjectAttributes] -> ShowS)
-> Show ObjectAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectAttributes] -> ShowS
$cshowList :: [ObjectAttributes] -> ShowS
show :: ObjectAttributes -> String
$cshow :: ObjectAttributes -> String
showsPrec :: Int -> ObjectAttributes -> ShowS
$cshowsPrec :: Int -> ObjectAttributes -> ShowS
Show, ObjectAttributes -> ObjectAttributes -> Bool
(ObjectAttributes -> ObjectAttributes -> Bool)
-> (ObjectAttributes -> ObjectAttributes -> Bool)
-> Eq ObjectAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectAttributes -> ObjectAttributes -> Bool
$c/= :: ObjectAttributes -> ObjectAttributes -> Bool
== :: ObjectAttributes -> ObjectAttributes -> Bool
$c== :: ObjectAttributes -> ObjectAttributes -> Bool
Eq, (forall x. ObjectAttributes -> Rep ObjectAttributes x)
-> (forall x. Rep ObjectAttributes x -> ObjectAttributes)
-> Generic ObjectAttributes
forall x. Rep ObjectAttributes x -> ObjectAttributes
forall x. ObjectAttributes -> Rep ObjectAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObjectAttributes x -> ObjectAttributes
$cfrom :: forall x. ObjectAttributes -> Rep ObjectAttributes x
Generic)

data MergeParams = MergeParams
  { MergeParams -> Maybe Text
mergeParams_force_remove_source_branch :: Maybe Text
  }
  deriving (Typeable, Int -> MergeParams -> ShowS
[MergeParams] -> ShowS
MergeParams -> String
(Int -> MergeParams -> ShowS)
-> (MergeParams -> String)
-> ([MergeParams] -> ShowS)
-> Show MergeParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeParams] -> ShowS
$cshowList :: [MergeParams] -> ShowS
show :: MergeParams -> String
$cshow :: MergeParams -> String
showsPrec :: Int -> MergeParams -> ShowS
$cshowsPrec :: Int -> MergeParams -> ShowS
Show, MergeParams -> MergeParams -> Bool
(MergeParams -> MergeParams -> Bool)
-> (MergeParams -> MergeParams -> Bool) -> Eq MergeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeParams -> MergeParams -> Bool
$c/= :: MergeParams -> MergeParams -> Bool
== :: MergeParams -> MergeParams -> Bool
$c== :: MergeParams -> MergeParams -> Bool
Eq, (forall x. MergeParams -> Rep MergeParams x)
-> (forall x. Rep MergeParams x -> MergeParams)
-> Generic MergeParams
forall x. Rep MergeParams x -> MergeParams
forall x. MergeParams -> Rep MergeParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MergeParams x -> MergeParams
$cfrom :: forall x. MergeParams -> Rep MergeParams x
Generic)

data UserEvent = UserEvent
  { UserEvent -> Text
userEvent_name :: Text,
    UserEvent -> Text
userEvent_username :: Text,
    UserEvent -> Text
userEvent_avatar_url :: Text
  }
  deriving (Typeable, Int -> UserEvent -> ShowS
[UserEvent] -> ShowS
UserEvent -> String
(Int -> UserEvent -> ShowS)
-> (UserEvent -> String)
-> ([UserEvent] -> ShowS)
-> Show UserEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserEvent] -> ShowS
$cshowList :: [UserEvent] -> ShowS
show :: UserEvent -> String
$cshow :: UserEvent -> String
showsPrec :: Int -> UserEvent -> ShowS
$cshowsPrec :: Int -> UserEvent -> ShowS
Show, UserEvent -> UserEvent -> Bool
(UserEvent -> UserEvent -> Bool)
-> (UserEvent -> UserEvent -> Bool) -> Eq UserEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserEvent -> UserEvent -> Bool
$c/= :: UserEvent -> UserEvent -> Bool
== :: UserEvent -> UserEvent -> Bool
$c== :: UserEvent -> UserEvent -> Bool
Eq, (forall x. UserEvent -> Rep UserEvent x)
-> (forall x. Rep UserEvent x -> UserEvent) -> Generic UserEvent
forall x. Rep UserEvent x -> UserEvent
forall x. UserEvent -> Rep UserEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserEvent x -> UserEvent
$cfrom :: forall x. UserEvent -> Rep UserEvent x
Generic)

data ProjectAction
  = ProjectCreated
  | ProjectDestroyed
  | ProjectRenamed
  | ProjectTransferred
  | ProjectUpdated
  | UserAddedToTeam
  | UserUpdatedForTeam
  | UserRemovedFromTeam
  | UserCreated
  | UserRemoved
  | UserFailedToLogin
  | UserRenamed
  | KeyCreated
  | KeyRemoved
  | GroupCreated
  | GroupRemoved
  | GroupRenamed
  | GroupMemberAdded
  | GroupMemberRemoved
  | GroupMemberUpdated
  | Pushed
  | TagPushed
  | RepositoryUpdated
  | MergeRequested
  deriving (Int -> ProjectAction -> ShowS
[ProjectAction] -> ShowS
ProjectAction -> String
(Int -> ProjectAction -> ShowS)
-> (ProjectAction -> String)
-> ([ProjectAction] -> ShowS)
-> Show ProjectAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectAction] -> ShowS
$cshowList :: [ProjectAction] -> ShowS
show :: ProjectAction -> String
$cshow :: ProjectAction -> String
showsPrec :: Int -> ProjectAction -> ShowS
$cshowsPrec :: Int -> ProjectAction -> ShowS
Show, ProjectAction -> ProjectAction -> Bool
(ProjectAction -> ProjectAction -> Bool)
-> (ProjectAction -> ProjectAction -> Bool) -> Eq ProjectAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectAction -> ProjectAction -> Bool
$c/= :: ProjectAction -> ProjectAction -> Bool
== :: ProjectAction -> ProjectAction -> Bool
$c== :: ProjectAction -> ProjectAction -> Bool
Eq)

-- |  Project visibility.
data Visibility
  = Public
  | Private
  | Internal
  deriving (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show, Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq)

instance FromJSON ProjectCreate where
  parseJSON :: Value -> Parser ProjectCreate
parseJSON =
    String
-> (Object -> Parser ProjectCreate)
-> Value
-> Parser ProjectCreate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectCreate" ((Object -> Parser ProjectCreate) -> Value -> Parser ProjectCreate)
-> (Object -> Parser ProjectCreate)
-> Value
-> Parser ProjectCreate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
ProjectCreated ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Visibility
-> ProjectCreate
ProjectCreate
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Visibility
 -> ProjectCreate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectCreate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectCreate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectCreate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectCreate)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Int -> Visibility -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser
  (Text
   -> Text -> Text -> Text -> Int -> Visibility -> ProjectCreate)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Visibility -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser (Text -> Text -> Text -> Int -> Visibility -> ProjectCreate)
-> Parser Text
-> Parser (Text -> Text -> Int -> Visibility -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Text -> Text -> Int -> Visibility -> ProjectCreate)
-> Parser Text
-> Parser (Text -> Int -> Visibility -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser (Text -> Int -> Visibility -> ProjectCreate)
-> Parser Text -> Parser (Int -> Visibility -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path_with_namespace"
                Parser (Int -> Visibility -> ProjectCreate)
-> Parser Int -> Parser (Visibility -> ProjectCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser (Visibility -> ProjectCreate)
-> Parser Visibility -> Parser ProjectCreate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
            ProjectAction
_unexpected -> String -> Parser ProjectCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_create parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser ProjectCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_create parsing failed"

instance FromJSON ProjectDestroy where
  parseJSON :: Value -> Parser ProjectDestroy
parseJSON =
    String
-> (Object -> Parser ProjectDestroy)
-> Value
-> Parser ProjectDestroy
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectDestroy" ((Object -> Parser ProjectDestroy)
 -> Value -> Parser ProjectDestroy)
-> (Object -> Parser ProjectDestroy)
-> Value
-> Parser ProjectDestroy
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
ProjectDestroyed ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Visibility
-> ProjectDestroy
ProjectDestroy
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Visibility
 -> ProjectDestroy)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectDestroy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectDestroy)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectDestroy)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectDestroy)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Int -> Visibility -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser
  (Text
   -> Text -> Text -> Text -> Int -> Visibility -> ProjectDestroy)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Visibility -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser
  (Text -> Text -> Text -> Int -> Visibility -> ProjectDestroy)
-> Parser Text
-> Parser (Text -> Text -> Int -> Visibility -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Text -> Text -> Int -> Visibility -> ProjectDestroy)
-> Parser Text
-> Parser (Text -> Int -> Visibility -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser (Text -> Int -> Visibility -> ProjectDestroy)
-> Parser Text -> Parser (Int -> Visibility -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path_with_namespace"
                Parser (Int -> Visibility -> ProjectDestroy)
-> Parser Int -> Parser (Visibility -> ProjectDestroy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser (Visibility -> ProjectDestroy)
-> Parser Visibility -> Parser ProjectDestroy
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
            ProjectAction
_unexpected -> String -> Parser ProjectDestroy
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_destroy parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser ProjectDestroy
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_destroy parsing failed"

instance FromJSON ProjectRename where
  parseJSON :: Value -> Parser ProjectRename
parseJSON =
    String
-> (Object -> Parser ProjectRename)
-> Value
-> Parser ProjectRename
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectRename" ((Object -> Parser ProjectRename) -> Value -> Parser ProjectRename)
-> (Object -> Parser ProjectRename)
-> Value
-> Parser ProjectRename
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
ProjectRenamed ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Visibility
-> Text
-> ProjectRename
ProjectRename
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Visibility
 -> Text
 -> ProjectRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectRename)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectRename)
-> Parser Text
-> Parser
     (Text
      -> Int -> Text -> Text -> Visibility -> Text -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser
  (Text
   -> Int -> Text -> Text -> Visibility -> Text -> ProjectRename)
-> Parser Text
-> Parser
     (Int -> Text -> Text -> Visibility -> Text -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path_with_namespace"
                Parser (Int -> Text -> Text -> Visibility -> Text -> ProjectRename)
-> Parser Int
-> Parser (Text -> Text -> Visibility -> Text -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser (Text -> Text -> Visibility -> Text -> ProjectRename)
-> Parser Text
-> Parser (Text -> Visibility -> Text -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Text -> Visibility -> Text -> ProjectRename)
-> Parser Text -> Parser (Visibility -> Text -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser (Visibility -> Text -> ProjectRename)
-> Parser Visibility -> Parser (Text -> ProjectRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
                Parser (Text -> ProjectRename)
-> Parser Text -> Parser ProjectRename
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"old_path_with_namespace"
            ProjectAction
_unexpected -> String -> Parser ProjectRename
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_rename parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser ProjectRename
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_rename parsing failed"

instance FromJSON ProjectTransfer where
  parseJSON :: Value -> Parser ProjectTransfer
parseJSON =
    String
-> (Object -> Parser ProjectTransfer)
-> Value
-> Parser ProjectTransfer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectTransfer" ((Object -> Parser ProjectTransfer)
 -> Value -> Parser ProjectTransfer)
-> (Object -> Parser ProjectTransfer)
-> Value
-> Parser ProjectTransfer
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
ProjectTransferred ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Visibility
-> Text
-> ProjectTransfer
ProjectTransfer
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Visibility
 -> Text
 -> ProjectTransfer)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectTransfer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectTransfer)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectTransfer)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectTransfer)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Visibility
      -> Text
      -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Visibility
   -> Text
   -> ProjectTransfer)
-> Parser Text
-> Parser
     (Text
      -> Int -> Text -> Text -> Visibility -> Text -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser
  (Text
   -> Int -> Text -> Text -> Visibility -> Text -> ProjectTransfer)
-> Parser Text
-> Parser
     (Int -> Text -> Text -> Visibility -> Text -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path_with_namespace"
                Parser
  (Int -> Text -> Text -> Visibility -> Text -> ProjectTransfer)
-> Parser Int
-> Parser (Text -> Text -> Visibility -> Text -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser (Text -> Text -> Visibility -> Text -> ProjectTransfer)
-> Parser Text
-> Parser (Text -> Visibility -> Text -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Text -> Visibility -> Text -> ProjectTransfer)
-> Parser Text -> Parser (Visibility -> Text -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser (Visibility -> Text -> ProjectTransfer)
-> Parser Visibility -> Parser (Text -> ProjectTransfer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
                Parser (Text -> ProjectTransfer)
-> Parser Text -> Parser ProjectTransfer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"old_path_with_namespace"
            ProjectAction
_unexpected -> String -> Parser ProjectTransfer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_transfer parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser ProjectTransfer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_transfer parsing failed"

instance FromJSON ProjectUpdate where
  parseJSON :: Value -> Parser ProjectUpdate
parseJSON =
    String
-> (Object -> Parser ProjectUpdate)
-> Value
-> Parser ProjectUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectUpdate" ((Object -> Parser ProjectUpdate) -> Value -> Parser ProjectUpdate)
-> (Object -> Parser ProjectUpdate)
-> Value
-> Parser ProjectUpdate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
ProjectUpdated ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Visibility
-> ProjectUpdate
ProjectUpdate
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Visibility
 -> ProjectUpdate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectUpdate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectUpdate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> ProjectUpdate)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Int -> Visibility -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser
  (Text
   -> Text -> Text -> Text -> Int -> Visibility -> ProjectUpdate)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Visibility -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser (Text -> Text -> Text -> Int -> Visibility -> ProjectUpdate)
-> Parser Text
-> Parser (Text -> Text -> Int -> Visibility -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Text -> Text -> Int -> Visibility -> ProjectUpdate)
-> Parser Text
-> Parser (Text -> Int -> Visibility -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser (Text -> Int -> Visibility -> ProjectUpdate)
-> Parser Text -> Parser (Int -> Visibility -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path_with_namespace"
                Parser (Int -> Visibility -> ProjectUpdate)
-> Parser Int -> Parser (Visibility -> ProjectUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser (Visibility -> ProjectUpdate)
-> Parser Visibility -> Parser ProjectUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
            ProjectAction
_unexpected -> String -> Parser ProjectUpdate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_update parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser ProjectUpdate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_update parsing failed"

instance FromJSON UserAddToTeam where
  parseJSON :: Value -> Parser UserAddToTeam
parseJSON =
    String
-> (Object -> Parser UserAddToTeam)
-> Value
-> Parser UserAddToTeam
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserAddToTeam" ((Object -> Parser UserAddToTeam) -> Value -> Parser UserAddToTeam)
-> (Object -> Parser UserAddToTeam)
-> Value
-> Parser UserAddToTeam
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
UserAddedToTeam ->
              Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Visibility
-> UserAddToTeam
UserAddToTeam
                (Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Visibility
 -> UserAddToTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserAddToTeam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserAddToTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserAddToTeam)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserAddToTeam)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"access_level"
                Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserAddToTeam)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserAddToTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserAddToTeam)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Int -> Visibility -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_path"
                Parser
  (Text
   -> Text -> Text -> Text -> Int -> Visibility -> UserAddToTeam)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Visibility -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_path_with_namespace"
                Parser (Text -> Text -> Text -> Int -> Visibility -> UserAddToTeam)
-> Parser Text
-> Parser (Text -> Text -> Int -> Visibility -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser (Text -> Text -> Int -> Visibility -> UserAddToTeam)
-> Parser Text
-> Parser (Text -> Int -> Visibility -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser (Text -> Int -> Visibility -> UserAddToTeam)
-> Parser Text -> Parser (Int -> Visibility -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_username"
                Parser (Int -> Visibility -> UserAddToTeam)
-> Parser Int -> Parser (Visibility -> UserAddToTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser (Visibility -> UserAddToTeam)
-> Parser Visibility -> Parser UserAddToTeam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
            ProjectAction
_unexpected -> String -> Parser UserAddToTeam
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_add_to_team parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser UserAddToTeam
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_add_to_team parsing failed"

instance FromJSON UserUpdateForTeam where
  parseJSON :: Value -> Parser UserUpdateForTeam
parseJSON =
    String
-> (Object -> Parser UserUpdateForTeam)
-> Value
-> Parser UserUpdateForTeam
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserUpdateForTeam" ((Object -> Parser UserUpdateForTeam)
 -> Value -> Parser UserUpdateForTeam)
-> (Object -> Parser UserUpdateForTeam)
-> Value
-> Parser UserUpdateForTeam
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
UserUpdatedForTeam ->
              Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Visibility
-> UserUpdateForTeam
UserUpdateForTeam
                (Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Visibility
 -> UserUpdateForTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserUpdateForTeam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserUpdateForTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserUpdateForTeam)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserUpdateForTeam)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"access_level"
                Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserUpdateForTeam)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserUpdateForTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserUpdateForTeam)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Int -> Visibility -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_path"
                Parser
  (Text
   -> Text -> Text -> Text -> Int -> Visibility -> UserUpdateForTeam)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Visibility -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_path_with_namespace"
                Parser
  (Text -> Text -> Text -> Int -> Visibility -> UserUpdateForTeam)
-> Parser Text
-> Parser (Text -> Text -> Int -> Visibility -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser (Text -> Text -> Int -> Visibility -> UserUpdateForTeam)
-> Parser Text
-> Parser (Text -> Int -> Visibility -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser (Text -> Int -> Visibility -> UserUpdateForTeam)
-> Parser Text -> Parser (Int -> Visibility -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_username"
                Parser (Int -> Visibility -> UserUpdateForTeam)
-> Parser Int -> Parser (Visibility -> UserUpdateForTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser (Visibility -> UserUpdateForTeam)
-> Parser Visibility -> Parser UserUpdateForTeam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
            ProjectAction
_unexpected -> String -> Parser UserUpdateForTeam
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_update_for_team parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser UserUpdateForTeam
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_update_for_team parsing failed"

instance FromJSON UserRemoveFromTeam where
  parseJSON :: Value -> Parser UserRemoveFromTeam
parseJSON =
    String
-> (Object -> Parser UserRemoveFromTeam)
-> Value
-> Parser UserRemoveFromTeam
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserRemoveFromTeam" ((Object -> Parser UserRemoveFromTeam)
 -> Value -> Parser UserRemoveFromTeam)
-> (Object -> Parser UserRemoveFromTeam)
-> Value
-> Parser UserRemoveFromTeam
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
UserRemovedFromTeam ->
              Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Visibility
-> UserRemoveFromTeam
UserRemoveFromTeam
                (Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Visibility
 -> UserRemoveFromTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserRemoveFromTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserRemoveFromTeam)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserRemoveFromTeam)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"access_level"
                Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserRemoveFromTeam)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserRemoveFromTeam)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Visibility
      -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Visibility
   -> UserRemoveFromTeam)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Int -> Visibility -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_path"
                Parser
  (Text
   -> Text -> Text -> Text -> Int -> Visibility -> UserRemoveFromTeam)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Visibility -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_path_with_namespace"
                Parser
  (Text -> Text -> Text -> Int -> Visibility -> UserRemoveFromTeam)
-> Parser Text
-> Parser (Text -> Text -> Int -> Visibility -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser (Text -> Text -> Int -> Visibility -> UserRemoveFromTeam)
-> Parser Text
-> Parser (Text -> Int -> Visibility -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser (Text -> Int -> Visibility -> UserRemoveFromTeam)
-> Parser Text -> Parser (Int -> Visibility -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_username"
                Parser (Int -> Visibility -> UserRemoveFromTeam)
-> Parser Int -> Parser (Visibility -> UserRemoveFromTeam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser (Visibility -> UserRemoveFromTeam)
-> Parser Visibility -> Parser UserRemoveFromTeam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Visibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_visibility"
            ProjectAction
_unexpected -> String -> Parser UserRemoveFromTeam
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_remove_from_team parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser UserRemoveFromTeam
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_remove_from_team parsing failed"

instance FromJSON UserCreate where
  parseJSON :: Value -> Parser UserCreate
parseJSON =
    String
-> (Object -> Parser UserCreate) -> Value -> Parser UserCreate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserCreate" ((Object -> Parser UserCreate) -> Value -> Parser UserCreate)
-> (Object -> Parser UserCreate) -> Value -> Parser UserCreate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
UserCreated ->
              Text -> Text -> Text -> Text -> Text -> Text -> Int -> UserCreate
UserCreate
                (Text -> Text -> Text -> Text -> Text -> Text -> Int -> UserCreate)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Int -> UserCreate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser (Text -> Text -> Text -> Text -> Text -> Int -> UserCreate)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Int -> UserCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser (Text -> Text -> Text -> Text -> Int -> UserCreate)
-> Parser Text
-> Parser (Text -> Text -> Text -> Int -> UserCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"email"
                Parser (Text -> Text -> Text -> Int -> UserCreate)
-> Parser Text -> Parser (Text -> Text -> Int -> UserCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser (Text -> Text -> Int -> UserCreate)
-> Parser Text -> Parser (Text -> Int -> UserCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser (Text -> Int -> UserCreate)
-> Parser Text -> Parser (Int -> UserCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
                Parser (Int -> UserCreate) -> Parser Int -> Parser UserCreate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
            ProjectAction
_unexpected -> String -> Parser UserCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_create parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser UserCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_create parsing failed"

instance FromJSON UserRemove where
  parseJSON :: Value -> Parser UserRemove
parseJSON =
    String
-> (Object -> Parser UserRemove) -> Value -> Parser UserRemove
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserRemove" ((Object -> Parser UserRemove) -> Value -> Parser UserRemove)
-> (Object -> Parser UserRemove) -> Value -> Parser UserRemove
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
UserRemoved ->
              Text -> Text -> Text -> Text -> Text -> Text -> Int -> UserRemove
UserRemove
                (Text -> Text -> Text -> Text -> Text -> Text -> Int -> UserRemove)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Int -> UserRemove)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser (Text -> Text -> Text -> Text -> Text -> Int -> UserRemove)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Int -> UserRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser (Text -> Text -> Text -> Text -> Int -> UserRemove)
-> Parser Text
-> Parser (Text -> Text -> Text -> Int -> UserRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"email"
                Parser (Text -> Text -> Text -> Int -> UserRemove)
-> Parser Text -> Parser (Text -> Text -> Int -> UserRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser (Text -> Text -> Int -> UserRemove)
-> Parser Text -> Parser (Text -> Int -> UserRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser (Text -> Int -> UserRemove)
-> Parser Text -> Parser (Int -> UserRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
                Parser (Int -> UserRemove) -> Parser Int -> Parser UserRemove
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
            ProjectAction
_unexpected -> String -> Parser UserRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_destroy parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser UserRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_destroy parsing failed"

instance FromJSON UserFailedLogin where
  parseJSON :: Value -> Parser UserFailedLogin
parseJSON =
    String
-> (Object -> Parser UserFailedLogin)
-> Value
-> Parser UserFailedLogin
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserFailedLogin" ((Object -> Parser UserFailedLogin)
 -> Value -> Parser UserFailedLogin)
-> (Object -> Parser UserFailedLogin)
-> Value
-> Parser UserFailedLogin
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
UserFailedToLogin ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> UserFailedLogin
UserFailedLogin
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> UserFailedLogin)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Int -> Text -> Text -> UserFailedLogin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text -> Text -> Text -> Int -> Text -> Text -> UserFailedLogin)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Text -> Text -> UserFailedLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text -> Text -> Text -> Int -> Text -> Text -> UserFailedLogin)
-> Parser Text
-> Parser (Text -> Text -> Int -> Text -> Text -> UserFailedLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser (Text -> Text -> Int -> Text -> Text -> UserFailedLogin)
-> Parser Text
-> Parser (Text -> Int -> Text -> Text -> UserFailedLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser (Text -> Int -> Text -> Text -> UserFailedLogin)
-> Parser Text -> Parser (Int -> Text -> Text -> UserFailedLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"email"
                Parser (Int -> Text -> Text -> UserFailedLogin)
-> Parser Int -> Parser (Text -> Text -> UserFailedLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser (Text -> Text -> UserFailedLogin)
-> Parser Text -> Parser (Text -> UserFailedLogin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
                Parser (Text -> UserFailedLogin)
-> Parser Text -> Parser UserFailedLogin
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"state"
            ProjectAction
_unexpected -> String -> Parser UserFailedLogin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_failed_login parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser UserFailedLogin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_failed_login parsing failed"

instance FromJSON UserRename where
  parseJSON :: Value -> Parser UserRename
parseJSON =
    String
-> (Object -> Parser UserRename) -> Value -> Parser UserRename
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserRename" ((Object -> Parser UserRename) -> Value -> Parser UserRename)
-> (Object -> Parser UserRename) -> Value -> Parser UserRename
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
UserRenamed ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> UserRename
UserRename
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> UserRename)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Int -> Text -> Text -> UserRename)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text -> Text -> Text -> Text -> Int -> Text -> Text -> UserRename)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Text -> Text -> UserRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser (Text -> Text -> Text -> Int -> Text -> Text -> UserRename)
-> Parser Text
-> Parser (Text -> Text -> Int -> Text -> Text -> UserRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser (Text -> Text -> Int -> Text -> Text -> UserRename)
-> Parser Text
-> Parser (Text -> Int -> Text -> Text -> UserRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser (Text -> Int -> Text -> Text -> UserRename)
-> Parser Text -> Parser (Int -> Text -> Text -> UserRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"email"
                Parser (Int -> Text -> Text -> UserRename)
-> Parser Int -> Parser (Text -> Text -> UserRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser (Text -> Text -> UserRename)
-> Parser Text -> Parser (Text -> UserRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
                Parser (Text -> UserRename) -> Parser Text -> Parser UserRename
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"old_username"
            ProjectAction
_unexpected -> String -> Parser UserRename
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_rename parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser UserRename
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_rename parsing failed"

instance FromJSON KeyCreate where
  parseJSON :: Value -> Parser KeyCreate
parseJSON =
    String -> (Object -> Parser KeyCreate) -> Value -> Parser KeyCreate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"KeyCreate" ((Object -> Parser KeyCreate) -> Value -> Parser KeyCreate)
-> (Object -> Parser KeyCreate) -> Value -> Parser KeyCreate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
KeyCreated ->
              Text -> Text -> Text -> Text -> Text -> Int -> KeyCreate
KeyCreate
                (Text -> Text -> Text -> Text -> Text -> Int -> KeyCreate)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Int -> KeyCreate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser (Text -> Text -> Text -> Text -> Int -> KeyCreate)
-> Parser Text -> Parser (Text -> Text -> Text -> Int -> KeyCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser (Text -> Text -> Text -> Int -> KeyCreate)
-> Parser Text -> Parser (Text -> Text -> Int -> KeyCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser (Text -> Text -> Int -> KeyCreate)
-> Parser Text -> Parser (Text -> Int -> KeyCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
                Parser (Text -> Int -> KeyCreate)
-> Parser Text -> Parser (Int -> KeyCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"key"
                Parser (Int -> KeyCreate) -> Parser Int -> Parser KeyCreate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
            ProjectAction
_unexpected -> String -> Parser KeyCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"key_create parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser KeyCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"key_create parsing failed"

instance FromJSON KeyRemove where
  parseJSON :: Value -> Parser KeyRemove
parseJSON =
    String -> (Object -> Parser KeyRemove) -> Value -> Parser KeyRemove
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"KeyRemove" ((Object -> Parser KeyRemove) -> Value -> Parser KeyRemove)
-> (Object -> Parser KeyRemove) -> Value -> Parser KeyRemove
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
KeyRemoved ->
              Text -> Text -> Text -> Text -> Text -> Int -> KeyRemove
KeyRemove
                (Text -> Text -> Text -> Text -> Text -> Int -> KeyRemove)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Int -> KeyRemove)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser (Text -> Text -> Text -> Text -> Int -> KeyRemove)
-> Parser Text -> Parser (Text -> Text -> Text -> Int -> KeyRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser (Text -> Text -> Text -> Int -> KeyRemove)
-> Parser Text -> Parser (Text -> Text -> Int -> KeyRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser (Text -> Text -> Int -> KeyRemove)
-> Parser Text -> Parser (Text -> Int -> KeyRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
                Parser (Text -> Int -> KeyRemove)
-> Parser Text -> Parser (Int -> KeyRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"key"
                Parser (Int -> KeyRemove) -> Parser Int -> Parser KeyRemove
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
            ProjectAction
_unexpected -> String -> Parser KeyRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"key_destroy parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser KeyRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"key_destroy parsing failed"

instance FromJSON GroupCreate where
  parseJSON :: Value -> Parser GroupCreate
parseJSON =
    String
-> (Object -> Parser GroupCreate) -> Value -> Parser GroupCreate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupCreate" ((Object -> Parser GroupCreate) -> Value -> Parser GroupCreate)
-> (Object -> Parser GroupCreate) -> Value -> Parser GroupCreate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
GroupCreated ->
              Text
-> Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Text
-> Int
-> GroupCreate
GroupCreate
                (Text
 -> Text
 -> Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Int
 -> GroupCreate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Int
      -> GroupCreate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Int
   -> GroupCreate)
-> Parser Text
-> Parser
     (Text
      -> Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupCreate)
-> Parser Text
-> Parser
     (Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupCreate)
-> Parser Text
-> Parser (Maybe Text -> Maybe Text -> Text -> Int -> GroupCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser (Maybe Text -> Maybe Text -> Text -> Int -> GroupCreate)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Text -> Int -> GroupCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser (Maybe Text -> Text -> Int -> GroupCreate)
-> Parser (Maybe Text) -> Parser (Text -> Int -> GroupCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Text -> Int -> GroupCreate)
-> Parser Text -> Parser (Int -> GroupCreate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser (Int -> GroupCreate) -> Parser Int -> Parser GroupCreate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_id"
            ProjectAction
_unexpected -> String -> Parser GroupCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_create parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser GroupCreate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_create parsing failed"

instance FromJSON GroupRemove where
  parseJSON :: Value -> Parser GroupRemove
parseJSON =
    String
-> (Object -> Parser GroupRemove) -> Value -> Parser GroupRemove
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupRemove" ((Object -> Parser GroupRemove) -> Value -> Parser GroupRemove)
-> (Object -> Parser GroupRemove) -> Value -> Parser GroupRemove
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
GroupRemoved ->
              Text
-> Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Text
-> Int
-> GroupRemove
GroupRemove
                (Text
 -> Text
 -> Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Int
 -> GroupRemove)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Int
      -> GroupRemove)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Int
   -> GroupRemove)
-> Parser Text
-> Parser
     (Text
      -> Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupRemove)
-> Parser Text
-> Parser
     (Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text -> Maybe Text -> Maybe Text -> Text -> Int -> GroupRemove)
-> Parser Text
-> Parser (Maybe Text -> Maybe Text -> Text -> Int -> GroupRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser (Maybe Text -> Maybe Text -> Text -> Int -> GroupRemove)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Text -> Int -> GroupRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser (Maybe Text -> Text -> Int -> GroupRemove)
-> Parser (Maybe Text) -> Parser (Text -> Int -> GroupRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Text -> Int -> GroupRemove)
-> Parser Text -> Parser (Int -> GroupRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser (Int -> GroupRemove) -> Parser Int -> Parser GroupRemove
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_id"
            ProjectAction
_unexpected -> String -> Parser GroupRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_remove parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser GroupRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_remove parsing failed"

instance FromJSON GroupRename where
  parseJSON :: Value -> Parser GroupRename
parseJSON =
    String
-> (Object -> Parser GroupRename) -> Value -> Parser GroupRename
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupRename" ((Object -> Parser GroupRename) -> Value -> Parser GroupRename)
-> (Object -> Parser GroupRename) -> Value -> Parser GroupRename
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
GroupRenamed ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> GroupRename
GroupRename
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Text
 -> GroupRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> GroupRename)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> GroupRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> GroupRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> GroupRename)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser
  (Text
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> GroupRename)
-> Parser Text
-> Parser
     (Text
      -> Int -> Maybe Text -> Maybe Text -> Text -> Text -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
                Parser
  (Text
   -> Int -> Maybe Text -> Maybe Text -> Text -> Text -> GroupRename)
-> Parser Text
-> Parser
     (Int -> Maybe Text -> Maybe Text -> Text -> Text -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"full_path"
                Parser
  (Int -> Maybe Text -> Maybe Text -> Text -> Text -> GroupRename)
-> Parser Int
-> Parser (Maybe Text -> Maybe Text -> Text -> Text -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_id"
                Parser (Maybe Text -> Maybe Text -> Text -> Text -> GroupRename)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Text -> Text -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_name"
                Parser (Maybe Text -> Text -> Text -> GroupRename)
-> Parser (Maybe Text) -> Parser (Text -> Text -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_email"
                Parser (Text -> Text -> GroupRename)
-> Parser Text -> Parser (Text -> GroupRename)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"old_path"
                Parser (Text -> GroupRename) -> Parser Text -> Parser GroupRename
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"old_full_path"
            ProjectAction
_unexpected -> String -> Parser GroupRename
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_rename parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser GroupRename
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_rename parsing failed"

instance FromJSON NewGroupMember where
  parseJSON :: Value -> Parser NewGroupMember
parseJSON =
    String
-> (Object -> Parser NewGroupMember)
-> Value
-> Parser NewGroupMember
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NewGroupMember" ((Object -> Parser NewGroupMember)
 -> Value -> Parser NewGroupMember)
-> (Object -> Parser NewGroupMember)
-> Value
-> Parser NewGroupMember
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
GroupMemberAdded ->
              Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> NewGroupMember
NewGroupMember
                (Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> NewGroupMember)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> NewGroupMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> NewGroupMember)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> NewGroupMember)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> NewGroupMember)
-> Parser Text
-> Parser
     (Int
      -> Text -> Text -> Text -> Text -> Text -> Int -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_access"
                Parser
  (Int
   -> Text -> Text -> Text -> Text -> Text -> Int -> NewGroupMember)
-> Parser Int
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Int -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_id"
                Parser
  (Text -> Text -> Text -> Text -> Text -> Int -> NewGroupMember)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Int -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_name"
                Parser (Text -> Text -> Text -> Text -> Int -> NewGroupMember)
-> Parser Text
-> Parser (Text -> Text -> Text -> Int -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_path"
                Parser (Text -> Text -> Text -> Int -> NewGroupMember)
-> Parser Text -> Parser (Text -> Text -> Int -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser (Text -> Text -> Int -> NewGroupMember)
-> Parser Text -> Parser (Text -> Int -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser (Text -> Int -> NewGroupMember)
-> Parser Text -> Parser (Int -> NewGroupMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_username"
                Parser (Int -> NewGroupMember)
-> Parser Int -> Parser NewGroupMember
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
            ProjectAction
_unexpected -> String -> Parser NewGroupMember
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_add_to_group parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser NewGroupMember
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_add_to_group parsing failed"

instance FromJSON GroupMemberRemove where
  parseJSON :: Value -> Parser GroupMemberRemove
parseJSON =
    String
-> (Object -> Parser GroupMemberRemove)
-> Value
-> Parser GroupMemberRemove
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupMemberRemove" ((Object -> Parser GroupMemberRemove)
 -> Value -> Parser GroupMemberRemove)
-> (Object -> Parser GroupMemberRemove)
-> Value
-> Parser GroupMemberRemove
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
GroupMemberRemoved ->
              Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> GroupMemberRemove
GroupMemberRemove
                (Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> GroupMemberRemove)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberRemove)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberRemove)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberRemove)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberRemove)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_access"
                Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberRemove)
-> Parser Int
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Int -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_id"
                Parser
  (Text -> Text -> Text -> Text -> Text -> Int -> GroupMemberRemove)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Int -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_name"
                Parser (Text -> Text -> Text -> Text -> Int -> GroupMemberRemove)
-> Parser Text
-> Parser (Text -> Text -> Text -> Int -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_path"
                Parser (Text -> Text -> Text -> Int -> GroupMemberRemove)
-> Parser Text -> Parser (Text -> Text -> Int -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser (Text -> Text -> Int -> GroupMemberRemove)
-> Parser Text -> Parser (Text -> Int -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser (Text -> Int -> GroupMemberRemove)
-> Parser Text -> Parser (Int -> GroupMemberRemove)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_username"
                Parser (Int -> GroupMemberRemove)
-> Parser Int -> Parser GroupMemberRemove
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
            ProjectAction
_unexpected -> String -> Parser GroupMemberRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_remove_from_group parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser GroupMemberRemove
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_remove_from_group parsing failed"

instance FromJSON GroupMemberUpdate where
  parseJSON :: Value -> Parser GroupMemberUpdate
parseJSON =
    String
-> (Object -> Parser GroupMemberUpdate)
-> Value
-> Parser GroupMemberUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupMemberUpdate" ((Object -> Parser GroupMemberUpdate)
 -> Value -> Parser GroupMemberUpdate)
-> (Object -> Parser GroupMemberUpdate)
-> Value
-> Parser GroupMemberUpdate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
GroupMemberUpdated ->
              Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> GroupMemberUpdate
GroupMemberUpdate
                (Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> GroupMemberUpdate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberUpdate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberUpdate)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberUpdate)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_access"
                Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> GroupMemberUpdate)
-> Parser Int
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Int -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_id"
                Parser
  (Text -> Text -> Text -> Text -> Text -> Int -> GroupMemberUpdate)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Int -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_name"
                Parser (Text -> Text -> Text -> Text -> Int -> GroupMemberUpdate)
-> Parser Text
-> Parser (Text -> Text -> Text -> Int -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group_path"
                Parser (Text -> Text -> Text -> Int -> GroupMemberUpdate)
-> Parser Text -> Parser (Text -> Text -> Int -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser (Text -> Text -> Int -> GroupMemberUpdate)
-> Parser Text -> Parser (Text -> Int -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser (Text -> Int -> GroupMemberUpdate)
-> Parser Text -> Parser (Int -> GroupMemberUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_username"
                Parser (Int -> GroupMemberUpdate)
-> Parser Int -> Parser GroupMemberUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
            ProjectAction
_unexpected -> String -> Parser GroupMemberUpdate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_update_for_group parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser GroupMemberUpdate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_update_for_group parsing failed"

instance FromJSON Push where
  parseJSON :: Value -> Parser Push
parseJSON =
    String -> (Object -> Parser Push) -> Value -> Parser Push
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Push" ((Object -> Parser Push) -> Value -> Parser Push)
-> (Object -> Parser Push) -> Value -> Parser Push
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
Pushed ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Int
-> ProjectEvent
-> RepositoryEvent
-> [CommitEvent]
-> Int
-> Push
Push
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Int
 -> ProjectEvent
 -> RepositoryEvent
 -> [CommitEvent]
 -> Int
 -> Push)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"before"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"after"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ref"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"checkout_sha"
                Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser
  (Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser
  (Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> Push)
-> Parser Text
-> Parser
     (Int
      -> ProjectEvent -> RepositoryEvent -> [CommitEvent] -> Int -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_avatar"
                Parser
  (Int
   -> ProjectEvent -> RepositoryEvent -> [CommitEvent] -> Int -> Push)
-> Parser Int
-> Parser
     (ProjectEvent -> RepositoryEvent -> [CommitEvent] -> Int -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser
  (ProjectEvent -> RepositoryEvent -> [CommitEvent] -> Int -> Push)
-> Parser ProjectEvent
-> Parser (RepositoryEvent -> [CommitEvent] -> Int -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser ProjectEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project"
                Parser (RepositoryEvent -> [CommitEvent] -> Int -> Push)
-> Parser RepositoryEvent -> Parser ([CommitEvent] -> Int -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser RepositoryEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"repository"
                Parser ([CommitEvent] -> Int -> Push)
-> Parser [CommitEvent] -> Parser (Int -> Push)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [CommitEvent]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"commits"
                Parser (Int -> Push) -> Parser Int -> Parser Push
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"total_commits_count"
            ProjectAction
_unexpected -> String -> Parser Push
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"push parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser Push
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"push parsing failed"

instance FromJSON TagPush where
  parseJSON :: Value -> Parser TagPush
parseJSON =
    String -> (Object -> Parser TagPush) -> Value -> Parser TagPush
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TagPush" ((Object -> Parser TagPush) -> Value -> Parser TagPush)
-> (Object -> Parser TagPush) -> Value -> Parser TagPush
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
TagPushed ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Int
-> ProjectEvent
-> RepositoryEvent
-> [CommitEvent]
-> Int
-> TagPush
TagPush
                (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Int
 -> ProjectEvent
 -> RepositoryEvent
 -> [CommitEvent]
 -> Int
 -> TagPush)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"before"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"after"
                Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ref"
                Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"checkout_sha"
                Parser
  (Int
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser
  (Text
   -> Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser
  (Text
   -> Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Text
-> Parser
     (Int
      -> ProjectEvent
      -> RepositoryEvent
      -> [CommitEvent]
      -> Int
      -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_avatar"
                Parser
  (Int
   -> ProjectEvent
   -> RepositoryEvent
   -> [CommitEvent]
   -> Int
   -> TagPush)
-> Parser Int
-> Parser
     (ProjectEvent
      -> RepositoryEvent -> [CommitEvent] -> Int -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser
  (ProjectEvent
   -> RepositoryEvent -> [CommitEvent] -> Int -> TagPush)
-> Parser ProjectEvent
-> Parser (RepositoryEvent -> [CommitEvent] -> Int -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser ProjectEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project"
                Parser (RepositoryEvent -> [CommitEvent] -> Int -> TagPush)
-> Parser RepositoryEvent
-> Parser ([CommitEvent] -> Int -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser RepositoryEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"repository"
                Parser ([CommitEvent] -> Int -> TagPush)
-> Parser [CommitEvent] -> Parser (Int -> TagPush)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [CommitEvent]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"commits"
                Parser (Int -> TagPush) -> Parser Int -> Parser TagPush
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"total_commits_count"
            ProjectAction
_unexpected -> String -> Parser TagPush
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"tag_push parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser TagPush
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"tag_push parsing failed"

instance FromJSON RepositoryUpdate where
  parseJSON :: Value -> Parser RepositoryUpdate
parseJSON =
    String
-> (Object -> Parser RepositoryUpdate)
-> Value
-> Parser RepositoryUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RepositoryUpdate" ((Object -> Parser RepositoryUpdate)
 -> Value -> Parser RepositoryUpdate)
-> (Object -> Parser RepositoryUpdate)
-> Value
-> Parser RepositoryUpdate
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
RepositoryUpdated ->
              Text
-> Int
-> Text
-> Text
-> Text
-> Int
-> ProjectEvent
-> [ProjectChanges]
-> [Text]
-> RepositoryUpdate
RepositoryUpdate
                (Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Int
 -> ProjectEvent
 -> [ProjectChanges]
 -> [Text]
 -> RepositoryUpdate)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> [ProjectChanges]
      -> [Text]
      -> RepositoryUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_name"
                Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> [ProjectChanges]
   -> [Text]
   -> RepositoryUpdate)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> ProjectEvent
      -> [ProjectChanges]
      -> [Text]
      -> RepositoryUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> ProjectEvent
   -> [ProjectChanges]
   -> [Text]
   -> RepositoryUpdate)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> ProjectEvent
      -> [ProjectChanges]
      -> [Text]
      -> RepositoryUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_name"
                Parser
  (Text
   -> Text
   -> Int
   -> ProjectEvent
   -> [ProjectChanges]
   -> [Text]
   -> RepositoryUpdate)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> ProjectEvent
      -> [ProjectChanges]
      -> [Text]
      -> RepositoryUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_email"
                Parser
  (Text
   -> Int
   -> ProjectEvent
   -> [ProjectChanges]
   -> [Text]
   -> RepositoryUpdate)
-> Parser Text
-> Parser
     (Int
      -> ProjectEvent -> [ProjectChanges] -> [Text] -> RepositoryUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_avatar"
                Parser
  (Int
   -> ProjectEvent -> [ProjectChanges] -> [Text] -> RepositoryUpdate)
-> Parser Int
-> Parser
     (ProjectEvent -> [ProjectChanges] -> [Text] -> RepositoryUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project_id"
                Parser
  (ProjectEvent -> [ProjectChanges] -> [Text] -> RepositoryUpdate)
-> Parser ProjectEvent
-> Parser ([ProjectChanges] -> [Text] -> RepositoryUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser ProjectEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project"
                Parser ([ProjectChanges] -> [Text] -> RepositoryUpdate)
-> Parser [ProjectChanges] -> Parser ([Text] -> RepositoryUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [ProjectChanges]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"changes"
                Parser ([Text] -> RepositoryUpdate)
-> Parser [Text] -> Parser RepositoryUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"refs"
            ProjectAction
_unexpected -> String -> Parser RepositoryUpdate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"repository_update parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser RepositoryUpdate
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"repository_update parsing failed"

instance FromJSON MergeRequestEvent where
  parseJSON :: Value -> Parser MergeRequestEvent
parseJSON =
    String
-> (Object -> Parser MergeRequestEvent)
-> Value
-> Parser MergeRequestEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MergeRequestEvent" ((Object -> Parser MergeRequestEvent)
 -> Value -> Parser MergeRequestEvent)
-> (Object -> Parser MergeRequestEvent)
-> Value
-> Parser MergeRequestEvent
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      -- Note: it's `event_name` in all other examples, but the GitLab
      -- documentation for MergeRequests says `object_kind`.
      --
      -- `object_kind` has been tried.
      --
      -- Bug in GitLab system hooks documentation?
      Maybe ProjectAction
isProjectEvent <- Object
v Object -> Text -> Parser (Maybe ProjectAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"object_kind"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
MergeRequested ->
              Text
-> Text
-> UserEvent
-> ProjectEvent
-> ObjectAttributes
-> Maybe [Text]
-> MergeRequestChanges
-> RepositoryEvent
-> MergeRequestEvent
MergeRequestEvent
                (Text
 -> Text
 -> UserEvent
 -> ProjectEvent
 -> ObjectAttributes
 -> Maybe [Text]
 -> MergeRequestChanges
 -> RepositoryEvent
 -> MergeRequestEvent)
-> Parser Text
-> Parser
     (Text
      -> UserEvent
      -> ProjectEvent
      -> ObjectAttributes
      -> Maybe [Text]
      -> MergeRequestChanges
      -> RepositoryEvent
      -> MergeRequestEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"object_kind"
                Parser
  (Text
   -> UserEvent
   -> ProjectEvent
   -> ObjectAttributes
   -> Maybe [Text]
   -> MergeRequestChanges
   -> RepositoryEvent
   -> MergeRequestEvent)
-> Parser Text
-> Parser
     (UserEvent
      -> ProjectEvent
      -> ObjectAttributes
      -> Maybe [Text]
      -> MergeRequestChanges
      -> RepositoryEvent
      -> MergeRequestEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_type"
                Parser
  (UserEvent
   -> ProjectEvent
   -> ObjectAttributes
   -> Maybe [Text]
   -> MergeRequestChanges
   -> RepositoryEvent
   -> MergeRequestEvent)
-> Parser UserEvent
-> Parser
     (ProjectEvent
      -> ObjectAttributes
      -> Maybe [Text]
      -> MergeRequestChanges
      -> RepositoryEvent
      -> MergeRequestEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser UserEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
                Parser
  (ProjectEvent
   -> ObjectAttributes
   -> Maybe [Text]
   -> MergeRequestChanges
   -> RepositoryEvent
   -> MergeRequestEvent)
-> Parser ProjectEvent
-> Parser
     (ObjectAttributes
      -> Maybe [Text]
      -> MergeRequestChanges
      -> RepositoryEvent
      -> MergeRequestEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser ProjectEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"project"
                Parser
  (ObjectAttributes
   -> Maybe [Text]
   -> MergeRequestChanges
   -> RepositoryEvent
   -> MergeRequestEvent)
-> Parser ObjectAttributes
-> Parser
     (Maybe [Text]
      -> MergeRequestChanges -> RepositoryEvent -> MergeRequestEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser ObjectAttributes
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"object_attributes"
                Parser
  (Maybe [Text]
   -> MergeRequestChanges -> RepositoryEvent -> MergeRequestEvent)
-> Parser (Maybe [Text])
-> Parser
     (MergeRequestChanges -> RepositoryEvent -> MergeRequestEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"labels"
                Parser
  (MergeRequestChanges -> RepositoryEvent -> MergeRequestEvent)
-> Parser MergeRequestChanges
-> Parser (RepositoryEvent -> MergeRequestEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser MergeRequestChanges
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"changes"
                Parser (RepositoryEvent -> MergeRequestEvent)
-> Parser RepositoryEvent -> Parser MergeRequestEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser RepositoryEvent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"repository"
            ProjectAction
_unexpected -> String -> Parser MergeRequestEvent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"merge_request parsing failed"
        Maybe ProjectAction
_unexpected -> String -> Parser MergeRequestEvent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"merge_request parsing failed"

bodyNoPrefix :: String -> String
bodyNoPrefix :: ShowS
bodyNoPrefix String
"projectEvent_name" = String
"name"
bodyNoPrefix String
"projectEvent_description" = String
"description"
bodyNoPrefix String
"projectEvent_web_url" = String
"web_url"
bodyNoPrefix String
"projectEvent_avatar_url" = String
"avatar_url"
bodyNoPrefix String
"projectEvent_git_ssh_url" = String
"git_ssh_url"
bodyNoPrefix String
"projectEvent_git_http_url" = String
"git_http_url"
bodyNoPrefix String
"projectEvent_namespace" = String
"namespace"
bodyNoPrefix String
"projectEvent_visibility_level" = String
"visibility_level"
bodyNoPrefix String
"projectEvent_path_with_namespace" = String
"path_with_namespace"
bodyNoPrefix String
"projectEvent_default_branch" = String
"default_branch"
-- bodyNoPrefix "projectEvent_ci_config_path" = "ci_config_path"
bodyNoPrefix String
"projectEvent_homepage" = String
"homepage"
bodyNoPrefix String
"projectEvent_url" = String
"url"
bodyNoPrefix String
"projectEvent_ssh_url" = String
"ssh_url"
bodyNoPrefix String
"projectEvent_http_url" = String
"http_url"
bodyNoPrefix String
"projectChanges_before" = String
"before"
bodyNoPrefix String
"projectChanges_after" = String
"after"
bodyNoPrefix String
"projectChanges_ref" = String
"ref"
bodyNoPrefix String
"repositoryEvent_name" = String
"name"
bodyNoPrefix String
"repositoryEvent_url" = String
"url"
bodyNoPrefix String
"repositoryEvent_description" = String
"description"
bodyNoPrefix String
"repositoryEvent_homepage" = String
"homepage"
bodyNoPrefix String
"repositoryEvent_git_http_url" = String
"git_http_url"
bodyNoPrefix String
"repositoryEvent_git_ssh_url" = String
"git_ssh_url"
bodyNoPrefix String
"repositoryEvent_visibility_level" = String
"visibility_level"
bodyNoPrefix String
"commitEvent_id" = String
"id"
bodyNoPrefix String
"commitEvent_message" = String
"message"
bodyNoPrefix String
"commitEvent_timestamp" = String
"timestamp"
bodyNoPrefix String
"commitEvent_url" = String
"url"
bodyNoPrefix String
"commitEvent_author" = String
"author"
bodyNoPrefix String
"commitAuthorEvent_name" = String
"name"
bodyNoPrefix String
"commitAuthorEvent_email" = String
"email"
bodyNoPrefix String
"mergeParams_force_remove_source_branch" = String
"force_remove_source_branch"
bodyNoPrefix String
"userEvent_name" = String
"name"
bodyNoPrefix String
"userEvent_username" = String
"username"
bodyNoPrefix String
"userEvent_avatar_url" = String
"avatar_url"
bodyNoPrefix String
"objectAttributes_id" = String
"id"
bodyNoPrefix String
"objectAttributes_target_branch" = String
"target_branch"
bodyNoPrefix String
"objectAttributes_source_branch" = String
"source_branch"
bodyNoPrefix String
"objectAttributes_source_project_id" = String
"source_project_id"
bodyNoPrefix String
"objectAttributes_author_id" = String
"author_id"
bodyNoPrefix String
"objectAttributes_assignee_id" = String
"assignee_id"
bodyNoPrefix String
"objectAttributes_assignee_ids" = String
"assignee_ids"
bodyNoPrefix String
"objectAttributes_title" = String
"title"
bodyNoPrefix String
"objectAttributes_created_at" = String
"created_at"
bodyNoPrefix String
"objectAttributes_updated_at" = String
"updated_at"
bodyNoPrefix String
"objectAttributes_milestone_id" = String
"milestone_id"
bodyNoPrefix String
"objectAttributes_state" = String
"state"
bodyNoPrefix String
"objectAttributes_state_id" = String
"state_id"
bodyNoPrefix String
"objectAttributes_merge_status" = String
"merge_status"
bodyNoPrefix String
"objectAttributes_target_project_id" = String
"target_project_id"
bodyNoPrefix String
"objectAttributes_iid" = String
"iid"
bodyNoPrefix String
"objectAttributes_description" = String
"description"
bodyNoPrefix String
"objectAttributes_updated_by_id" = String
"updated_by_id"
bodyNoPrefix String
"objectAttributes_merge_error" = String
"merge_error"
bodyNoPrefix String
"objectAttributes_merge_params" = String
"merge_params"
bodyNoPrefix String
"objectAttributes_merge_when_pipeline_succeeds" = String
"merge_when_pipeline_succeeds"
bodyNoPrefix String
"objectAttributes_merge_user_id" = String
"merge_user_id"
bodyNoPrefix String
"objectAttributes_merge_commit_sha" = String
"merge_commit_sha"
bodyNoPrefix String
"objectAttributes_deleted_at" = String
"deleted_at"
bodyNoPrefix String
"objectAttributes_in_progress_merge_commit_sha" = String
"in_progress_merge_commit_sha"
bodyNoPrefix String
"objectAttributes_lock_version" = String
"lock_version"
bodyNoPrefix String
"objectAttributes_time_estimate" = String
"time_estimate"
bodyNoPrefix String
"objectAttributes_last_edited_at" = String
"last_edited_at"
bodyNoPrefix String
"objectAttributes_last_edited_by_id" = String
"last_edited_by_id"
bodyNoPrefix String
"objectAttributes_head_pipeline_id" = String
"head_pipeline_id"
bodyNoPrefix String
"objectAttributes_ref_fetched" = String
"ref_fetched"
bodyNoPrefix String
"objectAttributes_merge_jid" = String
"merge_jid"
bodyNoPrefix String
"objectAttributes_source" = String
"source"
bodyNoPrefix String
"objectAttributes_target" = String
"target"
bodyNoPrefix String
"objectAttributes_last_commit" = String
"last_commit"
bodyNoPrefix String
"objectAttributes_work_in_progress" = String
"work_in_progress"
bodyNoPrefix String
"objectAttributes_total_time_spent" = String
"total_time_spent"
bodyNoPrefix String
"objectAttributes_human_total_time_spent" = String
"human_total_time_spent"
bodyNoPrefix String
"objectAttributes_human_time_estimate" = String
"human_time_estimate"
bodyNoPrefix String
"objectAttributes_action" = String
"action"
bodyNoPrefix String
"mergeRequestChanges_author_id" = String
"author_id"
bodyNoPrefix String
"mergeRequestChanges_created_at" = String
"created_at"
bodyNoPrefix String
"mergeRequestChanges_description" = String
"description"
bodyNoPrefix String
"mergeRequestChanges_id" = String
"id"
bodyNoPrefix String
"mergeRequestChanges_iid" = String
"iid"
bodyNoPrefix String
"mergeRequestChanges_source_branch" = String
"source_branch"
bodyNoPrefix String
"mergeRequestChanges_source_project_id" = String
"source_project_id"
bodyNoPrefix String
"mergeRequestChanges_target_branch" = String
"target_branch"
bodyNoPrefix String
"mergeRequestChanges_target_project_id" = String
"target_project_id"
bodyNoPrefix String
"mergeRequestChanges_title" = String
"title"
bodyNoPrefix String
"mergeRequestChanges_updated_at" = String
"updated_at"
bodyNoPrefix String
"mergeRequestChange_previous" = String
"previous"
bodyNoPrefix String
"mergeRequestChange_current" = String
"current"
bodyNoPrefix String
s = ShowS
forall a. HasCallStack => String -> a
error (String
"uexpected JSON field prefix: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s)

instance FromJSON ProjectEvent where
  parseJSON :: Value -> Parser ProjectEvent
parseJSON =
    Options -> Value -> Parser ProjectEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON ProjectChanges where
  parseJSON :: Value -> Parser ProjectChanges
parseJSON =
    Options -> Value -> Parser ProjectChanges
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON CommitEvent where
  parseJSON :: Value -> Parser CommitEvent
parseJSON =
    Options -> Value -> Parser CommitEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON RepositoryEvent where
  parseJSON :: Value -> Parser RepositoryEvent
parseJSON =
    Options -> Value -> Parser RepositoryEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON CommitAuthorEvent where
  parseJSON :: Value -> Parser CommitAuthorEvent
parseJSON =
    Options -> Value -> Parser CommitAuthorEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON ObjectAttributes where
  parseJSON :: Value -> Parser ObjectAttributes
parseJSON =
    Options -> Value -> Parser ObjectAttributes
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON MergeParams where
  parseJSON :: Value -> Parser MergeParams
parseJSON =
    Options -> Value -> Parser MergeParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON UserEvent where
  parseJSON :: Value -> Parser UserEvent
parseJSON =
    Options -> Value -> Parser UserEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON MergeRequestChanges where
  parseJSON :: Value -> Parser MergeRequestChanges
parseJSON =
    Options -> Value -> Parser MergeRequestChanges
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance (FromJSON a) => FromJSON (MergeRequestChange a) where
  parseJSON :: Value -> Parser (MergeRequestChange a)
parseJSON =
    Options -> Value -> Parser (MergeRequestChange a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON ProjectAction where
  parseJSON :: Value -> Parser ProjectAction
parseJSON (String Text
"project_create") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
ProjectCreated
  parseJSON (String Text
"project_destroy") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
ProjectDestroyed
  parseJSON (String Text
"project_rename") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
ProjectRenamed
  parseJSON (String Text
"project_transfer") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
ProjectTransferred
  parseJSON (String Text
"project_update") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
ProjectUpdated
  parseJSON (String Text
"user_add_to_team") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
UserAddedToTeam
  parseJSON (String Text
"user_update_for_team") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
UserUpdatedForTeam
  parseJSON (String Text
"user_remove_from_team") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
UserRemovedFromTeam
  parseJSON (String Text
"user_create") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
UserCreated
  parseJSON (String Text
"user_destroy") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
UserRemoved
  parseJSON (String Text
"user_failed_login") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
UserFailedToLogin
  parseJSON (String Text
"user_rename") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
UserRenamed
  parseJSON (String Text
"key_create") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
KeyCreated
  parseJSON (String Text
"key_destroy") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
KeyRemoved
  parseJSON (String Text
"group_create") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
GroupCreated
  parseJSON (String Text
"group_destroy") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
GroupRemoved
  parseJSON (String Text
"group_rename") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
GroupRenamed
  parseJSON (String Text
"user_add_to_group") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
GroupMemberAdded
  parseJSON (String Text
"user_remove_from_group") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
GroupMemberRemoved
  parseJSON (String Text
"user_update_for_group") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
GroupMemberUpdated
  parseJSON (String Text
"push") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
Pushed
  parseJSON (String Text
"tag_push") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
TagPushed
  parseJSON (String Text
"repository_update") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
RepositoryUpdated
  parseJSON (String Text
"merge_request") = ProjectAction -> Parser ProjectAction
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectAction
MergeRequested
  parseJSON Value
s = String -> Parser ProjectAction
forall a. HasCallStack => String -> a
error (String
"unexpected system hook event: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
s)

instance FromJSON Visibility where
  parseJSON :: Value -> Parser Visibility
parseJSON (String Text
"public") = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Public
  parseJSON (String Text
"private") = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Private
  parseJSON (String Text
"internal") = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Internal
  parseJSON (Number Scientific
0) = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Private
  parseJSON (Number Scientific
10) = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Internal
  parseJSON (Number Scientific
20) = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Public
  parseJSON Value
n = String -> Parser Visibility
forall a. HasCallStack => String -> a
error (Value -> String
forall a. Show a => a -> String
show Value
n)