2018-01-17 11:52:47 +01:00
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE PolyKinds #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
{-# LANGUAGE TypeOperators #-}
|
2016-01-06 18:20:20 +01:00
|
|
|
#include "overlapping-compat.h"
|
2015-11-04 12:16:14 +01:00
|
|
|
|
|
|
|
module Servant.ForeignSpec where
|
|
|
|
|
2015-12-02 13:28:04 +01:00
|
|
|
import Data.Monoid ((<>))
|
|
|
|
import Data.Proxy
|
|
|
|
import Servant.Foreign
|
2017-01-19 23:09:54 +01:00
|
|
|
import Servant.API.Internal.Test.ComprehensiveAPI
|
2015-11-04 12:16:14 +01:00
|
|
|
|
|
|
|
import Test.Hspec
|
|
|
|
|
2017-01-19 23:09:54 +01:00
|
|
|
|
2015-11-04 12:16:14 +01:00
|
|
|
spec :: Spec
|
|
|
|
spec = describe "Servant.Foreign" $ do
|
|
|
|
camelCaseSpec
|
2015-12-02 13:28:04 +01:00
|
|
|
listFromAPISpec
|
2015-11-04 12:16:14 +01:00
|
|
|
|
|
|
|
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"
|
2017-01-16 10:51:35 +01:00
|
|
|
camelCase (FunctionName ["get", "hyphen-ated", "counter"])
|
|
|
|
`shouldBe` "getHyphen-atedCounter"
|
|
|
|
|
2017-01-19 23:09:54 +01:00
|
|
|
----------------------------------------------------------------------
|
|
|
|
|
|
|
|
-- 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
|
|
|
|
|
2016-07-08 09:11:34 +02:00
|
|
|
instance HasForeignType LangX String NoContent where
|
2016-03-13 22:21:36 +01:00
|
|
|
typeFor _ _ _ = "voidX"
|
2016-02-11 11:41:34 +01:00
|
|
|
|
2017-01-19 23:09:54 +01:00
|
|
|
instance HasForeignType LangX String (Headers ctyps NoContent) where
|
|
|
|
typeFor _ _ _ = "voidX"
|
|
|
|
|
2016-03-13 22:21:36 +01:00
|
|
|
instance HasForeignType LangX String Int where
|
|
|
|
typeFor _ _ _ = "intX"
|
2016-02-11 11:41:34 +01:00
|
|
|
|
2016-03-13 22:21:36 +01:00
|
|
|
instance HasForeignType LangX String Bool where
|
|
|
|
typeFor _ _ _ = "boolX"
|
2016-02-11 11:41:34 +01:00
|
|
|
|
2016-03-13 22:21:36 +01:00
|
|
|
instance OVERLAPPING_ HasForeignType LangX String String where
|
|
|
|
typeFor _ _ _ = "stringX"
|
2016-02-11 11:41:34 +01:00
|
|
|
|
2016-03-13 22:21:36 +01: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
|
|
|
|
2017-11-27 00:23:55 +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
|
2016-07-08 09:11:34 +02:00
|
|
|
:<|> "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]
|
2017-05-16 12:31:33 +02:00
|
|
|
:<|> "test" :> EmptyAPI
|
2015-12-02 13:28:04 +01:00
|
|
|
|
2016-03-13 22:21:36 +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-02-11 11:41:34 +01:00
|
|
|
|
2016-05-26 21:51:28 +02:00
|
|
|
let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi
|
2016-02-11 11:41:34 +01:00
|
|
|
|
|
|
|
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 ]
|
2016-02-11 11:41:34 +01:00
|
|
|
, _reqMethod = "GET"
|
2017-11-27 00:23:55 +01:00
|
|
|
, _reqHeaders = [HeaderArg $ Arg "header" "maybe listX of stringX"]
|
2016-02-11 11:41:34 +01:00
|
|
|
, _reqBody = Nothing
|
2016-03-13 22:21:36 +01:00
|
|
|
, _reqReturnType = Just "intX"
|
2016-02-17 22:47:30 +01:00
|
|
|
, _reqFuncName = FunctionName ["get", "test"]
|
2016-02-11 11:41:34 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
it "collects all info for post request" $ do
|
|
|
|
shouldBe postReq $ defReq
|
|
|
|
{ _reqUrl = Url
|
|
|
|
[ Segment $ Static "test" ]
|
2016-02-17 22:47:30 +01:00
|
|
|
[ QueryArg (Arg "param" "intX") Normal ]
|
2016-02-11 11:41:34 +01:00
|
|
|
, _reqMethod = "POST"
|
|
|
|
, _reqHeaders = []
|
|
|
|
, _reqBody = Just "listX of stringX"
|
2016-03-13 22:21:36 +01:00
|
|
|
, _reqReturnType = Just "voidX"
|
2016-02-17 22:47:30 +01:00
|
|
|
, _reqFuncName = FunctionName ["post", "test"]
|
2016-02-11 11:41:34 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
it "collects all info for put request" $ do
|
|
|
|
shouldBe putReq $ defReq
|
|
|
|
{ _reqUrl = Url
|
|
|
|
[ Segment $ Static "test" ]
|
|
|
|
-- Shoud this be |intX| or |listX of intX| ?
|
2016-02-17 22:47:30 +01:00
|
|
|
[ QueryArg (Arg "params" "listX of intX") List ]
|
2016-02-11 11:41:34 +01:00
|
|
|
, _reqMethod = "PUT"
|
|
|
|
, _reqHeaders = []
|
|
|
|
, _reqBody = Just "stringX"
|
2016-03-13 22:21:36 +01:00
|
|
|
, _reqReturnType = Just "voidX"
|
2016-02-17 22:47:30 +01:00
|
|
|
, _reqFuncName = FunctionName ["put", "test"]
|
2016-02-11 11:41:34 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
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") ]
|
2016-02-11 11:41:34 +01:00
|
|
|
[]
|
|
|
|
, _reqMethod = "DELETE"
|
|
|
|
, _reqHeaders = []
|
|
|
|
, _reqBody = Nothing
|
2016-03-13 22:21:36 +01:00
|
|
|
, _reqReturnType = Just "voidX"
|
2016-02-17 22:47:30 +01:00
|
|
|
, _reqFuncName = FunctionName ["delete", "test", "by", "id"]
|
2016-02-11 11:41:34 +01:00
|
|
|
}
|
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"]
|
|
|
|
}
|