Merge branch 'master' into servant-dates

servant-foreign/servant-foreign.cabal

@@ -11,7 +11,7 @@ description:
   <https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md CHANGELOG>
 license:             BSD3
 license-file:        LICENSE
-author:              Denis Redozubov
+author:              Denis Redozubov, Maksymilian Owsianny
 maintainer:          denis.redozubov@gmail.com
 copyright:           2015 Denis Redozubov, Alp Mestanogullari
 category:            Web
@@ -45,4 +45,4 @@ test-suite spec
   build-depends:     base
                    , hspec >= 2.1.8
                    , servant-foreign
-  default-language:  Haskell2010
+  default-language:  Haskell2010

servant-foreign/src/Servant/Foreign.hs

@@ -2,6 +2,7 @@
 -- arbitrary programming languages.
 module Servant.Foreign
   ( HasForeign(..)
+  , HasForeignType(..)
   , Segment(..)
   , SegmentType(..)
   , FunctionName
@@ -24,8 +25,12 @@ module Servant.Foreign
   , reqBody
   , reqHeaders
   , reqMethod
+  , reqReturnType
   , segment
   , queryStr
+  , listFromAPI
+  , GenerateList(..)
+  , NoTypes
   -- re-exports
   , module Servant.API
   ) where

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

@@ -45,7 +45,8 @@ camelCase = camelCase' . Prelude.map (replace "-" "")
         capitalize ""   = ""
         capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
 
-type Arg = Text
+type ForeignType = Text
+type Arg = (Text, ForeignType)
 
 newtype Segment = Segment { _segment :: SegmentType  }
   deriving (Eq, Show)
@@ -68,10 +69,10 @@ data QueryArg = QueryArg
   } deriving (Eq, Show)
 
 data HeaderArg = HeaderArg
-    { headerArgName :: Text
+    { headerArg :: Arg
     }
   | ReplaceHeaderArg
-    { headerArgName :: Text
+    { headerArg :: Arg
     , headerPattern :: Text
     } deriving (Eq, Show)
 
@@ -88,11 +89,12 @@ type FunctionName = [Text]
 type Method = Text
 
 data Req = Req
-  { _reqUrl     :: Url
+  { _reqUrl        :: Url
-  , _reqMethod  :: Method
+  , _reqMethod     :: Method
-  , _reqHeaders :: [HeaderArg]
+  , _reqHeaders    :: [HeaderArg]
-  , _reqBody    :: Bool
+  , _reqBody       :: Maybe ForeignType
-  , _funcName   :: FunctionName
+  , _reqReturnType :: ForeignType
+  , _funcName      :: FunctionName
   } deriving (Eq, Show)
 
 makeLenses ''QueryArg
@@ -109,7 +111,7 @@ captureArg (Segment (Cap s)) = s
 captureArg                 _ = error "captureArg called on non capture"
 
 defReq :: Req
-defReq = Req defUrl "GET" [] False []
+defReq = Req defUrl "GET" [] Nothing "" []
 
 -- | To be used exclusively as a "negative" return type/constraint
 -- by @'Elem`@ type family.
@@ -120,142 +122,228 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
   Elem a (a ': list) = ()
   Elem a (b ': list) = Elem a list
 
-class HasForeign (layout :: *) where
+-- | 'HasForeignType' maps Haskell types with types in the target
-  type Foreign layout :: *
+-- language of your backend. For example, let's say you're
-  foreignFor :: Proxy layout -> Req -> Foreign layout
+-- implementing a backend to some language __X__:
+--
+-- > -- First you need to create a dummy type to parametrize your
+-- > -- instances.
+-- > data LangX
+-- >
+-- > -- Otherwise you define instances for the types you need
+-- > instance HasForeignType LangX Int where
+-- >    typeFor _ _ = "intX"
+-- >
+-- > -- Or for example in case of lists
+-- > instance HasForeignType LangX a => HasForeignType LangX [a] where
+-- >    typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
+--
+-- Finally to generate list of information about all the endpoints for
+-- an API you create a function of a form:
+--
+-- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api))
+-- >              => Proxy api -> [Req]
+-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api
+--
+-- > -- If language __X__ is dynamically typed then you can use
+-- > -- a predefined NoTypes parameter
+-- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api))
+-- >              => Proxy api -> [Req]
+-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api
+-- >
+--
+class HasForeignType lang a where
+    typeFor :: Proxy lang -> Proxy a -> ForeignType
 
-instance (HasForeign a, HasForeign b)
+data NoTypes
-      => HasForeign (a :<|> b) where
+
+instance HasForeignType NoTypes a where
+    typeFor _ _ = empty
+
+class HasForeign lang (layout :: *) where
+  type Foreign layout :: *
+  foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
+
+instance (HasForeign lang a, HasForeign lang b)
+      => HasForeign lang (a :<|> b) where
   type Foreign (a :<|> b) = Foreign a :<|> Foreign b
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-         foreignFor (Proxy :: Proxy a) req
+         foreignFor lang (Proxy :: Proxy a) req
-    :<|> foreignFor (Proxy :: Proxy b) req
+    :<|> foreignFor lang (Proxy :: Proxy b) req
 
-instance (KnownSymbol sym, HasForeign sublayout)
+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
-      => HasForeign (Capture sym a :> sublayout) where
+      => HasForeign lang (Capture sym a :> sublayout) where
   type Foreign (Capture sym a :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.path <>~ [Segment (Cap str)]
+      req & reqUrl.path <>~ [Segment (Cap arg)]
           & funcName %~ (++ ["by", str])
 
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
+    where
+    str = pack . symbolVal $ (Proxy :: Proxy sym)
+    arg = (str, typeFor lang (Proxy :: Proxy a))
 
-instance Elem JSON list => HasForeign (Delete list a) where
+instance (Elem JSON list, HasForeignType lang a)
+      => HasForeign lang (Delete list a) where
   type Foreign (Delete list a) = Req
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    req & funcName  %~ ("delete" :)
+    req & funcName      %~ ("delete" :)
-        & reqMethod .~ "DELETE"
+        & reqMethod     .~ "DELETE"
+        & reqReturnType .~ retType
+    where
+    retType = typeFor lang (Proxy :: Proxy a)
 
-instance Elem JSON list => HasForeign (Get list a) where
+instance (Elem JSON list, HasForeignType lang a)
+      => HasForeign lang (Get list a) where
   type Foreign (Get list a) = Req
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
     req & funcName  %~ ("get" :)
         & reqMethod .~ "GET"
+        & reqReturnType .~ retType
+    where
+    retType = typeFor lang (Proxy :: Proxy a)
 
-instance (KnownSymbol sym, HasForeign sublayout)
+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
-      => HasForeign (Header sym a :> sublayout) where
+      => HasForeign lang (Header sym a :> sublayout) where
   type Foreign (Header sym a :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
+    foreignFor lang subP $ req
+        & reqHeaders <>~ [HeaderArg arg]
 
-    where hname = pack . symbolVal $ (Proxy :: Proxy sym)
+    where
-          subP = Proxy :: Proxy sublayout
+    hname = pack . symbolVal $ (Proxy :: Proxy sym)
+    arg = (hname, typeFor lang (Proxy :: Proxy a))
+    subP = Proxy :: Proxy sublayout
 
-instance Elem JSON list => HasForeign (Post list a) where
+instance (Elem JSON list, HasForeignType lang a)
+      => HasForeign lang (Post list a) where
   type Foreign (Post list a) = Req
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
     req & funcName  %~ ("post" :)
         & reqMethod .~ "POST"
+        & reqReturnType .~ retType
+    where
+    retType = typeFor lang (Proxy :: Proxy a)
 
-instance Elem JSON list => HasForeign (Put list a) where
+instance (Elem JSON list, HasForeignType lang a)
+      => HasForeign lang (Put list a) where
   type Foreign (Put list a) = Req
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
     req & funcName  %~ ("put" :)
         & reqMethod .~ "PUT"
+        & reqReturnType .~ retType
+    where
+    retType = typeFor lang (Proxy :: Proxy a)
 
-instance (KnownSymbol sym, HasForeign sublayout)
+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
-      => HasForeign (QueryParam sym a :> sublayout) where
+      => HasForeign lang (QueryParam sym a :> sublayout) where
   type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.queryStr <>~ [QueryArg str Normal]
+      req & reqUrl.queryStr <>~ [QueryArg arg Normal]
 
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
+    where
+    str = pack . symbolVal $ (Proxy :: Proxy sym)
+    arg = (str, typeFor lang (Proxy :: Proxy a))
 
-instance (KnownSymbol sym, HasForeign sublayout)
+instance (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
-      => HasForeign (QueryParams sym a :> sublayout) where
+      => HasForeign lang (QueryParams sym a :> sublayout) where
   type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.queryStr <>~ [QueryArg str List]
+      req & reqUrl.queryStr <>~ [QueryArg arg List]
 
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
+    where
+    str = pack . symbolVal $ (Proxy :: Proxy sym)
+    arg = (str, typeFor lang (Proxy :: Proxy [a]))
 
-instance (KnownSymbol sym, HasForeign sublayout)
+instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout)
-      => HasForeign (QueryFlag sym :> sublayout) where
+      => HasForeign lang (QueryFlag sym :> sublayout) where
   type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.queryStr <>~ [QueryArg str Flag]
+      req & reqUrl.queryStr <>~ [QueryArg arg Flag]
 
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
+    where
+    str = pack . symbolVal $ (Proxy :: Proxy sym)
+    arg = (str, typeFor lang (Proxy :: Proxy a))
 
-instance HasForeign Raw where
+instance HasForeign lang Raw where
   type Foreign Raw = Method -> Req
 
-  foreignFor Proxy req method =
+  foreignFor _ Proxy req method =
     req & funcName %~ ((toLower method) :)
         & reqMethod .~ method
 
-instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
+instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
+      => HasForeign lang (ReqBody list a :> sublayout) where
   type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqBody .~ True
+      req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
 
-instance (KnownSymbol path, HasForeign sublayout)
+instance (KnownSymbol path, HasForeign lang sublayout)
-      => HasForeign (path :> sublayout) where
+      => HasForeign lang (path :> sublayout) where
   type Foreign (path :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang (Proxy :: Proxy sublayout) $
       req & reqUrl.path <>~ [Segment (Static str)]
           & funcName %~ (++ [str])
 
-    where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
+    where
+    str = Data.Text.map (\c -> if c == '.' then '_' else c)
+        . pack . symbolVal $ (Proxy :: Proxy path)
 
-instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
+instance HasForeign lang sublayout => HasForeign lang (RemoteHost :> sublayout) where
   type Foreign (RemoteHost :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
+    foreignFor lang (Proxy :: Proxy sublayout) req
 
-instance HasForeign sublayout => HasForeign (IsSecure :> sublayout) where
+instance HasForeign lang sublayout => HasForeign lang (IsSecure :> sublayout) where
   type Foreign (IsSecure :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
+    foreignFor lang (Proxy :: Proxy sublayout) req
 
-instance HasForeign sublayout => HasForeign (Vault :> sublayout) where
+instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
   type Foreign (Vault :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
+    foreignFor lang (Proxy :: Proxy sublayout) req
 
-instance HasForeign sublayout => HasForeign (HttpVersion :> sublayout) where
+instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where
   type Foreign (HttpVersion :> sublayout) = Foreign sublayout
 
-  foreignFor Proxy req =
+  foreignFor lang Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
+    foreignFor lang (Proxy :: Proxy sublayout) req
+
+-- | Utility class used by 'listFromAPI' which computes
+--   the data needed to generate a function for each endpoint
+--   and hands it all back in a list.
+class GenerateList reqs where
+  generateList :: reqs -> [Req]
+
+instance GenerateList Req where
+  generateList r = [r]
+
+instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where
+  generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
+
+-- | Generate the necessary data for codegen as a list, each 'Req'
+--   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

@@ -1,17 +1,114 @@
 {-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE CPP                   #-}
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE OverlappingInstances  #-}
+#endif
 
 module Servant.ForeignSpec where
 
-import Servant.Foreign (camelCase)
+import Data.Monoid ((<>))
+import Data.Proxy
+import Servant.Foreign
+import Servant.Foreign.Internal
 
 import Test.Hspec
 
 spec :: Spec
 spec = describe "Servant.Foreign" $ do
   camelCaseSpec
+  listFromAPISpec
 
 camelCaseSpec :: Spec
 camelCaseSpec = describe "camelCase" $ do
   it "converts FunctionNames to camelCase" $ do
     camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
     camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
+
+----------------------------------------------------------------------
+
+data LangX
+
+instance HasForeignType LangX () where
+    typeFor _ _ = "voidX"
+instance HasForeignType LangX Int where
+    typeFor _ _ = "intX"
+instance HasForeignType LangX Bool where
+    typeFor _ _ = "boolX"
+instance {-# Overlapping #-} HasForeignType LangX String where
+    typeFor _ _ = "stringX"
+instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where
+    typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
+
+type TestApi
+    = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
+ :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] ()
+ :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
+ :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
+
+testApi :: [Req]
+testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
+
+listFromAPISpec :: Spec
+listFromAPISpec = describe "listFromAPI" $ do
+    it "generates 4 endpoints for TestApi" $ do
+        length testApi `shouldBe` 4
+
+    let [getReq, postReq, putReq, deleteReq] = testApi
+
+    it "collects all info for get request" $ do
+        shouldBe getReq $ defReq
+            { _reqUrl        = Url
+                [ Segment $ Static "test" ]
+                [ QueryArg ("flag", "boolX") Flag ]
+            , _reqMethod     = "GET"
+            , _reqHeaders    = [HeaderArg ("header", "listX of stringX")]
+            , _reqBody       = Nothing
+            , _reqReturnType = "intX"
+            , _funcName      = ["get", "test"]
+            }
+
+    it "collects all info for post request" $ do
+        shouldBe postReq $ defReq
+            { _reqUrl        = Url
+                [ Segment $ Static "test" ]
+                [ QueryArg ("param", "intX") Normal ]
+            , _reqMethod     = "POST"
+            , _reqHeaders    = []
+            , _reqBody       = Just "listX of stringX"
+            , _reqReturnType = "voidX"
+            , _funcName      = ["post", "test"]
+            }
+
+    it "collects all info for put request" $ do
+        shouldBe putReq $ defReq
+            { _reqUrl        = Url
+                [ Segment $ Static "test" ]
+                -- Shoud this be |intX| or |listX of intX| ?
+                [ QueryArg ("params", "listX of intX") List ]
+            , _reqMethod     = "PUT"
+            , _reqHeaders    = []
+            , _reqBody       = Just "stringX"
+            , _reqReturnType = "voidX"
+            , _funcName      = ["put", "test"]
+            }
+
+    it "collects all info for delete request" $ do
+        shouldBe deleteReq $ defReq
+            { _reqUrl        = Url
+                [ Segment $ Static "test"
+                , Segment $ Cap ("id", "intX") ]
+                []
+            , _reqMethod     = "DELETE"
+            , _reqHeaders    = []
+            , _reqBody       = Nothing
+            , _reqReturnType = "voidX"
+            , _funcName      = ["delete", "test", "by", "id"]
+            }
+

servant-js/servant-js.cabal

@@ -13,7 +13,7 @@ description:
   <https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>
 license:             BSD3
 license-file:        LICENSE
-author:              Alp Mestanogullari
+author:              Alp Mestanogullari, Maksymilian Owsianny
 maintainer:          alpmestan@gmail.com
 copyright:           2014 Alp Mestanogullari
 category:            Web

servant-js/src/Servant/JS.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeOperators     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Servant.JS
@@ -109,6 +110,7 @@ module Servant.JS
   , -- * Misc.
     listFromAPI
   , javascript
+  , NoTypes
   , GenerateList(..)
   ) where
 
@@ -121,46 +123,30 @@ import           Servant.JS.Axios
 import           Servant.JS.Internal
 import           Servant.JS.JQuery
 import           Servant.JS.Vanilla
+import           Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
 
 -- | Generate the data necessary to generate javascript code
 --   for all the endpoints of an API, as ':<|>'-separated values
 --   of type 'AjaxReq'.
-javascript :: HasForeign layout => Proxy layout -> Foreign layout
+javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
-javascript p = foreignFor p defReq
+javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
 
 -- | Directly generate all the javascript functions for your API
 --   from a 'Proxy' for your API type. You can then write it to
 --   a file or integrate it in a page, for example.
-jsForAPI :: (HasForeign api, GenerateList (Foreign api))
+jsForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
          => Proxy api -- ^ proxy for your API type
          -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
          -> Text                -- ^ a text that you can embed in your pages or write to a file
-jsForAPI p gen = gen (listFromAPI p)
+jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) p)
 
 -- | Directly generate all the javascript functions for your API
 --   from a 'Proxy' for your API type using the given generator
 --   and write the resulting code to a file at the given path.
-writeJSForAPI :: (HasForeign api, GenerateList (Foreign api))
+writeJSForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
               => Proxy api -- ^ proxy for your API type
               -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
               -> FilePath -- ^ path to the file you want to write the resulting javascript code into
               -> IO ()
 writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen)
 
--- | Utility class used by 'jsForAPI' which computes
---   the data needed to generate a function for each endpoint
---   and hands it all back in a list.
-class GenerateList reqs where
-  generateList :: reqs -> [AjaxReq]
-
-instance GenerateList AjaxReq where
-  generateList r = [r]
-
-instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where
-  generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
-
--- | Generate the necessary data for JS codegen as a list, each 'AjaxReq'
---   describing one endpoint from your API type.
-listFromAPI :: (HasForeign api, GenerateList (Foreign api)) => Proxy api -> [AjaxReq]
-listFromAPI p = generateList (javascript p)
-

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

@@ -2,6 +2,7 @@
 module Servant.JS.Angular where
 
 import           Control.Lens
+import           Data.Maybe (isJust)
 import           Data.Monoid
 import qualified Data.Text as T
 import           Data.Text (Text)
@@ -74,9 +75,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
   where argsStr = T.intercalate ", " args
         args = http
             ++ captures
-            ++ map (view argName) queryparams
+            ++ map (view $ argName._1) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
+            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
 
         -- If we want to generate Top Level Function, they must depend on
         -- the $http service, if we generate a service, the functions will
@@ -85,7 +86,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
                   0 -> ["$http"]
                   _ -> []
 
-        captures = map captureArg
+        captures = map (fst . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -93,12 +94,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>
 
         queryparams = req ^.. reqUrl.queryStr.traverse
 
-        body = if req ^. reqBody
+        body = if isJust (req ^. reqBody)
                  then [requestBody opts]
                  else []
 
         dataBody =
-          if req ^. reqBody
+          if isJust (req ^. reqBody)
             then "    , data: JSON.stringify(body)\n" <>
                  "    , contentType: 'application/json'\n"
             else ""
@@ -110,7 +111,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
 
           where headersStr = T.intercalate ", " $ map headerStr hs
                 headerStr header = "\"" <>
-                  headerArgName header <>
+                  fst (headerArg header) <>
                   "\": " <> toJSHeader header
 
         namespace =

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

@@ -2,6 +2,7 @@
 module Servant.JS.Axios where
 
 import           Control.Lens
+import           Data.Maybe (isJust)
 import           Data.Monoid
 import           Data.Text (Text)
 import qualified Data.Text as T
@@ -60,11 +61,11 @@ generateAxiosJSWith aopts opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view argName) queryparams
+            ++ map (view $ argName._1) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
+            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
 
-        captures = map captureArg
+        captures = map (fst . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -72,12 +73,12 @@ generateAxiosJSWith aopts opts req = "\n" <>
 
         queryparams = req ^.. reqUrl.queryStr.traverse
 
-        body = if req ^. reqBody
+        body = if isJust (req ^. reqBody)
                  then [requestBody opts]
                  else []
 
         dataBody =
-          if req ^. reqBody
+          if isJust (req ^. reqBody)
             then "    , data: body\n" <>
                  "    , responseType: 'json'\n"
             else ""
@@ -104,7 +105,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
 
           where headersStr = T.intercalate ", " $ map headerStr hs
                 headerStr header = "\"" <>
-                  headerArgName header <>
+                  fst (headerArg header) <>
                   "\": " <> toJSHeader header
 
         namespace =

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

@@ -18,6 +18,7 @@ module Servant.JS.Internal
   , defReq
   , reqHeaders
   , HasForeign(..)
+  , HasForeignType(..)
   , HeaderArg(..)
   , concatCase
   , snakeCase
@@ -31,7 +32,7 @@ module Servant.JS.Internal
   , Header
   ) where
 
-import           Control.Lens                  ((^.))
+import           Control.Lens                  ((^.), _1)
 import qualified Data.CharSet as Set
 import qualified Data.CharSet.Unicode.Category as Set
 import           Data.Monoid
@@ -115,7 +116,7 @@ toValidFunctionName t =
                     ]
 
 toJSHeader :: HeaderArg -> Text
-toJSHeader (HeaderArg n)          = toValidFunctionName ("header" <> n)
+toJSHeader (HeaderArg n)          = toValidFunctionName ("header" <> fst n)
 toJSHeader (ReplaceHeaderArg n p)
   | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
   | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@@ -123,8 +124,8 @@ toJSHeader (ReplaceHeaderArg n p)
                              <> "\""
   | otherwise         = p
   where
-    pv = toValidFunctionName ("header" <> n)
+    pv = toValidFunctionName ("header" <> fst n)
-    pn = "{" <> n <> "}"
+    pn = "{" <> fst n <> "}"
     rp = T.replace pn "" p
 
 jsSegments :: [Segment] -> Text
@@ -138,7 +139,7 @@ segmentToStr (Segment st) notTheEnd =
 
 segmentTypeToStr :: SegmentType -> Text
 segmentTypeToStr (Static s) = s
-segmentTypeToStr (Cap s)    = "' + encodeURIComponent(" <> s <> ") + '"
+segmentTypeToStr (Cap s)    = "' + encodeURIComponent(" <> fst s <> ") + '"
 
 jsGParams :: Text -> [QueryArg] -> Text
 jsGParams _ []     = ""
@@ -160,4 +161,4 @@ paramToStr qarg notTheEnd =
            <> "[]=' + encodeURIComponent("
            <> name
            <> if notTheEnd then ") + '" else ")"
-  where name = qarg ^. argName
+  where name = qarg ^. argName . _1

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

@@ -2,6 +2,7 @@
 module Servant.JS.JQuery where
 
 import           Control.Lens
+import           Data.Maybe (isJust)
 import           Data.Monoid
 import qualified Data.Text as T
 import           Data.Text (Text)
@@ -40,12 +41,12 @@ generateJQueryJSWith opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view argName) queryparams
+            ++ map (view $ argName._1) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
+            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
             ++ [onSuccess, onError]
 
-        captures = map captureArg
+        captures = map (fst . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -53,7 +54,7 @@ generateJQueryJSWith opts req = "\n" <>
 
         queryparams = req ^.. reqUrl.queryStr.traverse
 
-        body = if req ^. reqBody
+        body = if isJust (req ^. reqBody)
                  then [requestBody opts]
                  else []
 
@@ -61,7 +62,7 @@ generateJQueryJSWith opts req = "\n" <>
         onError = errorCallback opts
 
         dataBody =
-          if req ^. reqBody
+          if isJust $ req ^. reqBody
             then "    , data: JSON.stringify(body)\n" <>
                  "    , contentType: 'application/json'\n"
             else ""
@@ -73,7 +74,7 @@ generateJQueryJSWith opts req = "\n" <>
 
           where headersStr = T.intercalate ", " $ map headerStr hs
                 headerStr header = "\"" <>
-                  headerArgName header <>
+                  fst (headerArg header) <>
                   "\": " <> toJSHeader header
 
         namespace = if (moduleName opts) == ""

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

@@ -2,6 +2,7 @@
 module Servant.JS.Vanilla where
 
 import           Control.Lens
+import           Data.Maybe (isJust)
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Monoid
@@ -47,12 +48,12 @@ generateVanillaJSWith opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view argName) queryparams
+            ++ map (view $ argName._1) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
+            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
             ++ [onSuccess, onError]
 
-        captures = map captureArg
+        captures = map (fst . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -60,7 +61,7 @@ generateVanillaJSWith opts req = "\n" <>
 
         queryparams = req ^.. reqUrl.queryStr.traverse
 
-        body = if req ^. reqBody
+        body = if isJust(req ^. reqBody)
                  then [requestBody opts]
                  else []
 
@@ -68,7 +69,7 @@ generateVanillaJSWith opts req = "\n" <>
         onError = errorCallback opts
 
         dataBody =
-          if req ^. reqBody
+          if isJust (req ^. reqBody)
             then "JSON.stringify(body)\n"
             else "null"
 
@@ -80,7 +81,7 @@ generateVanillaJSWith opts req = "\n" <>
 
           where headersStr = T.intercalate "\n" $ map headerStr hs
                 headerStr header = "  xhr.setRequestHeader(\"" <>
-                  headerArgName header <>
+                  fst (headerArg header) <>
                   "\", " <> toJSHeader header <> ");"
 
         namespace = if moduleName opts == ""

servant-js/test/Servant/JSSpec.hs

@@ -98,16 +98,17 @@ a `shouldNotContain` b  = shouldNotSatisfy a (T.isInfixOf b)
 
 axiosSpec :: Spec
 axiosSpec = describe specLabel $ do
+    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
     it "should add withCredentials when needed" $ do
-        let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
+        let jsText = genJS withCredOpts $ reqList
         output jsText
         jsText `shouldContain` "withCredentials: true"
     it "should add xsrfCookieName when needed" $ do
-        let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
+        let jsText = genJS cookieOpts $ reqList
         output jsText
         jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")
     it "should add withCredentials when needed" $ do
-        let jsText = genJS headerOpts $ listFromAPI (Proxy :: Proxy TestAPI)
+        let jsText = genJS headerOpts $ reqList
         output jsText
         jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")
     where
@@ -121,18 +122,19 @@ axiosSpec = describe specLabel $ do
 
 angularSpec :: TestNames -> Spec
 angularSpec test = describe specLabel $ do
+    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
     it "should implement a service globally" $ do
-        let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
+        let jsText = genJS reqList
         output jsText
         jsText `shouldContain` (".service('" <> testName <> "'")
 
     it "should depend on $http service globally" $ do
-        let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
+        let jsText = genJS reqList
         output jsText
         jsText `shouldContain` ("('" <> testName <> "', function($http) {")
 
     it "should not depend on $http service in handlers" $ do
-        let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
+        let jsText = genJS reqList
         output jsText
         jsText `shouldNotContain` "getsomething($http, "
     where

servant-js/test/Servant/JSSpec/CustomHeaders.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Servant.JSSpec.CustomHeaders where
 
@@ -21,12 +22,12 @@ import           Servant.JS.Internal
 -- using -- Basic, Digest, whatever.
 data Authorization (sym :: Symbol) a
 
-instance (KnownSymbol sym, HasForeign sublayout)
+instance (KnownSymbol sym, HasForeign lang sublayout)
-    => HasForeign (Authorization sym a :> sublayout) where
+    => HasForeign lang (Authorization sym a :> sublayout) where
     type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
 
-    foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
-        req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
+        req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $
                                tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
       where
         tokenType t = t <> " {Authorization}"
@@ -34,23 +35,23 @@ instance (KnownSymbol sym, HasForeign sublayout)
 -- | This is a combinator that fetches an X-MyLovelyHorse header.
 data MyLovelyHorse a
 
-instance (HasForeign sublayout)
+instance (HasForeign lang sublayout)
-    => HasForeign (MyLovelyHorse a :> sublayout) where
+    => HasForeign lang (MyLovelyHorse a :> sublayout) where
     type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
 
-    foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
-        req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]
+        req & reqHeaders <>~ [ ReplaceHeaderArg ("X-MyLovelyHorse", "") tpl ]
       where
         tpl = "I am good friends with {X-MyLovelyHorse}"
 
 -- | This is a combinator that fetches an X-WhatsForDinner header.
 data WhatsForDinner a
 
-instance (HasForeign sublayout)
+instance (HasForeign lang sublayout)
-    => HasForeign (WhatsForDinner a :> sublayout) where
+    => HasForeign lang (WhatsForDinner a :> sublayout) where
     type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
 
-    foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
+    foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
-        req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ]
+        req & reqHeaders <>~ [ ReplaceHeaderArg ("X-WhatsForDinner", "") tpl ]
       where
         tpl = "I would like {X-WhatsForDinner} with a cherry on top."