{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE PatternSynonyms            #-}
module Servant.Server.Internal.Handler where

import           Control.Monad.Base
                 (MonadBase (..))
import           Control.Monad.Catch
                 (MonadCatch, MonadMask, MonadThrow)
import           Control.Monad.Error.Class
                 (MonadError, throwError)
import           Control.Monad.IO.Class
                 (MonadIO)
import           Control.Monad.Trans.Control
                 (MonadBaseControl (..))
import           Control.Monad.Trans.Except
                 (ExceptT(ExceptT), runExceptT)
import           Data.String
                 (fromString)
import           GHC.Generics
                 (Generic)
import           Servant.Server.Internal.ServerError
                 (ServerError, errBody, err500)

newtype Handler a = Handler { forall a. Handler a -> ExceptT ServerError IO a
runHandler' :: ExceptT ServerError IO a }
  deriving stock ((forall x. Handler a -> Rep (Handler a) x)
-> (forall x. Rep (Handler a) x -> Handler a)
-> Generic (Handler a)
forall x. Rep (Handler a) x -> Handler a
forall x. Handler a -> Rep (Handler a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Handler a) x -> Handler a
forall a x. Handler a -> Rep (Handler a) x
$cfrom :: forall a x. Handler a -> Rep (Handler a) x
from :: forall x. Handler a -> Rep (Handler a) x
$cto :: forall a x. Rep (Handler a) x -> Handler a
to :: forall x. Rep (Handler a) x -> Handler a
Generic)
  deriving newtype
    ( (forall a b. (a -> b) -> Handler a -> Handler b)
-> (forall a b. a -> Handler b -> Handler a) -> Functor Handler
forall a b. a -> Handler b -> Handler a
forall a b. (a -> b) -> Handler a -> Handler b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Handler a -> Handler b
fmap :: forall a b. (a -> b) -> Handler a -> Handler b
$c<$ :: forall a b. a -> Handler b -> Handler a
<$ :: forall a b. a -> Handler b -> Handler a
Functor, Functor Handler
Functor Handler =>
(forall a. a -> Handler a)
-> (forall a b. Handler (a -> b) -> Handler a -> Handler b)
-> (forall a b c.
    (a -> b -> c) -> Handler a -> Handler b -> Handler c)
-> (forall a b. Handler a -> Handler b -> Handler b)
-> (forall a b. Handler a -> Handler b -> Handler a)
-> Applicative Handler
forall a. a -> Handler a
forall a b. Handler a -> Handler b -> Handler a
forall a b. Handler a -> Handler b -> Handler b
forall a b. Handler (a -> b) -> Handler a -> Handler b
forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Handler a
pure :: forall a. a -> Handler a
$c<*> :: forall a b. Handler (a -> b) -> Handler a -> Handler b
<*> :: forall a b. Handler (a -> b) -> Handler a -> Handler b
$cliftA2 :: forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
liftA2 :: forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
$c*> :: forall a b. Handler a -> Handler b -> Handler b
*> :: forall a b. Handler a -> Handler b -> Handler b
$c<* :: forall a b. Handler a -> Handler b -> Handler a
<* :: forall a b. Handler a -> Handler b -> Handler a
Applicative, Applicative Handler
Applicative Handler =>
(forall a b. Handler a -> (a -> Handler b) -> Handler b)
-> (forall a b. Handler a -> Handler b -> Handler b)
-> (forall a. a -> Handler a)
-> Monad Handler
forall a. a -> Handler a
forall a b. Handler a -> Handler b -> Handler b
forall a b. Handler a -> (a -> Handler b) -> Handler b
forall (m :: Type -> Type).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Handler a -> (a -> Handler b) -> Handler b
>>= :: forall a b. Handler a -> (a -> Handler b) -> Handler b
$c>> :: forall a b. Handler a -> Handler b -> Handler b
>> :: forall a b. Handler a -> Handler b -> Handler b
$creturn :: forall a. a -> Handler a
return :: forall a. a -> Handler a
Monad, Monad Handler
Monad Handler => (forall a. IO a -> Handler a) -> MonadIO Handler
forall a. IO a -> Handler a
forall (m :: Type -> Type).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Handler a
liftIO :: forall a. IO a -> Handler a
MonadIO
    , MonadError ServerError
    , Monad Handler
Monad Handler =>
(forall e a. (HasCallStack, Exception e) => e -> Handler a)
-> MonadThrow Handler
forall e a. (HasCallStack, Exception e) => e -> Handler a
forall (m :: Type -> Type).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> Handler a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Handler a
MonadThrow, MonadThrow Handler
MonadThrow Handler =>
(forall e a.
 (HasCallStack, Exception e) =>
 Handler a -> (e -> Handler a) -> Handler a)
-> MonadCatch Handler
forall e a.
(HasCallStack, Exception e) =>
Handler a -> (e -> Handler a) -> Handler a
forall (m :: Type -> Type).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
Handler a -> (e -> Handler a) -> Handler a
catch :: forall e a.
(HasCallStack, Exception e) =>
Handler a -> (e -> Handler a) -> Handler a
MonadCatch, MonadCatch Handler
MonadCatch Handler =>
(forall b.
 HasCallStack =>
 ((forall a. Handler a -> Handler a) -> Handler b) -> Handler b)
-> (forall b.
    HasCallStack =>
    ((forall a. Handler a -> Handler a) -> Handler b) -> Handler b)
-> (forall a b c.
    HasCallStack =>
    Handler a
    -> (a -> ExitCase b -> Handler c)
    -> (a -> Handler b)
    -> Handler (b, c))
-> MonadMask Handler
forall b.
HasCallStack =>
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
forall a b c.
HasCallStack =>
Handler a
-> (a -> ExitCase b -> Handler c)
-> (a -> Handler b)
-> Handler (b, c)
forall (m :: Type -> Type).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
mask :: forall b.
HasCallStack =>
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
$cgeneralBracket :: forall a b c.
HasCallStack =>
Handler a
-> (a -> ExitCase b -> Handler c)
-> (a -> Handler b)
-> Handler (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Handler a
-> (a -> ExitCase b -> Handler c)
-> (a -> Handler b)
-> Handler (b, c)
MonadMask
    )

instance MonadFail Handler where
  fail :: forall a. String -> Handler a
fail String
str = ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError ServerError
err500 { errBody = fromString str }

instance MonadBase IO Handler where
  liftBase :: forall a. IO a -> Handler a
liftBase = ExceptT ServerError IO α -> Handler α
forall a. ExceptT ServerError IO a -> Handler a
Handler (ExceptT ServerError IO α -> Handler α)
-> (IO α -> ExceptT ServerError IO α) -> IO α -> Handler α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO α -> ExceptT ServerError IO α
forall α. IO α -> ExceptT ServerError IO α
forall (b :: Type -> Type) (m :: Type -> Type) α.
MonadBase b m =>
b α -> m α
liftBase

instance MonadBaseControl IO Handler where
  type StM Handler a = Either ServerError a

  -- liftBaseWith :: (RunInBase Handler IO -> IO a) -> Handler a
  liftBaseWith :: forall a. (RunInBase Handler IO -> IO a) -> Handler a
liftBaseWith RunInBase Handler IO -> IO a
f = ExceptT ServerError IO a -> Handler a
forall a. ExceptT ServerError IO a -> Handler a
Handler ((RunInBase (ExceptT ServerError IO) IO -> IO a)
-> ExceptT ServerError IO a
forall a.
(RunInBase (ExceptT ServerError IO) IO -> IO a)
-> ExceptT ServerError IO a
forall (b :: Type -> Type) (m :: Type -> Type) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase (ExceptT ServerError IO) IO
g -> RunInBase Handler IO -> IO a
f (ExceptT ServerError IO a -> IO (Either ServerError a)
ExceptT ServerError IO a -> IO (StM (ExceptT ServerError IO) a)
RunInBase (ExceptT ServerError IO) IO
g (ExceptT ServerError IO a -> IO (Either ServerError a))
-> (Handler a -> ExceptT ServerError IO a)
-> Handler a
-> IO (Either ServerError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler a -> ExceptT ServerError IO a
forall a. Handler a -> ExceptT ServerError IO a
runHandler')))

  -- restoreM :: StM Handler a -> Handler a
  restoreM :: forall a. StM Handler a -> Handler a
restoreM StM Handler a
st = ExceptT ServerError IO a -> Handler a
forall a. ExceptT ServerError IO a -> Handler a
Handler (StM (ExceptT ServerError IO) a -> ExceptT ServerError IO a
forall a.
StM (ExceptT ServerError IO) a -> ExceptT ServerError IO a
forall (b :: Type -> Type) (m :: Type -> Type) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM (ExceptT ServerError IO) a
StM Handler a
st)

runHandler :: Handler a -> IO (Either ServerError a)
runHandler :: forall a. Handler a -> IO (Either ServerError a)
runHandler = ExceptT ServerError IO a -> IO (Either ServerError a)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ServerError IO a -> IO (Either ServerError a))
-> (Handler a -> ExceptT ServerError IO a)
-> Handler a
-> IO (Either ServerError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler a -> ExceptT ServerError IO a
forall a. Handler a -> ExceptT ServerError IO a
runHandler'

-- | Pattern synonym that matches directly on the inner 'IO' action.
--
-- To lift 'IO' actions that don't carry a 'ServerError', use 'Control.Monad.IO.Class.liftIO' instead.
pattern MkHandler :: IO (Either ServerError a) -> Handler a
pattern $mMkHandler :: forall {r} {a}.
Handler a -> (IO (Either ServerError a) -> r) -> ((# #) -> r) -> r
$bMkHandler :: forall a. IO (Either ServerError a) -> Handler a
MkHandler ioe = Handler (ExceptT ioe)
{-# COMPLETE MkHandler #-}