59 lines
1.9 KiB
Haskell
59 lines
1.9 KiB
Haskell
|
{-# LANGUAGE CPP #-}
|
||
|
|
{-# LANGUAGE ConstraintKinds #-}
|
||
|
|
{-# LANGUAGE DataKinds #-}
|
||
|
|
{-# LANGUAGE FlexibleContexts #-}
|
||
|
|
{-# LANGUAGE FlexibleInstances #-}
|
||
|
|
{-# LANGUAGE GADTs #-}
|
||
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||
|
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
{-# LANGUAGE PolyKinds #-}
|
||
|
|
{-# LANGUAGE RecordWildCards #-}
|
||
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||
|
|
{-# LANGUAGE TypeFamilies #-}
|
||
|
|
{-# LANGUAGE TypeOperators #-}
|
||
|
|
{-# LANGUAGE UndecidableInstances #-}
|
||
|
|
{-# OPTIONS_GHC -freduction-depth=100 #-}
|
||
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||
|
|
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
||
|
|
|
||
|
|
module Servant.HoistClientSpec (spec) where
|
||
|
|
|
||
|
|
import Prelude ()
|
||
|
|
import Prelude.Compat
|
||
|
|
|
||
|
|
import Data.Monoid ()
|
||
|
|
import Data.Proxy
|
||
|
|
import Test.Hspec
|
||
|
|
|
||
|
|
import Servant.API
|
||
|
|
((:<|>) ((:<|>)), (:>), Capture,
|
||
|
|
Get, JSON, Post)
|
||
|
|
import Servant.Client
|
||
|
|
import Servant.Server
|
||
|
|
import Servant.ClientTestUtils
|
||
|
|
|
||
|
|
|
||
|
|
spec :: Spec
|
||
|
|
spec = describe "Servant.HoistClientSpec" $ do
|
||
|
|
hoistClientSpec
|
||
|
|
|
||
|
|
type HoistClientAPI = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
|
||
|
|
|
||
|
|
hoistClientAPI :: Proxy HoistClientAPI
|
||
|
|
hoistClientAPI = Proxy
|
||
|
|
|
||
|
|
hoistClientServer :: Application -- implements HoistClientAPI
|
||
|
|
hoistClientServer = serve hoistClientAPI $ return 5 :<|> return
|
||
|
|
|
||
|
|
hoistClientSpec :: Spec
|
||
|
|
hoistClientSpec = beforeAll (startWaiApp hoistClientServer) $ afterAll endWaiApp $ do
|
||
|
|
describe "Servant.Client.hoistClient" $ do
|
||
|
|
it "allows us to GET/POST/... requests in IO instead of ClientM" $ \(_, baseUrl) -> do
|
||
|
|
let (getInt :<|> postInt)
|
||
|
|
= hoistClient hoistClientAPI
|
||
|
|
(fmap (either (error . show) id) . flip runClient baseUrl)
|
||
|
|
(client hoistClientAPI)
|
||
|
|
|
||
|
|
getInt `shouldReturn` 5
|
||
|
|
postInt 5 `shouldReturn` 5
|