{-# LANGUAGE CPP #-}
{-# 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 (..),
    Label (..),
    MergeRequestChanges (..),
    MergeRequestChange (..),
    ObjectAttributes (..),
    MergeParams (..),
    UserEvent (..),
    parseEvent,
  )
where

import Data.Aeson
import Data.Text (Text)
import qualified Data.Text.Encoding as T
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) => Text -> Maybe a
parseEvent :: forall a. FromJSON a => Text -> Maybe a
parseEvent Text
eventText =
  case forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (Text -> ByteString
T.encodeUtf8 Text
eventText) of
    Left String
_error -> forall a. Maybe a
Nothing
    Right a
event -> forall a. a -> Maybe a
Just a
event

instance SystemHook ProjectCreate where
  match :: String -> (ProjectCreate -> GitLab ()) -> Rule
match = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectCreate -> GitLab Bool)
-> (ProjectCreate -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectDestroy -> GitLab Bool)
-> (ProjectDestroy -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectRename -> GitLab Bool)
-> (ProjectRename -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectTransfer -> GitLab Bool)
-> (ProjectTransfer -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (ProjectUpdate -> GitLab Bool)
-> (ProjectUpdate -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserAddToTeam -> GitLab Bool)
-> (UserAddToTeam -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserUpdateForTeam -> GitLab Bool)
-> (UserUpdateForTeam -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserRemoveFromTeam -> GitLab Bool)
-> (UserRemoveFromTeam -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserCreate -> GitLab Bool) -> (UserCreate -> GitLab ()) -> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserRemove -> GitLab Bool) -> (UserRemove -> GitLab ()) -> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserFailedLogin -> GitLab Bool)
-> (UserFailedLogin -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (UserRename -> GitLab Bool) -> (UserRename -> GitLab ()) -> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (KeyCreate -> GitLab Bool) -> (KeyCreate -> GitLab ()) -> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (KeyRemove -> GitLab Bool) -> (KeyRemove -> GitLab ()) -> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupCreate -> GitLab Bool)
-> (GroupCreate -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupRemove -> GitLab Bool)
-> (GroupRemove -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupRename -> GitLab Bool)
-> (GroupRename -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (NewGroupMember -> GitLab Bool)
-> (NewGroupMember -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupMemberRemove -> GitLab Bool)
-> (GroupMemberRemove -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (GroupMemberUpdate -> GitLab Bool)
-> (GroupMemberUpdate -> GitLab ())
-> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String -> (Push -> GitLab Bool) -> (Push -> GitLab ()) -> Rule
matchIf = 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 -> Maybe Text
push_user_username :: Maybe Text,
    Push -> Maybe Text
push_user_email :: Maybe 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (TagPush -> GitLab Bool) -> (TagPush -> GitLab ()) -> Rule
matchIf = 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
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
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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (RepositoryUpdate -> GitLab Bool)
-> (RepositoryUpdate -> GitLab ())
-> Rule
matchIf = 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
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
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 -> Maybe Text
projectEvent_description :: Maybe 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
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
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. 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
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
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. 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 -> Maybe Text
repositoryEvent_description :: Maybe 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
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
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. 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
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
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. 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
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
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. 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 = forall a.
(Typeable a, SystemHook a) =>
String -> (a -> GitLab ()) -> Rule
Match
  matchIf :: String
-> (MergeRequestEvent -> GitLab Bool)
-> (MergeRequestEvent -> GitLab ())
-> Rule
matchIf = 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 [Label]
mergeRequest_labels :: Maybe [Label],
    MergeRequestEvent -> MergeRequestChanges
mergeRequest_changes :: MergeRequestChanges,
    MergeRequestEvent -> RepositoryEvent
mergeRequest_repository :: RepositoryEvent
  }
  deriving (Typeable, Int -> MergeRequestEvent -> ShowS
[MergeRequestEvent] -> ShowS
MergeRequestEvent -> String
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
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. 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)

-- | Label associated with a merge request
data Label = Label
  { Label -> Maybe Int
label_id :: Maybe Int,
    Label -> Maybe Text
label_title :: Maybe Text,
    Label -> Maybe Text
label_color :: Maybe Text,
    Label -> Maybe Int
label_project_id :: Maybe Int,
    Label -> Maybe Text
label_created_at :: Maybe Text, -- TODO date from e.g. "2013-12-03T17:15:43Z"
    Label -> Maybe Text
label_updated_at :: Maybe Text, -- TODO date
    Label -> Maybe Bool
label_template :: Maybe Bool,
    Label -> Maybe Text
label_description :: Maybe Text,
    Label -> Maybe Text
label_type :: Maybe Text, -- TODO type from "ProjectLabel"
    Label -> Maybe Int
label_group_id :: Maybe Int
  }
  deriving (Typeable, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show, Label -> Label -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, forall x. Rep Label x -> Label
forall x. Label -> Rep Label x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Label x -> Label
$cfrom :: forall x. Label -> Rep Label x
Generic)

-- | Changes that a merge request will make
data MergeRequestChanges = MergeRequestChanges
  { MergeRequestChanges -> Maybe (MergeRequestChange Int)
mergeRequestChanges_author_id :: Maybe (MergeRequestChange Int),
    MergeRequestChanges -> Maybe (MergeRequestChange Text)
mergeRequestChanges_created_at :: Maybe (MergeRequestChange Text),
    MergeRequestChanges -> Maybe (MergeRequestChange Text)
mergeRequestChanges_description :: Maybe (MergeRequestChange Text),
    MergeRequestChanges -> Maybe (MergeRequestChange Int)
mergeRequestChanges_id :: Maybe (MergeRequestChange Int),
    MergeRequestChanges -> Maybe (MergeRequestChange Int)
mergeRequestChanges_iid :: Maybe (MergeRequestChange Int),
    MergeRequestChanges -> Maybe (MergeRequestChange Text)
mergeRequestChanges_source_branch :: Maybe (MergeRequestChange Text),
    MergeRequestChanges -> Maybe (MergeRequestChange Int)
mergeRequestChanges_source_project_id :: Maybe (MergeRequestChange Int),
    MergeRequestChanges -> Maybe (MergeRequestChange Text)
mergeRequestChanges_target_branch :: Maybe (MergeRequestChange Text),
    MergeRequestChanges -> Maybe (MergeRequestChange Int)
mergeRequestChanges_target_project_id :: Maybe (MergeRequestChange Int),
    MergeRequestChanges -> Maybe (MergeRequestChange Text)
mergeRequestChanges_title :: Maybe (MergeRequestChange Text),
    MergeRequestChanges -> Maybe (MergeRequestChange Text)
mergeRequestChanges_updated_at :: Maybe (MergeRequestChange Text)
  }
  deriving (Typeable, Int -> MergeRequestChanges -> ShowS
[MergeRequestChanges] -> ShowS
MergeRequestChanges -> String
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
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. 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)

-- | The change between for a given GitLab data field a merge request
-- will make
data MergeRequestChange a = MergeRequestChange
  { forall a. MergeRequestChange a -> Maybe a
mergeRequestChange_previous :: Maybe a,
    forall a. MergeRequestChange a -> Maybe a
mergeRequestChange_current :: Maybe a
  }
  deriving (Typeable, Int -> MergeRequestChange a -> ShowS
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
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 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)

-- | Attributes associated with a merge request
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 -> Maybe Int
objectAttributes_author_id :: Maybe 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 -> Maybe MergeParams
objectAttributes_merge_params :: Maybe MergeParams,
    ObjectAttributes -> Maybe Bool
objectAttributes_merge_when_pipeline_succeeds :: Maybe 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 -> Maybe Int
objectAttributes_time_estimate :: Maybe 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 -> Maybe Int
objectAttributes_total_time_spent :: Maybe 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
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
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. 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)

-- | Merge parameters associated with a merge request
newtype MergeParams = MergeParams
  { MergeParams -> Maybe Text
mergeParams_force_remove_source_branch :: Maybe Text
  }
  deriving (Typeable, Int -> MergeParams -> ShowS
[MergeParams] -> ShowS
MergeParams -> String
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
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. 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)

-- | User associated with a merge request
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
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
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. 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
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
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)

instance FromJSON ProjectCreate where
  parseJSON :: Value -> Parser ProjectCreate
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectCreate" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_create parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_create parsing failed"

instance FromJSON ProjectDestroy where
  parseJSON :: Value -> Parser ProjectDestroy
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectDestroy" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_destroy parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_destroy parsing failed"

instance FromJSON ProjectRename where
  parseJSON :: Value -> Parser ProjectRename
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectRename" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"old_path_with_namespace"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_rename parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_rename parsing failed"

instance FromJSON ProjectTransfer where
  parseJSON :: Value -> Parser ProjectTransfer
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectTransfer" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"old_path_with_namespace"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_transfer parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_transfer parsing failed"

instance FromJSON ProjectUpdate where
  parseJSON :: Value -> Parser ProjectUpdate
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectUpdate" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_update parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"project_update parsing failed"

instance FromJSON UserAddToTeam where
  parseJSON :: Value -> Parser UserAddToTeam
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserAddToTeam" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_level"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_add_to_team parsing failed"
        Maybe ProjectAction
_unexpected -> 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserUpdateForTeam" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_level"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_update_for_team parsing failed"
        Maybe ProjectAction
_unexpected -> 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserRemoveFromTeam" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_level"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_path_with_namespace"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_visibility"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_remove_from_team parsing failed"
        Maybe ProjectAction
_unexpected -> 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserCreate" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_create parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_create parsing failed"

instance FromJSON UserRemove where
  parseJSON :: Value -> Parser UserRemove
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserRemove" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_destroy parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_destroy parsing failed"

instance FromJSON UserFailedLogin where
  parseJSON :: Value -> Parser UserFailedLogin
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserFailedLogin" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_failed_login parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_failed_login parsing failed"

instance FromJSON UserRename where
  parseJSON :: Value -> Parser UserRename
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserRename" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"old_username"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_rename parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_rename parsing failed"

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

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

instance FromJSON GroupCreate where
  parseJSON :: Value -> Parser GroupCreate
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupCreate" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_id"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_create parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_create parsing failed"

instance FromJSON GroupRemove where
  parseJSON :: Value -> Parser GroupRemove
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupRemove" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_id"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_remove parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"group_remove parsing failed"

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

instance FromJSON NewGroupMember where
  parseJSON :: Value -> Parser NewGroupMember
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NewGroupMember" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_access"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_add_to_group parsing failed"
        Maybe ProjectAction
_unexpected -> 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupMemberRemove" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_access"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_remove_from_group parsing failed"
        Maybe ProjectAction
_unexpected -> 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GroupMemberUpdate" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_access"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"group_path"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"user_update_for_group parsing failed"
        Maybe ProjectAction
_unexpected -> 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 =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Push" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"event_name"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
Pushed ->
              Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Text
-> Maybe Text
-> Maybe Text
-> Text
-> Int
-> ProjectEvent
-> RepositoryEvent
-> [CommitEvent]
-> Int
-> Push
Push
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"before"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"after"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ref"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"checkout_sha"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_username"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_avatar"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commits"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_commits_count"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"push parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"push parsing failed"

instance FromJSON TagPush where
  parseJSON :: Value -> Parser TagPush
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TagPush" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"before"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"after"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ref"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"checkout_sha"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_avatar"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commits"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_commits_count"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"tag_push parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"tag_push parsing failed"

instance FromJSON RepositoryUpdate where
  parseJSON :: Value -> Parser RepositoryUpdate
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RepositoryUpdate" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe ProjectAction
isProjectEvent <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_email"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_avatar"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_id"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"changes"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"refs"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"repository_update parsing failed"
        Maybe ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"repository_update parsing failed"

instance FromJSON MergeRequestEvent where
  parseJSON :: Value -> Parser MergeRequestEvent
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"object_kind"
      case Maybe ProjectAction
isProjectEvent of
        Just ProjectAction
theEvent ->
          case ProjectAction
theEvent of
            ProjectAction
MergeRequested ->
              Text
-> Text
-> UserEvent
-> ProjectEvent
-> ObjectAttributes
-> Maybe [Label]
-> MergeRequestChanges
-> RepositoryEvent
-> MergeRequestEvent
MergeRequestEvent
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"object_kind"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_type"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"object_attributes"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"changes"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository"
            ProjectAction
_unexpected -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"merge_request parsing failed"
        Maybe ProjectAction
_unexpected -> 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 = forall a. HasCallStack => String -> a
error (String
"uexpected JSON field prefix: " forall a. Semigroup a => a -> a -> a
<> String
s)

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

instance FromJSON Label where
  parseJSON :: Value -> Parser Label
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Label" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Maybe Int
labelId <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    Maybe Text
labelTitle <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title"
    Maybe Text
labelColor <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"color"
    Maybe Int
labelProjectId <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_id"
    Maybe Text
labelCreatedAt <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at"
    Maybe Text
labelUpdatedAt <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at"
    Maybe Bool
labelTemplate <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"template"
    Maybe Text
labelDescription <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    Maybe Text
labelType <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
    Maybe Int
labelGroupId <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"group_id"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Label
        { $sel:label_id:Label :: Maybe Int
label_id = Maybe Int
labelId,
          $sel:label_title:Label :: Maybe Text
label_title = Maybe Text
labelTitle,
          $sel:label_color:Label :: Maybe Text
label_color = Maybe Text
labelColor,
          $sel:label_project_id:Label :: Maybe Int
label_project_id = Maybe Int
labelProjectId,
          $sel:label_created_at:Label :: Maybe Text
label_created_at = Maybe Text
labelCreatedAt,
          $sel:label_updated_at:Label :: Maybe Text
label_updated_at = Maybe Text
labelUpdatedAt,
          $sel:label_template:Label :: Maybe Bool
label_template = Maybe Bool
labelTemplate,
          $sel:label_description:Label :: Maybe Text
label_description = Maybe Text
labelDescription,
          $sel:label_type:Label :: Maybe Text
label_type = Maybe Text
labelType,
          $sel:label_group_id:Label :: Maybe Int
label_group_id = Maybe Int
labelGroupId
        }

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