Verb for -mock, -js and -foreign.

servant-foreign/servant-foreign.cabal

@@ -27,10 +27,11 @@ source-repository head
 
 library
   exposed-modules:     Servant.Foreign, Servant.Foreign.Internal
-  build-depends:       base    == 4.*
+  build-depends:       base       == 4.*
-                     , lens    == 4.*
+                     , lens       == 4.*
-                     , servant == 0.5.*
+                     , servant    == 0.5.*
-                     , text    >= 1.2  && < 1.3
+                     , text       >= 1.2  && < 1.3
+                     , http-types
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
@@ -41,6 +42,7 @@ test-suite spec
   type:              exitcode-stdio-1.0
   hs-source-dirs:    test
   ghc-options:       -Wall
+  include-dirs:      include
   main-is:           Spec.hs
   other-modules:
       Servant.ForeignSpec

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -13,18 +13,21 @@
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
 {-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE PolyKinds             #-}
 
 -- | Generalizes all the data needed to make code generation work with
 -- arbitrary programming languages.
 module Servant.Foreign.Internal where
 
-import           Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
+import           Control.Lens          (makeLenses, (%~), (&), (.~), (<>~))
-import qualified Data.Char    as C
+import qualified Data.Char             as C
 import           Data.Proxy
 import           Data.Text
-import           GHC.Exts     (Constraint)
+import           Data.Text.Encoding    (decodeUtf8)
+import           GHC.Exts              (Constraint)
 import           GHC.TypeLits
-import           Prelude      hiding (concat)
+import qualified Network.HTTP.Types    as HTTP
+import           Prelude               hiding (concat)
 import           Servant.API
 
 -- | Function name builder that simply concat each part together
@@ -86,11 +89,10 @@ defUrl :: Url
 defUrl = Url [] []
 
 type FunctionName = [Text]
-type Method = Text
 
 data Req = Req
   { _reqUrl        :: Url
-  , _reqMethod     :: Method
+  , _reqMethod     :: HTTP.Method
   , _reqHeaders    :: [HeaderArg]
   , _reqBody       :: Maybe ForeignType
   , _reqReturnType :: ForeignType
@@ -185,27 +187,18 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
     str = pack . symbolVal $ (Proxy :: Proxy sym)
     arg = (str, typeFor lang (Proxy :: Proxy a))
 
-instance (Elem JSON list, HasForeignType lang a)
+instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
-      => HasForeign lang (Delete list a) where
+      => HasForeign lang (Verb method status list a) where
-  type Foreign (Delete list a) = Req
+  type Foreign (Verb method status list a) = Req
 
   foreignFor lang Proxy req =
-    req & funcName      %~ ("delete" :)
+    req & funcName  %~ (methodLC :)
-        & reqMethod     .~ "DELETE"
+        & reqMethod .~ method
         & reqReturnType .~ retType
     where
-    retType = typeFor lang (Proxy :: Proxy a)
+    retType  = typeFor lang (Proxy :: Proxy a)
-
+    method   = reflectMethod (Proxy :: Proxy method)
-instance (Elem JSON list, HasForeignType lang a)
+    methodLC = toLower $ decodeUtf8 method
-      => HasForeign lang (Get list a) where
-  type Foreign (Get list a) = Req
-
-  foreignFor lang Proxy req =
-    req & funcName  %~ ("get" :)
-        & reqMethod .~ "GET"
-        & reqReturnType .~ retType
-    where
-    retType = typeFor lang (Proxy :: Proxy a)
 
 instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
       => HasForeign lang (Header sym a :> sublayout) where
@@ -220,28 +213,6 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
     arg = (hname, typeFor lang (Proxy :: Proxy a))
     subP = Proxy :: Proxy sublayout
 
-instance (Elem JSON list, HasForeignType lang a)
-      => HasForeign lang (Post list a) where
-  type Foreign (Post list a) = Req
-
-  foreignFor lang Proxy req =
-    req & funcName  %~ ("post" :)
-        & reqMethod .~ "POST"
-        & reqReturnType .~ retType
-    where
-    retType = typeFor lang (Proxy :: Proxy a)
-
-instance (Elem JSON list, HasForeignType lang a)
-      => HasForeign lang (Put list a) where
-  type Foreign (Put list a) = Req
-
-  foreignFor lang Proxy req =
-    req & funcName  %~ ("put" :)
-        & reqMethod .~ "PUT"
-        & reqReturnType .~ retType
-    where
-    retType = typeFor lang (Proxy :: Proxy a)
-
 instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
       => HasForeign lang (QueryParam sym a :> sublayout) where
   type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
@@ -279,10 +250,10 @@ instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang subl
     arg = (str, typeFor lang (Proxy :: Proxy a))
 
 instance HasForeign lang Raw where
-  type Foreign Raw = Method -> Req
+  type Foreign Raw = HTTP.Method -> Req
 
   foreignFor _ Proxy req method =
-    req & funcName %~ ((toLower method) :)
+    req & funcName %~ ((toLower $ decodeUtf8 method) :)
         & reqMethod .~ method
 
 instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
@@ -346,4 +317,3 @@ instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> res
 --   describing one endpoint from your API type.
 listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]
 listFromAPI lang p = generateList (foreignFor lang p defReq)
-

servant-foreign/test/Servant/ForeignSpec.hs

@@ -7,9 +7,8 @@
 {-# LANGUAGE TypeSynonymInstances  #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE CPP                   #-}
-#if __GLASGOW_HASKELL__ < 710
+
-{-# LANGUAGE OverlappingInstances  #-}
+#include "overlapping-compat.h"
-#endif
 
 module Servant.ForeignSpec where
 
@@ -41,9 +40,9 @@ instance HasForeignType LangX Int where
     typeFor _ _ = "intX"
 instance HasForeignType LangX Bool where
     typeFor _ _ = "boolX"
-instance {-# Overlapping #-} HasForeignType LangX String where
+instance OVERLAPPING_ HasForeignType LangX String where
     typeFor _ _ = "stringX"
-instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where
+instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where
     typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
 
 type TestApi

servant-js/src/Servant/JS/Angular.hs

@@ -6,6 +6,7 @@ import           Data.Maybe (isJust)
 import           Data.Monoid
 import qualified Data.Text as T
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import           Servant.Foreign
 import           Servant.JS.Internal
 
@@ -68,7 +69,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
  <> "    { url: " <> url <> "\n"
  <> dataBody
  <> reqheaders
- <> "    , method: '" <> method <> "'\n"
+ <> "    , method: '" <> decodeUtf8 method <> "'\n"
  <> "    });\n"
  <> "}\n"
 

servant-js/src/Servant/JS/Axios.hs

@@ -5,6 +5,7 @@ import           Control.Lens
 import           Data.Maybe (isJust)
 import           Data.Monoid
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import qualified Data.Text as T
 import           Servant.Foreign
 import           Servant.JS.Internal
@@ -117,7 +118,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
 
         fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
 
-        method = T.toLower $ req ^. reqMethod
+        method = T.toLower . decodeUtf8 $ req ^. reqMethod
         url = if url' == "'" then "'/'" else url'
         url' = "'"
            <> urlPrefix opts

servant-js/src/Servant/JS/JQuery.hs

@@ -6,6 +6,7 @@ import           Data.Maybe (isJust)
 import           Data.Monoid
 import qualified Data.Text as T
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import           Servant.Foreign
 import           Servant.JS.Internal
 
@@ -35,7 +36,7 @@ generateJQueryJSWith opts req = "\n" <>
  <> dataBody
  <> reqheaders
  <> "    , error: " <> onError <> "\n"
- <> "    , type: '" <> method <> "'\n"
+ <> "    , type: '" <> decodeUtf8 method <> "'\n"
  <> "    });\n"
  <> "}\n"
 

servant-js/src/Servant/JS/Vanilla.hs

@@ -4,6 +4,7 @@ module Servant.JS.Vanilla where
 import           Control.Lens
 import           Data.Maybe (isJust)
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import qualified Data.Text as T
 import           Data.Monoid
 import           Servant.Foreign
@@ -31,7 +32,7 @@ generateVanillaJSWith opts req = "\n" <>
     fname <> " = function(" <> argsStr <> ")\n"
  <> "{\n"
  <> "  var xhr = new XMLHttpRequest();\n"
- <> "  xhr.open('" <> method <> "', " <> url <> ", true);\n"
+ <> "  xhr.open('" <> decodeUtf8 method <> "', " <> url <> ", true);\n"
  <>    reqheaders
  <> "  xhr.setRequestHeader(\"Accept\",\"application/json\");\n"
  <> (if isJust (req ^. reqBody) then "  xhr.setRequestHeader(\"Content-Type\",\"application/json\");\n" else "")

servant-mock/src/Servant/Mock.hs

@@ -139,19 +139,8 @@ instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
 instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
   mock _ = \_ -> mock (Proxy :: Proxy rest)
 
-instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where
+instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
-  mock _ = mockArbitrary
+    => HasMock (Verb method status ctypes a) where
-
-instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Get ctypes a) where
-  mock _ = mockArbitrary
-
-instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Patch ctypes a) where
-  mock _ = mockArbitrary
-
-instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Post ctypes a) where
-  mock _ = mockArbitrary
-
-instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Put ctypes a) where
   mock _ = mockArbitrary
 
 instance HasMock Raw where