@@ -1,9 +1,10 @@
11{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE GeneralizedNewtypeDeriving #-}
45{-# LANGUAGE KindSignatures #-}
56{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE TemplateHaskell #-}
7+{-# LANGUAGE RecordWildCards #-}
78{-# LANGUAGE TypeFamilies #-}
89{-# LANGUAGE UndecidableInstances #-}
910
@@ -19,27 +20,20 @@
1920
2021module Control.Monad.Trans.PagerDuty where
2122
22−import Control.Applicative
23−import Control.Lens
24−import Control.Monad.Base
25−import Control.Monad.Catch
26−import Control.Monad.Except
27−import Control.Monad.Morph
28−import Control.Monad.Reader
29−import Control.Monad.Trans.Control
30−import Network.HTTP.Client (Manager)
31−import Network.PagerDuty.Types
32−
33−-- -- | Provides an alias for shortening type signatures if preferred.
34−-- --
35−-- -- Note: requires the @ConstraintKinds@ extension.
36−-- type MonadAWS m =
37−-- ( MonadBaseControl IO m
38−-- , MonadCatch m
39−-- , MonadResource m
40−-- , MonadError Error m
41−-- , MonadReader Env m
42−-- )
23+import Control.Applicative
24+import Control.Monad.Base
25+import Control.Monad.Catch
26+import Control.Monad.Except
27+import Control.Monad.Morph
28+import Control.Monad.Reader
29+import Control.Monad.Trans.Control
30+import Data.Aeson
31+import Data.Conduit
32+import Network.HTTP.Client (Manager)
33+import Network.PagerDuty.Integration (Event, Response)
34+import qualified Network.PagerDuty.Integration as Int
35+import qualified Network.PagerDuty.REST as REST
36+import Network.PagerDuty.Types
4337
4438data Env (s :: Security) = Env
4539 { _envDomain :: SubDomain
@@ -47,8 +41,6 @@ data Env (s :: Security) = Env
4741 , _envManager :: Manager
4842 }
4943
50−makeLenses ''Env
51−
5244-- | A convenient alias for 'PDT' 'IO'.
5345type PD s = PDT s IO
5446
@@ -106,3 +98,26 @@ instance MMonad (PDT s) where
10698
10799runPDT :: PDT s m a -> Env s -> m (Either Error a)
108100runPDT (PDT k) = runExceptT . runReaderT k
101+
102+hoistEither :: (MonadError Error m) => Either Error a -> m a
103+hoistEither = either throwError return
104+
105+scoped f = ask >>= f
106+
107+submit = submitCatch >=> hoistEither
108+
109+submitCatch x = scoped $ \e ->
110+ Int.submit (_envManager e) x
111+
112+send = sendCatch >=> hoistEither
113+
114+sendCatch x = scoped $ \Env{..} ->
115+ REST.send _envAuth _envDomain _envManager x
116+
117+paginate x = paginateCatch x $= awaitForever (hoistEither >=> yield)
118+
119+paginateCatch :: (MonadIO m, MonadReader (Env s) m, Paginate a, FromJSON b)
120+ => Request a s b
121+ -> Source m (Either Error b)
122+paginateCatch x = scoped $ \Env{..} ->
123+ REST.paginate _envAuth _envDomain _envManager x