{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Web.Spock.Api.Server
    ( defEndpoint )
where

import Web.Spock.Api
import Web.Spock.Core

import Control.Monad.Trans
import Data.HVect
import qualified Data.HVect as HV

-- | Wire an 'Endpoint' defined using the @Spock-api@ package
defEndpoint ::
    forall p i o m ctx.
    (MonadIO m, HasRep p)
    => Endpoint p i o
    -> HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
    -> SpockCtxT ctx m ()
defEndpoint :: Endpoint p i o
-> HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
-> SpockCtxT ctx m ()
defEndpoint Endpoint p i o
ep HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
handler =
    (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
forall (p :: [*]) (i :: Maybe *) o (m :: * -> *) ctx.
(MonadIO m, HasRep p) =>
(Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
defEndpointCore (Endpoint p i o
ep, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
step2)
    where
      step1 :: HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
      step1 :: HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
step1 = HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
-> HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
forall (ts :: [*]) a. HVectElim ts a -> HVect ts -> a
HV.uncurry HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
handler

      step2 :: HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
      step2 :: HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
step2 HVect p
p = HVectElim (MaybeToList i) (ActionCtxT ctx m o)
-> HVect (MaybeToList i) -> ActionCtxT ctx m o
forall (ts :: [*]) a. HVectElim ts a -> HVect ts -> a
HV.uncurry (HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
step1 HVect p
p)

defEndpointCore ::
    forall p i o m ctx.
    (MonadIO m, HasRep p)
    => (Endpoint p i o, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
    -> SpockCtxT ctx m ()
defEndpointCore :: (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
defEndpointCore (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
t =
    case (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
t of
      (MethodGet Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
          let pf :: HVect p -> ActionCtxT ctx m ()
              pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args =
                  do o
r <- HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler HVect p
args HVect '[]
HVect (MaybeToList i)
HNil
                     o -> ActionCtxT ctx m ()
forall a (m :: * -> *) ctx b.
(ToJSON a, MonadIO m) =>
a -> ActionCtxT ctx m b
json o
r
          in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
get Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)
      (MethodPost Proxy (i1 -> o)
_ Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
          let pf :: HVect p -> ActionCtxT ctx m ()
              pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args =
                  do i1
req <- ActionCtxT ctx m i1
forall (m :: * -> *) a ctx.
(MonadIO m, FromJSON a) =>
ActionCtxT ctx m a
jsonBody'
                     o
r <- HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler HVect p
args (i1
req i1 -> HVect '[] -> HVect '[i1]
forall t (ts1 :: [*]). t -> HVect ts1 -> HVect (t : ts1)
:&: HVect '[]
HNil)
                     o -> ActionCtxT ctx m ()
forall a (m :: * -> *) ctx b.
(ToJSON a, MonadIO m) =>
a -> ActionCtxT ctx m b
json o
r
          in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
post Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)
      (MethodPut Proxy (i1 -> o)
_ Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
          let pf :: HVect p -> ActionCtxT ctx m ()
              pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args =
                  do i1
req <- ActionCtxT ctx m i1
forall (m :: * -> *) a ctx.
(MonadIO m, FromJSON a) =>
ActionCtxT ctx m a
jsonBody'
                     o
r <- HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler HVect p
args (i1
req i1 -> HVect '[] -> HVect '[i1]
forall t (ts1 :: [*]). t -> HVect ts1 -> HVect (t : ts1)
:&: HVect '[]
HNil)
                     o -> ActionCtxT ctx m ()
forall a (m :: * -> *) ctx b.
(ToJSON a, MonadIO m) =>
a -> ActionCtxT ctx m b
json o
r
          in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
put Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)