From e23245c5bf2abddcd6041684614463a3820167c8 Mon Sep 17 00:00:00 2001
From: Nickolay Kudasov <nickolay.kudasov@gmail.com>
Date: Wed, 20 Jan 2016 19:49:54 +0300
Subject: [PATCH] Update servant-server with support for CaptureAll

---
 servant-server/src/Servant/Server/Internal.hs | 22 +++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index d1ea0673..68aea907 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -43,9 +43,10 @@ import           Network.Wai                (Application, Request, Response,
 import           Web.HttpApiData            (FromHttpApiData)
 import           Web.HttpApiData.Internal   (parseHeaderMaybe,
                                              parseQueryParamMaybe,
-                                             parseUrlPieceMaybe)
+                                             parseUrlPieceMaybe,
+                                             parseUrlPieces)
 
-import           Servant.API                 ((:<|>) (..), (:>), Capture,
+import           Servant.API                 ((:<|>) (..), (:>), Capture, CaptureAll,
                                               Verb, ReflectMethod(reflectMethod),
                                               IsSecure(..), Header,
                                               QueryFlag, QueryParam, QueryParams,
@@ -95,6 +96,9 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
 captured :: FromHttpApiData a => proxy (Capture sym a) -> Text -> Maybe a
 captured _ = parseUrlPieceMaybe
 
+capturedAll :: FromHttpApiData a => proxy (CaptureAll a) -> [Text] -> Maybe [a]
+capturedAll _ = either (const Nothing) Just . parseUrlPieces
+
 -- | If you use 'Capture' in one of the endpoints for your API,
 -- this automatically requires your server-side handler to be a function
 -- that takes an argument of the type specified by the 'Capture'.
@@ -128,6 +132,20 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
     where
       captureProxy = Proxy :: Proxy (Capture capture a)
 
+instance (FromHttpApiData a, HasServer sublayout)
+  => HasServer (CaptureAll a :> sublayout) where
+
+  type ServerT (CaptureAll a :> sublayout) m = [a] -> ServerT sublayout m
+
+  route _ d = WithRequest $ \request ->
+    let
+      subRequest = request { pathInfo = [] }
+      subRoute = route (Proxy :: Proxy sublayout) (addCapture d (return xs))
+      xs = case capturedAll (Proxy :: Proxy (CaptureAll a)) (pathInfo request) of
+              Nothing -> Fail err404
+              Just vs -> Route vs
+    in (subRequest, subRoute)
+
 allowedMethodHead :: Method -> Request -> Bool
 allowedMethodHead method request = method == methodGet && requestMethod request == methodHead