From cda31614bfa6a65ad22d3f5f6bf0a9386d311bc5 Mon Sep 17 00:00:00 2001
From: Jonathan Lange <jml@mumak.net>
Date: Thu, 26 May 2016 20:51:28 +0100
Subject: [PATCH] servant-foreign support for CaptureAll

---
 .../src/Servant/Foreign/Internal.hs            | 15 +++++++++++++++
 servant-foreign/test/Servant/ForeignSpec.hs    | 18 ++++++++++++++++--
 2 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs
index 0e68cc6c..59d09436 100644
--- a/servant-foreign/src/Servant/Foreign/Internal.hs
+++ b/servant-foreign/src/Servant/Foreign/Internal.hs
@@ -211,6 +211,21 @@ instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype ap
         { _argName = PathSegment str
         , _argType = ftype }
 
+instance (KnownSymbol sym, HasForeignType lang ftype [t], HasForeign lang ftype sublayout)
+  => HasForeign lang ftype (CaptureAll sym t :> sublayout) where
+  type Foreign ftype (CaptureAll sym t :> sublayout) = Foreign ftype sublayout
+
+  foreignFor lang Proxy Proxy req =
+    foreignFor lang Proxy (Proxy :: Proxy sublayout) $
+      req & reqUrl . path <>~ [Segment (Cap arg)]
+          & reqFuncName . _FunctionName %~ (++ ["by", str])
+    where
+      str   = pack . symbolVal $ (Proxy :: Proxy sym)
+      ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [t])
+      arg   = Arg
+        { _argName = PathSegment str
+        , _argType = ftype }
+
 instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
   => HasForeign lang ftype (Verb method status list a) where
   type Foreign ftype (Verb method status list a) = Req ftype
diff --git a/servant-foreign/test/Servant/ForeignSpec.hs b/servant-foreign/test/Servant/ForeignSpec.hs
index 2df0c1ba..966861d5 100644
--- a/servant-foreign/test/Servant/ForeignSpec.hs
+++ b/servant-foreign/test/Servant/ForeignSpec.hs
@@ -46,6 +46,7 @@ type TestApi
  :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
  :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
  :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
+ :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]
 
 testApi :: [Req String]
 testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
@@ -53,9 +54,9 @@ testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: P
 listFromAPISpec :: Spec
 listFromAPISpec = describe "listFromAPI" $ do
   it "generates 4 endpoints for TestApi" $ do
-    length testApi `shouldBe` 4
+    length testApi `shouldBe` 5
 
-  let [getReq, postReq, putReq, deleteReq] = testApi
+  let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi
 
   it "collects all info for get request" $ do
     shouldBe getReq $ defReq
@@ -106,3 +107,16 @@ listFromAPISpec = describe "listFromAPI" $ do
       , _reqReturnType = Just "voidX"
       , _reqFuncName   = FunctionName ["delete", "test", "by", "id"]
       }
+
+  it "collects all info for capture all request" $ do
+    shouldBe captureAllReq $ defReq
+      { _reqUrl        = Url
+          [ Segment $ Static "test"
+          , Segment $ Cap (Arg "ids" "listX of intX") ]
+          []
+      , _reqMethod     = "GET"
+      , _reqHeaders    = []
+      , _reqBody       = Nothing
+      , _reqReturnType = Just "listX of intX"
+      , _reqFuncName   = FunctionName ["get", "test", "by", "ids"]
+      }