git.iko.soy/typeable/servant
on master help sign in
Verb for -mock, -js and -foreign.
bd77b4aJulian K. Arni
servant-foreign/servant-foreign.cabal+6−4
compare with master
unifiedsplit
@@ -27,10 +27,11 @@ source-repository head
27
27
28library
28library
29 exposed-modules: Servant.Foreign, Servant.Foreign.Internal
29 exposed-modules: Servant.Foreign, Servant.Foreign.Internal
30− build-depends: base == 4.*
30+ build-depends: base == 4.*
31− , lens == 4.*
31+ , lens == 4.*
32− , servant == 0.5.*
32+ , servant == 0.5.*
33− , text >= 1.2 && < 1.3
33+ , text >= 1.2 && < 1.3
34+ , http-types
34 hs-source-dirs: src
35 hs-source-dirs: src
35 default-language: Haskell2010
36 default-language: Haskell2010
36 ghc-options: -Wall
37 ghc-options: -Wall
@@ -41,6 +42,7 @@ test-suite spec
41 type: exitcode-stdio-1.0
42 type: exitcode-stdio-1.0
42 hs-source-dirs: test
43 hs-source-dirs: test
43 ghc-options: -Wall
44 ghc-options: -Wall
45+ include-dirs: include
44 main-is: Spec.hs
46 main-is: Spec.hs
45 other-modules:
47 other-modules:
46 Servant.ForeignSpec
48 Servant.ForeignSpec
servant-foreign/src/Servant/Foreign/Internal.hs+18−48
@@ -13,18 +13,21 @@
13{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE UndecidableInstances #-}
14{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE OverloadedStrings #-}
15{-# LANGUAGE OverloadedStrings #-}
16+{-# LANGUAGE PolyKinds #-}
16
17
17-- | Generalizes all the data needed to make code generation work with
18-- | Generalizes all the data needed to make code generation work with
18-- arbitrary programming languages.
19-- arbitrary programming languages.
19module Servant.Foreign.Internal where
20module Servant.Foreign.Internal where
20
21
21−import Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
22+import Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
22−import qualified Data.Char as C
23+import qualified Data.Char as C
23import Data.Proxy
24import Data.Proxy
24import Data.Text
25import Data.Text
26+import Data.Text.Encoding (decodeUtf8)
25−import GHC.Exts (Constraint)
27+import GHC.Exts (Constraint)
26import GHC.TypeLits
28import GHC.TypeLits
29+import qualified Network.HTTP.Types as HTTP
27−import Prelude hiding (concat)
30+import Prelude hiding (concat)
28import Servant.API
31import Servant.API
29
32
30-- | Function name builder that simply concat each part together
33-- | Function name builder that simply concat each part together
@@ -86,11 +89,10 @@ defUrl :: Url
86defUrl = Url [] []
89defUrl = Url [] []
87
90
88type FunctionName = [Text]
91type FunctionName = [Text]
89−type Method = Text
90
92
91data Req = Req
93data Req = Req
92 { _reqUrl :: Url
94 { _reqUrl :: Url
93− , _reqMethod :: Method
95+ , _reqMethod :: HTTP.Method
94 , _reqHeaders :: [HeaderArg]
96 , _reqHeaders :: [HeaderArg]
95 , _reqBody :: Maybe ForeignType
97 , _reqBody :: Maybe ForeignType
96 , _reqReturnType :: ForeignType
98 , _reqReturnType :: ForeignType
@@ -185,27 +187,18 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
185 str = pack . symbolVal $ (Proxy :: Proxy sym)
187 str = pack . symbolVal $ (Proxy :: Proxy sym)
186 arg = (str, typeFor lang (Proxy :: Proxy a))
188 arg = (str, typeFor lang (Proxy :: Proxy a))
187
189
188−instance (Elem JSON list, HasForeignType lang a)
190+instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
189− => HasForeign lang (Delete list a) where
191+ => HasForeign lang (Verb method status list a) where
190− type Foreign (Delete list a) = Req
192+ type Foreign (Verb method status list a) = Req
191
193
192 foreignFor lang Proxy req =
194 foreignFor lang Proxy req =
193− req & funcName %~ ("delete" :)
195+ req & funcName %~ (methodLC :)
194− & reqMethod .~ "DELETE"
195− & reqReturnType .~ retType
196− where
197− retType = typeFor lang (Proxy :: Proxy a)
198−
199−instance (Elem JSON list, HasForeignType lang a)
200− => HasForeign lang (Get list a) where
201− type Foreign (Get list a) = Req
202−
203− foreignFor lang Proxy req =
204− req & funcName %~ ("get" :)
205− & reqMethod .~ "GET"
196+ & reqMethod .~ method
206 & reqReturnType .~ retType
197 & reqReturnType .~ retType
207 where
198 where
208− retType = typeFor lang (Proxy :: Proxy a)
199+ retType = typeFor lang (Proxy :: Proxy a)
200+ method = reflectMethod (Proxy :: Proxy method)
201+ methodLC = toLower $ decodeUtf8 method
209
202
210instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
203instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
211 => HasForeign lang (Header sym a :> sublayout) where
204 => HasForeign lang (Header sym a :> sublayout) where
@@ -220,28 +213,6 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
220 arg = (hname, typeFor lang (Proxy :: Proxy a))
213 arg = (hname, typeFor lang (Proxy :: Proxy a))
221 subP = Proxy :: Proxy sublayout
214 subP = Proxy :: Proxy sublayout
222
215
223−instance (Elem JSON list, HasForeignType lang a)
224− => HasForeign lang (Post list a) where
225− type Foreign (Post list a) = Req
226−
227− foreignFor lang Proxy req =
228− req & funcName %~ ("post" :)
229− & reqMethod .~ "POST"
230− & reqReturnType .~ retType
231− where
232− retType = typeFor lang (Proxy :: Proxy a)
233−
234−instance (Elem JSON list, HasForeignType lang a)
235− => HasForeign lang (Put list a) where
236− type Foreign (Put list a) = Req
237−
238− foreignFor lang Proxy req =
239− req & funcName %~ ("put" :)
240− & reqMethod .~ "PUT"
241− & reqReturnType .~ retType
242− where
243− retType = typeFor lang (Proxy :: Proxy a)
244−
245instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
216instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
246 => HasForeign lang (QueryParam sym a :> sublayout) where
217 => HasForeign lang (QueryParam sym a :> sublayout) where
247 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
218 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
@@ -279,10 +250,10 @@ instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang subl
279 arg = (str, typeFor lang (Proxy :: Proxy a))
250 arg = (str, typeFor lang (Proxy :: Proxy a))
280
251
281instance HasForeign lang Raw where
252instance HasForeign lang Raw where
282− type Foreign Raw = Method -> Req
253+ type Foreign Raw = HTTP.Method -> Req
283
254
284 foreignFor _ Proxy req method =
255 foreignFor _ Proxy req method =
285− req & funcName %~ ((toLower method) :)
256+ req & funcName %~ ((toLower $ decodeUtf8 method) :)
286 & reqMethod .~ method
257 & reqMethod .~ method
287
258
288instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
259instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
@@ -346,4 +317,3 @@ instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> res
346-- describing one endpoint from your API type.
317-- describing one endpoint from your API type.
347listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]
318listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]
348listFromAPI lang p = generateList (foreignFor lang p defReq)
319listFromAPI lang p = generateList (foreignFor lang p defReq)
349−
servant-foreign/test/Servant/ForeignSpec.hs+4−5
@@ -7,9 +7,8 @@
7{-# LANGUAGE TypeSynonymInstances #-}
7{-# LANGUAGE TypeSynonymInstances #-}
8{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE CPP #-}
9{-# LANGUAGE CPP #-}
10−#if __GLASGOW_HASKELL__ < 710
10+
11−{-# LANGUAGE OverlappingInstances #-}
11+#include "overlapping-compat.h"
12−#endif
13
12
14module Servant.ForeignSpec where
13module Servant.ForeignSpec where
15
14
@@ -41,9 +40,9 @@ instance HasForeignType LangX Int where
41 typeFor _ _ = "intX"
40 typeFor _ _ = "intX"
42instance HasForeignType LangX Bool where
41instance HasForeignType LangX Bool where
43 typeFor _ _ = "boolX"
42 typeFor _ _ = "boolX"
44−instance {-# Overlapping #-} HasForeignType LangX String where
43+instance OVERLAPPING_ HasForeignType LangX String where
45 typeFor _ _ = "stringX"
44 typeFor _ _ = "stringX"
46−instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where
45+instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where
47 typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
46 typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
48
47
49type TestApi
48type TestApi
servant-js/src/Servant/JS/Angular.hs+2−1
@@ -6,6 +6,7 @@ import Data.Maybe (isJust)
6import Data.Monoid
6import Data.Monoid
7import qualified Data.Text as T
7import qualified Data.Text as T
8import Data.Text (Text)
8import Data.Text (Text)
9+import Data.Text.Encoding (decodeUtf8)
9import Servant.Foreign
10import Servant.Foreign
10import Servant.JS.Internal
11import Servant.JS.Internal
11
12
@@ -68,7 +69,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
68 <> " { url: " <> url <> "\n"
69 <> " { url: " <> url <> "\n"
69 <> dataBody
70 <> dataBody
70 <> reqheaders
71 <> reqheaders
71− <> " , method: '" <> method <> "'\n"
72+ <> " , method: '" <> decodeUtf8 method <> "'\n"
72 <> " });\n"
73 <> " });\n"
73 <> "}\n"
74 <> "}\n"
74
75
servant-js/src/Servant/JS/Axios.hs+2−1
@@ -5,6 +5,7 @@ import Control.Lens
5import Data.Maybe (isJust)
5import Data.Maybe (isJust)
6import Data.Monoid
6import Data.Monoid
7import Data.Text (Text)
7import Data.Text (Text)
8+import Data.Text.Encoding (decodeUtf8)
8import qualified Data.Text as T
9import qualified Data.Text as T
9import Servant.Foreign
10import Servant.Foreign
10import Servant.JS.Internal
11import Servant.JS.Internal
@@ -117,7 +118,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
117
118
118 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
119 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
119
120
120− method = T.toLower $ req ^. reqMethod
121+ method = T.toLower . decodeUtf8 $ req ^. reqMethod
121 url = if url' == "'" then "'/'" else url'
122 url = if url' == "'" then "'/'" else url'
122 url' = "'"
123 url' = "'"
123 <> urlPrefix opts
124 <> urlPrefix opts
servant-js/src/Servant/JS/JQuery.hs+2−1
@@ -6,6 +6,7 @@ import Data.Maybe (isJust)
6import Data.Monoid
6import Data.Monoid
7import qualified Data.Text as T
7import qualified Data.Text as T
8import Data.Text (Text)
8import Data.Text (Text)
9+import Data.Text.Encoding (decodeUtf8)
9import Servant.Foreign
10import Servant.Foreign
10import Servant.JS.Internal
11import Servant.JS.Internal
11
12
@@ -35,7 +36,7 @@ generateJQueryJSWith opts req = "\n" <>
35 <> dataBody
36 <> dataBody
36 <> reqheaders
37 <> reqheaders
37 <> " , error: " <> onError <> "\n"
38 <> " , error: " <> onError <> "\n"
38− <> " , type: '" <> method <> "'\n"
39+ <> " , type: '" <> decodeUtf8 method <> "'\n"
39 <> " });\n"
40 <> " });\n"
40 <> "}\n"
41 <> "}\n"
41
42
servant-js/src/Servant/JS/Vanilla.hs+2−1
@@ -4,6 +4,7 @@ module Servant.JS.Vanilla where
4import Control.Lens
4import Control.Lens
5import Data.Maybe (isJust)
5import Data.Maybe (isJust)
6import Data.Text (Text)
6import Data.Text (Text)
7+import Data.Text.Encoding (decodeUtf8)
7import qualified Data.Text as T
8import qualified Data.Text as T
8import Data.Monoid
9import Data.Monoid
9import Servant.Foreign
10import Servant.Foreign
@@ -31,7 +32,7 @@ generateVanillaJSWith opts req = "\n" <>
31 fname <> " = function(" <> argsStr <> ")\n"
32 fname <> " = function(" <> argsStr <> ")\n"
32 <> "{\n"
33 <> "{\n"
33 <> " var xhr = new XMLHttpRequest();\n"
34 <> " var xhr = new XMLHttpRequest();\n"
34− <> " xhr.open('" <> method <> "', " <> url <> ", true);\n"
35+ <> " xhr.open('" <> decodeUtf8 method <> "', " <> url <> ", true);\n"
35 <> reqheaders
36 <> reqheaders
36 <> " xhr.setRequestHeader(\"Accept\",\"application/json\");\n"
37 <> " xhr.setRequestHeader(\"Accept\",\"application/json\");\n"
37 <> (if isJust (req ^. reqBody) then " xhr.setRequestHeader(\"Content-Type\",\"application/json\");\n" else "")
38 <> (if isJust (req ^. reqBody) then " xhr.setRequestHeader(\"Content-Type\",\"application/json\");\n" else "")
servant-mock/src/Servant/Mock.hs+2−13
@@ -139,19 +139,8 @@ instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
139instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
139instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
140 mock _ = \_ -> mock (Proxy :: Proxy rest)
140 mock _ = \_ -> mock (Proxy :: Proxy rest)
141
141
142−instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where
142+instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
143− mock _ = mockArbitrary
143+ => HasMock (Verb method status ctypes a) where
144−
145−instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Get ctypes a) where
146− mock _ = mockArbitrary
147−
148−instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Patch ctypes a) where
149− mock _ = mockArbitrary
150−
151−instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Post ctypes a) where
152− mock _ = mockArbitrary
153−
154−instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Put ctypes a) where
155 mock _ = mockArbitrary
144 mock _ = mockArbitrary
156
145
157instance HasMock Raw where
146instance HasMock Raw where