module Tendermint.SDK.BaseApp.Router.Delayed
  ( Delayed
  , runAction
  , delayedFail
  , addBody
  , addCapture
  , addParameter
  , emptyDelayed
  , withRequest
  ) where

import           Control.Monad.Reader                (MonadReader, ReaderT, ask,
                                                      runReaderT)
import           Control.Monad.Trans                 (MonadTrans (..))
import           Polysemy                            (Sem)
import           Tendermint.SDK.BaseApp.Router.Types (RouteResult (..),
                                                      RouteResultT (..),
                                                      RouterError (..))

--------------------------------------------------------------------------------
-- NOTE: most of this was vendored and repurposed from servant


newtype DelayedM m req a =
  DelayedM { DelayedM m req a -> ReaderT req (RouteResultT m) a
runDelayedM' :: ReaderT req (RouteResultT m) a }
    deriving (a -> DelayedM m req b -> DelayedM m req a
(a -> b) -> DelayedM m req a -> DelayedM m req b
(forall a b. (a -> b) -> DelayedM m req a -> DelayedM m req b)
-> (forall a b. a -> DelayedM m req b -> DelayedM m req a)
-> Functor (DelayedM m req)
forall a b. a -> DelayedM m req b -> DelayedM m req a
forall a b. (a -> b) -> DelayedM m req a -> DelayedM m req b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) req a b.
Functor m =>
a -> DelayedM m req b -> DelayedM m req a
forall (m :: * -> *) req a b.
Functor m =>
(a -> b) -> DelayedM m req a -> DelayedM m req b
<$ :: a -> DelayedM m req b -> DelayedM m req a
$c<$ :: forall (m :: * -> *) req a b.
Functor m =>
a -> DelayedM m req b -> DelayedM m req a
fmap :: (a -> b) -> DelayedM m req a -> DelayedM m req b
$cfmap :: forall (m :: * -> *) req a b.
Functor m =>
(a -> b) -> DelayedM m req a -> DelayedM m req b
Functor, Functor (DelayedM m req)
a -> DelayedM m req a
Functor (DelayedM m req) =>
(forall a. a -> DelayedM m req a)
-> (forall a b.
    DelayedM m req (a -> b) -> DelayedM m req a -> DelayedM m req b)
-> (forall a b c.
    (a -> b -> c)
    -> DelayedM m req a -> DelayedM m req b -> DelayedM m req c)
-> (forall a b.
    DelayedM m req a -> DelayedM m req b -> DelayedM m req b)
-> (forall a b.
    DelayedM m req a -> DelayedM m req b -> DelayedM m req a)
-> Applicative (DelayedM m req)
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
DelayedM m req a -> DelayedM m req b -> DelayedM m req a
DelayedM m req (a -> b) -> DelayedM m req a -> DelayedM m req b
(a -> b -> c)
-> DelayedM m req a -> DelayedM m req b -> DelayedM m req c
forall a. a -> DelayedM m req a
forall a b.
DelayedM m req a -> DelayedM m req b -> DelayedM m req a
forall a b.
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
forall a b.
DelayedM m req (a -> b) -> DelayedM m req a -> DelayedM m req b
forall a b c.
(a -> b -> c)
-> DelayedM m req a -> DelayedM m req b -> DelayedM m req 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 (m :: * -> *) req. Monad m => Functor (DelayedM m req)
forall (m :: * -> *) req a. Monad m => a -> DelayedM m req a
forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> DelayedM m req b -> DelayedM m req a
forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req (a -> b) -> DelayedM m req a -> DelayedM m req b
forall (m :: * -> *) req a b c.
Monad m =>
(a -> b -> c)
-> DelayedM m req a -> DelayedM m req b -> DelayedM m req c
<* :: DelayedM m req a -> DelayedM m req b -> DelayedM m req a
$c<* :: forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> DelayedM m req b -> DelayedM m req a
*> :: DelayedM m req a -> DelayedM m req b -> DelayedM m req b
$c*> :: forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
liftA2 :: (a -> b -> c)
-> DelayedM m req a -> DelayedM m req b -> DelayedM m req c
$cliftA2 :: forall (m :: * -> *) req a b c.
Monad m =>
(a -> b -> c)
-> DelayedM m req a -> DelayedM m req b -> DelayedM m req c
<*> :: DelayedM m req (a -> b) -> DelayedM m req a -> DelayedM m req b
$c<*> :: forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req (a -> b) -> DelayedM m req a -> DelayedM m req b
pure :: a -> DelayedM m req a
$cpure :: forall (m :: * -> *) req a. Monad m => a -> DelayedM m req a
$cp1Applicative :: forall (m :: * -> *) req. Monad m => Functor (DelayedM m req)
Applicative, Applicative (DelayedM m req)
a -> DelayedM m req a
Applicative (DelayedM m req) =>
(forall a b.
 DelayedM m req a -> (a -> DelayedM m req b) -> DelayedM m req b)
-> (forall a b.
    DelayedM m req a -> DelayedM m req b -> DelayedM m req b)
-> (forall a. a -> DelayedM m req a)
-> Monad (DelayedM m req)
DelayedM m req a -> (a -> DelayedM m req b) -> DelayedM m req b
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
forall a. a -> DelayedM m req a
forall a b.
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
forall a b.
DelayedM m req a -> (a -> DelayedM m req b) -> DelayedM m req 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
forall (m :: * -> *) req. Monad m => Applicative (DelayedM m req)
forall (m :: * -> *) req a. Monad m => a -> DelayedM m req a
forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> (a -> DelayedM m req b) -> DelayedM m req b
return :: a -> DelayedM m req a
$creturn :: forall (m :: * -> *) req a. Monad m => a -> DelayedM m req a
>> :: DelayedM m req a -> DelayedM m req b -> DelayedM m req b
$c>> :: forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> DelayedM m req b -> DelayedM m req b
>>= :: DelayedM m req a -> (a -> DelayedM m req b) -> DelayedM m req b
$c>>= :: forall (m :: * -> *) req a b.
Monad m =>
DelayedM m req a -> (a -> DelayedM m req b) -> DelayedM m req b
$cp1Monad :: forall (m :: * -> *) req. Monad m => Applicative (DelayedM m req)
Monad, MonadReader req)

liftRouteResult :: Monad m => RouteResult a -> DelayedM m req a
liftRouteResult :: RouteResult a -> DelayedM m req a
liftRouteResult x :: RouteResult a
x = ReaderT req (RouteResultT m) a -> DelayedM m req a
forall (m :: * -> *) req a.
ReaderT req (RouteResultT m) a -> DelayedM m req a
DelayedM (ReaderT req (RouteResultT m) a -> DelayedM m req a)
-> ReaderT req (RouteResultT m) a -> DelayedM m req a
forall a b. (a -> b) -> a -> b
$ RouteResultT m a -> ReaderT req (RouteResultT m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RouteResultT m a -> ReaderT req (RouteResultT m) a)
-> RouteResultT m a -> ReaderT req (RouteResultT m) a
forall a b. (a -> b) -> a -> b
$ m (RouteResult a) -> RouteResultT m a
forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT (m (RouteResult a) -> RouteResultT m a)
-> (RouteResult a -> m (RouteResult a))
-> RouteResult a
-> RouteResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteResult a -> m (RouteResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RouteResult a -> RouteResultT m a)
-> RouteResult a -> RouteResultT m a
forall a b. (a -> b) -> a -> b
$ RouteResult a
x

runDelayedM :: DelayedM m req a -> req -> m (RouteResult a)
runDelayedM :: DelayedM m req a -> req -> m (RouteResult a)
runDelayedM m :: DelayedM m req a
m req :: req
req = RouteResultT m a -> m (RouteResult a)
forall (m :: * -> *) a. RouteResultT m a -> m (RouteResult a)
runRouteResultT (RouteResultT m a -> m (RouteResult a))
-> RouteResultT m a -> m (RouteResult a)
forall a b. (a -> b) -> a -> b
$ ReaderT req (RouteResultT m) a -> req -> RouteResultT m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DelayedM m req a -> ReaderT req (RouteResultT m) a
forall (m :: * -> *) req a.
DelayedM m req a -> ReaderT req (RouteResultT m) a
runDelayedM' DelayedM m req a
m) req
req

--------------------------------------------------------------------------------

data Delayed m env req a where
  Delayed :: { ()
delayedCaptures :: env -> DelayedM m req captures
             , ()
delayedBody :: DelayedM m req body
             , ()
delayedParams :: DelayedM m req params
             , ()
delayedHandler :: captures -> body -> params -> req -> RouteResult a
             } -> Delayed m env req a

instance Functor m => Functor (Delayed m env req) where
  fmap :: (a -> b) -> Delayed m env req a -> Delayed m env req b
fmap f :: a -> b
f Delayed{..} =
    $WDelayed :: forall env (m :: * -> *) req captures body params a.
(env -> DelayedM m req captures)
-> DelayedM m req body
-> DelayedM m req params
-> (captures -> body -> params -> req -> RouteResult a)
-> Delayed m env req a
Delayed { delayedHandler :: captures -> body -> params -> req -> RouteResult b
delayedHandler = \captures :: captures
captures body :: body
body params :: params
params req :: req
req -> a -> b
f (a -> b) -> RouteResult a -> RouteResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> captures -> body -> params -> req -> RouteResult a
delayedHandler captures
captures body
body params
params req
req
            , ..
            }

runDelayed
  :: Monad m
  => Delayed m env req a
  -> env
  -> req
  -> m (RouteResult a)
runDelayed :: Delayed m env req a -> env -> req -> m (RouteResult a)
runDelayed Delayed{..} env :: env
env = DelayedM m req a -> req -> m (RouteResult a)
forall (m :: * -> *) req a.
DelayedM m req a -> req -> m (RouteResult a)
runDelayedM (do
    req
req <- DelayedM m req req
forall r (m :: * -> *). MonadReader r m => m r
ask
    captures
captures <- env -> DelayedM m req captures
delayedCaptures env
env
    body
body <- DelayedM m req body
delayedBody
    params
params <- DelayedM m req params
delayedParams
    RouteResult a -> DelayedM m req a
forall (m :: * -> *) a req.
Monad m =>
RouteResult a -> DelayedM m req a
liftRouteResult (RouteResult a -> DelayedM m req a)
-> RouteResult a -> DelayedM m req a
forall a b. (a -> b) -> a -> b
$ captures -> body -> params -> req -> RouteResult a
delayedHandler captures
captures body
body params
params req
req
  )

runAction
  :: Delayed (Sem r) env req (Sem r a)
  -> env
  -> req
  -> (a -> Sem r (RouteResult b))
  -> Sem r (RouteResult b)
runAction :: Delayed (Sem r) env req (Sem r a)
-> env
-> req
-> (a -> Sem r (RouteResult b))
-> Sem r (RouteResult b)
runAction action :: Delayed (Sem r) env req (Sem r a)
action env :: env
env req :: req
req k :: a -> Sem r (RouteResult b)
k = do
    RouteResult (Sem r a)
res <- Delayed (Sem r) env req (Sem r a)
-> env -> req -> Sem r (RouteResult (Sem r a))
forall (m :: * -> *) env req a.
Monad m =>
Delayed m env req a -> env -> req -> m (RouteResult a)
runDelayed Delayed (Sem r) env req (Sem r a)
action env
env req
req
    case RouteResult (Sem r a)
res of
      Route a :: Sem r a
a     -> a -> Sem r (RouteResult b)
k (a -> Sem r (RouteResult b)) -> Sem r a -> Sem r (RouteResult b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r a
a
      Fail e :: RouterError
e      -> RouteResult b -> Sem r (RouteResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RouteResult b -> Sem r (RouteResult b))
-> RouteResult b -> Sem r (RouteResult b)
forall a b. (a -> b) -> a -> b
$ RouterError -> RouteResult b
forall a. RouterError -> RouteResult a
Fail RouterError
e
      FailFatal e :: RouterError
e -> RouteResult b -> Sem r (RouteResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RouteResult b -> Sem r (RouteResult b))
-> RouteResult b -> Sem r (RouteResult b)
forall a b. (a -> b) -> a -> b
$ RouterError -> RouteResult b
forall a. RouterError -> RouteResult a
FailFatal RouterError
e

-- | Fail with the option to recover.
delayedFail :: Monad m => RouterError -> DelayedM m req a
delayedFail :: RouterError -> DelayedM m req a
delayedFail err :: RouterError
err = RouteResult a -> DelayedM m req a
forall (m :: * -> *) a req.
Monad m =>
RouteResult a -> DelayedM m req a
liftRouteResult (RouteResult a -> DelayedM m req a)
-> RouteResult a -> DelayedM m req a
forall a b. (a -> b) -> a -> b
$ RouterError -> RouteResult a
forall a. RouterError -> RouteResult a
Fail RouterError
err

addBody
  :: Monad m
  => Delayed m env req (a -> b)
  -> DelayedM m req a
  -> Delayed m env req b
addBody :: Delayed m env req (a -> b)
-> DelayedM m req a -> Delayed m env req b
addBody Delayed{..} newBody :: DelayedM m req a
newBody =
  $WDelayed :: forall env (m :: * -> *) req captures body params a.
(env -> DelayedM m req captures)
-> DelayedM m req body
-> DelayedM m req params
-> (captures -> body -> params -> req -> RouteResult a)
-> Delayed m env req a
Delayed
    { delayedBody :: DelayedM m req (body, a)
delayedBody = (,) (body -> a -> (body, a))
-> DelayedM m req body -> DelayedM m req (a -> (body, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedM m req body
delayedBody DelayedM m req (a -> (body, a))
-> DelayedM m req a -> DelayedM m req (body, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedM m req a
newBody
    , delayedHandler :: captures -> (body, a) -> params -> req -> RouteResult b
delayedHandler = \caps :: captures
caps (body :: body
body, bodyNew :: a
bodyNew) p :: params
p req :: req
req -> ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
bodyNew) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> captures -> body -> params -> req -> RouteResult (a -> b)
delayedHandler captures
caps body
body params
p req
req
    , ..
    }

addCapture
  :: Monad m
  => Delayed m env req (a -> b)
  -> (captured -> DelayedM m req a)
  -> Delayed m (captured, env) req b
addCapture :: Delayed m env req (a -> b)
-> (captured -> DelayedM m req a)
-> Delayed m (captured, env) req b
addCapture Delayed{..} new :: captured -> DelayedM m req a
new =
  $WDelayed :: forall env (m :: * -> *) req captures body params a.
(env -> DelayedM m req captures)
-> DelayedM m req body
-> DelayedM m req params
-> (captures -> body -> params -> req -> RouteResult a)
-> Delayed m env req a
Delayed
    { delayedCaptures :: (captured, env) -> DelayedM m req (captures, a)
delayedCaptures = \ (txt :: captured
txt, env :: env
env) -> (,) (captures -> a -> (captures, a))
-> DelayedM m req captures -> DelayedM m req (a -> (captures, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> DelayedM m req captures
delayedCaptures env
env DelayedM m req (a -> (captures, a))
-> DelayedM m req a -> DelayedM m req (captures, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> captured -> DelayedM m req a
new captured
txt
    , delayedHandler :: (captures, a) -> body -> params -> req -> RouteResult b
delayedHandler   = \ (x :: captures
x, v :: a
v) body :: body
body p :: params
p query :: req
query -> ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
v) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> captures -> body -> params -> req -> RouteResult (a -> b)
delayedHandler captures
x body
body params
p req
query
    , ..
    } -- Note [Existential Record Update]

addParameter
  :: Monad m
  => Delayed m env req (a -> b)
  -> DelayedM m req a
  -> Delayed m env req b
addParameter :: Delayed m env req (a -> b)
-> DelayedM m req a -> Delayed m env req b
addParameter Delayed {..} new :: DelayedM m req a
new =
  $WDelayed :: forall env (m :: * -> *) req captures body params a.
(env -> DelayedM m req captures)
-> DelayedM m req body
-> DelayedM m req params
-> (captures -> body -> params -> req -> RouteResult a)
-> Delayed m env req a
Delayed
    { delayedParams :: DelayedM m req (params, a)
delayedParams = (,) (params -> a -> (params, a))
-> DelayedM m req params -> DelayedM m req (a -> (params, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedM m req params
delayedParams DelayedM m req (a -> (params, a))
-> DelayedM m req a -> DelayedM m req (params, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedM m req a
new
    , delayedHandler :: captures -> body -> (params, a) -> req -> RouteResult b
delayedHandler = \caps :: captures
caps body :: body
body (p :: params
p, pNew :: a
pNew) query :: req
query -> ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
pNew) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> captures -> body -> params -> req -> RouteResult (a -> b)
delayedHandler captures
caps body
body params
p req
query
    , ..
    }

emptyDelayed :: Monad m => RouteResult a -> Delayed m b req a
emptyDelayed :: RouteResult a -> Delayed m b req a
emptyDelayed response :: RouteResult a
response =
  let r :: DelayedM m req ()
r = () -> DelayedM m req ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  in (b -> DelayedM m req ())
-> DelayedM m req ()
-> DelayedM m req ()
-> (() -> () -> () -> req -> RouteResult a)
-> Delayed m b req a
forall env (m :: * -> *) req captures body params a.
(env -> DelayedM m req captures)
-> DelayedM m req body
-> DelayedM m req params
-> (captures -> body -> params -> req -> RouteResult a)
-> Delayed m env req a
Delayed (DelayedM m req () -> b -> DelayedM m req ()
forall a b. a -> b -> a
const DelayedM m req ()
r) DelayedM m req ()
r DelayedM m req ()
r ((() -> () -> () -> req -> RouteResult a) -> Delayed m b req a)
-> (() -> () -> () -> req -> RouteResult a) -> Delayed m b req a
forall a b. (a -> b) -> a -> b
$ \_ _ _ _ -> RouteResult a
response

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