bd77b4a · typeable/servant

git.iko.soy/typeable/servant

Verb for -mock, -js and -foreign.

commitbd77b4acba4a81608827bad72ac70e93cb13271c authorJulian K. Arni <jkarni@gmail.com> dateWed 6 Jan 2016, 18:20 (11 years ago) parent208bcf5

8 files changed+38−74

compare with master

unifiedsplit

servant-foreign/servant-foreign.cabal+6−4 servant-foreign/src/Servant/Foreign/Internal.hs+18−48 servant-foreign/test/Servant/ForeignSpec.hs+4−5 servant-js/src/Servant/JS/Angular.hs+2−1 servant-js/src/Servant/JS/Axios.hs+2−1 servant-js/src/Servant/JS/JQuery.hs+2−1 servant-js/src/Servant/JS/Vanilla.hs+2−1 servant-mock/src/Servant/Mock.hs+2−13

servant-foreign/servant-foreign.cabal+6−4

@@ -27,10 +27,11 @@ source-repository head

2727

2828library

2929 exposed-modules: Servant.Foreign, Servant.Foreign.Internal

30− build-depends: base == 4.*

31− , lens == 4.*

32− , servant == 0.5.*

33− , text >= 1.2 && < 1.3

30+ build-depends: base == 4.*

31+ , lens == 4.*

32+ , servant == 0.5.*

33+ , text >= 1.2 && < 1.3

34+ , http-types

3435 hs-source-dirs: src

3536 default-language: Haskell2010

3637 ghc-options: -Wall

@@ -41,6 +42,7 @@ test-suite spec

4142 type: exitcode-stdio-1.0

4243 hs-source-dirs: test

4344 ghc-options: -Wall

45+ include-dirs: include

4446 main-is: Spec.hs

4547 other-modules:

4648 Servant.ForeignSpec

servant-foreign/src/Servant/Foreign/Internal.hs+18−48

@@ -13,18 +13,21 @@

1313{-# LANGUAGE TypeOperators #-}

1414{-# LANGUAGE UndecidableInstances #-}

1515{-# LANGUAGE OverloadedStrings #-}

16+{-# LANGUAGE PolyKinds #-}

1617

1718-- | Generalizes all the data needed to make code generation work with

1819-- arbitrary programming languages.

1920module Servant.Foreign.Internal where

2021

21−import Control.Lens (makeLenses, (%~), (&), (.~), (<>~))

22−import qualified Data.Char as C

22+import Control.Lens (makeLenses, (%~), (&), (.~), (<>~))

23+import qualified Data.Char as C

2324import Data.Proxy

2425import Data.Text

25−import GHC.Exts (Constraint)

26+import Data.Text.Encoding (decodeUtf8)

27+import GHC.Exts (Constraint)

2628import GHC.TypeLits

27−import Prelude hiding (concat)

29+import qualified Network.HTTP.Types as HTTP

30+import Prelude hiding (concat)

2831import Servant.API

2932

3033-- | Function name builder that simply concat each part together

@@ -86,11 +89,10 @@ defUrl :: Url

8689defUrl = Url [] []

8790

8891type FunctionName = [Text]

89−type Method = Text

9092

9193data Req = Req

9294 { _reqUrl :: Url

93− , _reqMethod :: Method

95+ , _reqMethod :: HTTP.Method

9496 , _reqHeaders :: [HeaderArg]

9597 , _reqBody :: Maybe ForeignType

9698 , _reqReturnType :: ForeignType

@@ -185,27 +187,18 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)

185187 str = pack . symbolVal $ (Proxy :: Proxy sym)

186188 arg = (str, typeFor lang (Proxy :: Proxy a))

187189

188−instance (Elem JSON list, HasForeignType lang a)

189− => HasForeign lang (Delete list a) where

190− type Foreign (Delete list a) = Req

190+instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)

191+ => HasForeign lang (Verb method status list a) where

192+ type Foreign (Verb method status list a) = Req

191193

192194 foreignFor lang Proxy req =

193− req & funcName %~ ("delete" :)

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"

195+ req & funcName %~ (methodLC :)

196+ & reqMethod .~ method

206197 & reqReturnType .~ retType

207198 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

209202

210203instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)

211204 => HasForeign lang (Header sym a :> sublayout) where

@@ -220,28 +213,6 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)

220213 arg = (hname, typeFor lang (Proxy :: Proxy a))

221214 subP = Proxy :: Proxy sublayout

222215

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−

245216instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)

246217 => HasForeign lang (QueryParam sym a :> sublayout) where

247218 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout

@@ -279,10 +250,10 @@ instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang subl

279250 arg = (str, typeFor lang (Proxy :: Proxy a))

280251

281252instance HasForeign lang Raw where

282− type Foreign Raw = Method -> Req

253+ type Foreign Raw = HTTP.Method -> Req

283254

284255 foreignFor _ Proxy req method =

285− req & funcName %~ ((toLower method) :)

256+ req & funcName %~ ((toLower $ decodeUtf8 method) :)

286257 & reqMethod .~ method

287258

288259instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)

@@ -346,4 +317,3 @@ instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> res

346317-- describing one endpoint from your API type.

347318listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]

348319listFromAPI lang p = generateList (foreignFor lang p defReq)

349−

servant-foreign/test/Servant/ForeignSpec.hs+4−5

@@ -7,9 +7,8 @@

77{-# LANGUAGE TypeSynonymInstances #-}

88{-# LANGUAGE ScopedTypeVariables #-}

99{-# LANGUAGE CPP #-}

10−#if __GLASGOW_HASKELL__ < 710

11−{-# LANGUAGE OverlappingInstances #-}

12−#endif

10+

11+#include "overlapping-compat.h"

1312

1413module Servant.ForeignSpec where

1514

@@ -41,9 +40,9 @@ instance HasForeignType LangX Int where

4140 typeFor _ _ = "intX"

4241instance HasForeignType LangX Bool where

4342 typeFor _ _ = "boolX"

44−instance {-# Overlapping #-} HasForeignType LangX String where

43+instance OVERLAPPING_ HasForeignType LangX String where

4544 typeFor _ _ = "stringX"

46−instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where

45+instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where

4746 typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)

4847

4948type TestApi

servant-js/src/Servant/JS/Angular.hs+2−1

@@ -6,6 +6,7 @@ import Data.Maybe (isJust)

66import Data.Monoid

77import qualified Data.Text as T

88import Data.Text (Text)

9+import Data.Text.Encoding (decodeUtf8)

910import Servant.Foreign

1011import Servant.JS.Internal

1112

@@ -68,7 +69,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>

6869 <> " { url: " <> url <> "\n"

6970 <> dataBody

7071 <> reqheaders

71− <> " , method: '" <> method <> "'\n"

72+ <> " , method: '" <> decodeUtf8 method <> "'\n"

7273 <> " });\n"

7374 <> "}\n"

7475

servant-js/src/Servant/JS/Axios.hs+2−1

@@ -5,6 +5,7 @@ import Control.Lens

55import Data.Maybe (isJust)

66import Data.Monoid

77import Data.Text (Text)

8+import Data.Text.Encoding (decodeUtf8)

89import qualified Data.Text as T

910import Servant.Foreign

1011import Servant.JS.Internal

@@ -117,7 +118,7 @@ generateAxiosJSWith aopts opts req = "\n" <>

117118

118119 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)

119120

120− method = T.toLower $ req ^. reqMethod

121+ method = T.toLower . decodeUtf8 $ req ^. reqMethod

121122 url = if url' == "'" then "'/'" else url'

122123 url' = "'"

123124 <> urlPrefix opts

servant-js/src/Servant/JS/JQuery.hs+2−1

@@ -6,6 +6,7 @@ import Data.Maybe (isJust)

66import Data.Monoid

77import qualified Data.Text as T

88import Data.Text (Text)

9+import Data.Text.Encoding (decodeUtf8)

910import Servant.Foreign

1011import Servant.JS.Internal

1112

@@ -35,7 +36,7 @@ generateJQueryJSWith opts req = "\n" <>

3536 <> dataBody

3637 <> reqheaders

3738 <> " , error: " <> onError <> "\n"

38− <> " , type: '" <> method <> "'\n"

39+ <> " , type: '" <> decodeUtf8 method <> "'\n"

3940 <> " });\n"

4041 <> "}\n"

4142

servant-js/src/Servant/JS/Vanilla.hs+2−1

@@ -4,6 +4,7 @@ module Servant.JS.Vanilla where

44import Control.Lens

55import Data.Maybe (isJust)

66import Data.Text (Text)

7+import Data.Text.Encoding (decodeUtf8)

78import qualified Data.Text as T

89import Data.Monoid

910import Servant.Foreign

@@ -31,7 +32,7 @@ generateVanillaJSWith opts req = "\n" <>

3132 fname <> " = function(" <> argsStr <> ")\n"

3233 <> "{\n"

3334 <> " var xhr = new XMLHttpRequest();\n"

34− <> " xhr.open('" <> method <> "', " <> url <> ", true);\n"

35+ <> " xhr.open('" <> decodeUtf8 method <> "', " <> url <> ", true);\n"

3536 <> reqheaders

3637 <> " xhr.setRequestHeader(\"Accept\",\"application/json\");\n"

3738 <> (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

139139instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where

140140 mock _ = \_ -> mock (Proxy :: Proxy rest)

141141

142−instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where

143− mock _ = mockArbitrary

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

142+instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)

143+ => HasMock (Verb method status ctypes a) where

155144 mock _ = mockArbitrary

156145

157146instance HasMock Raw where