servant/servant-server/test/Servant/ArbitraryMonadServerSpec.hs
2017-04-28 14:31:57 +03:00

59 lines
1.8 KiB
Haskell

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module Servant.ArbitraryMonadServerSpec where
import qualified Control.Category as C
import Control.Monad.Reader
import Data.Functor.Identity
import Data.Proxy
import Servant.API
import Servant.Server
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Wai (get, matchStatus, post,
shouldRespondWith, with)
spec :: Spec
spec = describe "Arbitrary monad server" $ do
enterSpec
type ReaderAPI = "int" :> Get '[JSON] Int
:<|> "string" :> Post '[JSON] String
type IdentityAPI = "bool" :> Get '[JSON] Bool
type CombinedAPI = ReaderAPI :<|> IdentityAPI
readerAPI :: Proxy ReaderAPI
readerAPI = Proxy
combinedAPI :: Proxy CombinedAPI
combinedAPI = Proxy
readerServer' :: ServerT ReaderAPI (Reader String)
readerServer' = return 1797 :<|> ask
fReader :: Reader String :~> Handler
fReader = generalizeNat C.. (runReaderTNat "hi")
readerServer :: Server ReaderAPI
readerServer = enter fReader readerServer'
combinedReaderServer' :: ServerT CombinedAPI (Reader String)
combinedReaderServer' = readerServer' :<|> enter (generalizeNat :: Identity :~> Reader String) (return True)
combinedReaderServer :: Server CombinedAPI
combinedReaderServer = enter fReader combinedReaderServer'
enterSpec :: Spec
enterSpec = describe "Enter" $ do
with (return (serve readerAPI readerServer)) $ do
it "allows running arbitrary monads" $ do
get "int" `shouldRespondWith` "1797"
post "string" "3" `shouldRespondWith` "\"hi\""{ matchStatus = 200 }
with (return (serve combinedAPI combinedReaderServer)) $ do
it "allows combnation of enters" $ do
get "bool" `shouldRespondWith` "true"