servant/servant-foreign/test/Servant/ForeignSpec.hs

151 lines
5 KiB
Haskell
Raw Permalink Normal View History

2018-06-29 21:08:26 +02:00
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Servant.ForeignSpec where
2018-06-29 21:08:26 +02:00
import Data.Monoid
((<>))
import Data.Proxy
import Servant.Test.ComprehensiveAPI
2018-06-29 21:08:26 +02:00
import Servant.Foreign
import Servant.Types.SourceT
(SourceT)
2018-06-29 21:08:26 +02:00
import Test.Hspec
spec :: Spec
spec = describe "Servant.Foreign" $ do
camelCaseSpec
2015-12-02 13:28:04 +01:00
listFromAPISpec
camelCaseSpec :: Spec
camelCaseSpec = describe "camelCase" $ do
it "converts FunctionNames to camelCase" $ do
2016-02-17 22:47:30 +01:00
camelCase (FunctionName ["post", "counter", "inc"])
`shouldBe` "postCounterInc"
camelCase (FunctionName ["get", "hyphen-ated", "counter"])
`shouldBe` "getHyphen-atedCounter"
----------------------------------------------------------------------
-- This declaration simply checks that all instances are in place.
_ = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) comprehensiveAPIWithoutRaw
2015-12-02 13:28:04 +01:00
----------------------------------------------------------------------
data LangX
instance HasForeignType LangX String NoContent where
typeFor _ _ _ = "voidX"
instance HasForeignType LangX String (Headers ctyps NoContent) where
typeFor _ _ _ = "voidX"
instance HasForeignType LangX String Int where
typeFor _ _ _ = "intX"
instance HasForeignType LangX String (SourceT m a) where
typeFor _ _ _ = "streamTX"
instance HasForeignType LangX String Bool where
typeFor _ _ _ = "boolX"
2018-07-11 00:39:38 +02:00
instance {-# OVERLAPPING #-} HasForeignType LangX String String where
typeFor _ _ _ = "stringX"
2018-07-11 00:39:38 +02:00
instance {-# OVERLAPPABLE #-} HasForeignType LangX String a => HasForeignType LangX String [a] where
typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
2015-12-02 13:28:04 +01:00
instance (HasForeignType LangX String a) => HasForeignType LangX String (Maybe a) where
typeFor lang ftype _ = "maybe " <> typeFor lang ftype (Proxy :: Proxy a)
2015-12-02 13:28:04 +01:00
type TestApi
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
:<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
:<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
2016-05-26 21:51:28 +02:00
:<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]
:<|> "test" :> EmptyAPI
2015-12-02 13:28:04 +01:00
testApi :: [Req String]
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
2015-12-02 13:28:04 +01:00
listFromAPISpec :: Spec
listFromAPISpec = describe "listFromAPI" $ do
2017-05-16 12:31:02 +02:00
it "generates 5 endpoints for TestApi" $ do
2016-05-26 21:51:28 +02:00
length testApi `shouldBe` 5
2016-05-26 21:51:28 +02:00
let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi
it "collects all info for get request" $ do
shouldBe getReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test" ]
2016-02-17 22:47:30 +01:00
[ QueryArg (Arg "flag" "boolX") Flag ]
, _reqMethod = "GET"
, _reqHeaders = [HeaderArg $ Arg "header" "maybe listX of stringX"]
, _reqBody = Nothing
, _reqReturnType = Just "intX"
2016-02-17 22:47:30 +01:00
, _reqFuncName = FunctionName ["get", "test"]
}
it "collects all info for post request" $ do
shouldBe postReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test" ]
[ QueryArg (Arg "param" "maybe intX") Normal ]
, _reqMethod = "POST"
, _reqHeaders = []
, _reqBody = Just "listX of stringX"
, _reqReturnType = Just "voidX"
2016-02-17 22:47:30 +01:00
, _reqFuncName = FunctionName ["post", "test"]
}
it "collects all info for put request" $ do
shouldBe putReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test" ]
-- Should this be |intX| or |listX of intX| ?
2016-02-17 22:47:30 +01:00
[ QueryArg (Arg "params" "listX of intX") List ]
, _reqMethod = "PUT"
, _reqHeaders = []
, _reqBody = Just "stringX"
, _reqReturnType = Just "voidX"
2016-02-17 22:47:30 +01:00
, _reqFuncName = FunctionName ["put", "test"]
}
it "collects all info for delete request" $ do
shouldBe deleteReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test"
2016-02-17 22:47:30 +01:00
, Segment $ Cap (Arg "id" "intX") ]
[]
, _reqMethod = "DELETE"
, _reqHeaders = []
, _reqBody = Nothing
, _reqReturnType = Just "voidX"
2016-02-17 22:47:30 +01:00
, _reqFuncName = FunctionName ["delete", "test", "by", "id"]
}
2016-05-26 21:51:28 +02:00
it "collects all info for capture all request" $ do
shouldBe captureAllReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test"
, Segment $ Cap (Arg "ids" "listX of intX") ]
[]
, _reqMethod = "GET"
, _reqHeaders = []
, _reqBody = Nothing
, _reqReturnType = Just "listX of intX"
, _reqFuncName = FunctionName ["get", "test", "by", "ids"]
}