2018-06-29 21:08:26 +02:00
|
|
|
{-# LANGUAGE DataKinds #-}
|
2017-10-01 18:20:09 +02:00
|
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Servant.HoistSpec where
|
|
|
|
|
2018-06-29 21:08:26 +02:00
|
|
|
import Test.Hspec
|
|
|
|
(Spec)
|
2017-10-01 18:20:09 +02:00
|
|
|
|
2018-06-29 21:08:26 +02:00
|
|
|
import Servant
|
2017-10-01 18:20:09 +02:00
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- https://github.com/haskell-servant/servant/issues/734
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
-- This didn't fail if executed in GHCi; cannot have as a doctest.
|
|
|
|
|
|
|
|
newtype App a = App a
|
|
|
|
|
|
|
|
type API = Get '[JSON] Int
|
|
|
|
:<|> ReqBody '[JSON] String :> Get '[JSON] Bool
|
|
|
|
|
|
|
|
api :: Proxy API
|
|
|
|
api = Proxy
|
|
|
|
|
|
|
|
server :: App Int :<|> (String -> App Bool)
|
|
|
|
server = undefined
|
|
|
|
|
|
|
|
-- Natural transformation still seems to need an explicit type.
|
|
|
|
f :: App a -> App a
|
|
|
|
f = id
|
|
|
|
|
|
|
|
server' :: App Int :<|> (String -> App Bool)
|
|
|
|
server' = hoistServer api f server
|
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Spec
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
spec :: Spec
|
|
|
|
spec = return ()
|