    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE TypeFamilies               #-}
    module Servant.Server.Internal.DelayedIO where

    import           Control.Monad.Base
                     (MonadBase (..))
    import           Control.Monad.Catch
                     (MonadThrow (..))
    import           Control.Monad.Reader
                     (MonadReader (..), ReaderT (..), runReaderT)
    import           Control.Monad.Trans
                     (MonadIO (..), MonadTrans (..))
    import           Control.Monad.Trans.Control
                     (MonadBaseControl (..))
    import           Control.Monad.Trans.Resource
                     (MonadResource (..), ResourceT, runInternalState,
                     transResourceT, withInternalState)
    import           Network.Wai
                     (Request)

    import           Servant.Server.Internal.RouteResult
    import           Servant.Server.Internal.ServerError

    -- | Computations used in a 'Delayed' can depend on the
    -- incoming 'Request', may perform 'IO', and result in a
    -- 'RouteResult', meaning they can either succeed, fail
    -- (with the possibility to recover), or fail fatally.
    --
    newtype DelayedIO a = DelayedIO { forall a.
    DelayedIO a -> ReaderT Request (ResourceT (RouteResultT IO)) a
    runDelayedIO' :: ReaderT Request (ResourceT (RouteResultT IO)) a }
      deriving newtype
        ( (forall a b. (a -> b) -> DelayedIO a -> DelayedIO b)
    -> (forall a b. a -> DelayedIO b -> DelayedIO a)
    -> Functor DelayedIO
    forall a b. a -> DelayedIO b -> DelayedIO a
    forall a b. (a -> b) -> DelayedIO a -> DelayedIO 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) -> DelayedIO a -> DelayedIO b
    fmap :: forall a b. (a -> b) -> DelayedIO a -> DelayedIO b
    $c<$ :: forall a b. a -> DelayedIO b -> DelayedIO a
    <$ :: forall a b. a -> DelayedIO b -> DelayedIO a
    Functor, Functor DelayedIO
    Functor DelayedIO =>
    (forall a. a -> DelayedIO a)
    -> (forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b)
    -> (forall a b c.
        (a -> b -> c) -> DelayedIO a -> DelayedIO b -> DelayedIO c)
    -> (forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b)
    -> (forall a b. DelayedIO a -> DelayedIO b -> DelayedIO a)
    -> Applicative DelayedIO
    forall a. a -> DelayedIO a
    forall a b. DelayedIO a -> DelayedIO b -> DelayedIO a
    forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b
    forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    forall a b c.
    (a -> b -> c) -> DelayedIO a -> DelayedIO b -> DelayedIO 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 -> DelayedIO a
    pure :: forall a. a -> DelayedIO a
    $c<*> :: forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    <*> :: forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    $cliftA2 :: forall a b c.
    (a -> b -> c) -> DelayedIO a -> DelayedIO b -> DelayedIO c
    liftA2 :: forall a b c.
    (a -> b -> c) -> DelayedIO a -> DelayedIO b -> DelayedIO c
    $c*> :: forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b
    *> :: forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b
    $c<* :: forall a b. DelayedIO a -> DelayedIO b -> DelayedIO a
    <* :: forall a b. DelayedIO a -> DelayedIO b -> DelayedIO a
    Applicative, Applicative DelayedIO
    Applicative DelayedIO =>
    (forall a b. DelayedIO a -> (a -> DelayedIO b) -> DelayedIO b)
    -> (forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b)
    -> (forall a. a -> DelayedIO a)
    -> Monad DelayedIO
    forall a. a -> DelayedIO a
    forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b
    forall a b. DelayedIO a -> (a -> DelayedIO b) -> DelayedIO 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. DelayedIO a -> (a -> DelayedIO b) -> DelayedIO b
    >>= :: forall a b. DelayedIO a -> (a -> DelayedIO b) -> DelayedIO b
    $c>> :: forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b
    >> :: forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b
    $creturn :: forall a. a -> DelayedIO a
    return :: forall a. a -> DelayedIO a
    Monad
        , Monad DelayedIO
    Monad DelayedIO =>
    (forall a. IO a -> DelayedIO a) -> MonadIO DelayedIO
    forall a. IO a -> DelayedIO a
    forall (m :: Type -> Type).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> DelayedIO a
    liftIO :: forall a. IO a -> DelayedIO a
    MonadIO, MonadReader Request
        , Monad DelayedIO
    Monad DelayedIO =>
    (forall e a. (HasCallStack, Exception e) => e -> DelayedIO a)
    -> MonadThrow DelayedIO
    forall e a. (HasCallStack, Exception e) => e -> DelayedIO 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 -> DelayedIO a
    throwM :: forall e a. (HasCallStack, Exception e) => e -> DelayedIO a
    MonadThrow
        , MonadIO DelayedIO
    MonadIO DelayedIO =>
    (forall a. ResourceT IO a -> DelayedIO a)
    -> MonadResource DelayedIO
    forall a. ResourceT IO a -> DelayedIO a
    forall (m :: Type -> Type).
    MonadIO m =>
    (forall a. ResourceT IO a -> m a) -> MonadResource m
    $cliftResourceT :: forall a. ResourceT IO a -> DelayedIO a
    liftResourceT :: forall a. ResourceT IO a -> DelayedIO a
    MonadResource
        )

    instance MonadBase IO DelayedIO where
        liftBase :: forall a. IO a -> DelayedIO a
    liftBase = IO α -> DelayedIO α
    forall a. IO a -> DelayedIO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO

    liftRouteResult :: RouteResult a -> DelayedIO a
    liftRouteResult :: forall a. RouteResult a -> DelayedIO a
    liftRouteResult RouteResult a
    x = ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    forall a.
    ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    DelayedIO (ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a)
    -> ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    forall a b. (a -> b) -> a -> b
    $ ResourceT (RouteResultT IO) a
    -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall (m :: Type -> Type) a. Monad m => m a -> ReaderT Request m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ResourceT (RouteResultT IO) a
     -> ReaderT Request (ResourceT (RouteResultT IO)) a)
    -> (RouteResultT IO a -> ResourceT (RouteResultT IO) a)
    -> RouteResultT IO a
    -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RouteResultT IO a -> ResourceT (RouteResultT IO) a
    forall (m :: Type -> Type) a. Monad m => m a -> ResourceT m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RouteResultT IO a
     -> ReaderT Request (ResourceT (RouteResultT IO)) a)
    -> RouteResultT IO a
    -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall a b. (a -> b) -> a -> b
    $ IO (RouteResult a) -> RouteResultT IO a
    forall (m :: Type -> Type) a. m (RouteResult a) -> RouteResultT m a
    RouteResultT (IO (RouteResult a) -> RouteResultT IO a)
    -> (RouteResult a -> IO (RouteResult a))
    -> RouteResult a
    -> RouteResultT IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RouteResult a -> IO (RouteResult a)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (RouteResult a -> RouteResultT IO a)
    -> RouteResult a -> RouteResultT IO a
    forall a b. (a -> b) -> a -> b
    $ RouteResult a
    x

    instance MonadBaseControl IO DelayedIO where
        -- type StM DelayedIO a = StM (ReaderT Request (ResourceT (RouteResultT IO))) a
        -- liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
        -- restoreM       = DelayedIO . restoreM

        type StM DelayedIO a = RouteResult a
        liftBaseWith :: forall a. (RunInBase DelayedIO IO -> IO a) -> DelayedIO a
    liftBaseWith RunInBase DelayedIO IO -> IO a
    f = ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    forall a.
    ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    DelayedIO (ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a)
    -> ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    forall a b. (a -> b) -> a -> b
    $ (Request -> ResourceT (RouteResultT IO) a)
    -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
    ReaderT ((Request -> ResourceT (RouteResultT IO) a)
     -> ReaderT Request (ResourceT (RouteResultT IO)) a)
    -> (Request -> ResourceT (RouteResultT IO) a)
    -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall a b. (a -> b) -> a -> b
    $ \Request
    req -> (InternalState -> RouteResultT IO a)
    -> ResourceT (RouteResultT IO) a
    forall (m :: Type -> Type) a.
    (InternalState -> m a) -> ResourceT m a
    withInternalState ((InternalState -> RouteResultT IO a)
     -> ResourceT (RouteResultT IO) a)
    -> (InternalState -> RouteResultT IO a)
    -> ResourceT (RouteResultT IO) a
    forall a b. (a -> b) -> a -> b
    $ \InternalState
    s ->
            (RunInBase (RouteResultT IO) IO -> IO a) -> RouteResultT IO a
    forall a.
    (RunInBase (RouteResultT IO) IO -> IO a) -> RouteResultT IO a
    forall (b :: Type -> Type) (m :: Type -> Type) a.
    MonadBaseControl b m =>
    (RunInBase m b -> b a) -> m a
    liftBaseWith ((RunInBase (RouteResultT IO) IO -> IO a) -> RouteResultT IO a)
    -> (RunInBase (RouteResultT IO) IO -> IO a) -> RouteResultT IO a
    forall a b. (a -> b) -> a -> b
    $ \RunInBase (RouteResultT IO) IO
    runInBase -> RunInBase DelayedIO IO -> IO a
    f (RunInBase DelayedIO IO -> IO a) -> RunInBase DelayedIO IO -> IO a
    forall a b. (a -> b) -> a -> b
    $ \DelayedIO a
    x ->
                RouteResultT IO a -> IO (StM (RouteResultT IO) a)
    RunInBase (RouteResultT IO) IO
    runInBase (ResourceT (RouteResultT IO) a -> InternalState -> RouteResultT IO a
    forall (m :: Type -> Type) a. ResourceT m a -> InternalState -> m a
    runInternalState (ReaderT Request (ResourceT (RouteResultT IO)) a
    -> Request -> ResourceT (RouteResultT IO) a
    forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
    runReaderT (DelayedIO a -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall a.
    DelayedIO a -> ReaderT Request (ResourceT (RouteResultT IO)) a
    runDelayedIO' DelayedIO a
    x) Request
    req) InternalState
    s)
        restoreM :: forall a. StM DelayedIO a -> DelayedIO a
    restoreM      = ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    forall a.
    ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a
    DelayedIO (ReaderT Request (ResourceT (RouteResultT IO)) a -> DelayedIO a)
    -> (RouteResult a
        -> ReaderT Request (ResourceT (RouteResultT IO)) a)
    -> RouteResult a
    -> DelayedIO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResourceT (RouteResultT IO) a
    -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall (m :: Type -> Type) a. Monad m => m a -> ReaderT Request m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ResourceT (RouteResultT IO) a
     -> ReaderT Request (ResourceT (RouteResultT IO)) a)
    -> (RouteResult a -> ResourceT (RouteResultT IO) a)
    -> RouteResult a
    -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (InternalState -> RouteResultT IO a)
    -> ResourceT (RouteResultT IO) a
    forall (m :: Type -> Type) a.
    (InternalState -> m a) -> ResourceT m a
    withInternalState ((InternalState -> RouteResultT IO a)
     -> ResourceT (RouteResultT IO) a)
    -> (RouteResult a -> InternalState -> RouteResultT IO a)
    -> RouteResult a
    -> ResourceT (RouteResultT IO) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RouteResultT IO a -> InternalState -> RouteResultT IO a
    forall a b. a -> b -> a
    const (RouteResultT IO a -> InternalState -> RouteResultT IO a)
    -> (RouteResult a -> RouteResultT IO a)
    -> RouteResult a
    -> InternalState
    -> RouteResultT IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StM (RouteResultT IO) a -> RouteResultT IO a
    RouteResult a -> RouteResultT IO a
    forall a. StM (RouteResultT IO) a -> RouteResultT IO a
    forall (b :: Type -> Type) (m :: Type -> Type) a.
    MonadBaseControl b m =>
    StM m a -> m a
    restoreM

    runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
    runDelayedIO :: forall a. DelayedIO a -> Request -> ResourceT IO (RouteResult a)
    runDelayedIO DelayedIO a
    m Request
    req = (RouteResultT IO a -> IO (RouteResult a))
    -> ResourceT (RouteResultT IO) a -> ResourceT IO (RouteResult a)
    forall (m :: Type -> Type) a (n :: Type -> Type) b.
    (m a -> n b) -> ResourceT m a -> ResourceT n b
    transResourceT RouteResultT IO a -> IO (RouteResult a)
    forall (m :: Type -> Type) a. RouteResultT m a -> m (RouteResult a)
    runRouteResultT (ResourceT (RouteResultT IO) a -> ResourceT IO (RouteResult a))
    -> ResourceT (RouteResultT IO) a -> ResourceT IO (RouteResult a)
    forall a b. (a -> b) -> a -> b
    $ ReaderT Request (ResourceT (RouteResultT IO)) a
    -> Request -> ResourceT (RouteResultT IO) a
    forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
    runReaderT (DelayedIO a -> ReaderT Request (ResourceT (RouteResultT IO)) a
    forall a.
    DelayedIO a -> ReaderT Request (ResourceT (RouteResultT IO)) a
    runDelayedIO' DelayedIO a
    m) Request
    req

    -- | Fail with the option to recover.
    delayedFail :: ServerError -> DelayedIO a
    delayedFail :: forall a. ServerError -> DelayedIO a
    delayedFail ServerError
    err = RouteResult a -> DelayedIO a
    forall a. RouteResult a -> DelayedIO a
    liftRouteResult (RouteResult a -> DelayedIO a) -> RouteResult a -> DelayedIO a
    forall a b. (a -> b) -> a -> b
    $ ServerError -> RouteResult a
    forall a. ServerError -> RouteResult a
    Fail ServerError
    err

    -- | Fail fatally, i.e., without any option to recover.
    delayedFailFatal :: ServerError -> DelayedIO a
    delayedFailFatal :: forall a. ServerError -> DelayedIO a
    delayedFailFatal ServerError
    err = RouteResult a -> DelayedIO a
    forall a. RouteResult a -> DelayedIO a
    liftRouteResult (RouteResult a -> DelayedIO a) -> RouteResult a -> DelayedIO a
    forall a b. (a -> b) -> a -> b
    $ ServerError -> RouteResult a
    forall a. ServerError -> RouteResult a
    FailFatal ServerError
    err

    -- | Gain access to the incoming request.
    withRequest :: (Request -> DelayedIO a) -> DelayedIO a
    withRequest :: forall a. (Request -> DelayedIO a) -> DelayedIO a
    withRequest Request -> DelayedIO a
    f = do
        req <- DelayedIO Request
    forall r (m :: Type -> Type). MonadReader r m => m r
    ask
        f req