on master help sign in
Fix errors in test suite for servant-js.
0017957Arian van Putten
servant-js/test/Servant/JSSpec.hs+35−26
@@ -4,13 +4,17 @@
4{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
7+{-# LANGUAGE OverloadedStrings #-}
7{-# OPTIONS_GHC -fno-warn-orphans #-}
8{-# OPTIONS_GHC -fno-warn-orphans #-}
8module Servant.JSSpec where
9module Servant.JSSpec where
9
10
10import Data.Either (isRight)
11import Data.Either (isRight)
12+import Data.Monoid ((<>))
11import Data.Proxy
13import Data.Proxy
14+import Data.Text (Text)
15+import qualified Data.Text as T
12−import Language.ECMAScript3.Parser (parseFromString)
16+import Language.ECMAScript3.Parser (program, parse)
13−import Test.Hspec
17+import Test.Hspec hiding (shouldContain, shouldNotContain)
14
18
15import Servant.JS
19import Servant.JS
16import Servant.JS.Internal
20import Servant.JS.Internal
@@ -20,22 +24,22 @@ import qualified Servant.JS.JQuery as JQ
20import qualified Servant.JS.Vanilla as JS
24import qualified Servant.JS.Vanilla as JS
21import Servant.JSSpec.CustomHeaders
25import Servant.JSSpec.CustomHeaders
22
26
23−type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON] Bool
27+type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool
24 :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
28 :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
25
29
26type TopLevelRawAPI = "something" :> Get '[JSON] Int
30type TopLevelRawAPI = "something" :> Get '[JSON] Int
27 :<|> Raw
31 :<|> Raw
28
32
29−type HeaderHandlingAPI = "something" :> Header "Foo" String
33+type HeaderHandlingAPI = "something" :> Header "Foo" Text
30 :> Get '[JSON] Int
34 :> Get '[JSON] Int
31
35
32−type CustomAuthAPI = "something" :> Authorization "Basic" String
36+type CustomAuthAPI = "something" :> Authorization "Basic" Text
33 :> Get '[JSON] Int
37 :> Get '[JSON] Int
34
38
35−type CustomHeaderAPI = "something" :> MyLovelyHorse String
39+type CustomHeaderAPI = "something" :> MyLovelyHorse Text
36 :> Get '[JSON] Int
40 :> Get '[JSON] Int
37
41
38−type CustomHeaderAPI2 = "something" :> WhatsForDinner String
42+type CustomHeaderAPI2 = "something" :> WhatsForDinner Text
39 :> Get '[JSON] Int
43 :> Get '[JSON] Int
40
44
41headerHandlingProxy :: Proxy HeaderHandlingAPI
45headerHandlingProxy :: Proxy HeaderHandlingAPI
@@ -81,12 +85,16 @@ spec = describe "Servant.JQuery" $ do
81 axiosSpec
85 axiosSpec
82 --angularSpec AngularCustom
86 --angularSpec AngularCustom
83
87
88+
89+a `shouldContain` b = shouldSatisfy a (T.isInfixOf b)
90+a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
91+
84axiosSpec :: Spec
92axiosSpec :: Spec
85axiosSpec = describe specLabel $ do
93axiosSpec = describe specLabel $ do
86 it "should add withCredentials when needed" $ do
94 it "should add withCredentials when needed" $ do
87 let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
95 let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
88 output jsText
96 output jsText
89− jsText `shouldContain` ("withCredentials: true")
97+ jsText `shouldContain` "withCredentials: true"
90 it "should add xsrfCookieName when needed" $ do
98 it "should add xsrfCookieName when needed" $ do
91 let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
99 let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
92 output jsText
100 output jsText
@@ -101,79 +109,80 @@ axiosSpec = describe specLabel $ do
101 withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }
109 withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }
102 cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }
110 cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }
103 headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }
111 headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }
104− genJS :: AxiosOptions -> [AjaxReq] -> String
112+ genJS :: AxiosOptions -> [AjaxReq] -> Text
105− genJS opts req = concatMap (AX.generateAxiosJS opts) req
113+ genJS opts req = mconcat . map (AX.generateAxiosJS opts) $ req
106
114
107angularSpec :: TestNames -> Spec
115angularSpec :: TestNames -> Spec
108angularSpec test = describe specLabel $ do
116angularSpec test = describe specLabel $ do
109 it "should implement a service globally" $ do
117 it "should implement a service globally" $ do
110 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
118 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
111 output jsText
119 output jsText
112− jsText `shouldContain` (".service('" ++ testName ++ "'")
120+ jsText `shouldContain` (".service('" <> testName <> "'")
113
121
114 it "should depend on $http service globally" $ do
122 it "should depend on $http service globally" $ do
115 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
123 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
116 output jsText
124 output jsText
117− jsText `shouldContain` ("('" ++ testName ++ "', function($http) {")
125+ jsText `shouldContain` ("('" <> testName <> "', function($http) {")
118
126
119 it "should not depend on $http service in handlers" $ do
127 it "should not depend on $http service in handlers" $ do
120 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
128 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
121 output jsText
129 output jsText
122 jsText `shouldNotContain` "getsomething($http, "
130 jsText `shouldNotContain` "getsomething($http, "
123 where
131 where
124− specLabel = "AngularJS(" ++ (show test) ++ ")"
132+ specLabel = "AngularJS(" <> (show test) <> ")"
125 output _ = return ()
133 output _ = return ()
126 testName = "MyService"
134 testName = "MyService"
127 ngOpts = NG.defAngularOptions { NG.serviceName = testName }
135 ngOpts = NG.defAngularOptions { NG.serviceName = testName }
128 genJS req = NG.angularService ngOpts req
136 genJS req = NG.angularService ngOpts req
129
137
138+parseFromText = parse program ""
130−generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec
139+generateJSSpec :: TestNames -> (AjaxReq -> Text) -> Spec
131generateJSSpec n gen = describe specLabel $ do
140generateJSSpec n gen = describe specLabel $ do
132 it "should generate valid javascript" $ do
141 it "should generate valid javascript" $ do
133− let s = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen)
142+ let s = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)
134− parseFromString s `shouldSatisfy` isRight
143+ parseFromText s `shouldSatisfy` isRight
135
144
136 it "should use non-empty function names" $ do
145 it "should use non-empty function names" $ do
137 let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI)
146 let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI)
138 output $ genJS (topLevel "GET")
147 output $ genJS (topLevel "GET")
139− parseFromString (genJS $ topLevel "GET") `shouldSatisfy` isRight
148+ parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight
140
149
141 it "should handle simple HTTP headers" $ do
150 it "should handle simple HTTP headers" $ do
142 let jsText = genJS $ javascript headerHandlingProxy
151 let jsText = genJS $ javascript headerHandlingProxy
143 output jsText
152 output jsText
144− parseFromString jsText `shouldSatisfy` isRight
153+ parseFromText jsText `shouldSatisfy` isRight
145 jsText `shouldContain` "headerFoo"
154 jsText `shouldContain` "headerFoo"
146 jsText `shouldContain` (header n "Foo" $ "headerFoo")
155 jsText `shouldContain` (header n "Foo" $ "headerFoo")
147
156
148 it "should handle complex HTTP headers" $ do
157 it "should handle complex HTTP headers" $ do
149 let jsText = genJS $ javascript customAuthProxy
158 let jsText = genJS $ javascript customAuthProxy
150 output jsText
159 output jsText
151− parseFromString jsText `shouldSatisfy` isRight
160+ parseFromText jsText `shouldSatisfy` isRight
152 jsText `shouldContain` "headerAuthorization"
161 jsText `shouldContain` "headerAuthorization"
153 jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization")
162 jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization")
154
163
155 it "should handle complex, custom HTTP headers" $ do
164 it "should handle complex, custom HTTP headers" $ do
156 let jsText = genJS $ javascript customHeaderProxy
165 let jsText = genJS $ javascript customHeaderProxy
157 output jsText
166 output jsText
158− parseFromString jsText `shouldSatisfy` isRight
167+ parseFromText jsText `shouldSatisfy` isRight
159 jsText `shouldContain` "headerXMyLovelyHorse"
168 jsText `shouldContain` "headerXMyLovelyHorse"
160 jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse")
169 jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse")
161
170
162 it "should handle complex, custom HTTP headers (template replacement)" $ do
171 it "should handle complex, custom HTTP headers (template replacement)" $ do
163 let jsText = genJS $ javascript customHeaderProxy2
172 let jsText = genJS $ javascript customHeaderProxy2
164 output jsText
173 output jsText
165− parseFromString jsText `shouldSatisfy` isRight
174+ parseFromText jsText `shouldSatisfy` isRight
166 jsText `shouldContain` "headerXWhatsForDinner"
175 jsText `shouldContain` "headerXWhatsForDinner"
167 jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"")
176 jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"")
168
177
169 it "can generate the whole javascript code string at once with jsForAPI" $ do
178 it "can generate the whole javascript code string at once with jsForAPI" $ do
170 let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen)
179 let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen)
171− parseFromString jsStr `shouldSatisfy` isRight
180+ parseFromText jsStr `shouldSatisfy` isRight
172 where
181 where
173− specLabel = "generateJS(" ++ (show n) ++ ")"
182+ specLabel = "generateJS(" <> (show n) <> ")"
174 output _ = return ()
183 output _ = return ()
175 genJS req = gen req
184 genJS req = gen req
176− header :: TestNames -> String -> String -> String
185+ header :: TestNames -> Text -> Text -> Text
177 header v headerName headerValue
186 header v headerName headerValue
178− | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" ++ headerName ++ "\", " ++ headerValue ++ ");\n"
187+ | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n"
179− | otherwise = "headers: { \"" ++ headerName ++ "\": " ++ headerValue ++ " }\n"
188+ | otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n"
servant-js/test/Servant/JSSpec/CustomHeaders.hs+3−1
@@ -5,12 +5,14 @@
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8+{-# LANGUAGE OverloadedStrings #-}
8
9
9module Servant.JSSpec.CustomHeaders where
10module Servant.JSSpec.CustomHeaders where
10
11
11import Control.Lens
12import Control.Lens
12import Data.Monoid
13import Data.Monoid
13import Data.Proxy
14import Data.Proxy
15+import Data.Text (pack)
14import GHC.TypeLits
16import GHC.TypeLits
15import Servant.JS.Internal
17import Servant.JS.Internal
16
18
@@ -25,7 +27,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
25
27
26 foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
28 foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
27 req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
29 req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
28− tokenType (symbolVal (Proxy :: Proxy sym)) ]
30+ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
29 where
31 where
30 tokenType t = t <> " {Authorization}"
32 tokenType t = t <> " {Authorization}"
31
33