git.iko.soy/typeable/servant-reflex
on master help sign in
Add QueryParam handling, and example usage
commit43ad24b74427dc5ccf191ec1ebb038c3534c29b8 authorGreg Hale <imalsogreg@gmail.com> dateSun 6 Mar 2016, 13:20 (11 years ago) parent851c1f2
4 files changed+35−12
compare with master
unifiedsplit
exec/API.hs+1 exec/Example.hs+11−1 src/Servant/Common/Req.hs+18−1 testserver/Main.hs+5−10
exec/API.hs+1
@@ -8,4 +8,5 @@ import Servant.API
88-- | API spec for server, client, and docs
99type API = "getunit" :> Get '[JSON] ()
1010 :<|> "getint" :> Get '[JSON] Int
11+ :<|> "sayhi" :> QueryParam "username" String :> Get '[JSON] String
1112 :<|> Raw
exec/Example.hs+11−1
@@ -3,6 +3,7 @@
33
44module Main where
55
6+import Data.Bool
67import Data.Maybe
78import Servant.API
89import Servant.Reflex
@@ -24,7 +25,7 @@ run :: forall t m. MonadWidget t m => m ()
2425run = do
2526
2627 -- Name the computed API client functions
27− let (getUnit :<|> getInt :<|> doRaw) =
28+ let (getUnit :<|> getInt :<|> sayhi :<|> doRaw) =
2829 client api (Proxy :: Proxy m) (constDyn url)
2930
3031 unitBtn <- button "Get unit"
@@ -41,6 +42,15 @@ run = do
4142 ]
4243 dynText r >> el "br" (return ()) >> text "Total: " >> display score
4344
45+ el "br" $ return ()
46+ text "Name"
47+ inp :: Dynamic t String <- fmap value (textInput def)
48+ let checkedinp = fmap (\i -> bool (Just i) Nothing (null i)) (current inp)
49+ sayhiClicks :: Event t () <- button "Say hi"
50+ resp <- fmap fst <$> sayhi checkedinp sayhiClicks
51+ el "br" $ return ()
52+ dynText =<< holdDyn "No hi yet" (fmapMaybe id resp)
53+
4454showXhrResponse :: XhrResponse -> String
4555showXhrResponse (XhrResponse stat stattxt rbmay rtmay) =
4656 unlines ["stat: " ++ show stat
src/Servant/Common/Req.hs+18−1
@@ -9,6 +9,7 @@ module Servant.Common.Req where
99-- import Control.Monad.Catch (MonadThrow)
1010-- import Control.Monad.IO.Class
1111-- import Control.Monad.Trans.Except
12+import Control.Applicative (liftA2)
1213import Data.ByteString.Char8 hiding (pack, filter, map, null, elem)
1314import qualified Data.ByteString.Lazy.Char8 as BL
1415import qualified Data.Text.Encoding as TE
@@ -96,10 +97,26 @@ performRequest :: forall t m.MonadWidget t m => String -> Req t -> Dynamic t Bas
9697 -- -> ExceptT ServantError IO ( Int, ByteString, MediaType
9798 -- , [HTTP.Header], Response ByteString)
9899performRequest reqMethod req _ trigger = do
100+
101+ -- Ridiculous functor-juggling! How to clean this up?
99102 let t :: Behavior t [Maybe String] = sequence $ reqPathParts req
100103 let urlParts :: Behavior t (Maybe [String]) = fmap sequence t
101104 let urlPath :: Behavior t (Maybe String) = (fmap.fmap) (L.intercalate "/") urlParts
102− xhrReq = (fmap . fmap) (\p -> XhrRequest reqMethod p def) urlPath
105+
106+ let oneNamedPair :: String -> [String] -> String
107+ oneNamedPair pName ps =
108+ L.intercalate "&" $ map (\p -> pName ++ "=" ++ p) ps
109+
110+ t' :: [Behavior t String]
111+ t' = map (\(pName, pVals) -> fmap (oneNamedPair pName) pVals)
112+ (qParams req)
113+
114+ queryString :: Behavior t String
115+ queryString = fmap (L.intercalate "&") (sequence t')
116+
117+ xhrUrl = (liftA2 . liftA2) (\u q -> u ++ '?' : q) urlPath (fmap Just queryString)
118+ xhrReq = (fmap . fmap) (\p -> XhrRequest reqMethod p def) xhrUrl
119+
103120 performRequestAsync (fmapMaybe id $ tag xhrReq trigger)
104121
105122-- TODO implement
testserver/Main.hs+5−10
@@ -41,15 +41,10 @@ data App = App
4141--
4242-- Each handler runs in the 'ExceptT ServantErr IO' monad.
4343server :: Server API (Handler App App)
44−server = return () :<|> return 100 :<|> serveDirectory "static"
45−
46− -- where helloH name Nothing = helloH name (Just False)
47− -- helloH name (Just False) = return . Greet $ "Hello, " <> name
48− -- helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
49−
50− -- postGreetH greet = return greet
51−
52− -- deleteGreetH _ = return ()
44+server = return () :<|> return 100 :<|> sayhi :<|> serveDirectory "static"
45+ where sayhi nm = case nm of
46+ Nothing -> return "Sorry, who are you?"
47+ Just n -> return $ "Hi, " <> n <> "!"
5348
5449-- Turn the server into a WAI app. 'serve' is provided by servant,
5550-- more precisely by the Servant.Server module.
@@ -59,7 +54,7 @@ test = serve testApi server
5954initApp :: SnapletInit App App
6055initApp = makeSnaplet "myapp" "example" Nothing $ do
6156 addRoutes [("", applicationToSnap test)
62− -- ,("", serveDirectory "static")
57+ ,("", serveDirectory "static")
6358 ]
6459 return App
6560