{-# 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 ep handler =
    defEndpointCore (ep, step2)
    where
      step1 :: HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
      step1 = HV.uncurry handler

      step2 :: HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
      step2 p = HV.uncurry (step1 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 t =
    case t of
      (MethodGet path, handler) ->
          let pf :: HVect p -> ActionCtxT ctx m ()
              pf args =
                  do r <- handler args HNil
                     json r
          in get path (HV.curry pf)
      (MethodPost _ path, handler) ->
          let pf :: HVect p -> ActionCtxT ctx m ()
              pf args =
                  do req <- jsonBody'
                     r <- handler args (req :&: HNil)
                     json r
          in post path (HV.curry pf)
      (MethodPut _ path, handler) ->
          let pf :: HVect p -> ActionCtxT ctx m ()
              pf args =
                  do req <- jsonBody'
                     r <- handler args (req :&: HNil)
                     json r
          in put path (HV.curry pf)