@@ -1,17 +1,110 @@
11{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TypeOperators #-}
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE FlexibleContexts #-}
6+{-# LANGUAGE FlexibleInstances #-}
7+{-# LANGUAGE TypeSynonymInstances #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
29
310module Servant.ForeignSpec where
411
5−import Servant.Foreign (camelCase)
12+import Data.Monoid ((<>))
13+import Data.Proxy
14+import Servant.Foreign
15+import Servant.Foreign.Internal
616
717import Test.Hspec
818
919spec :: Spec
1020spec = describe "Servant.Foreign" $ do
1121 camelCaseSpec
22+ listFromAPISpec
1223
1324camelCaseSpec :: Spec
1425camelCaseSpec = describe "camelCase" $ do
1526 it "converts FunctionNames to camelCase" $ do
1627 camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
1728 camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
29+
30+----------------------------------------------------------------------
31+
32+data LangX
33+
34+instance HasForeignType LangX () where
35+ typeFor _ _ = "voidX"
36+instance HasForeignType LangX Int where
37+ typeFor _ _ = "intX"
38+instance HasForeignType LangX Bool where
39+ typeFor _ _ = "boolX"
40+instance {-# Overlapping #-} HasForeignType LangX String where
41+ typeFor _ _ = "stringX"
42+instance {-# Overlapable #-} HasForeignType LangX a => HasForeignType LangX [a] where
43+ typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
44+
45+type TestApi
46+ = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
47+ :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] ()
48+ :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
49+ :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
50+
51+testApi :: [Req]
52+testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
53+
54+listFromAPISpec :: Spec
55+listFromAPISpec = describe "listFromAPI" $ do
56+ it "generates 4 endpoints for TestApi" $ do
57+ length testApi `shouldBe` 4
58+
59+ let [getReq, postReq, putReq, deleteReq] = testApi
60+
61+ it "collects all info for get request" $ do
62+ shouldBe getReq $ defReq
63+ { _reqUrl = Url
64+ [ Segment $ Static "test" ]
65+ [ QueryArg ("flag", "boolX") Flag ]
66+ , _reqMethod = "GET"
67+ , _reqHeaders = [HeaderArg ("header", "listX of stringX")]
68+ , _reqBody = Nothing
69+ , _reqReturnType = "intX"
70+ , _funcName = ["get", "test"]
71+ }
72+
73+ it "collects all info for post request" $ do
74+ shouldBe postReq $ defReq
75+ { _reqUrl = Url
76+ [ Segment $ Static "test" ]
77+ [ QueryArg ("param", "intX") Normal ]
78+ , _reqMethod = "POST"
79+ , _reqHeaders = []
80+ , _reqBody = Just "listX of stringX"
81+ , _reqReturnType = "voidX"
82+ , _funcName = ["post", "test"]
83+ }
84+
85+ it "collects all info for put request" $ do
86+ shouldBe putReq $ defReq
87+ { _reqUrl = Url
88+ [ Segment $ Static "test" ]
89+ -- Shoud this be |intX| or |listX of intX| ?
90+ [ QueryArg ("params", "listX of intX") List ]
91+ , _reqMethod = "PUT"
92+ , _reqHeaders = []
93+ , _reqBody = Just "stringX"
94+ , _reqReturnType = "voidX"
95+ , _funcName = ["put", "test"]
96+ }
97+
98+ it "collects all info for delete request" $ do
99+ shouldBe deleteReq $ defReq
100+ { _reqUrl = Url
101+ [ Segment $ Static "test"
102+ , Segment $ Cap ("id", "intX") ]
103+ []
104+ , _reqMethod = "DELETE"
105+ , _reqHeaders = []
106+ , _reqBody = Nothing
107+ , _reqReturnType = "voidX"
108+ , _funcName = ["delete", "test", "by", "id"]
109+ }
110+