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

import           Prelude ()
import           Prelude.Compat

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, runExceptT)
import           Data.String
                 (fromString)
import           GHC.Generics
                 (Generic)
import           Servant.Server.Internal.ServerError
                 (ServerError, errBody, err500)

newtype Handler a = Handler { Handler a -> ExceptT ServerError IO a
runHandler' :: ExceptT ServerError IO a }
  deriving
    ( a -> Handler b -> Handler a
(a -> b) -> Handler a -> Handler b
(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 :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Handler b -> Handler a
$c<$ :: forall a b. a -> Handler b -> Handler a
fmap :: (a -> b) -> Handler a -> Handler b
$cfmap :: forall a b. (a -> b) -> Handler a -> Handler b
Functor, Functor Handler
a -> Handler a
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
Handler a -> Handler b -> Handler b
Handler a -> Handler b -> Handler a
Handler (a -> b) -> Handler a -> Handler b
(a -> b -> c) -> Handler a -> Handler b -> Handler c
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 :: * -> *).
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
<* :: Handler a -> Handler b -> Handler a
$c<* :: forall a b. Handler a -> Handler b -> Handler a
*> :: Handler a -> Handler b -> Handler b
$c*> :: forall a b. Handler a -> Handler b -> Handler b
liftA2 :: (a -> b -> c) -> Handler a -> Handler b -> Handler c
$cliftA2 :: forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
<*> :: Handler (a -> b) -> Handler a -> Handler b
$c<*> :: forall a b. Handler (a -> b) -> Handler a -> Handler b
pure :: a -> Handler a
$cpure :: forall a. a -> Handler a
$cp1Applicative :: Functor Handler
Applicative, Applicative Handler
a -> Handler a
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
Handler a -> (a -> Handler b) -> Handler b
Handler a -> Handler b -> Handler b
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 :: * -> *).
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
return :: a -> Handler a
$creturn :: forall a. a -> Handler a
>> :: Handler a -> Handler b -> Handler b
$c>> :: forall a b. Handler a -> Handler b -> Handler b
>>= :: Handler a -> (a -> Handler b) -> Handler b
$c>>= :: forall a b. Handler a -> (a -> Handler b) -> Handler b
$cp1Monad :: Applicative Handler
Monad, Monad Handler
Monad Handler -> (forall a. IO a -> Handler a) -> MonadIO Handler
IO a -> Handler a
forall a. IO a -> Handler a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Handler a
$cliftIO :: forall a. IO a -> Handler a
$cp1MonadIO :: Monad Handler
MonadIO, (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
$cto :: forall a x. Rep (Handler a) x -> Handler a
$cfrom :: forall a x. Handler a -> Rep (Handler a) x
Generic
    , MonadError ServerError
    , Monad Handler
e -> Handler a
Monad Handler
-> (forall e a. Exception e => e -> Handler a)
-> MonadThrow Handler
forall e a. Exception e => e -> Handler a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Handler a
$cthrowM :: forall e a. Exception e => e -> Handler a
$cp1MonadThrow :: Monad Handler
MonadThrow, MonadThrow Handler
MonadThrow Handler
-> (forall e a.
    Exception e =>
    Handler a -> (e -> Handler a) -> Handler a)
-> MonadCatch Handler
Handler a -> (e -> Handler a) -> Handler a
forall e a.
Exception e =>
Handler a -> (e -> Handler a) -> Handler a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: Handler a -> (e -> Handler a) -> Handler a
$ccatch :: forall e a.
Exception e =>
Handler a -> (e -> Handler a) -> Handler a
$cp1MonadCatch :: MonadThrow Handler
MonadCatch, MonadCatch Handler
MonadCatch Handler
-> (forall b.
    ((forall a. Handler a -> Handler a) -> Handler b) -> Handler b)
-> (forall b.
    ((forall a. Handler a -> Handler a) -> Handler b) -> Handler b)
-> (forall a b c.
    Handler a
    -> (a -> ExitCase b -> Handler c)
    -> (a -> Handler b)
    -> Handler (b, c))
-> MonadMask Handler
Handler a
-> (a -> ExitCase b -> Handler c)
-> (a -> Handler b)
-> Handler (b, c)
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
forall b.
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
forall a b c.
Handler a
-> (a -> ExitCase b -> Handler c)
-> (a -> Handler b)
-> Handler (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: Handler a
-> (a -> ExitCase b -> Handler c)
-> (a -> Handler b)
-> Handler (b, c)
$cgeneralBracket :: forall a b c.
Handler a
-> (a -> ExitCase b -> Handler c)
-> (a -> Handler b)
-> Handler (b, c)
uninterruptibleMask :: ((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
$cuninterruptibleMask :: forall b.
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
mask :: ((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
$cmask :: forall b.
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
$cp1MonadMask :: MonadCatch Handler
MonadMask
    )

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

instance MonadBase IO Handler where
  liftBase :: IO α -> Handler α
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 (b :: * -> *) (m :: * -> *) α. 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 :: (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 (b :: * -> *) (m :: * -> *) 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)
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 :: 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 (b :: * -> *) (m :: * -> *) 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 :: Handler a -> IO (Either ServerError a)
runHandler = ExceptT ServerError IO a -> IO (Either ServerError a)
forall e (m :: * -> *) 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'