{-# 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 { forall a. Handler a -> ExceptT ServerError IO a
runHandler' :: ExceptT ServerError IO a }
  deriving
    ( 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
<$ :: forall a b. a -> Handler b -> Handler a
$c<$ :: forall a b. a -> Handler b -> Handler a
fmap :: forall a b. (a -> b) -> Handler a -> Handler b
$cfmap :: forall a b. (a -> b) -> Handler a -> Handler b
Functor, Functor 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 :: * -> *).
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
<* :: forall a b. Handler a -> Handler b -> Handler a
$c<* :: forall a b. Handler a -> Handler b -> Handler a
*> :: forall a b. Handler a -> Handler b -> Handler b
$c*> :: forall a b. Handler a -> Handler b -> Handler b
liftA2 :: forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
$cliftA2 :: forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
<*> :: forall a b. Handler (a -> b) -> Handler a -> Handler b
$c<*> :: forall a b. Handler (a -> b) -> Handler a -> Handler b
pure :: forall a. a -> Handler a
$cpure :: forall a. a -> Handler a
Applicative, Applicative 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 :: * -> *).
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 :: forall a. a -> Handler a
$creturn :: forall a. a -> Handler a
>> :: forall a b. Handler a -> Handler b -> Handler b
$c>> :: forall a b. Handler a -> Handler b -> Handler b
>>= :: forall a b. Handler a -> (a -> Handler b) -> Handler b
$c>>= :: forall a b. Handler a -> (a -> Handler b) -> Handler b
Monad, Monad Handler
forall a. IO a -> Handler a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Handler a
$cliftIO :: forall a. IO a -> Handler a
MonadIO, 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
forall e a. Exception e => e -> Handler a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> Handler a
$cthrowM :: forall e a. Exception e => e -> Handler a
MonadThrow, MonadThrow Handler
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 :: forall e a.
Exception e =>
Handler a -> (e -> Handler a) -> Handler a
$ccatch :: forall e a.
Exception e =>
Handler a -> (e -> Handler a) -> Handler a
MonadCatch, MonadCatch Handler
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 :: forall a b c.
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 b.
((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 b.
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
$cmask :: forall b.
((forall a. Handler a -> Handler a) -> Handler b) -> Handler b
MonadMask
    )

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

instance MonadBase IO Handler where
  liftBase :: forall a. IO a -> Handler a
liftBase = forall a. ExceptT ServerError IO a -> Handler a
Handler forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (RunInBase Handler IO -> IO a) -> Handler a
liftBaseWith RunInBase Handler IO -> IO a
f = forall a. ExceptT ServerError IO a -> Handler a
Handler (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 (RunInBase (ExceptT ServerError IO) IO
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ExceptT ServerError IO a -> Handler a
Handler (forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM Handler a
st)

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