Add QueryParam handling, and example usage

exec/API.hs

@@ -8,4 +8,5 @@ import Servant.API
 -- | API spec for server, client, and docs
 type API = "getunit" :> Get '[JSON] ()
       :<|> "getint"  :> Get '[JSON] Int
+      :<|> "sayhi"   :> QueryParam "username" String :> Get '[JSON] String
       :<|> Raw

exec/Example.hs

@@ -3,6 +3,7 @@
 
 module Main where
 
+import Data.Bool
 import Data.Maybe
 import Servant.API
 import Servant.Reflex
@@ -24,7 +25,7 @@ run :: forall t m. MonadWidget t m => m ()
 run = do
 
   -- Name the computed API client functions
-  let (getUnit :<|> getInt :<|> doRaw) =
+  let (getUnit :<|> getInt :<|> sayhi :<|> doRaw) =
         client api (Proxy :: Proxy m) (constDyn url)
 
   unitBtn  <- button "Get unit"
@@ -41,6 +42,15 @@ run = do
                   ]
   dynText r >> el "br" (return ()) >> text "Total: " >> display score
 
+  el "br" $ return ()
+  text "Name"
+  inp :: Dynamic t String <- fmap value (textInput def)
+  let checkedinp = fmap (\i -> bool (Just i) Nothing (null i)) (current inp)
+  sayhiClicks :: Event t () <- button "Say hi"
+  resp <- fmap fst <$> sayhi checkedinp sayhiClicks
+  el "br" $ return ()
+  dynText =<< holdDyn "No hi yet" (fmapMaybe id resp)
+
 showXhrResponse :: XhrResponse -> String
 showXhrResponse (XhrResponse stat stattxt rbmay rtmay) =
   unlines ["stat: " ++ show stat

src/Servant/Common/Req.hs

@@ -9,6 +9,7 @@ module Servant.Common.Req where
 -- import Control.Monad.Catch (MonadThrow)
 -- import Control.Monad.IO.Class
 -- import Control.Monad.Trans.Except
+import Control.Applicative (liftA2)
 import Data.ByteString.Char8 hiding (pack, filter, map, null, elem)
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text.Encoding as TE
@@ -96,10 +97,26 @@ performRequest :: forall t m.MonadWidget t m => String -> Req t -> Dynamic t Bas
                -- -> ExceptT ServantError IO ( Int, ByteString, MediaType
                --                            , [HTTP.Header], Response ByteString)
 performRequest reqMethod req _ trigger = do
+
+  -- Ridiculous functor-juggling! How to clean this up?
   let t :: Behavior t [Maybe String] = sequence $ reqPathParts req
   let urlParts :: Behavior t (Maybe [String]) = fmap sequence t
   let urlPath :: Behavior t (Maybe String) = (fmap.fmap) (L.intercalate "/") urlParts
-      xhrReq  = (fmap . fmap) (\p -> XhrRequest reqMethod p def) urlPath
+
+  let oneNamedPair :: String -> [String] -> String
+      oneNamedPair pName ps =
+        L.intercalate "&" $ map (\p -> pName ++ "=" ++ p) ps
+
+      t' :: [Behavior t String]
+      t' = map (\(pName, pVals) -> fmap (oneNamedPair pName) pVals)
+            (qParams req)
+
+      queryString :: Behavior t String
+      queryString = fmap (L.intercalate "&") (sequence t')
+
+      xhrUrl = (liftA2 . liftA2) (\u q -> u ++ '?' : q) urlPath (fmap Just queryString)
+      xhrReq = (fmap . fmap) (\p -> XhrRequest reqMethod p def) xhrUrl
+
   performRequestAsync (fmapMaybe id $ tag xhrReq trigger)
 
 -- TODO implement

testserver/Main.hs

@@ -41,15 +41,10 @@ data App = App
 --
 -- Each handler runs in the 'ExceptT ServantErr IO' monad.
 server :: Server API (Handler App App)
-server = return () :<|> return 100 :<|> serveDirectory "static"
-
-  -- where helloH name Nothing = helloH name (Just False)
-  --       helloH name (Just False) = return . Greet $ "Hello, " <> name
-  --       helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
-
-  --       postGreetH greet = return greet
-
-  --       deleteGreetH _ = return ()
+server = return () :<|> return 100 :<|> sayhi :<|> serveDirectory "static"
+  where sayhi nm = case nm of
+          Nothing -> return "Sorry, who are you?"
+          Just n  -> return $ "Hi, " <> n <> "!"
 
 -- Turn the server into a WAI app. 'serve' is provided by servant,
 -- more precisely by the Servant.Server module.
@@ -59,7 +54,7 @@ test = serve testApi server
 initApp :: SnapletInit App App
 initApp = makeSnaplet "myapp" "example" Nothing $ do
   addRoutes [("", applicationToSnap test)
-            -- ,("",    serveDirectory "static")
+            ,("", serveDirectory "static")
             ]
   return App