{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : GitLab.SystemHooks.GitLabSystemHooks
-- Description : Haskell records corresponding to JSON data from GitLab system hooks
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.SystemHooks.GitLabSystemHooks
  ( receive,
    receiveString,
    tryFire,
  )
where

import qualified Control.Exception as E
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Typeable
import GitLab.SystemHooks.Types
import GitLab.Types
import System.IO.Temp
import System.Posix.Files

-- | Attempts to fire each rule in sequence. Reads the JSON data
-- received from the GitLab server from standard input.
receive :: [Rule] -> GitLab ()
receive :: [Rule] -> GitLab ()
receive [Rule]
rules = do
  String
eventContent <- IO String -> ReaderT GitLabState IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getContents
  String -> [Rule] -> GitLab ()
receiveString String
eventContent [Rule]
rules

-- | Attempts to fire each rule in sequence. Reads the JSON data
-- received from a function argument.
receiveString :: String -> [Rule] -> GitLab ()
receiveString :: String -> [Rule] -> GitLab ()
receiveString String
eventContent [Rule]
rules = do
  String -> GitLab ()
traceSystemHook String
eventContent
  (Rule -> GitLab ()) -> [Rule] -> GitLab ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Rule -> GitLab ()
fire String
eventContent) [Rule]
rules

traceSystemHook :: String -> GitLab ()
traceSystemHook :: String -> GitLab ()
traceSystemHook String
eventContent = do
  GitLabServerConfig
cfg <- GitLabState -> GitLabServerConfig
serverCfg (GitLabState -> GitLabServerConfig)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO GitLabServerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO () -> GitLab ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> GitLab ()) -> IO () -> GitLab ()
forall a b. (a -> b) -> a -> b
$
    IO () -> (ErrorCall -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
      ( Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GitLabServerConfig -> Bool
debugSystemHooks GitLabServerConfig
cfg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          String
fpath <- String -> String -> IO String
writeSystemTempFile String
"gitlab-system-hook-" String
eventContent
          IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> FileMode -> IO ()
setFileMode String
fpath FileMode
otherReadMode
      )
      -- runGitLabDbg must have been used, which doesn't define a GitLabServerConfig
      (\(ErrorCall
_exception :: E.ErrorCall) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

orElse :: GitLab Bool -> GitLab Bool -> GitLab Bool
orElse :: GitLab Bool -> GitLab Bool -> GitLab Bool
orElse GitLab Bool
f GitLab Bool
g = do
  Bool
x <- GitLab Bool
f
  if Bool
x
    then Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else GitLab Bool
g

fire :: String -> Rule -> GitLab ()
fire :: String -> Rule -> GitLab ()
fire String
contents Rule
rule = do
  Bool
result <- String -> Rule -> GitLab Bool
tryFire String
contents Rule
rule
  Bool -> GitLab () -> GitLab ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
result (GitLab () -> GitLab ()) -> GitLab () -> GitLab ()
forall a b. (a -> b) -> a -> b
$
    IO () -> GitLab ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn (String
"fired: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Rule -> String
labelOf Rule
rule))
  where
    labelOf :: Rule -> String
    labelOf :: Rule -> String
labelOf (Match String
lbl a -> GitLab ()
_) = String
lbl
    labelOf (MatchIf String
lbl a -> GitLab Bool
_ a -> GitLab ()
_) = String
lbl

-- | Try to fire a GitLab rule, returns 'True' if the rule fired and
-- 'False' if it did not fire.
tryFire :: String -> Rule -> GitLab Bool
tryFire :: String -> Rule -> GitLab Bool
tryFire String
contents (Match String
_ a -> GitLab ()
f) = do
  Maybe (ProjectCreate -> GitLab Bool)
-> Maybe (ProjectCreate -> GitLab ())
-> Maybe ProjectCreate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
    ((ProjectCreate -> GitLab Bool)
-> Maybe (ProjectCreate -> GitLab Bool)
forall a. a -> Maybe a
Just (\ProjectCreate
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
    ((a -> GitLab ()) -> Maybe (ProjectCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectCreate -> GitLab ()))
    (String -> Maybe ProjectCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectDestroy -> GitLab Bool)
-> Maybe (ProjectDestroy -> GitLab ())
-> Maybe ProjectDestroy
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((ProjectDestroy -> GitLab Bool)
-> Maybe (ProjectDestroy -> GitLab Bool)
forall a. a -> Maybe a
Just (\ProjectDestroy
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (ProjectDestroy -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectDestroy -> GitLab ()))
      (String -> Maybe ProjectDestroy
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectDestroy)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectRename -> GitLab Bool)
-> Maybe (ProjectRename -> GitLab ())
-> Maybe ProjectRename
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((ProjectRename -> GitLab Bool)
-> Maybe (ProjectRename -> GitLab Bool)
forall a. a -> Maybe a
Just (\ProjectRename
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (ProjectRename -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectRename -> GitLab ()))
      (String -> Maybe ProjectRename
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectTransfer -> GitLab Bool)
-> Maybe (ProjectTransfer -> GitLab ())
-> Maybe ProjectTransfer
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((ProjectTransfer -> GitLab Bool)
-> Maybe (ProjectTransfer -> GitLab Bool)
forall a. a -> Maybe a
Just (\ProjectTransfer
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (ProjectTransfer -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectTransfer -> GitLab ()))
      (String -> Maybe ProjectTransfer
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectTransfer)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectUpdate -> GitLab Bool)
-> Maybe (ProjectUpdate -> GitLab ())
-> Maybe ProjectUpdate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((ProjectUpdate -> GitLab Bool)
-> Maybe (ProjectUpdate -> GitLab Bool)
forall a. a -> Maybe a
Just (\ProjectUpdate
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (ProjectUpdate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectUpdate -> GitLab ()))
      (String -> Maybe ProjectUpdate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupMemberUpdate -> GitLab Bool)
-> Maybe (GroupMemberUpdate -> GitLab ())
-> Maybe GroupMemberUpdate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((GroupMemberUpdate -> GitLab Bool)
-> Maybe (GroupMemberUpdate -> GitLab Bool)
forall a. a -> Maybe a
Just (\GroupMemberUpdate
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (GroupMemberUpdate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberUpdate -> GitLab ()))
      (String -> Maybe GroupMemberUpdate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupMemberUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserAddToTeam -> GitLab Bool)
-> Maybe (UserAddToTeam -> GitLab ())
-> Maybe UserAddToTeam
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((UserAddToTeam -> GitLab Bool)
-> Maybe (UserAddToTeam -> GitLab Bool)
forall a. a -> Maybe a
Just (\UserAddToTeam
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (UserAddToTeam -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserAddToTeam -> GitLab ()))
      (String -> Maybe UserAddToTeam
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserAddToTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserUpdateForTeam -> GitLab Bool)
-> Maybe (UserUpdateForTeam -> GitLab ())
-> Maybe UserUpdateForTeam
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((UserUpdateForTeam -> GitLab Bool)
-> Maybe (UserUpdateForTeam -> GitLab Bool)
forall a. a -> Maybe a
Just (\UserUpdateForTeam
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (UserUpdateForTeam -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserUpdateForTeam -> GitLab ()))
      (String -> Maybe UserUpdateForTeam
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserUpdateForTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserRemoveFromTeam -> GitLab Bool)
-> Maybe (UserRemoveFromTeam -> GitLab ())
-> Maybe UserRemoveFromTeam
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((UserRemoveFromTeam -> GitLab Bool)
-> Maybe (UserRemoveFromTeam -> GitLab Bool)
forall a. a -> Maybe a
Just (\UserRemoveFromTeam
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (UserRemoveFromTeam -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemoveFromTeam -> GitLab ()))
      (String -> Maybe UserRemoveFromTeam
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserRemoveFromTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserCreate -> GitLab Bool)
-> Maybe (UserCreate -> GitLab ())
-> Maybe UserCreate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((UserCreate -> GitLab Bool) -> Maybe (UserCreate -> GitLab Bool)
forall a. a -> Maybe a
Just (\UserCreate
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (UserCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserCreate -> GitLab ()))
      (String -> Maybe UserCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserRemove -> GitLab Bool)
-> Maybe (UserRemove -> GitLab ())
-> Maybe UserRemove
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((UserRemove -> GitLab Bool) -> Maybe (UserRemove -> GitLab Bool)
forall a. a -> Maybe a
Just (\UserRemove
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (UserRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemove -> GitLab ()))
      (String -> Maybe UserRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserFailedLogin -> GitLab Bool)
-> Maybe (UserFailedLogin -> GitLab ())
-> Maybe UserFailedLogin
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((UserFailedLogin -> GitLab Bool)
-> Maybe (UserFailedLogin -> GitLab Bool)
forall a. a -> Maybe a
Just (\UserFailedLogin
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (UserFailedLogin -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserFailedLogin -> GitLab ()))
      (String -> Maybe UserFailedLogin
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserFailedLogin)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserRename -> GitLab Bool)
-> Maybe (UserRename -> GitLab ())
-> Maybe UserRename
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((UserRename -> GitLab Bool) -> Maybe (UserRename -> GitLab Bool)
forall a. a -> Maybe a
Just (\UserRename
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (UserRename -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRename -> GitLab ()))
      (String -> Maybe UserRename
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (KeyCreate -> GitLab Bool)
-> Maybe (KeyCreate -> GitLab ()) -> Maybe KeyCreate -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((KeyCreate -> GitLab Bool) -> Maybe (KeyCreate -> GitLab Bool)
forall a. a -> Maybe a
Just (\KeyCreate
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (KeyCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyCreate -> GitLab ()))
      (String -> Maybe KeyCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe KeyCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (KeyRemove -> GitLab Bool)
-> Maybe (KeyRemove -> GitLab ()) -> Maybe KeyRemove -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((KeyRemove -> GitLab Bool) -> Maybe (KeyRemove -> GitLab Bool)
forall a. a -> Maybe a
Just (\KeyRemove
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (KeyRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyRemove -> GitLab ()))
      (String -> Maybe KeyRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe KeyRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupCreate -> GitLab Bool)
-> Maybe (GroupCreate -> GitLab ())
-> Maybe GroupCreate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((GroupCreate -> GitLab Bool) -> Maybe (GroupCreate -> GitLab Bool)
forall a. a -> Maybe a
Just (\GroupCreate
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (GroupCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupCreate -> GitLab ()))
      (String -> Maybe GroupCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupRemove -> GitLab Bool)
-> Maybe (GroupRemove -> GitLab ())
-> Maybe GroupRemove
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((GroupRemove -> GitLab Bool) -> Maybe (GroupRemove -> GitLab Bool)
forall a. a -> Maybe a
Just (\GroupRemove
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (GroupRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRemove -> GitLab ()))
      (String -> Maybe GroupRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupRename -> GitLab Bool)
-> Maybe (GroupRename -> GitLab ())
-> Maybe GroupRename
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((GroupRename -> GitLab Bool) -> Maybe (GroupRename -> GitLab Bool)
forall a. a -> Maybe a
Just (\GroupRename
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (GroupRename -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRename -> GitLab ()))
      (String -> Maybe GroupRename
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (NewGroupMember -> GitLab Bool)
-> Maybe (NewGroupMember -> GitLab ())
-> Maybe NewGroupMember
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((NewGroupMember -> GitLab Bool)
-> Maybe (NewGroupMember -> GitLab Bool)
forall a. a -> Maybe a
Just (\NewGroupMember
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (NewGroupMember -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (NewGroupMember -> GitLab ()))
      (String -> Maybe NewGroupMember
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe NewGroupMember)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupMemberRemove -> GitLab Bool)
-> Maybe (GroupMemberRemove -> GitLab ())
-> Maybe GroupMemberRemove
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((GroupMemberRemove -> GitLab Bool)
-> Maybe (GroupMemberRemove -> GitLab Bool)
forall a. a -> Maybe a
Just (\GroupMemberRemove
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (GroupMemberRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberRemove -> GitLab ()))
      (String -> Maybe GroupMemberRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupMemberRemove)
    -- `orElse` fireIf'
    --   (Just (\_ -> return True))
    --   (cast f :: Maybe (ProjectEvent -> GitLab ()))
    --   (parseEvent contents :: Maybe ProjectEvent)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (Push -> GitLab Bool)
-> Maybe (Push -> GitLab ()) -> Maybe Push -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((Push -> GitLab Bool) -> Maybe (Push -> GitLab Bool)
forall a. a -> Maybe a
Just (\Push
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (Push -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (Push -> GitLab ()))
      (String -> Maybe Push
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe Push)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (TagPush -> GitLab Bool)
-> Maybe (TagPush -> GitLab ()) -> Maybe TagPush -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((TagPush -> GitLab Bool) -> Maybe (TagPush -> GitLab Bool)
forall a. a -> Maybe a
Just (\TagPush
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (TagPush -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (TagPush -> GitLab ()))
      (String -> Maybe TagPush
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe TagPush)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (RepositoryUpdate -> GitLab Bool)
-> Maybe (RepositoryUpdate -> GitLab ())
-> Maybe RepositoryUpdate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((RepositoryUpdate -> GitLab Bool)
-> Maybe (RepositoryUpdate -> GitLab Bool)
forall a. a -> Maybe a
Just (\RepositoryUpdate
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (RepositoryUpdate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (RepositoryUpdate -> GitLab ()))
      (String -> Maybe RepositoryUpdate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe RepositoryUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (MergeRequestEvent -> GitLab Bool)
-> Maybe (MergeRequestEvent -> GitLab ())
-> Maybe MergeRequestEvent
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((MergeRequestEvent -> GitLab Bool)
-> Maybe (MergeRequestEvent -> GitLab Bool)
forall a. a -> Maybe a
Just (\MergeRequestEvent
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      ((a -> GitLab ()) -> Maybe (MergeRequestEvent -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (MergeRequestEvent -> GitLab ()))
      (String -> Maybe MergeRequestEvent
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe MergeRequestEvent)
tryFire String
contents (MatchIf String
_ a -> GitLab Bool
predF a -> GitLab ()
f) = do
  Maybe (ProjectCreate -> GitLab Bool)
-> Maybe (ProjectCreate -> GitLab ())
-> Maybe ProjectCreate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
    ((a -> GitLab Bool) -> Maybe (ProjectCreate -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectCreate -> GitLab Bool))
    ((a -> GitLab ()) -> Maybe (ProjectCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectCreate -> GitLab ()))
    (String -> Maybe ProjectCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectDestroy -> GitLab Bool)
-> Maybe (ProjectDestroy -> GitLab ())
-> Maybe ProjectDestroy
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (ProjectDestroy -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectDestroy -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (ProjectDestroy -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectDestroy -> GitLab ()))
      (String -> Maybe ProjectDestroy
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectDestroy)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectRename -> GitLab Bool)
-> Maybe (ProjectRename -> GitLab ())
-> Maybe ProjectRename
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (ProjectRename -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectRename -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (ProjectRename -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectRename -> GitLab ()))
      (String -> Maybe ProjectRename
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectTransfer -> GitLab Bool)
-> Maybe (ProjectTransfer -> GitLab ())
-> Maybe ProjectTransfer
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (ProjectTransfer -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectTransfer -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (ProjectTransfer -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectTransfer -> GitLab ()))
      (String -> Maybe ProjectTransfer
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectTransfer)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (ProjectUpdate -> GitLab Bool)
-> Maybe (ProjectUpdate -> GitLab ())
-> Maybe ProjectUpdate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (ProjectUpdate -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectUpdate -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (ProjectUpdate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectUpdate -> GitLab ()))
      (String -> Maybe ProjectUpdate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe ProjectUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupMemberUpdate -> GitLab Bool)
-> Maybe (GroupMemberUpdate -> GitLab ())
-> Maybe GroupMemberUpdate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (GroupMemberUpdate -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupMemberUpdate -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (GroupMemberUpdate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberUpdate -> GitLab ()))
      (String -> Maybe GroupMemberUpdate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupMemberUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserAddToTeam -> GitLab Bool)
-> Maybe (UserAddToTeam -> GitLab ())
-> Maybe UserAddToTeam
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (UserAddToTeam -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserAddToTeam -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (UserAddToTeam -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserAddToTeam -> GitLab ()))
      (String -> Maybe UserAddToTeam
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserAddToTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserUpdateForTeam -> GitLab Bool)
-> Maybe (UserUpdateForTeam -> GitLab ())
-> Maybe UserUpdateForTeam
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (UserUpdateForTeam -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserUpdateForTeam -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (UserUpdateForTeam -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserUpdateForTeam -> GitLab ()))
      (String -> Maybe UserUpdateForTeam
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserUpdateForTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserRemoveFromTeam -> GitLab Bool)
-> Maybe (UserRemoveFromTeam -> GitLab ())
-> Maybe UserRemoveFromTeam
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (UserRemoveFromTeam -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserRemoveFromTeam -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (UserRemoveFromTeam -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemoveFromTeam -> GitLab ()))
      (String -> Maybe UserRemoveFromTeam
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserRemoveFromTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserCreate -> GitLab Bool)
-> Maybe (UserCreate -> GitLab ())
-> Maybe UserCreate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (UserCreate -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserCreate -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (UserCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserCreate -> GitLab ()))
      (String -> Maybe UserCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserRemove -> GitLab Bool)
-> Maybe (UserRemove -> GitLab ())
-> Maybe UserRemove
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (UserRemove -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserRemove -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (UserRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemove -> GitLab ()))
      (String -> Maybe UserRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserFailedLogin -> GitLab Bool)
-> Maybe (UserFailedLogin -> GitLab ())
-> Maybe UserFailedLogin
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (UserFailedLogin -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserFailedLogin -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (UserFailedLogin -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserFailedLogin -> GitLab ()))
      (String -> Maybe UserFailedLogin
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserFailedLogin)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (UserRename -> GitLab Bool)
-> Maybe (UserRename -> GitLab ())
-> Maybe UserRename
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (UserRename -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserRename -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (UserRename -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRename -> GitLab ()))
      (String -> Maybe UserRename
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe UserRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (KeyCreate -> GitLab Bool)
-> Maybe (KeyCreate -> GitLab ()) -> Maybe KeyCreate -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (KeyCreate -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (KeyCreate -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (KeyCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyCreate -> GitLab ()))
      (String -> Maybe KeyCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe KeyCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (KeyRemove -> GitLab Bool)
-> Maybe (KeyRemove -> GitLab ()) -> Maybe KeyRemove -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (KeyRemove -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (KeyRemove -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (KeyRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyRemove -> GitLab ()))
      (String -> Maybe KeyRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe KeyRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupCreate -> GitLab Bool)
-> Maybe (GroupCreate -> GitLab ())
-> Maybe GroupCreate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (GroupCreate -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupCreate -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (GroupCreate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupCreate -> GitLab ()))
      (String -> Maybe GroupCreate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupRemove -> GitLab Bool)
-> Maybe (GroupRemove -> GitLab ())
-> Maybe GroupRemove
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (GroupRemove -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupRemove -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (GroupRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRemove -> GitLab ()))
      (String -> Maybe GroupRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupRename -> GitLab Bool)
-> Maybe (GroupRename -> GitLab ())
-> Maybe GroupRename
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (GroupRename -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupRename -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (GroupRename -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRename -> GitLab ()))
      (String -> Maybe GroupRename
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (NewGroupMember -> GitLab Bool)
-> Maybe (NewGroupMember -> GitLab ())
-> Maybe NewGroupMember
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (NewGroupMember -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (NewGroupMember -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (NewGroupMember -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (NewGroupMember -> GitLab ()))
      (String -> Maybe NewGroupMember
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe NewGroupMember)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (GroupMemberRemove -> GitLab Bool)
-> Maybe (GroupMemberRemove -> GitLab ())
-> Maybe GroupMemberRemove
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (GroupMemberRemove -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupMemberRemove -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (GroupMemberRemove -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberRemove -> GitLab ()))
      (String -> Maybe GroupMemberRemove
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe GroupMemberRemove)
    -- `orElse` fireIf'
    --   (cast predF :: Maybe (ProjectEvent -> GitLab Bool))
    --   (cast f :: Maybe (ProjectEvent -> GitLab ()))
    --   (parseEvent contents :: Maybe ProjectEvent)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (Push -> GitLab Bool)
-> Maybe (Push -> GitLab ()) -> Maybe Push -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (Push -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (Push -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (Push -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (Push -> GitLab ()))
      (String -> Maybe Push
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe Push)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (TagPush -> GitLab Bool)
-> Maybe (TagPush -> GitLab ()) -> Maybe TagPush -> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (TagPush -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (TagPush -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (TagPush -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (TagPush -> GitLab ()))
      (String -> Maybe TagPush
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe TagPush)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (RepositoryUpdate -> GitLab Bool)
-> Maybe (RepositoryUpdate -> GitLab ())
-> Maybe RepositoryUpdate
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (RepositoryUpdate -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (RepositoryUpdate -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (RepositoryUpdate -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (RepositoryUpdate -> GitLab ()))
      (String -> Maybe RepositoryUpdate
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe RepositoryUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` Maybe (MergeRequestEvent -> GitLab Bool)
-> Maybe (MergeRequestEvent -> GitLab ())
-> Maybe MergeRequestEvent
-> GitLab Bool
forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      ((a -> GitLab Bool) -> Maybe (MergeRequestEvent -> GitLab Bool)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (MergeRequestEvent -> GitLab Bool))
      ((a -> GitLab ()) -> Maybe (MergeRequestEvent -> GitLab ())
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (MergeRequestEvent -> GitLab ()))
      (String -> Maybe MergeRequestEvent
forall a. FromJSON a => String -> Maybe a
parseEvent String
contents :: Maybe MergeRequestEvent)

fireIf' :: (Typeable a, Show a) => Maybe (a -> GitLab Bool) -> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf' :: Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf' Maybe (a -> GitLab Bool)
castPred Maybe (a -> GitLab ())
castF Maybe a
parsed = do
  case Maybe (a -> GitLab Bool)
castPred of
    Maybe (a -> GitLab Bool)
Nothing -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just a -> GitLab Bool
pred' ->
      case Maybe (a -> GitLab ())
castF of
        Maybe (a -> GitLab ())
Nothing -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just a -> GitLab ()
f' ->
          case Maybe a
parsed of
            Maybe a
Nothing -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            Just a
parsed' -> do
              Bool
testPred <- a -> GitLab Bool
pred' a
parsed'
              if Bool
testPred
                then do
                  a -> GitLab ()
f' a
parsed'
                  Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                else Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False